Commits

Yaron Minsky committed 8fa0f77

small cleanups, startup geometry handled better

  • Participants
  • Parent commits d9e8265

Comments (0)

Files changed (3)

 open World
 
 type platform = { height: float;
-		  start: float;
-		  stop: float;
-		}
+                  start: float;
+                  stop: float;
+                }
 
 let platform height start stop = { height; start; stop }
 
 type world = { pos: posn;
                vel: posn;
-	       plats: platform list
+               plats: platform list
              }
 
 let onplat plat posn =
 
 let ship =
   rotate (square 25. (color 0.3 0.3 1.)) ~deg:45.
-  +< square 10. yellow
+  ++ square 10. yellow
 
 let platform_image p =
   let path = [ posn p.start p.height
-	     ; posn p.stop  p.height
-	     ; posn p.stop  (p.height -. 5.)
-	     ; posn p.start (p.height -. 5.)
-	     ]
+             ; posn p.stop  p.height
+             ; posn p.stop  (p.height -. 5.)
+             ; posn p.start (p.height -. 5.)
+             ]
   in
   poly path orange
 
 let platforms ps =
   List.fold ps ~init:empty_image
-    ~f:(fun x p -> x +< platform_image p)
+    ~f:(fun x p -> x ++ platform_image p)
 
 let display w =
-  empty_scene ~ll:(posn (-.200.) (-.200.)) ~ur:(posn 200. 200.) white
-  ++ platforms w.plats
-  ++ shift ship w.pos
+  empty_scene ~ll:(posn (-.500.) (-.200.)) ~ur:(posn 500. 200.) white
+  +: platforms w.plats
+  +: shift ship w.pos
 
 let rec on_some_plat plats posn =
   match plats with
     then { w with vel = origin;}
     else
       { w with
-	pos = w.pos +! w.vel;
-	vel = w.vel +! posn 0. (-.0.008);
+        pos = w.pos +! w.vel;
+        vel = w.vel +! posn 0. (-.0.008);
       }
   else
     let new_vel =
       if w.vel.y < 3.
       then if w.vel.y > -3.
-	then w.vel +! posn 0. (-.0.008)
-	else { w.vel with y = -3.}
+        then w.vel +! posn 0. (-.0.008)
+        else { w.vel with y = -3.}
       else { w.vel with y = 3.}
     in
     { w with
   { pos = origin;
     vel = origin;
     plats = [ platform (-20.) 50. 100.
-	    ; platform 40. (-30.) 20.
-	    ; platform (-80.) (-30.) (150.)
-	    ; platform 120.  (-30.) 30.
-	    ; platform (-195.) (-200.)200.
-	    ]
+            ; platform 40. (-30.) 20.
+            ; platform (-80.) (-30.) (150.)
+            ; platform 120.  (-30.) 30.
+            ; platform (-195.) (-200.)200.
+            ]
   }
 
 
             else ()
         in
         pop ();
-        Stack.push envelope p 
+        Stack.push envelope p
       );
       Stack.to_list envelope
     in
           = [posn 1. 1.001; posn 0. 0.;  posn 3. 3.]);
 ;;
 
-let _ = convex_hull
+let _ = convex_test
 
 type color = { r: float; g: float; b: float }
 let color r g b = {r;g;b}
   let scene t = Lazy.force (snd t.world_and_scene)
 end
 
-let aspect_ratio scene =
+let scale_wh scene (w,h) =
+  let w = float w and h = float h in
   let ll = scene_ll scene in
   let ur = scene_ur scene in
