Changed type signature of JSON.fromString; added multiplayer mario example

.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
+/Examples/elm-js/Maps/Map.html
+elm/elm-runtime.js

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
+

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)
+

Examples/mario_mp/Object.elm

@@ -0,0 +1,8 @@
+
+module Object where
+
+import JavaScript
+import JSON
+
+main = plainText . castJSStringToString . (toPrettyJSString "") . fromList $ [ ("answer", JsonNumber 42) ]
+

Examples/mario_mp/Values.elm

@@ -0,0 +1,7 @@
+
+module Values where
+
+import Dict
+
+main = constant . plainText . show . values $ empty
+

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()
+}

Examples/mario_mp/elm-runtime.js

@@ -0,0 +1 @@
+../../elm/elm-runtime.js

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()
+				}
+			}
+		}
+	}
+}

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)
+	}
+}

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

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

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"]),

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