diff options
| author | Mikkel Thestrup <mithe24@student.sdu.dk> | 2025-12-25 15:21:35 +0100 |
|---|---|---|
| committer | Mikkel Thestrup <mithe24@student.sdu.dk> | 2025-12-25 15:21:35 +0100 |
| commit | b9a23720c7ebe67f84bec0af147fca9b132525ac (patch) | |
| tree | 92b914e608e63b6c1405e0c749759ab196bcb3b1 /app/Scratchy/World.hs | |
| parent | a517d54e9032299e6f550759ac0bb6df3f9aa38c (diff) | |
| download | scratchy-b9a23720c7ebe67f84bec0af147fca9b132525ac.tar.gz scratchy-b9a23720c7ebe67f84bec0af147fca9b132525ac.zip | |
Feat(Scratchy): Implemented Scratchy DSL
Sprite and Grid Actions;
- NewSprite
- SetColor
- SetTarget
- GetTarget
- SetBackgroundColor
- InspectCell
Event Listening;
- OnKeyEvent
- OnTargetReached
- OnTargetUpdated
- OnBarrierHit
Timer Operation;
- After
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 }) |