diff options
Diffstat (limited to 'app/Scratchy')
| -rw-r--r-- | app/Scratchy/Syntax.hs | 42 | ||||
| -rw-r--r-- | app/Scratchy/World.hs | 75 |
2 files changed, 58 insertions, 59 deletions
diff --git a/app/Scratchy/Syntax.hs b/app/Scratchy/Syntax.hs index 128ea01..277cebd 100644 --- a/app/Scratchy/Syntax.hs +++ b/app/Scratchy/Syntax.hs @@ -88,64 +88,64 @@ combine (Pure ()) p2 = p2 combine p1 (Pure ()) = p1 combine (OnKeyEvent k1 handler1 cont1) p2 = - OnKeyEvent k1 handler1 (combine cont1 p2) + OnKeyEvent k1 handler1 (combine cont1 p2) combine p1 (OnKeyEvent k2 handler2 cont2) = - OnKeyEvent k2 handler2 (combine p1 cont2) + OnKeyEvent k2 handler2 (combine p1 cont2) combine (OnTargetReached sp1 h1 c1) p2 = - OnTargetReached sp1 h1 (combine c1 p2) + OnTargetReached sp1 h1 (combine c1 p2) combine p1 (OnTargetReached sp2 h2 c2) = - OnTargetReached sp2 h2 (combine p1 c2) + OnTargetReached sp2 h2 (combine p1 c2) combine (OnTargetUpdated sp1 h1 c1) p2 = - OnTargetUpdated sp1 h1 (combine c1 p2) + OnTargetUpdated sp1 h1 (combine c1 p2) combine p1 (OnTargetUpdated sp2 h2 c2) = - OnTargetUpdated sp2 h2 (combine p1 c2) + OnTargetUpdated sp2 h2 (combine p1 c2) combine (OnBarrierHit sp1 h1 c1) p2 = - OnBarrierHit sp1 h1 (combine c1 p2) + OnBarrierHit sp1 h1 (combine c1 p2) combine p1 (OnBarrierHit sp2 h2 c2) = - OnBarrierHit sp2 h2 (combine p1 c2) + OnBarrierHit sp2 h2 (combine p1 c2) combine (After dur1 handler1 cont1) p2 = - After dur1 handler1 (combine cont1 p2) + After dur1 handler1 (combine cont1 p2) combine p1 (After dur2 handler2 cont2) = - After dur2 handler2 (combine p1 cont2) + After dur2 handler2 (combine p1 cont2) combine (NewSprite cell pic k1) p2 = - NewSprite cell pic (\sp -> combine (k1 sp) p2) + NewSprite cell pic (\sp -> combine (k1 sp) p2) combine p1 (NewSprite cell pic k2) = - NewSprite cell pic (combine p1 . k2) + NewSprite cell pic (combine p1 . k2) combine (SetColor sp c cont1) p2 = - SetColor sp c (combine cont1 p2) + SetColor sp c (combine cont1 p2) combine p1 (SetColor sp c cont2) = - SetColor sp c (combine p1 cont2) + SetColor sp c (combine p1 cont2) combine (SetTarget sp cell cont1) p2 = - SetTarget sp cell (combine cont1 p2) + SetTarget sp cell (combine cont1 p2) combine p1 (SetTarget sp cell cont2) = - SetTarget sp cell (combine p1 cont2) + SetTarget sp cell (combine p1 cont2) combine (GetTarget sp k1) p2 = - GetTarget sp (\cell -> combine (k1 cell) p2) + GetTarget sp (\cell -> combine (k1 cell) p2) combine p1 (GetTarget sp k2) = - GetTarget sp (combine p1 . k2) + GetTarget sp (combine p1 . k2) combine (SetBackgroundColor c cont1) p2 = - SetBackgroundColor c (combine cont1 p2) + SetBackgroundColor c (combine cont1 p2) combine p1 (SetBackgroundColor c cont2) = - SetBackgroundColor c (combine p1 cont2) + SetBackgroundColor c (combine p1 cont2) combine (InspectCell cell k1) p2 = - InspectCell cell (\result -> combine (k1 result) p2) + InspectCell cell (\result -> combine (k1 result) p2) diff --git a/app/Scratchy/World.hs b/app/Scratchy/World.hs index 89d45e5..c128682 100644 --- a/app/Scratchy/World.hs +++ b/app/Scratchy/World.hs @@ -186,52 +186,51 @@ tickTimers = Game $ \w@World{..} -> runProg :: Game () runProg = Game $ \w -> (go (prog w) w { prog = Pure () } , ()) - where - go :: SProg () -> World -> World - go (Pure ()) w = w + where + go :: SProg () -> World -> World + go (Pure ()) w = w - go (OnKeyEvent k handler cont) w = - go cont (w { keyHdlrs = (k, handler) : keyHdlrs w }) + go (OnKeyEvent k handler cont) w = + go cont (w { keyHdlrs = (k, handler) : keyHdlrs w }) - go (OnTargetReached ptr handler cont) w = - go cont (w { trHdlrs = (ptr, handler) : trHdlrs w }) + go (OnTargetReached ptr handler cont) w = + go cont (w { trHdlrs = (ptr, handler) : trHdlrs w }) - go (OnTargetUpdated ptr handler cont) w = - go cont (w { tuHdlrs = (ptr, handler) : tuHdlrs w }) + go (OnTargetUpdated ptr handler cont) w = + go cont (w { tuHdlrs = (ptr, handler) : tuHdlrs w }) - go (OnBarrierHit ptr handler cont) w = - go cont (w { bhHdlrs = (ptr, handler) : bhHdlrs w }) + go (OnBarrierHit ptr handler cont) w = + go cont (w { bhHdlrs = (ptr, handler) : bhHdlrs w }) - go (NewSprite cell pic k) w = - let ptr = length (sprites w) - sprite = Sprite pic (bimap fromIntegral fromIntegral cell) cell - in go (k ptr) (w { sprites = sprites w ++ [sprite] }) + go (NewSprite cell pic k) w = + let ptr = length (sprites w) + sprite = Sprite pic (bimap fromIntegral fromIntegral cell) cell + in go (k ptr) (w { sprites = sprites w ++ [sprite] }) - go (SetColor ptr c cont) w = - go cont (w { sprites = setAt ptr (spr { pic = pic' }) - (sprites w) }) - where - spr = sprites w !! ptr - pic' = Graphics.Gloss.Interface.Pure.Game.color c (pic spr) + go (SetColor ptr c cont) w = + go cont (w { sprites = setAt ptr (spr { pic = pic' }) (sprites w) }) + where + spr = sprites w !! ptr + pic' = Graphics.Gloss.Interface.Pure.Game.color c (pic spr) - go (SetTarget ptr cell cont) w = - let w' = fst $ runGame (setSpriteTarget ptr cell) w - in go cont w' + go (SetTarget ptr cell cont) w = + let w' = fst $ runGame (setSpriteTarget ptr cell) w + in go cont w' - go (GetTarget ptr k) w = - let targetCell = tgt (sprites w !! ptr) - in go (k targetCell) w + go (GetTarget ptr k) w = + let targetCell = tgt (sprites w !! ptr) + in go (k targetCell) w - go (SetBackgroundColor c cont) w = - go cont (w { bg = c }) + go (SetBackgroundColor c cont) w = + go cont (w { bg = c }) - go (InspectCell cell k) w = - case spriteExistsAt cell (sprites w) of - Just _ -> go (k HasSprite) w - Nothing -> - if inBounds cell - then go (k IsFree) w - else go (k HasBarrier) w + go (InspectCell cell k) w = + case spriteExistsAt cell (sprites w) of + Just _ -> go (k HasSprite) w + Nothing -> + if inBounds cell + then go (k IsFree) w + else go (k HasBarrier) w - go (After dur handler cont) w = - go cont (w { timers = (dur, handler) : timers w }) + go (After dur handler cont) w = + go cont (w { timers = (dur, handler) : timers w }) |