91 lines
3 KiB
Elm
91 lines
3 KiB
Elm
|
|
module Mario where
|
|
|
|
import Dict
|
|
import JavaScript
|
|
import JSON
|
|
import Random
|
|
import WebSocket
|
|
|
|
{- INPUT -}
|
|
|
|
jumpStep isJump obj = if isJump && obj.y == 0 then { obj | vy <- 5 } else obj
|
|
gravityStep t obj = { obj | vy <- if obj.y > 0 then obj.vy - t/4 else obj.vy }
|
|
timeStep t obj = let {x,y,vx,vy} = obj in
|
|
{ obj | x <- x + t * vx , y <- max 0 $ y + t * vy }
|
|
walkStep dir obj = { obj | vx <- dir, dir <- if | dir < 0 -> "left"
|
|
| dir > 0 -> "right"
|
|
| otherwise -> obj.dir }
|
|
|
|
step t d j = timeStep t . gravityStep t . jumpStep j . walkStep d
|
|
|
|
delta = lift (flip (/) 20) (fps 25)
|
|
leftRight = toFloat . .x <~ Keyboard.arrows
|
|
jump = (\{y} -> y > 0) <~ Keyboard.arrows
|
|
steps = sampleOn delta (lift3 step delta leftRight jump)
|
|
|
|
{- LOCAL STATE -}
|
|
|
|
initialMario = { x = 0, y = 0, vx = 0, vy = 0, dir = "right" }
|
|
stateSignal = foldp ($) initialMario steps
|
|
|
|
encode obj id =
|
|
castJSStringToString . (toPrettyJSString "") . JSON.fromList $
|
|
[ ("id", JsonNumber id)
|
|
, ("x", JsonNumber obj.x)
|
|
, ("y", JsonNumber obj.y)
|
|
, ("vx", JsonNumber obj.vx)
|
|
, ("dir", JsonString obj.dir) ]
|
|
--encode obj id = show id ++ " " ++ show obj.x ++ " " ++ show obj.y
|
|
|
|
clientID = inRange 0 99999
|
|
myStream = encode <~ stateSignal ~ clientID
|
|
|
|
{- NETWORK LAYER -}
|
|
|
|
worldMessageStream = open "ws://localhost:8080/ws" myStream
|
|
|
|
-- :: String -> Maybe (Float, Record)
|
|
parsePlayer msg =
|
|
case fromString msg of
|
|
Nothing -> Nothing
|
|
Just json ->
|
|
let id = findNumber "id" json
|
|
x = findNumber "x" json
|
|
y = findNumber "y" json
|
|
vx = findNumber "vx" json
|
|
dir = findString "dir" json
|
|
in Just (id, { x = x, y = y, vx = vx, vy = 0, dir = dir })
|
|
|
|
-- :: Maybe (Float, Record) -> Dict String Record -> Dict String Record
|
|
updateWorldPositions maybeMario marioDict = case maybeMario of
|
|
Just (id, mario) -> (Dict.insert) (show id) mario marioDict
|
|
Nothing -> marioDict
|
|
|
|
-- :: Signal (Dict String Record)
|
|
worldPositions = foldp updateWorldPositions Dict.empty (parsePlayer <~ worldMessageStream)
|
|
--worldPositions = constant empty
|
|
|
|
marios = Dict.values <~ worldPositions
|
|
|
|
{- RENDER CODE -}
|
|
|
|
-- :: Record -> Form
|
|
mario2Form (w,h) mario =
|
|
let verb = if mario.vx /= 0 then "walk" else "stand"
|
|
src = "/imgs/mario/" ++ verb ++ "/" ++ mario.dir ++ ".gif"
|
|
in toForm (mario.x, (h-63)-mario.y) (image 35 35 src)
|
|
|
|
-- :: (Int,Int) -> [Record] -> Element
|
|
render (w,h) marios =
|
|
collage w h ( (filled cyan $ rect w h (w `div` 2, h `div` 2))
|
|
: (filled green $ rect w 50 (w `div` 2,h-25))
|
|
: List.map (mario2Form (w,h)) marios )
|
|
|
|
{- PUTTING IT TOGETHER -}
|
|
|
|
-- :: Signal Element
|
|
main = render <~ Window.dimensions ~ marios
|
|
--main = above <~ ((plainText . show) <~ (marios)) ~ (render <~ Window.dimensions ~ marios)
|
|
--main = (plainText . show) <~ (marios)
|
|
|