diff --git a/.gitignore b/.gitignore index 1864319f..4bc19d61 100644 --- a/.gitignore +++ b/.gitignore @@ -11,4 +11,5 @@ cabal-dev /Examples/elm-js/Redirect/Redirect.html /Examples/elm-js/Form/Form.html /Examples/elm-js/FrameRate/FrameRate.html -/Examples/elm-js/Maps/Map.html \ No newline at end of file +/Examples/elm-js/Maps/Map.html +elm/elm-runtime.js diff --git a/Examples/mario_mp/Clicks.elm b/Examples/mario_mp/Clicks.elm new file mode 100644 index 00000000..fa121205 --- /dev/null +++ b/Examples/mario_mp/Clicks.elm @@ -0,0 +1,6 @@ + +module Clicks where +import WebSocket +msgs = show <~ count Mouse.clicks +main = asText <~ open "ws://localhost:8080/ws" msgs + diff --git a/Examples/mario_mp/Mario.elm b/Examples/mario_mp/Mario.elm new file mode 100644 index 00000000..4830ecfa --- /dev/null +++ b/Examples/mario_mp/Mario.elm @@ -0,0 +1,91 @@ + +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) + diff --git a/Examples/mario_mp/Object.elm b/Examples/mario_mp/Object.elm new file mode 100644 index 00000000..42bb4576 --- /dev/null +++ b/Examples/mario_mp/Object.elm @@ -0,0 +1,8 @@ + +module Object where + +import JavaScript +import JSON + +main = plainText . castJSStringToString . (toPrettyJSString "") . fromList $ [ ("answer", JsonNumber 42) ] + diff --git a/Examples/mario_mp/Values.elm b/Examples/mario_mp/Values.elm new file mode 100644 index 00000000..54eae628 --- /dev/null +++ b/Examples/mario_mp/Values.elm @@ -0,0 +1,7 @@ + +module Values where + +import Dict + +main = constant . plainText . show . values $ empty + diff --git a/Examples/mario_mp/conn.go b/Examples/mario_mp/conn.go new file mode 100644 index 00000000..569b1485 --- /dev/null +++ b/Examples/mario_mp/conn.go @@ -0,0 +1,43 @@ +package main + +import ( + "code.google.com/p/go.net/websocket" +) + +type connection struct { + // The websocket connection. + ws *websocket.Conn + + // Buffered channel of outbound messages. + send chan string +} + +func (c *connection) reader() { + for { + var message string + err := websocket.Message.Receive(c.ws, &message) + if err != nil { + break + } + h.broadcast <- message + } + c.ws.Close() +} + +func (c *connection) writer() { + for message := range c.send { + err := websocket.Message.Send(c.ws, message) + if err != nil { + break + } + } + c.ws.Close() +} + +func wsHandler(ws *websocket.Conn) { + c := &connection{send: make(chan string, 256), ws: ws} + h.register <- c + defer func() { h.unregister <- c }() + go c.writer() + c.reader() +} diff --git a/Examples/mario_mp/elm-runtime.js b/Examples/mario_mp/elm-runtime.js new file mode 120000 index 00000000..a9aaf0c6 --- /dev/null +++ b/Examples/mario_mp/elm-runtime.js @@ -0,0 +1 @@ +../../elm/elm-runtime.js \ No newline at end of file diff --git a/Examples/mario_mp/hub.go b/Examples/mario_mp/hub.go new file mode 100644 index 00000000..f45decb5 --- /dev/null +++ b/Examples/mario_mp/hub.go @@ -0,0 +1,44 @@ +package main + +type hub struct { + // Registered connections. + connections map[*connection]bool + + // Inbound messages from the connections. + broadcast chan string + + // Register requests from the connections. + register chan *connection + + // Unregister requests from connections. + unregister chan *connection +} + +var h = hub{ + broadcast: make(chan string), + register: make(chan *connection), + unregister: make(chan *connection), + connections: make(map[*connection]bool), +} + +func (h *hub) run() { + for { + select { + case c := <-h.register: + h.connections[c] = true + case c := <-h.unregister: + delete(h.connections, c) + close(c.send) + case m := <-h.broadcast: + for c := range h.connections { + select { + case c.send <- m: + default: + delete(h.connections, c) + close(c.send) + go c.ws.Close() + } + } + } + } +} diff --git a/Examples/mario_mp/imgs/mario/stand/left.gif b/Examples/mario_mp/imgs/mario/stand/left.gif new file mode 100644 index 00000000..9e8ec007 Binary files /dev/null and b/Examples/mario_mp/imgs/mario/stand/left.gif differ diff --git a/Examples/mario_mp/imgs/mario/stand/right.gif b/Examples/mario_mp/imgs/mario/stand/right.gif new file mode 100644 index 00000000..56fbc914 Binary files /dev/null and b/Examples/mario_mp/imgs/mario/stand/right.gif differ diff --git a/Examples/mario_mp/imgs/mario/walk/left.gif b/Examples/mario_mp/imgs/mario/walk/left.gif new file mode 100644 index 00000000..c2143a28 Binary files /dev/null and b/Examples/mario_mp/imgs/mario/walk/left.gif differ diff --git a/Examples/mario_mp/imgs/mario/walk/right.gif b/Examples/mario_mp/imgs/mario/walk/right.gif new file mode 100644 index 00000000..4e698048 Binary files /dev/null and b/Examples/mario_mp/imgs/mario/walk/right.gif differ diff --git a/Examples/mario_mp/main.go b/Examples/mario_mp/main.go new file mode 100644 index 00000000..d574d1e9 --- /dev/null +++ b/Examples/mario_mp/main.go @@ -0,0 +1,24 @@ +package main + +import ( + "code.google.com/p/go.net/websocket" + "flag" + "log" + "net/http" +) + +var addr = flag.String("addr", ":8080", "http service address") + +func fileHandler(w http.ResponseWriter, r *http.Request) { + http.ServeFile(w, r, r.URL.Path[1:]) +} + +func main() { + flag.Parse() + go h.run() + http.HandleFunc("/", fileHandler) + http.Handle("/ws", websocket.Handler(wsHandler)) + if err := http.ListenAndServe(*addr, nil); err != nil { + log.Fatal("ListenAndServe:", err) + } +} diff --git a/Examples/mario_mp/makefile b/Examples/mario_mp/makefile new file mode 100644 index 00000000..c7e995e9 --- /dev/null +++ b/Examples/mario_mp/makefile @@ -0,0 +1,19 @@ +all: mario_mp Mario.html Clicks.html Object.html Values.html + +mario_mp: *.go + go build + +Mario.html: Mario.elm + elm -r elm-runtime.js Mario.elm + +Clicks.html: Clicks.elm + elm -r elm-runtime.js Clicks.elm + +Object.html: Object.elm + elm -r elm-runtime.js Object.elm + +Values.html: Values.elm + elm -r elm-runtime.js Values.elm + +clean: + rm -rf *.html mario_mp diff --git a/core-js/cat.sh b/core-js/cat.sh index 55604e0e..bd7f823c 100755 --- a/core-js/cat.sh +++ b/core-js/cat.sh @@ -5,10 +5,10 @@ cat \ Guid.js\ foreign/JavaScript.js\ - foreign/JSON.js\ - Value.js\ List.js\ Maybe.js\ + foreign/JSON.js\ + Value.js\ Char.js\ Graphics/Color.js\ Graphics/Collage.js\ @@ -29,4 +29,5 @@ cat \ Dict.js\ Set.js\ Automaton.js\ + Signal/WebSocket.js\ > ../elm/elm-runtime.js diff --git a/core-js/foreign/JSON.js b/core-js/foreign/JSON.js index 789acd7a..dd87d00b 100644 --- a/core-js/foreign/JSON.js +++ b/core-js/foreign/JSON.js @@ -104,7 +104,12 @@ Elm.JSON = function() { }; } function fromJSString(str) { - var obj = JSjson.parse(str); + var obj; + try { + obj = JSjson.parse(str); + } catch (e) { + return Elm.Maybe.Nothing; + } function toValue(v) { switch (typeof v) { case 'string' : return [ "JsonString", JS.castJSStringToString(v) ]; @@ -122,12 +127,13 @@ Elm.JSON = function() { for (var i in obj) { obj[i] = toValue(obj[i]); } - return ['JSON',obj]; + return Elm.Maybe.Just( ['JSON',obj] ); } return {empty : empty, singleton : singleton, insert : insert, lookup : lookup, + findNumber : find("JsonNumber",0), findString : find("JsonString",["Nil"]), findObject : find("JsonObject", empty ), findArray : find("JsonArray" ,["Nil"]), diff --git a/elm/src/Types/Hints.hs b/elm/src/Types/Hints.hs index 7bbe4f3e..bb8bac3a 100644 --- a/elm/src/Types/Hints.hs +++ b/elm/src/Types/Hints.hs @@ -125,7 +125,7 @@ json = prefix "JSON" , "JsonObject" -: jsonObject ==> jsonValue , numScheme (\n -> n ==> jsonValue) "JsonNumber" , "toString" -: jsonObject ==> string - , "fromString" -: string ==> jsonObject + , "fromString" -: string ==> maybeOf jsonObject , "lookup" -: string ==> jsonObject ==> maybeOf jsonValue , "findObject" -: string ==> jsonObject ==> jsonObject , "findArray" -: string ==> jsonObject ==> listOf jsonValue