summaryrefslogtreecommitdiff
path: root/app/Scratchy/World.hs
diff options
context:
space:
mode:
authorMikkel Thestrup <mithe24@student.sdu.dk>2025-12-25 15:21:35 +0100
committerMikkel Thestrup <mithe24@student.sdu.dk>2025-12-25 15:21:35 +0100
commitb9a23720c7ebe67f84bec0af147fca9b132525ac (patch)
tree92b914e608e63b6c1405e0c749759ab196bcb3b1 /app/Scratchy/World.hs
parenta517d54e9032299e6f550759ac0bb6df3f9aa38c (diff)
downloadscratchy-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 'app/Scratchy/World.hs')
-rw-r--r--app/Scratchy/World.hs53
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 })