diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..81f187b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,6 @@
+.psci_modules
+bower_components
+built-tests
+coverage
+lib
+node_modules
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..68b62ea
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2014, Michael Ficarra. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ * Neither the name of the project nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+This software is provided by the copyright holders and contributors "as is" and
+any express or implied warranties, including, but not limited to, the implied
+warranties of merchantability and fitness for a particular purpose are
+disclaimed. In no event shall the copyright holder be liable for any direct,
+indirect, incidental, special, exemplary, or consequential damages (including,
+but not limited to, procurement of substitute goods or services; loss of use,
+data, or profits; or business interruption) however caused and on any theory of
+liability, whether in contract, strict liability, or tort (including negligence
+or otherwise) arising in any way out of the use of this software, even if
+advised of the possibility of such damage.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..5c0a130
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,61 @@
+default: build doc
+all: build doc test
+
+MODULE = Mario
+
+build: lib/$(MODULE).js
+build-tests: $(TESTSOUT)
+externs: lib/$(MODULE).externs.purs
+deps: node_modules bower_components
+doc: docs/README.md
+
+
+BOWER_DEPS = $(shell find bower_components/purescript-*/src -name '*.purs' -type f | sort)
+SRC = $(shell find src -name '*.purs' -type f | sort)
+TESTS = $([ -d test ] && shell find test -name '*.purs' -type f | sort)
+TESTSOUT = $(TESTS:test/%.purs=built-tests/%.js)
+
+BOWER = node_modules/.bin/bower
+ISTANBUL = node_modules/.bin/istanbul
+MOCHA = node_modules/.bin/_mocha
+MOCHA_OPTS = --inline-diffs --check-leaks -R dot
+
+lib/$(MODULE).js: bower_components src/$(MODULE).purs
+ @mkdir -p '$(@D)'
+ psc --verbose-errors \
+ --main $(MODULE) \
+ ${BOWER_DEPS} $(SRC) \
+ > lib/$(MODULE).js
+
+.PHONY: default all build externs deps doc clean test build-tests
+
+lib/$(MODULE).externs.purs: bower_components src/$(MODULE).purs
+ @mkdir -p '$(@D)'
+ psc --verbose-errors \
+ -m $(MODULE) \
+ --codegen $(MODULE) \
+ -e lib/$(MODULE).externs.purs \
+ ${BOWER_DEPS} $(SRC) \
+ > /dev/null
+
+docs/README.md: lib/$(MODULE).externs.purs
+ @mkdir -p '$(@D)'
+ docgen lib/$(MODULE).externs.purs > docs/README.md
+
+built-tests/%.js: bower_components test/%.purs
+ @mkdir -p '$(@D)'
+ psc --verbose-errors -m Tests \
+ $(BOWER_DEPS) '$<' \
+ >'$@'
+
+node_modules:
+ npm install
+
+bower_components: node_modules
+ $(BOWER) install
+
+test: node_modules $(TESTSOUT) lib/$(MODULE).js
+ [ -d test ] && $(ISTANBUL) cover --root lib $(MOCHA) -- $(MOCHA_OPTS) -- built-tests
+
+clean:
+ rm -rf lib built-tests coverage bower_components node_modules
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..39afeeb
--- /dev/null
+++ b/README.md
@@ -0,0 +1,18 @@
+purescript-demo-mario
+=====================
+
+Implementation of [Elm's Mario demo](http://elm-lang.org/edit/examples/Intermediate/Mario.elm) in PureScript.
+
+
+
+## Usage
+
+```sh
+make
+```
+
+Open `index.html` to interact.
+
+## Documentation
+
+See the [auto-generated documentation](./docs).
diff --git a/bower.json b/bower.json
new file mode 100644
index 0000000..e094f13
--- /dev/null
+++ b/bower.json
@@ -0,0 +1,28 @@
+{
+ "name": "purescript-demo-mario",
+ "homepage": "https://github.com/michaelficarra/purescript-demo-mario",
+ "description": "implementation of Elm's Mario demo in PureScript",
+ "keywords": [
+ "purescript",
+ "demo",
+ "mario",
+ "example",
+ "sample",
+ "frp",
+ "elm"
+ ],
+ "license": "BSD-3-Clause",
+ "ignore": [
+ "**/.*",
+ "bower_components",
+ "node_modules",
+ "bower.json",
+ "package.json"
+ ],
+ "dependencies": {
+ "purescript-dom": "*",
+ "purescript-math": "*",
+ "purescript-signal": "git@github.com:bodil/purescript-signal.git"
+ },
+ "devDependencies": {}
+}
diff --git a/demo.gif b/demo.gif
new file mode 100644
index 0000000..b08bf6c
Binary files /dev/null and b/demo.gif differ
diff --git a/docs/README.md b/docs/README.md
new file mode 100644
index 0000000..3e0f410
--- /dev/null
+++ b/docs/README.md
@@ -0,0 +1,72 @@
+# Module Documentation
+
+## Module Mario
+
+### Types
+
+ data Direction where
+ Left :: Direction
+ Right :: Direction
+
+ data Verb where
+ Jumping :: Verb
+ Walking :: Verb
+ Standing :: Verb
+
+
+### Values
+
+ accel :: Mario.GameState -> Number
+
+ airAccel :: Number
+
+ airFriction :: Number
+
+ applyFriction :: Mario.GameState -> Mario.GameState
+
+ applyGravity :: Mario.GameState -> Mario.GameState
+
+ currentActivity :: Mario.GameState -> Mario.Verb
+
+ friction :: Mario.GameState -> Number
+
+ gravity :: Number
+
+ groundAccel :: Number
+
+ groundFriction :: Number
+
+ groundHeight :: Number
+
+ initialState :: Mario.GameState
+
+ isAirborne :: Mario.GameState -> Boolean
+
+ jump :: Boolean -> Mario.GameState -> Mario.GameState
+
+ jumpKeyCode :: Number
+
+ jumpSpeed :: Number
+
+ leftKeyCode :: Number
+
+ main :: forall t1844. Control.Monad.Eff.Eff t1844 Prelude.Unit
+
+ marioLogic :: Mario.Inputs -> Mario.GameState -> Mario.GameState
+
+ marioSpriteUrl :: Mario.Verb -> Mario.Direction -> String
+
+ maxMoveSpeed :: Number
+
+ mkInputs :: Boolean -> Boolean -> Boolean -> Mario.Inputs
+
+ offsetGround :: Number -> Mario.DOM.Coordinate -> Mario.DOM.Coordinate
+
+ rightKeyCode :: Number
+
+ velocity :: Mario.GameState -> Mario.GameState
+
+ walk :: Boolean -> Boolean -> Mario.GameState -> Mario.GameState
+
+
+
diff --git a/index.html b/index.html
new file mode 100644
index 0000000..d735905
--- /dev/null
+++ b/index.html
@@ -0,0 +1,29 @@
+
+
+
+
+ purescript-demo-mario
+
+
+
+
+ 
+
+
+
diff --git a/package.json b/package.json
new file mode 100644
index 0000000..759fa23
--- /dev/null
+++ b/package.json
@@ -0,0 +1,33 @@
+{
+ "name": "purescript-demo-mario",
+ "version": "0.0.0",
+ "description": "implementation of Elm's Mario demo in PureScript",
+ "main": "index.js",
+ "scripts": {
+ "test": "make test"
+ },
+ "repository": {
+ "type": "git",
+ "url": "https://github.com/michaelficarra/purescript-demo-mario"
+ },
+ "keywords": [
+ "purescript",
+ "demo",
+ "mario",
+ "example",
+ "sample",
+ "frp",
+ "elm"
+ ],
+ "author": "Michael Ficarra",
+ "license": "BSD-3-Clause",
+ "bugs": {
+ "url": "https://github.com/michaelficarra/purescript-demo-mario/issues"
+ },
+ "homepage": "https://github.com/michaelficarra/purescript-demo-mario",
+ "devDependencies": {
+ "bower": "^1.3.12",
+ "istanbul": "^0.3.2",
+ "mocha": "^1.21.4"
+ }
+}
diff --git a/src/Mario.purs b/src/Mario.purs
new file mode 100644
index 0000000..0189652
--- /dev/null
+++ b/src/Mario.purs
@@ -0,0 +1,119 @@
+module Mario where
+
+import Math (abs, max, min)
+import Signal ((~>), foldp, runSignal, sampleOn)
+import Signal.DOM (animationFrame, keyPressed)
+
+import Mario.DOM
+
+
+initialState :: GameState
+initialState = {
+ x: -40, y: 0,
+ dx: maxMoveSpeed, dy: jumpSpeed,
+ dir: Right
+ }
+
+data Direction = Left | Right
+instance showDirection :: Show Direction where
+ show Left = "left"
+ show Right = "right"
+
+data Verb = Jumping | Walking | Standing
+instance showVerb :: Show Verb where
+ show Jumping = "jump"
+ show Walking = "walk"
+ show Standing = "stand"
+
+type GameState = { x :: Number, y :: Number, dx :: Number, dy :: Number, dir :: Direction }
+type Inputs = { right :: Boolean, left :: Boolean, jump :: Boolean }
+
+
+jumpKeyCode = 38 -- up arrow
+rightKeyCode = 39 -- right arrow
+leftKeyCode = 37 -- left arrow
+
+groundHeight = 0.08 -- * viewport height
+
+gravity = 0.3 -- px / frame^2
+
+jumpSpeed = 6 -- px / frame
+maxMoveSpeed = 4 -- px / frame
+
+groundAccel = 0.06 -- px / frame^2
+airAccel = 0.04 -- px / frame^2
+
+groundFriction = 0.15 -- px / frame^2
+airFriction = 0.02 -- px / frame^2
+
+
+marioSpriteUrl :: Verb -> Direction -> String
+marioSpriteUrl verb dir = "http://elm-lang.org/imgs/mario/" ++ show verb ++ "/" ++ show dir ++ ".gif"
+
+offsetGround :: Number -> Coordinate -> Coordinate
+offsetGround amount pos = pos { y = pos.y + amount - 4 } -- 4 pixels for image offset
+
+mkInputs :: Boolean -> Boolean -> Boolean -> Inputs
+mkInputs l r j = { left: l, right: r, jump: j }
+
+isAirborne :: GameState -> Boolean
+isAirborne s = s.y > 0
+
+currentActivity :: GameState -> Verb
+currentActivity s | isAirborne s = Jumping
+currentActivity s | s.dx /= 0 = Walking
+currentActivity s = Standing
+
+accel :: GameState -> Number
+accel s = if isAirborne s then airAccel else groundAccel
+
+friction :: GameState -> Number
+friction s = if isAirborne s then airFriction else groundFriction
+
+
+velocity :: GameState -> GameState
+velocity s = s { x = s.x + s.dx, y = s.y + s.dy }
+
+applyGravity :: GameState -> GameState
+applyGravity s =
+ if s.y <= -s.dy
+ then s { y = 0, dy = 0 }
+ else s { y = s.y + s.dy, dy = s.dy - gravity }
+
+jump :: Boolean -> GameState -> GameState
+jump true s | not (isAirborne s) = s { dy = jumpSpeed }
+jump _ s = s
+
+walk :: Boolean -> Boolean -> GameState -> GameState
+walk true false s =
+ let s' = if s.dx > 0 then applyFriction s else s in
+ s' { dx = max (-maxMoveSpeed) (s'.dx - accel s'), dir = Left }
+walk false true s =
+ let s' = if s.dx < 0 then applyFriction s else s in
+ s' { dx = min maxMoveSpeed (s'.dx + accel s'), dir = Right }
+walk x y s = applyFriction s
+
+applyFriction :: GameState -> GameState
+applyFriction s | s.dx == 0 = s
+applyFriction s | abs s.dx <= friction s = s { dx = 0 }
+applyFriction s | s.dx > 0 = s { dx = s.dx - friction s }
+applyFriction s | s.dx < 0 = s { dx = s.dx + friction s }
+
+marioLogic :: Inputs -> GameState -> GameState
+marioLogic inputs = velocity <<< applyGravity
+ <<< jump inputs.jump
+ <<< walk inputs.left inputs.right
+
+
+main = onDOMContentLoaded do
+ marioElement <- getMario
+ viewportDimensions <- getViewportDimensions
+ let groundHeightPx = groundHeight * viewportDimensions.height
+ jumpKey <- keyPressed jumpKeyCode
+ rightKey <- keyPressed rightKeyCode
+ leftKey <- keyPressed leftKeyCode
+ let inputs = mkInputs <$> leftKey <*> rightKey <*> jumpKey
+ frames <- animationFrame
+ runSignal $ foldp marioLogic initialState (sampleOn frames inputs) ~> \gameState -> do
+ updateSprite marioElement $ marioSpriteUrl (currentActivity gameState) gameState.dir
+ updatePosition marioElement (offsetGround groundHeightPx {x: gameState.x, y: gameState.y})
diff --git a/src/Mario/DOM.purs b/src/Mario/DOM.purs
new file mode 100644
index 0000000..e7018b3
--- /dev/null
+++ b/src/Mario/DOM.purs
@@ -0,0 +1,54 @@
+module Mario.DOM where
+
+import Control.Monad.Eff
+
+import DOM (DOM(..), Node(..))
+
+type Dimensions = { width :: Number, height :: Number }
+type Coordinate = { x :: Number, y :: Number }
+
+foreign import getViewportDimensions """
+ function getViewportDimensions() {
+ return {
+ width: document.documentElement.clientWidth,
+ height: document.documentElement.clientHeight
+ };
+ }
+ """ :: forall eff. Eff (dom :: DOM | eff) Dimensions
+
+foreign import updatePosition """
+ function updatePosition(node) {
+ return function(coord) {
+ return function() {
+ node.style.left = coord.x + 'px';
+ node.style.bottom = coord.y + 'px';
+ };
+ };
+ }
+ """ :: Node -> Coordinate -> forall eff. Eff (dom :: DOM | eff) Unit
+
+foreign import updateSprite """
+ function updateSprite(node) {
+ return function(url) {
+ return function() {
+ if (node.src !== url) node.src = url;
+ };
+ };
+ }
+ """ :: Node -> String -> forall eff. Eff (dom :: DOM | eff) Unit
+
+foreign import onDOMContentLoaded """
+ function onDOMContentLoaded(action) {
+ if (document.readyState === 'interactive') {
+ action();
+ } else {
+ document.addEventListener('DOMContentLoaded', action);
+ }
+ return function() { return {}; };
+ }
+ """ :: forall eff a. Eff (dom :: DOM | eff) a -> Eff (eff) Unit
+
+foreign import getMario
+ "function getMario() { return document.getElementById('mario'); }"
+ :: forall eff. Eff (dom :: DOM | eff) Node
+