@@ -0,0 +1,67 @@
4+import Data.Maybe (mapMaybe)
5+import Foreign.JavaScript
6+import Signal.Keyboard.Raw
10+foreign import jsevent "trigger" (castIntToJSNumber 0)
11+ jsTime :: Signal JSNumber
13+foreign export jsevent "finished"
14+ done :: Signal JSBool
16+foreign export jsevent "desiredFPS"
17+ desiredFPS :: Signal JSNumber
19+desiredFPS = constant (castIntToJSNumber 30)
21+time = lift castJSNumberToFloat jsTime
24+-- Calculate FPS based on incoming times.
27+ let len = length ts in
28+ if len > 1 then (len-1) / (head ts - last ts) else 0
29+truncate n = castJSNumberToInt (castFloatToJSNumber $ 100 * n) / 100
30+fps = lift (truncate . getFPS) (foldp (\t ts -> take 10 (t:ts)) [0] time)
33+-- Use time and keyboard input to determine the
34+-- position of the black square.
36+addVecs (x1,y1) (x2,y2) = (x1+x2, y1+y2)
37+scaleBy s (x,y) = (x*s, y*s)
40+ if k < 37 || k > 40 then (x,y) else
41+ if k `mod` 2 == 1 then (x + k - 38, y)
44+velocity = lift (foldl addKey (0,0)) keysDown
46+timestep = lift snd $ foldp (\t1 (t0,d) -> (t1, t1-t0)) (0,0) time
48+delta = dropIf (\(x,y) -> x == 0 && y == 0) (0,0) $
49+ lift (scaleBy 100) (lift2 scaleBy timestep velocity)
51+position = foldp addVecs (0,0) delta
54+-- Display moving square and FPS on screen.
56+screen pos actual desired =
57+ flow down [ collage 400 400 [ outlined black (rect 40 40 pos) ]
58+ , plainText "Move the square around with the arrow keys."
59+ , text $ toText "Actual frames per second: " ++ show actual
60+ , text $ toText "Desired frames per second: " ++ show desired
64+game = lift3 screen position fps desiredFPS
65+done = lift (\_ -> castBoolToJSBool True) game