From b9a23720c7ebe67f84bec0af147fca9b132525ac Mon Sep 17 00:00:00 2001
From: Mikkel Thestrup <mithe24@student.sdu.dk>
Date: Thu, 25 Dec 2025 15:21:35 +0100
Subject: Feat(Scratchy): Implemented Scratchy DSL

Sprite and Grid Actions;
    - NewSprite
    - SetColor
    - SetTarget
    - GetTarget
    - SetBackgroundColor
    - InspectCell

Event Listening;
    - OnKeyEvent
    - OnTargetReached
    - OnTargetUpdated
    - OnBarrierHit

Timer Operation;
    - After
---
 app/Scratchy/World.hs | 55 +++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 51 insertions(+), 4 deletions(-)

(limited to 'app/Scratchy/World.hs')

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 })
-- 
cgit v1.2.3-70-g09d2