commit 1bef01087a33f1be9dceadc0b455c310db639336 Author: Alexandre Date: Sun Oct 20 19:35:06 2024 +0200 Initial commit diff --git a/a.out b/a.out new file mode 100755 index 0000000..41c6c9c Binary files /dev/null and b/a.out differ diff --git a/compilation.sh b/compilation.sh new file mode 100644 index 0000000..8286cfa --- /dev/null +++ b/compilation.sh @@ -0,0 +1 @@ +ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics main.ml \ No newline at end of file diff --git a/main.cmi b/main.cmi new file mode 100644 index 0000000..6514211 Binary files /dev/null and b/main.cmi differ diff --git a/main.cmx b/main.cmx new file mode 100644 index 0000000..3345001 Binary files /dev/null and b/main.cmx differ diff --git a/main.ml b/main.ml new file mode 100644 index 0000000..3840a40 --- /dev/null +++ b/main.ml @@ -0,0 +1,305 @@ +open Graphics ;; + +Random.self_init () ;; + +(* use Ctrl+F with 'XXXXXX' to look for sections *) + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Types + Constants *) + +exception ReturnBool of bool ;; +exception ReturnInt of int ;; + +type pt_2d = { + mutable x : float ; + mutable y : float ; +} ;; + +type polygon = { + vertexes : pt_2d array ; + rgb : int ; + xmin : float ; + xmax : float ; + ymin : float ; + ymax : float ; + mutable restitution : float ; + score : int ; +} ;; + +type ball = { + radius : float ; + mass : float ; + rgb : int ; + xy : pt_2d ; + v : pt_2d ; + a : pt_2d ; + angv : pt_2d ; +} ;; + +let univ_dt = 0.05 ;; +let univ_friction = 0.8 ;; +let univ_g = 300.0 ;; +let pi = 3.14159265358979343 ;; + +let score = ref 0 ;; + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Arithmetical operations *) + +let rec ln10 n = match n with + | k when k < 0 -> failwith "Are you sure about that ?" + | k when k < 10 -> 0 + | k -> 1 + ln10 (k/10) ;; + +let convexf x y theta = + (1.0 -. theta) *. x +. theta *. y ;; + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Vectorial operations *) + +let vect_convexf (px : pt_2d) (py : pt_2d) theta = + { + x = convexf px.x py.x theta ; + y = convexf px.y py.y theta ; + } ;; + + +let vect_sum_2D (p1 : pt_2d) (p2 : pt_2d) = + { + x = p1.x +. p2.x ; + y = p1.y +. p2.y ; + } ;; + +let vect_diff_2D (p1 : pt_2d) (p2 : pt_2d) = + { + x = p1.x -. p2.x ; + y = p1.y -. p2.y ; + } ;; + +let vect_mult_2D (p1 : pt_2d) (lambda : float) = + { + x = p1.x *. lambda ; + y = p1.y *. lambda ; + } ;; + +let vect_midpoint_2D (p1 : pt_2d) (p2 : pt_2d) = + { + x = (p1.x +. p2.x) /. 2.0 ; + y = (p1.y +. p2.y) /. 2.0 ; + } ;; + +let vect_normal_2D (p1 : pt_2d) (p2 : pt_2d) = + { + x = -. (p2.y -. p1.y) ; + y = (p2.x -. p1.x) ; + } ;; + +let vect_dot_product_2D (p1 : pt_2d) (p2 : pt_2d) = + p1.x *. p2.x +. p1.y *. p2.y ;; + +let vect_norm_2D (p1 : pt_2d) = + Float.sqrt (vect_dot_product_2D p1 p1) ;; + +let vect_dist_2D (p1 : pt_2d) (p2 : pt_2d) = + vect_norm_2D (vect_diff_2D p1 p2) ;; + +let vect_scale_2D (v1 : pt_2d) (v2 : pt_2d) = + vect_mult_2D v1 ((vect_norm_2D v2) /. (vect_norm_2D v1)) ;; + +let vect_normalize_2D (v1 : pt_2d) = + vect_mult_2D v1 (1.0 /. (vect_norm_2D v1)) ;; + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Physics functions *) + +let step_one_ball (b : ball) (dt : float) = + { + x = b.xy.x +. b.v.x *. dt ; + y = b.xy.y +. b.v.y *. dt ; + } ;; + +let is_in_bounding_box (b : ball) (poly : polygon) = + (b.xy.x +. b.radius >= poly.xmin) && (b.xy.x -. b.radius <= poly.xmax) && + (b.xy.y +. b.radius >= poly.ymin) && (b.xy.y -. b.radius <= poly.ymax) ;; + +let distance_line_segment (m : pt_2d) (spt : pt_2d) (ept : pt_2d) = + match (-. ((ept.x -. spt.x) *. (spt.x -. m.x) +. (ept.y -. spt.y) *. (spt.y -. m.y)) /. ((ept.x -. spt.x) *. (ept.x -. spt.x) +. (ept.y -. spt.y) *. (ept.y -. spt.y))) with + | k when k >= 0. && k <= 1. -> vect_dist_2D (vect_convexf spt ept k) m + | k when k < 0. -> vect_dist_2D spt m + | k -> vect_dist_2D ept m ;; + +let return_proj_of_point (m : pt_2d) (spt : pt_2d) (ept : pt_2d) = + match (-. ((ept.x -. spt.x) *. (spt.x -. m.x) +. (ept.y -. spt.y) *. (spt.y -. m.y)) /. ((ept.x -. spt.x) *. (ept.x -. spt.x) +. (ept.y -. spt.y) *. (ept.y -. spt.y))) with + | k when k >= 0. && k <= 1. -> (vect_convexf spt ept k) + | k when k < 0. -> spt + | k -> ept;; + +let is_collision (b : ball) (poly : polygon) (dt : float) = + (* returns the 1st point of the line that the ball collides with *) + if not (is_in_bounding_box b poly) then + (-1) + else begin + try + for i = 0 to Array.length poly.vertexes - 1 do + if (distance_line_segment (step_one_ball b dt) poly.vertexes.(i) poly.vertexes.((i+1) mod Array.length poly.vertexes)) <= b.radius then + raise (ReturnInt i) + done; + (-1) + with + | ReturnInt b -> b + end ;; + +let update_ball_data (b : ball) (polys : polygon array) (dt : float) = + let add = ref true in + + for p = 0 to (Array.length polys -1) do + let hit = (is_collision b polys.(p) dt) in + if !add && hit <> -1 then begin + add := false; + score := !score + polys.(p).score ; + + (* apply normal reaction force *) + b.v.x <- b.v.x -. b.a.x *. dt ; + b.v.y <- b.v.y -. b.a.y *. dt ; + + let hit2 = (hit +1) mod (Array.length polys.(p).vertexes) in + let proj = return_proj_of_point b.xy polys.(p).vertexes.(hit) polys.(p).vertexes.(hit2) in + + let nv = vect_norm_2D b.v in + + let reaction_force = vect_mult_2D (vect_normalize_2D (vect_diff_2D b.xy proj)) nv in + + b.v.x <- ((reaction_force.x *. polys.(p).restitution)) ; + b.v.y <- ((reaction_force.y *. polys.(p).restitution)) ; + + (* apply friction/rotational force *) + end + done ; + + b.xy.x <- b.xy.x +. b.v.x *. dt ; + b.xy.y <- b.xy.y +. b.v.y *. dt ; + + b.v.x <- b.v.x +. b.a.x *. dt ; + b.v.y <- b.v.y +. b.a.y *. dt ; + + b.a.y <- -. univ_g ;; + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Graphics fcts *) + +let draw_integer x0 y n0 r = + (* 7-seg display *) + let n = ref n0 in + let size = ln10 n0 in + let len = r/3 in + let offset = size*(len*11/7)/2 in + for i = 0 to size do + let x = x0 + offset - i*(len*11/7) in + if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then + draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|]; + + if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then + draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|]; + + if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then + draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|]; + + if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then + draw_poly_line [|(x-len/2, y); (x+len/2, y)|]; + + if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then + draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|]; + + if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then + draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|]; + + if Array.mem (!n mod 10) [|0; 2; 6; 8|] then + draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|]; + + n := !n/10; + done ;; + +let draw_polygon (poly : polygon) = + set_color (rgb (poly.rgb mod 256) ((poly.rgb / 256) mod 256) ((poly.rgb / (256*256)) mod 256)) ; + fill_poly (Array.init (Array.length poly.vertexes) (fun i -> (int_of_float poly.vertexes.(i).x, int_of_float poly.vertexes.(i).y))) ;; + +let draw_ball (b : ball) = + set_color (rgb (b.rgb mod 256) ((b.rgb / 256) mod 256) ((b.rgb / (256*256)) mod 256)) ; + fill_circle (int_of_float b.xy.x) (int_of_float b.xy.y) (int_of_float b.radius) ; + set_line_width 4 ; + draw_circle (int_of_float b.xy.x) (int_of_float b.xy.y) (int_of_float b.radius) ;; + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Misc fcts *) + +let get1char_plus () = + if key_pressed () then + read_key () + else + '@' ;; + +let create_ball (r : float) (x0 : int) (y0 : int) (m : float) (red : int) (green : int) (blue : int) = + { + radius = r ; + rgb = red + 256 * green + 256 * 256 * blue ; + mass = m; + xy = {x = float_of_int x0; y = float_of_int y0} ; + v = {x = 0. ; y = 0.} ; + a = {x = 0. ; y = 0.} ; + angv = {x = 0. ; y = 0.} ; + } ;; + +let create_polygon (arr : (int * int) array) (rest : float) (pts : int) (red : int) (green : int) (blue : int) = + { + vertexes = Array.init (Array.length arr) (fun k -> {x = float_of_int (fst arr.(k)); y = float_of_int (snd arr.(k))}) ; + rgb = red + 256 * green + 256 * 256 * blue ; + xmin = float_of_int (Array.fold_left (fun acc k -> min acc (fst k)) 99999 arr) ; + xmax = float_of_int (Array.fold_left (fun acc k -> max acc (fst k)) (-99999) arr) ; + ymin = float_of_int (Array.fold_left (fun acc k -> min acc (snd k)) 99999 arr) ; + ymax = float_of_int (Array.fold_left (fun acc k -> max acc (snd k)) (-99999) arr) ; + restitution = rest ; + score = pts ; + } ;; + +(* ------------------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------------------- *) +(* XXXXXX Main *) + +let simulate () = + open_graph " 1200x800" ; + set_window_title "WAH" ; + + let pinball = create_ball 25.0 600 700 0.15 169 169 169 in + let triangle = create_polygon [|(100, 100); (1100, 800); (1100, 100)|] 0.75 0 128 255 128 in + + while true do + let __start = Unix.gettimeofday() in + auto_synchronize false ; + clear_graph () ; + + set_color black ; + set_line_width 4 ; + draw_integer 600 770 !score 50 ; + + set_line_width 1 ; + draw_polygon triangle ; + draw_ball pinball ; + + auto_synchronize true ; + Unix.sleepf 0.005 ; + + let __end = Unix.gettimeofday() in + update_ball_data pinball [|triangle|] (__end -. __start) ; + done; + + close_graph () ;; + +simulate () ;; + +(* ocamlfind ocamlopt -linkpkg -package unix -linkpkg -package graphics -thread -package threads -linkpkg main.ml *) \ No newline at end of file diff --git a/main.o b/main.o new file mode 100644 index 0000000..3a06798 Binary files /dev/null and b/main.o differ