Commits

Yaron Minsky  committed 775b6ca

zev's changes

  • Participants
  • Parent commits 2dde945

Comments (0)

Files changed (4)

 
 for TARGET in $*
 do
-  ocamlbuild -use-ocamlfind $TARGET -cflags "-w @A-4-33"
+  ocamlbuild -use-ocamlfind $TARGET -cflags "-w @A-4-33" && ./$TARGET
 done
 
 
 open Geometry
 open World
 
+type platform = { height: float;
+		  start: float;
+		  stop: float;
+		}
+
+let platform height start stop = { height; start; stop }
+
 type world = { pos: posn;
                vel: posn;
+	       plats: platform list
              }
 
+let onplat plat posn =
+  ((posn.x <  plat.stop) && (posn.x > plat.start))
+  && (posn.y > (plat.height +. 5.) && (posn.y < (plat.height +. 10.)))
+
 let square s color =
   let h = s /. 2. in
   let path = [ posn (-. h) (-. h)
   poly path color
 
 let ship =
-  rotate (square 25. black) ~deg:45.
-  +< square 10. blue
+  rotate (square 25. (color 0.3 0.3 1.)) ~deg:45.
+  +< 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.)
+	     ]
+  in
+  poly path orange
+
+let platforms ps =
+  List.fold ps ~init:empty_image
+    ~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
 
-let kick = 0.2
+let rec on_some_plat plats posn =
+  match plats with
+  | [] -> false
+  | hd :: tl ->
+    if onplat hd posn then true
+    else on_some_plat tl posn
+
+
+let tick w _ =  
+  if on_some_plat w.plats w.pos
+  then
+    if w.vel.y < 0.
+    then { w with vel = origin;}
+    else
+      { w with  
+	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.}  
+      else { w.vel with y = 3.}
+    in
+    { w with
+      pos = w.pos +! w.vel;
+      vel = new_vel;
+    }
+
+let kick = 0.4
+
+let world =
+  { 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. 
+	    ]
+  }
+      
+
+let key w k =
+  match k with
+  | Up | (Char 'i') ->
+    { w with vel = w.vel +! (posn 0. kick)}
+  | Down | Char 'k' ->
+    { w with vel = w.vel +! (posn 0. (-. kick))}
+  | Left | Char 'j' ->
+    { w with vel = w.vel +! (posn (-. kick) 0.)}
+  | Right | Char 'l' ->
+    { w with vel = w.vel +! (posn kick 0.)}
+  | Char 'h' ->
+    { w with pos = origin; vel = origin }
+  | Char 'q' ->
+    exit 0
+  | _ -> w
 
 let () =
-  big_bang
-    { pos = origin; vel = origin }
+  big_bang world
     ~display
-    ~tick:(fun w _ -> { w with pos = w.pos +! w.vel })
-    ~key:(fun w k ->
-      match k with
-      | Up | (Char 'i') ->
-        { w with vel = w.vel +! { origin with y =    kick }}
-      | Down | Char 'k' ->
-        { w with vel = w.vel +! { origin with y = -. kick }}
-      | Left | Char 'j' ->
-        { w with vel = w.vel +! { origin with x = -. kick }}
-      | Right | Char 'l' ->
-        { w with vel = w.vel +! { origin with x =    kick }}
-      | Char 'h' ->
-        { pos = origin; vel = origin }
-      | Char 'q' ->
-        exit 0
-      | _ -> w
-    )
+    ~tick
+    ~key
 

File geometry.mli

 
 type color = { r: float; g: float; b: float }
 
+val color : float -> float -> float -> color
 val black  : color
 val blue   : color
 val green  : color
     in
     let rec timer_loop () =
       let start = Time.now () in
-      let world' = tick (fst !world) start in
-      let new_world = tick world' start in
-      set_world new_world;
+      set_world (tick (fst !world) start);
       let after = Time.now () in
       let next = Time.add start granularity in
       let remaining = Time.diff next after in