@@ -0,0 +1,91 @@
1+
2+module Mario where
3+
4+import Dict
5+import JavaScript
6+import JSON
7+import Random
8+import WebSocket
9+
10+{- INPUT -}
11+
12+jumpStep isJump obj = if isJump && obj.y == 0 then { obj | vy <- 5 } else obj
13+gravityStep t obj = { obj | vy <- if obj.y > 0 then obj.vy - t/4 else obj.vy }
14+timeStep t obj = let {x,y,vx,vy} = obj in
15+ { obj | x <- x + t * vx , y <- max 0 $ y + t * vy }
16+walkStep dir obj = { obj | vx <- dir, dir <- if | dir < 0 -> "left"
17+ | dir > 0 -> "right"
18+ | otherwise -> obj.dir }
19+
20+step t d j = timeStep t . gravityStep t . jumpStep j . walkStep d
21+
22+delta = lift (flip (/) 20) (fps 25)
23+leftRight = toFloat . .x <~ Keyboard.arrows
24+jump = (\{y} -> y > 0) <~ Keyboard.arrows
25+steps = sampleOn delta (lift3 step delta leftRight jump)
26+
27+{- LOCAL STATE -}
28+
29+initialMario = { x = 0, y = 0, vx = 0, vy = 0, dir = "right" }
30+stateSignal = foldp ($) initialMario steps
31+
32+encode obj id =
33+ castJSStringToString . (toPrettyJSString "") . JSON.fromList $
34+ [ ("id", JsonNumber id)
35+ , ("x", JsonNumber obj.x)
36+ , ("y", JsonNumber obj.y)
37+ , ("vx", JsonNumber obj.vx)
38+ , ("dir", JsonString obj.dir) ]
39+--encode obj id = show id ++ " " ++ show obj.x ++ " " ++ show obj.y
40+
41+clientID = inRange 0 99999
42+myStream = encode <~ stateSignal ~ clientID
43+
44+{- NETWORK LAYER -}
45+
46+worldMessageStream = open "ws://localhost:8080/ws" myStream
47+
48+-- :: String -> Maybe (Float, Record)
49+parsePlayer msg =
50+ case fromString msg of
51+ Nothing -> Nothing
52+ Just json ->
53+ let id = findNumber "id" json
54+ x = findNumber "x" json
55+ y = findNumber "y" json
56+ vx = findNumber "vx" json
57+ dir = findString "dir" json
58+ in Just (id, { x = x, y = y, vx = vx, vy = 0, dir = dir })
59+
60+-- :: Maybe (Float, Record) -> Dict String Record -> Dict String Record
61+updateWorldPositions maybeMario marioDict = case maybeMario of
62+ Just (id, mario) -> (Dict.insert) (show id) mario marioDict
63+ Nothing -> marioDict
64+
65+-- :: Signal (Dict String Record)
66+worldPositions = foldp updateWorldPositions Dict.empty (parsePlayer <~ worldMessageStream)
67+--worldPositions = constant empty
68+
69+marios = Dict.values <~ worldPositions
70+
71+{- RENDER CODE -}
72+
73+-- :: Record -> Form
74+mario2Form (w,h) mario =
75+ let verb = if mario.vx /= 0 then "walk" else "stand"
76+ src = "/imgs/mario/" ++ verb ++ "/" ++ mario.dir ++ ".gif"
77+ in toForm (mario.x, (h-63)-mario.y) (image 35 35 src)
78+
79+-- :: (Int,Int) -> [Record] -> Element
80+render (w,h) marios =
81+ collage w h ( (filled cyan $ rect w h (w `div` 2, h `div` 2))
82+ : (filled green $ rect w 50 (w `div` 2,h-25))
83+ : List.map (mario2Form (w,h)) marios )
84+
85+{- PUTTING IT TOGETHER -}
86+
87+-- :: Signal Element
88+main = render <~ Window.dimensions ~ marios
89+--main = above <~ ((plainText . show) <~ (marios)) ~ (render <~ Window.dimensions ~ marios)
90+--main = (plainText . show) <~ (marios)
91+