-  let diff = ur -! ll in
+  let {x;y} = ur -! ll in
+  let (w,h) =
+    if w /. h < x /. y  then
+      let h = y *. w /. x in
+      (w,h)
+    else
+      let w = x *. h /. y in
+      (w,h)
+  in
+  (Float.to_int w, Float.to_int h)
+;;
+
+let start_world world ~w ~h ~display ~tick ~key =
+  (* Setup some shared state *)
+  let state = State.create world display in
+  let render () =
+    let scene = State.scene state in
+    GlMat.mode `projection;
+    GlMat.load_identity ();
+    let ll = scene_ll scene in
+    let ur = scene_ur scene in
+    GluMat.ortho2d ~x:(ll.x,ur.x) ~y:(ll.y, ur.y);
+    GlMat.mode `modelview;
+    GlMat.load_identity ();
+    GlClear.clear [ `color ];
+    image_iter (image scene) ~f:draw_base_image;
+    Gl.flush ();
+    Glut.swapBuffers ()
+  in
+  let granularity = sec 0.02 in
+  let rec timer_loop () =
+    let start = Time.now () in
+    let world = tick (State.world state) start in
+    State.set state world;
+    let after = Time.now () in
+    let next = Time.add start granularity in
+    let remaining = Time.diff next after in
+    Glut.timerFunc ~ms:(Float.to_int (Time.Span.to_ms remaining))
+      ~value:() ~cb:(fun ~value:() -> timer_loop ())
+  in
+  Glut.initDisplayMode ~double_buffer:true ();
+  let (w,h) = scale_wh (State.scene state) (w,h) in
+  printf "%d, %d\n%!" w h;
+  Glut.initWindowSize ~w ~h;
+  ignore (Glut.createWindow ~title:"Play");
+  GlClear.color (gl_color (bg (State.scene state)));
+  GlDraw.shade_model `smooth;
+  timer_loop ();
+  Glut.displayFunc ~cb:render;
+  Glut.idleFunc ~cb:(Some Glut.postRedisplay);
+  Glut.keyboardFunc ~cb:(fun ~key:key_num ~x:_ ~y:_ ->
+    State.set state (key (State.world state)
+                       (Char (Char.of_int_exn key_num)))
+  );
+  Glut.keyboardFunc ~cb:(fun ~key:key_num ~x:_ ~y:_ ->
+    State.set state (key (State.world state)
+                       (Char (Char.of_int_exn key_num)))
+  );
+  Glut.specialFunc ~cb:(fun ~key:special_key ~x:_ ~y:_ ->
+    let new_key = special_key_to_key special_key in
+    Option.iter new_key ~f:(fun k ->
+      State.set state (key (State.world state) k)));
+  Glut.mainLoop ()
+
 
 
 let big_bang world ~display ~tick ~key =
   let command =
-    (* Setup some shared state *)
-    let state = State.create world display in
-    let render () =
-      let scene = State.scene state in
-      GlMat.mode `projection;
-      GlMat.load_identity ();
-      let ll = scene_ll scene in
-      let ur = scene_ur scene in
-      GluMat.ortho2d ~x:(ll.x,ur.x) ~y:(ll.y, ur.y);
-      GlMat.mode `modelview;
-      GlMat.load_identity ();
-      GlClear.clear [ `color ];
-      image_iter (image scene) ~f:draw_base_image;
-      Gl.flush ();
-      Glut.swapBuffers ()
-    in
-    let granularity = sec 0.02 in
-    let rec timer_loop () =
-      let start = Time.now () in
-      let world = tick (State.world state) start in
-      State.set state world;
-      let after = Time.now () in
-      let next = Time.add start granularity in
-      let remaining = Time.diff next after in
-      Glut.timerFunc ~ms:(Float.to_int (Time.Span.to_ms remaining))
-        ~value:() ~cb:(fun ~value:() -> timer_loop ())
-    in
     Command.basic
       ~summary:"Test OpenGL program"
       Command.Spec.(
         empty
-        +> flag "-width"  (optional_with_default 512 int) ~doc:" Max screen width"
-        +> flag "-height" (optional_with_default 512 int) ~doc:" Max screen height"
+        +> flag "-width"  (optional_with_default 1024 int) ~doc:" Max screen width"
+        +> flag "-height" (optional_with_default 768 int) ~doc:" Max screen height"
       )
-      (fun w h () ->
-        Glut.initDisplayMode ~double_buffer:true ();
-        Glut.initWindowSize ~w ~h;
-        ignore (Glut.createWindow ~title:"Play");
-        GlClear.color (gl_color (bg (State.scene state)));
-        GlDraw.shade_model `smooth;
-        timer_loop ();
-        Glut.displayFunc ~cb:render;
-        Glut.idleFunc ~cb:(Some Glut.postRedisplay);
-        Glut.keyboardFunc ~cb:(fun ~key:key_num ~x:_ ~y:_ ->
-          State.set state (key (State.world state)
-                             (Char (Char.of_int_exn key_num)))
-        );
-        Glut.keyboardFunc ~cb:(fun ~key:key_num ~x:_ ~y:_ ->
-          State.set state (key (State.world state)
-                             (Char (Char.of_int_exn key_num)))
-        );
-        Glut.specialFunc ~cb:(fun ~key:special_key ~x:_ ~y:_ ->
-          let new_key = special_key_to_key special_key in
-          Option.iter new_key ~f:(fun k ->
-            State.set state (key (State.world state) k)));
-        Glut.mainLoop ()
-      )
+      (fun w h () -> start_world world ~w ~h ~display ~tick ~key)
   in
   let argv = Array.to_list (Glut.init ~argv:Sys.argv) in
   Command.run ~argv command