Permalink
Browse files

cleanups and fixes

  • Loading branch information...
1 parent efdd241 commit 109665847127c345c6091e0960a862c793aa08e5 Jake Donham committed May 6, 2010
Showing with 33 additions and 17 deletions.
  1. +33 −17 examples/froc-dom/bounce/bounce.ml
@@ -15,24 +15,32 @@ ENDIF
let get id = D.document#getElementById id
let onload () =
- let radius = 25. in
+ let paddle_radius = 25. in
+ let ball_radius = 5. in
let min = 0. in
let max = 500. in
let init_p = (Random.float max, Random.float max) in
let init_v = (Random.float 5., Random.float 5.) in
- let paddle_point = F.blift (Fd.mouse_b ()) (fun (x, y) -> (float_of_int x, float_of_int y)) in
- let paddle = F.blift paddle_point (fun p -> Fda.disk p radius (Fda.color 255 0 0)) in
+ let paddle_point =
+ F.blift (Fd.mouse_b ()) begin fun (x, y) ->
+ let x = float_of_int x in
+ let y = float_of_int y in
+ let x = if x < min then min else if x > max then max else x in
+ let y = if y < min then min else if y > max then max else y in
+ (x, y)
+ end in
+
+ let paddle = F.blift paddle_point (fun p -> Fda.disk p paddle_radius (Fda.color 255 0 0)) in
let ball_point =
F.fix_b begin fun bp ->
- let x_bounds =
- F.map (fun () -> `X_bounds) (F.when_true (F.blift bp (fun (x, _) -> x <= min || x >= max))) in
-
- let y_bounds =
- F.map (fun () -> `Y_bounds) (F.when_true (F.blift bp (fun (_, y) -> y <= min || y >= max))) in
+ let x_lo = F.map (fun () -> `X_lo) (F.when_true (F.blift bp (fun (x, _) -> x <= min))) in
+ let x_hi = F.map (fun () -> `X_hi) (F.when_true (F.blift bp (fun (x, _) -> x >= max))) in
+ let y_lo = F.map (fun () -> `Y_lo) (F.when_true (F.blift bp (fun (_, y) -> y <= min))) in
+ let y_hi = F.map (fun () -> `Y_hi) (F.when_true (F.blift bp (fun (_, y) -> y >= max))) in
let hit_paddle =
F.map (fun () -> `Paddle)
@@ -41,9 +49,13 @@ let onload () =
let (px, py) = F.sample paddle_point in
let dist_x = px -. x in
let dist_y = py -. y in
- dist_x *. dist_x +. dist_y *. dist_y <= radius *. radius
+ let dist = paddle_radius +. ball_radius in
+ dist_x *. dist_x +. dist_y *. dist_y <= dist *. dist
end)) in
+ let positive v = if v < 0. then -.v else v in
+ let negative v = if v > 0. then -.v else v in
+
let v =
F.fix_b begin fun v ->
F.hold
@@ -52,8 +64,11 @@ let onload () =
begin fun e ->
let (vx, vy) = F.sample v in
match e with
- | `X_bounds -> (-.vx, vy)
- | `Y_bounds -> (vx, -.vy)
+ | `X_lo -> (positive vx, vy)
+ | `X_hi -> (negative vx, vy)
+ | `Y_lo -> (vx, positive vy)
+ | `Y_hi -> (vx, negative vy)
+
| `Paddle ->
(* bounce v off the tangent to the paddle *)
let (x, y) = F.sample bp in
@@ -65,18 +80,19 @@ let onload () =
let dp = vx *. nx +. vy *. ny in
(vx -. 2. *. dp *. nx, vy -. 2. *. dp *. ny)
end
- (F.merge [ x_bounds; y_bounds; hit_paddle ]))
+ (F.merge [ x_lo; x_hi; y_lo; y_hi; hit_paddle ]))
end in
- let collect (x, y) () =
- let vx, vy = F.sample v in
- (x +. vx, y +. vy) in
- F.hold init_p (F.collect collect init_p (Fd.ticks 20.))
+ F.hold init_p
+ (F.collect
+ (fun (x, y) () -> let vx, vy = F.sample v in (x +. vx, y +. vy))
+ init_p
+ (Fd.ticks 20.))
end in
let ball =
F.blift ball_point begin fun (x, y) ->
- Fda.disk (x, y) 5. (Fda.color 0 255 0)
+ Fda.disk (x, y) ball_radius (Fda.color 0 255 0)
end in
let shapes = F.bliftN [ paddle; ball ] (fun shapes -> shapes) in

0 comments on commit 1096658

Please sign in to comment.