diff options
Diffstat (limited to 'app/Scratchy/World.hs')
| -rw-r--r-- | app/Scratchy/World.hs | 75 |
1 files changed, 37 insertions, 38 deletions
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 }) |