├── .gitignore ├── README.md ├── bower.json └── src ├── Core.js ├── Core.purs ├── Dom.js ├── Dom.purs ├── Dom ├── Props.js ├── Props.purs ├── Tweens.js ├── Tweens.purs └── Utils.purs ├── Sigment.purs └── Sigment └── Subcomponents.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /dist/ 6 | TAGS 7 | /.psci* 8 | /src/.webpack.js 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Sigment (SImple GaMe ENgine) uses [virtual-pixi](https://github.com/ptol/virtual-pixi) and can use Canvas or WebGL for scene rendering 2 | 3 | Also it uses approach similar to [Elm architecture](https://github.com/evancz/elm-architecture-tutorial/) 4 | 5 | # Counter 6 | 7 | ``` 8 | data Action = Increase | Decrease 9 | 10 | type Model = Int 11 | 12 | initState = 0 13 | 14 | component :: Component Unit Action Model _ 15 | component = newComponent (const initState >>> pure) (pureEval eval) render 16 | 17 | eval :: PureEval Action Model 18 | eval Increase = (_ + 1) 19 | eval Decrease = (_ - 1) 20 | 21 | render :: Render Action Model _ 22 | render action state dispatch = D.group' [P.x 120, P.y 200] [ 23 | D.text [P.txt "+", P.onClick (dispatch Increase), P.x 30], 24 | D.text [P.txt "-", P.onClick (dispatch Decrease), P.x 60], 25 | D.text [P.txt (show state), P.x 120] 26 | ] 27 | 28 | main = do 29 | init (defConfig {width = 400, height = 400, containerId = "container"}) unit component 30 | ``` 31 | 32 | # Other examples 33 | 34 | ## Snake 35 | 36 | [Demo](http://ptol.github.io/purescript-sigment-examples/snake/public.html) 37 | 38 | [Source](https://github.com/ptol/purescript-sigment-examples/tree/master/snake/src) 39 | 40 | ## Counter 41 | 42 | [Demo](http://ptol.github.io/purescript-sigment-examples/counter/public.html) 43 | 44 | [Source](https://github.com/ptol/purescript-sigment-examples/tree/master/counter/src) 45 | 46 | ## Counter list 47 | 48 | [Demo](http://ptol.github.io/purescript-sigment-examples/counter-list/public.html) 49 | 50 | [Source](https://github.com/ptol/purescript-sigment-examples/tree/master/counter-list/src) 51 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-sigment", 3 | "description": "A simple game-engine/ui library for PureScript", 4 | "license": "MIT", 5 | "ignore": [ 6 | "**/.*", 7 | "node_modules", 8 | "bower_components" 9 | ], 10 | "keywords": [ 11 | "PureScript", 12 | "Game Engine" 13 | ], 14 | "repository": { 15 | "type": "git", 16 | "url": "git://github.com/ptol/purescript-sigment.git" 17 | }, 18 | "homepage": "https://github.com/ptol/purescript-sigment", 19 | "dependencies": { 20 | "purescript-functions": "^3.0.0", 21 | "purescript-eff": "^3.0.0", 22 | "purescript-refs": "^3.0.0", 23 | "purescript-tuples": "^4.0.0", 24 | "purescript-maybe": "^3.0.0", 25 | "purescript-arrays": "^4.0.0", 26 | "virtual-pixi": "0.1.1" 27 | }, 28 | "devDependencies": { 29 | "purescript-psci-support": "^3.0.0" 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /src/Core.js: -------------------------------------------------------------------------------- 1 | var execActionF = null; 2 | var renderer = null; 3 | var stage = null; 4 | var config = null; 5 | var mapFunction = null; 6 | function initSigment(pExecAction, pMapFunction, pConfig, cb){ 7 | mapFunction = pMapFunction; 8 | config = pConfig; 9 | execActionF = pExecAction; 10 | renderer = PIXI.autoDetectRenderer(config.width, config.height, {backgroundColor : parseInt("0x" + pConfig.backgroundColor)}); 11 | stage = virtualPixi.api.createElement("group"); 12 | var container = config.containerId ? document.getElementById(config.containerId) : document.body; 13 | container.appendChild(renderer.view); 14 | if(config.containerId){ 15 | resize(container.clientWidth, container.clientHeight); 16 | }else{ 17 | resize(window.innerWidth, window.innerHeight); 18 | } 19 | if(config.sprites.length > 0){ 20 | PIXI.loader.add(config.sprites).load(function(){ 21 | cb(); 22 | startRender(); 23 | }); 24 | }else{ 25 | cb(); 26 | startRender(); 27 | } 28 | } 29 | 30 | // window.onresize = () => resize(window.innerWidth, window.innerHeight); 31 | 32 | function resize(width, height) { 33 | var ratio = config.width/config.height; 34 | var x = 0; 35 | var y = 0; 36 | var w = 0; 37 | var h = 0; 38 | if (width / height >= ratio) { 39 | w = height * ratio; 40 | x = (width - w)/2; 41 | h = height; 42 | } else { 43 | w = width; 44 | h = width / ratio; 45 | y = (height - h)/2; 46 | } 47 | renderer.view.style.width = w + 'px'; 48 | renderer.view.style.height = h + 'px'; 49 | renderer.view.style.left = x + 'px'; 50 | renderer.view.style.top = y + 'px'; 51 | renderer.view.style.position = "relative"; 52 | } 53 | 54 | var currentVNode = null; 55 | function updateStage(vNode){ 56 | var vn = virtualPixi.h("group", {}, [vNode]); 57 | if(currentVNode){ 58 | currentVNode = virtualPixi.patch(currentVNode, vn); 59 | }else{ 60 | currentVNode = virtualPixi.patch(stage, vn); 61 | } 62 | } 63 | 64 | function startRender(){ 65 | requestAnimationFrame(render); 66 | } 67 | 68 | var prevTimestamp = null; 69 | 70 | function render(timestamp) { 71 | requestAnimationFrame(render); 72 | if (!prevTimestamp) prevTimestamp = timestamp; 73 | var interval = timestamp - prevTimestamp; 74 | prevTimestamp = timestamp; 75 | mapFunction(function(x){ 76 | execActionF(x(interval))(); 77 | })(config.frameAction); 78 | TWEEN.update(timestamp); 79 | renderer.render(stage); 80 | } 81 | 82 | exports._updateStage = updateStage; 83 | exports._initSigment = initSigment; 84 | exports._requestAnimationFrame = requestAnimationFrame; 85 | -------------------------------------------------------------------------------- /src/Core.purs: -------------------------------------------------------------------------------- 1 | module Sigment.Core where 2 | 3 | import Prelude (Unit) 4 | import Control.Monad.Eff (Eff) 5 | import Control.Monad.Eff.Uncurried (EffFn1, EffFn4, runEffFn1, runEffFn4) 6 | import Data.Maybe (Maybe) 7 | import Sigment.Dom (Node) 8 | 9 | type Url = String 10 | 11 | type Urls = Array Url 12 | 13 | type Config a = 14 | { sprites :: Urls 15 | , width :: Int 16 | , height :: Int 17 | , backgroundColor :: String 18 | , frameAction :: Maybe (Number -> a) 19 | , containerId :: String 20 | , initAction :: Maybe a 21 | } 22 | 23 | foreign import _initSigment :: forall eff any a. EffFn4 eff any ((a -> Unit) -> Maybe a -> Maybe Unit) (Config a) (Eff eff Unit) Unit 24 | 25 | initSigment :: forall eff any a. any -> ((a -> Unit) -> Maybe a -> Maybe Unit) -> (Config a) -> (Eff eff Unit) -> Eff eff Unit 26 | initSigment = runEffFn4 _initSigment 27 | 28 | foreign import _updateStage :: forall eff. EffFn1 eff Node Unit 29 | 30 | updateStage :: forall eff. Node -> Eff eff Unit 31 | updateStage = runEffFn1 _updateStage 32 | 33 | foreign import _requestAnimationFrame :: forall eff. EffFn1 eff (Eff eff Unit) Unit 34 | 35 | requestAnimationFrame :: forall eff. (Eff eff Unit) -> Eff eff Unit 36 | requestAnimationFrame = runEffFn1 _requestAnimationFrame 37 | -------------------------------------------------------------------------------- /src/Dom.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | var vp = virtualPixi; 4 | 5 | function merge(props){ 6 | var result = {}; 7 | if(props){ 8 | props.forEach(function(x) { 9 | result[x.key] = x.value; 10 | }); 11 | } 12 | return result; 13 | } 14 | 15 | function createTween(value){ 16 | var tween = merge(value); 17 | tween.from = merge(tween.from); 18 | tween.to = merge(tween.to); 19 | return tween; 20 | } 21 | 22 | var dataKeys = ["props", "on", "tween", "keyboard"]; 23 | var tweenPrefix = "tween-"; 24 | var onPrefix = "on-"; 25 | 26 | function convertProps(props){ 27 | var o = {}; 28 | dataKeys.forEach(function(x) { 29 | o[x] = {}; 30 | }); 31 | props.forEach(function(x){ 32 | var value = x.value; 33 | var key = x.key; 34 | if(!key){ 35 | }else if(key == "key"){ 36 | o.key = value; 37 | }else if(key.indexOf(tweenPrefix) == 0){ 38 | var tweenKey = key.replace(tweenPrefix, ""); 39 | o.tween[tweenKey] = createTween(value); 40 | }else if(key.indexOf(onPrefix) == 0){ 41 | var onKey = key.replace(onPrefix, ""); 42 | if(onKey == "mouseortouchstart"){ 43 | o.on["touchstart"] = value; 44 | o.on["mousedown"] = value; 45 | }else{ 46 | o.on[onKey] = value; 47 | } 48 | }else if(key == "keyboard"){ 49 | value.forEach(function(x) { 50 | o.keyboard[x.keys] = x; 51 | }); 52 | }else{ 53 | o.props[key] = value; 54 | } 55 | }); 56 | return o; 57 | }; 58 | 59 | function createNode(name, props, children){ 60 | var data = convertProps(props); 61 | var s = vp.h(name, data, children.filter(function(x) { 62 | return x != null; 63 | })); 64 | return s; 65 | } 66 | 67 | function thunk(name, render, state){ 68 | return vp.thunk(name, render, state); 69 | } 70 | 71 | function thunk4(name, render, state, compare){ 72 | return vp.thunk(name, render, state, function(x,y){ 73 | return compare(x)(y); 74 | }); 75 | } 76 | 77 | function addProps(newData, oldData){ 78 | dataKeys.forEach(function(dataKey){ 79 | var newProps = newData[dataKey]; 80 | var oldProps = oldData[dataKey]; 81 | for(var key in oldProps){ 82 | if(!newProps[key]){ 83 | newProps[key] = oldProps[key]; 84 | } 85 | } 86 | }); 87 | } 88 | 89 | function setProps(props, node){ 90 | var data = convertProps(props); 91 | addProps(data, node.data); 92 | return vp.h(node.sel, data, node.children); 93 | } 94 | 95 | exports._createNode = createNode; 96 | exports._thunk = thunk; 97 | exports._thunk4 = thunk4; 98 | exports._setProps = setProps; 99 | exports.empty = null; 100 | 101 | -------------------------------------------------------------------------------- /src/Dom.purs: -------------------------------------------------------------------------------- 1 | module Sigment.Dom where 2 | 3 | import Sigment.Dom.Props (Props) 4 | import Data.Function.Uncurried (Fn2, Fn4, Fn3, runFn2, runFn4, runFn3) 5 | 6 | foreign import data Node :: Type 7 | 8 | foreign import _createNode :: Fn3 String Props (Array Node) Node 9 | 10 | createNode :: String -> Props -> Array Node -> Node 11 | createNode = runFn3 _createNode 12 | 13 | group' :: Props -> Array Node -> Node 14 | group' = createNode "group" 15 | 16 | group :: Array Node -> Node 17 | group = group' [] 18 | 19 | text' :: Props -> Array Node -> Node 20 | text' = createNode "text" 21 | 22 | text :: Props -> Node 23 | text props = text' props [] 24 | 25 | sprite' :: Props -> Array Node -> Node 26 | sprite' = createNode "sprite" 27 | 28 | sprite :: Props -> Node 29 | sprite props = sprite' props [] 30 | 31 | foreign import _thunk ::forall a. Fn3 String (a -> Node) a Node 32 | 33 | thunk :: forall a. String -> (a -> Node) -> a -> Node 34 | thunk = runFn3 _thunk 35 | 36 | foreign import _thunk4 ::forall a. Fn4 String (a -> Node) a (a -> a -> Boolean) Node 37 | 38 | thunk4 :: forall a. String -> (a -> Node) -> a -> (a -> a -> Boolean) -> Node 39 | thunk4 = runFn4 _thunk4 40 | 41 | foreign import _setProps :: Fn2 Props Node Node 42 | 43 | setProps :: Props -> Node -> Node 44 | setProps = runFn2 _setProps 45 | 46 | foreign import empty :: Node 47 | 48 | permanent :: String -> Node -> Node 49 | permanent name node = thunk name (\_ -> node) true 50 | 51 | -------------------------------------------------------------------------------- /src/Dom/Props.js: -------------------------------------------------------------------------------- 1 | function createProp(key,value){ 2 | return {key:key, value:value}; 3 | } 4 | 5 | function newRectangle(x, y, width, height){ 6 | return new PIXI.Rectangle(x, y, width, height); 7 | } 8 | 9 | 10 | function newPoint(x, y){ 11 | return new PIXI.Point(x, y); 12 | } 13 | 14 | exports._createProp = createProp; 15 | exports._newRectangle = newRectangle; 16 | exports._newPoint = newPoint; 17 | 18 | exports.none = {}; 19 | -------------------------------------------------------------------------------- /src/Dom/Props.purs: -------------------------------------------------------------------------------- 1 | module Sigment.Dom.Props where 2 | 3 | import Prelude 4 | import Control.Monad.Eff (Eff) 5 | import Data.Function.Uncurried (Fn2, Fn4, runFn2, runFn4) 6 | 7 | type Props = Array Prop 8 | 9 | foreign import data Prop :: Type 10 | 11 | foreign import data Rectangle :: Type 12 | 13 | foreign import data Point :: Type 14 | 15 | foreign import none :: Prop 16 | 17 | foreign import _createProp :: forall val. Fn2 String val Prop 18 | 19 | createProp :: forall val. String -> val -> Prop 20 | createProp = runFn2 _createProp 21 | 22 | foreign import _newRectangle :: Fn4 Int Int Int Int Rectangle 23 | 24 | newRectangle :: Int -> Int -> Int -> Int -> Rectangle 25 | newRectangle = runFn4 _newRectangle 26 | 27 | foreign import _newPoint :: forall a. Fn2 a a Point 28 | 29 | newPoint :: forall a. a -> a -> Point 30 | newPoint = runFn2 _newPoint 31 | 32 | newPoint1 :: forall a. a -> Point 33 | newPoint1 x' = newPoint x' x' 34 | 35 | x :: forall a. Ring a => a-> Prop 36 | x = createProp "x" 37 | 38 | y :: forall a. Ring a => a-> Prop 39 | y = createProp "y" 40 | 41 | width :: forall a. Ring a => a-> Prop 42 | width = createProp "width" 43 | 44 | height :: forall a. Ring a => a-> Prop 45 | height = createProp "height" 46 | 47 | type KeyData eff = 48 | { keys :: String 49 | , callback :: Eff eff Unit 50 | , action :: String 51 | } 52 | 53 | newKeys :: forall eff. String -> Eff eff Unit -> KeyData eff 54 | newKeys keys callback = { keys, callback, action : "keydown" } 55 | 56 | keyboard :: forall eff. Array (KeyData eff) -> Prop 57 | keyboard = createProp "keyboard" 58 | 59 | scale :: Point -> Prop 60 | scale = createProp "scale" 61 | 62 | scaleOne :: Prop 63 | scaleOne = scale1 1.0 64 | 65 | scaleZero :: Prop 66 | scaleZero = scale1 0.0 67 | 68 | scale1 :: forall a. a -> Prop 69 | scale1 x' = scale (newPoint1 x') 70 | 71 | scale2 :: forall a. a -> a -> Prop 72 | scale2 x' y' = scale (newPoint x' y') 73 | 74 | hitArea :: Rectangle -> Prop 75 | hitArea = createProp "hitArea" 76 | 77 | anchor :: Point -> Prop 78 | anchor = createProp "anchor" 79 | 80 | anchorCenter :: Prop 81 | anchorCenter = anchor (newPoint1 0.5) 82 | 83 | pivot :: Point -> Prop 84 | pivot = createProp "pivot" 85 | 86 | pivotAnchor :: Point -> Prop 87 | pivotAnchor = createProp "pivotAnchor" 88 | 89 | pivotCenter :: Prop 90 | pivotCenter = pivotAnchor (newPoint1 0.5) 91 | 92 | pivotCenterX :: Prop 93 | pivotCenterX = pivotAnchor (newPoint 0.5 0.0) 94 | 95 | pivotCenterY :: Prop 96 | pivotCenterY = pivotAnchor (newPoint 0.0 0.5) 97 | 98 | alpha :: Number -> Prop 99 | alpha = createProp "alpha" 100 | 101 | rotation :: Number -> Prop 102 | rotation = createProp "rotation" 103 | 104 | txt :: String -> Prop 105 | txt = createProp "text" 106 | 107 | style :: forall vals. { | vals } -> Prop 108 | style = createProp "style" 109 | 110 | key :: forall a. a -> Prop 111 | key = createProp "key" 112 | 113 | src :: String -> Prop 114 | src = createProp "src" 115 | 116 | cacheAsBitmap :: Boolean -> Prop 117 | cacheAsBitmap = createProp "cacheAsBitmap" 118 | 119 | onClick :: forall eff. Eff eff Unit -> Prop 120 | onClick = createProp "on-click" 121 | 122 | onMouseDown :: forall eff. Eff eff Unit -> Prop 123 | onMouseDown = createProp "on-mousedown" 124 | 125 | onTouchStart :: forall eff. Eff eff Unit -> Prop 126 | onTouchStart = createProp "on-touchstart" 127 | 128 | onMouseOrTouchStart :: forall eff. Eff eff Unit -> Prop 129 | onMouseOrTouchStart = createProp "on-mouseortouchstart" 130 | -------------------------------------------------------------------------------- /src/Dom/Tweens.js: -------------------------------------------------------------------------------- 1 | function lowerFirstChar(string) { 2 | return string.charAt(0).toLowerCase() + string.slice(1); 3 | } 4 | 5 | function convertEasing(){ 6 | var result = {}; 7 | for(var key in TWEEN.Easing){ 8 | var easing = TWEEN.Easing[key]; 9 | result[lowerFirstChar(key)] = {in: easing.In, out: easing.Out, inOut : easing.InOut}; 10 | } 11 | return result; 12 | } 13 | 14 | exports.types = convertEasing(); 15 | -------------------------------------------------------------------------------- /src/Dom/Tweens.purs: -------------------------------------------------------------------------------- 1 | module Sigment.Dom.Tweens where 2 | 3 | import Prelude (Unit) 4 | import Sigment.Dom.Props (Prop, Props, createProp) 5 | import Control.Monad.Eff (Eff) 6 | 7 | to :: Props -> Prop 8 | to = createProp "to" 9 | 10 | from :: Props -> Prop 11 | from = createProp "from" 12 | 13 | duration :: Int -> Prop 14 | duration = createProp "duration" 15 | 16 | yoyo :: Boolean -> Prop 17 | yoyo = createProp "yoyo" 18 | 19 | yoyoOnce :: Props 20 | yoyoOnce = [yoyo true, repeat 1] 21 | 22 | repeat :: Int -> Prop 23 | repeat = createProp "repeat" 24 | 25 | foreign import data EasingType :: Type 26 | 27 | type InAndOut a = 28 | { in :: a 29 | , out :: a 30 | , inOut :: a 31 | } 32 | 33 | map :: forall a b. (a -> b) -> InAndOut a -> InAndOut b 34 | map f x = 35 | { in : f x.in 36 | , out : f x.out 37 | , inOut : f x.inOut 38 | } 39 | 40 | foreign import types :: 41 | { linear :: InAndOut EasingType 42 | , quadratic :: InAndOut EasingType 43 | , cubic :: InAndOut EasingType 44 | , quartic :: InAndOut EasingType 45 | , quintic :: InAndOut EasingType 46 | , sinusoidal :: InAndOut EasingType 47 | , exponential :: InAndOut EasingType 48 | , circular :: InAndOut EasingType 49 | , elastic :: InAndOut EasingType 50 | , back :: InAndOut EasingType 51 | , bounce :: InAndOut EasingType 52 | } 53 | 54 | easing :: EasingType -> Prop 55 | easing = createProp "easing" 56 | 57 | easingLinear :: InAndOut Prop 58 | easingLinear = map easing types.linear 59 | 60 | easingQuadratic :: InAndOut Prop 61 | easingQuadratic = map easing types.quadratic 62 | 63 | easingCubic :: InAndOut Prop 64 | easingCubic = map easing types.cubic 65 | 66 | easingQuartic :: InAndOut Prop 67 | easingQuartic = map easing types.quartic 68 | 69 | easingQuintic :: InAndOut Prop 70 | easingQuintic = map easing types.quintic 71 | 72 | easingSinusoidal :: InAndOut Prop 73 | easingSinusoidal = map easing types.sinusoidal 74 | 75 | easingExponential :: InAndOut Prop 76 | easingExponential = map easing types.exponential 77 | 78 | easingCircular :: InAndOut Prop 79 | easingCircular = map easing types.circular 80 | 81 | easingElastic :: InAndOut Prop 82 | easingElastic = map easing types.elastic 83 | 84 | easingBack :: InAndOut Prop 85 | easingBack = map easing types.back 86 | 87 | easingBounce :: InAndOut Prop 88 | easingBounce = map easing types.bounce 89 | 90 | onComplete :: forall eff. Eff eff Unit -> Prop 91 | onComplete = createProp "onComplete" 92 | 93 | updating :: Props -> Prop 94 | updating = createProp "tween-update" 95 | 96 | removing :: Props -> Prop 97 | removing = createProp "tween-remove" 98 | 99 | creating :: Props -> Prop 100 | creating = createProp "tween-create" 101 | 102 | -------------------------------------------------------------------------------- /src/Dom/Utils.purs: -------------------------------------------------------------------------------- 1 | module Sigment.Dom.Utils where 2 | 3 | import Prelude 4 | import Sigment.Dom as D 5 | import Sigment.Dom.Props as P 6 | import Data.Array as A 7 | 8 | mapIndex :: forall a c. (a -> Int -> c) -> Array a -> Array c 9 | mapIndex f a = A.zipWith f a (A.range 0 (A.length a - 1)) 10 | 11 | stackH :: Int -> Array D.Node -> Array D.Node 12 | stackH distance = mapIndex (\x i -> D.setProps [P.x $ i * distance] x) 13 | 14 | stackV :: Int -> Array D.Node -> Array D.Node 15 | stackV distance = mapIndex (\x i -> D.setProps [P.y $ i * distance] x) 16 | -------------------------------------------------------------------------------- /src/Sigment.purs: -------------------------------------------------------------------------------- 1 | module Sigment where 2 | 3 | import Prelude 4 | import Control.Monad.Eff.Ref (REF, Ref, readRef, writeRef, newRef) 5 | import Control.Monad.Eff (Eff) 6 | import Data.Maybe (Maybe(..), maybe) 7 | import Sigment.Core (Config, updateStage, requestAnimationFrame, initSigment) 8 | import Sigment.Dom as D 9 | 10 | type EvalResult state eff = Eff eff state 11 | type Dispatch a eff = a -> Eff eff Unit 12 | type Eval a state eff = a -> state -> Dispatch a eff -> EvalResult state eff 13 | type PureEval a state = a -> state -> state 14 | 15 | type Render a state eff = Maybe a -> state -> Dispatch a eff -> D.Node 16 | type Init i state eff = i -> Eff eff state 17 | 18 | type Component i a state eff = { 19 | init :: Init i state eff, 20 | eval :: Eval a state eff, 21 | render :: Render a state eff 22 | } 23 | 24 | pureEval :: forall a state eff. PureEval a state -> Eval a state eff 25 | pureEval eval a s d = pure $ (eval a s) 26 | 27 | newComponent :: forall i a state eff. Init i state eff -> Eval a state eff -> Render a state eff -> Component i a state eff 28 | newComponent = {init:_, eval:_, render:_} 29 | 30 | defConfig :: forall a. Config a 31 | defConfig = { 32 | sprites: [], 33 | width: 800, 34 | height: 600, 35 | frameAction : Nothing, 36 | containerId : "", 37 | backgroundColor : "000000", 38 | initAction : Nothing 39 | } 40 | 41 | init :: forall i state a eff. Config a -> i -> Component i a state (ref :: REF | eff) -> Eff (ref :: REF | eff) (a -> Eff (ref :: REF | eff) Unit) 42 | init config initParam component = do 43 | initState <- (component.init initParam) 44 | stateRef <- newRef initState 45 | let dispatch = updateStateRef stateRef component.eval component.render 46 | initSigment dispatch map config 47 | (config.initAction # maybe (updateStage (component.render Nothing initState dispatch)) dispatch) 48 | pure $ dispatch 49 | 50 | updateStateRef :: forall state a eff. Ref state -> Eval a state (ref :: REF | eff) -> Render a state (ref :: REF | eff) -> a -> Eff ( ref :: REF | eff) Unit 51 | updateStateRef stateRef eval render action = do 52 | oldState <- readRef stateRef 53 | let dispatch = updateStateRef stateRef eval render 54 | let dispatchNextFrame a = requestAnimationFrame (dispatch a) 55 | result <- eval action oldState dispatchNextFrame 56 | writeRef stateRef result 57 | newState <- readRef stateRef 58 | let vNode = render (Just action) newState dispatch 59 | updateStage vNode 60 | 61 | -------------------------------------------------------------------------------- /src/Sigment/Subcomponents.purs: -------------------------------------------------------------------------------- 1 | module Sigment.Subcomponents where 2 | 3 | import Control.Monad.Eff (Eff) 4 | import Data.Maybe (Maybe(..), fromMaybe, fromMaybe') 5 | import Prelude 6 | import Data.Array (null, head, tail, foldM) 7 | import Sigment (Dispatch, Component) 8 | import Sigment.Dom as D 9 | 10 | type Accessor key a s subA subS = 11 | { actionUnwrap :: a -> Maybe subA 12 | , actionWrap :: key -> subA -> a 13 | , stateGet :: key -> s -> Maybe subS 14 | , stateSet :: key -> Maybe s -> subS -> s 15 | } 16 | 17 | type Subcomponent i a s eff = 18 | { init :: i -> Eff eff s 19 | , eval :: a -> s -> Dispatch a eff -> Eff eff s 20 | , render :: Maybe a -> s -> Dispatch a eff -> Maybe D.Node 21 | } 22 | 23 | type SubcomponentER a s eff = 24 | { eval :: a -> s -> Dispatch a eff -> Eff eff s 25 | , render :: Maybe a -> s -> Dispatch a eff -> Maybe D.Node 26 | } 27 | 28 | toER :: forall i a s eff. Subcomponent i a s eff -> SubcomponentER a s eff 29 | toER meta = 30 | { eval : meta.eval 31 | , render : meta.render 32 | } 33 | 34 | type SubcomponentData key i a s subA subS eff = 35 | { component :: Component i subA subS eff 36 | , accessor :: Accessor key a s subA subS 37 | } 38 | 39 | newSubcomponent :: forall i a s subA subS eff. Component i subA subS eff -> Accessor Unit a s subA subS -> Subcomponent i a s eff 40 | newSubcomponent component accessor = { init, eval, render } 41 | where 42 | init i = initSubcomponent i subData 43 | eval = evalSubcomponent subData 44 | render = renderSubcomponent subData 45 | subData = { component, accessor } 46 | 47 | type SubcomponentWithKey key a s eff = 48 | { eval :: key -> a -> s -> Dispatch a eff -> Eff eff s 49 | , render :: key -> Maybe a -> s -> Dispatch a eff -> Maybe D.Node 50 | } 51 | 52 | newSubcomponentWithKey :: forall key i a s subA subS eff. Component i subA subS eff -> Accessor key a s subA subS -> SubcomponentWithKey key a s eff 53 | newSubcomponentWithKey component accessor = 54 | { eval : \key -> evalSubcomponentWithKey key subData 55 | , render : \key -> renderSubcomponentWithKey key subData 56 | } 57 | 58 | where 59 | subData = {component, accessor} 60 | 61 | initSubcomponent :: forall i a s subA subS eff. i -> SubcomponentData Unit i a s subA subS eff -> Eff eff s 62 | initSubcomponent initParam subcomponent = do 63 | initState <- subcomponent.component.init initParam 64 | pure $ acc.stateSet unit Nothing initState 65 | 66 | where 67 | acc = subcomponent.accessor 68 | 69 | evalSubcomponents :: forall a m eff. Array (SubcomponentER a m eff) -> a -> m -> Dispatch a eff -> Eff eff m 70 | evalSubcomponents subcomponents action state dispatch = 71 | foldM (\acc subcomponent -> subcomponent.eval action acc dispatch) state subcomponents 72 | 73 | renderSubcomponents :: forall a m eff. Array (SubcomponentER a m eff) -> Maybe a -> m -> Dispatch a eff -> D.Node 74 | renderSubcomponents subcomponents action state dispatch = 75 | if null subcomponents then D.empty 76 | else 77 | fromMaybe' (const $ renderSubcomponents tail' action state dispatch) mnode 78 | 79 | where 80 | tail' = fromMaybe' (const []) $ tail subcomponents 81 | mnode = (\subcomponent -> subcomponent.render action state dispatch) =<< head subcomponents 82 | 83 | evalSubcomponent :: forall i a s subA subS eff. SubcomponentData Unit i a s subA subS eff -> a -> s -> Dispatch a eff -> Eff eff s 84 | evalSubcomponent = evalSubcomponentWithKey unit 85 | 86 | evalSubcomponentWithKey :: forall key i a s subA subS eff. key -> SubcomponentData key i a s subA subS eff -> a -> s -> Dispatch a eff -> Eff eff s 87 | evalSubcomponentWithKey key subcomponent action state dispatch = fromMaybe (pure state) do 88 | act <- acc.actionUnwrap action 89 | st <- acc.stateGet key state 90 | pure do 91 | x' <- subcomponent.component.eval act st (\x -> dispatch (acc.actionWrap key x)) 92 | pure (acc.stateSet key (Just state) x') 93 | 94 | where 95 | acc = subcomponent.accessor 96 | 97 | renderSubcomponent :: forall i a s subA subS eff. SubcomponentData Unit i a s subA subS eff -> Maybe a -> s -> Dispatch a eff -> Maybe D.Node 98 | renderSubcomponent = renderSubcomponentWithKey unit 99 | 100 | renderSubcomponentWithKey :: forall key i a s subA subS eff. key -> SubcomponentData key i a s subA subS eff -> Maybe a -> s -> Dispatch a eff -> Maybe D.Node 101 | renderSubcomponentWithKey key subcomponent action state dispatch = do 102 | st <- acc.stateGet key state 103 | pure $ render (action >>= acc.actionUnwrap) st (\x -> dispatch (acc.actionWrap key x)) 104 | 105 | where 106 | acc = subcomponent.accessor 107 | render = subcomponent.component.render 108 | --------------------------------------------------------------------------------