diff options
Diffstat (limited to '')
| -rw-r--r-- | app/Scratchy/World.hs | 53 |
1 files changed, 50 insertions, 3 deletions
diff --git a/app/Scratchy/World.hs b/app/Scratchy/World.hs index e727baf..89d45e5 100644 --- a/app/Scratchy/World.hs +++ b/app/Scratchy/World.hs @@ -6,6 +6,8 @@ import Graphics.Gloss.Interface.Pure.Game import Scratchy.Syntax +import Data.Bifunctor (bimap) + -- Some useful helpers ------------------------------------------------------------ @@ -184,7 +186,52 @@ tickTimers = Game $ \w@World{..} -> runProg :: Game () runProg = Game $ \w -> (go (prog w) w { prog = Pure () } , ()) - where - go :: SProg () -> World -> World - go = undefined -- Fill this in + where + go :: SProg () -> World -> World + go (Pure ()) w = 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 (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 (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 (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 (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 (After dur handler cont) w = + go cont (w { timers = (dur, handler) : timers w }) |