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/Syntax.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++++-
 app/Scratchy/World.hs  | 55 ++++++++++++++++++++++++++++++++++++++---
 2 files changed, 116 insertions(+), 5 deletions(-)

(limited to 'app')

diff --git a/app/Scratchy/Syntax.hs b/app/Scratchy/Syntax.hs
index c77e51a..128ea01 100644
--- a/app/Scratchy/Syntax.hs
+++ b/app/Scratchy/Syntax.hs
@@ -82,6 +82,70 @@ data SProg a
 ------------------------------------------------------------
 
 combine :: SProg () -> SProg () -> SProg ()
-combine = undefined -- Fill this in
 
+-- Base cases
+combine (Pure ()) p2 = p2
+combine p1 (Pure ()) = p1
 
+combine (OnKeyEvent k1 handler1 cont1) p2 =
+    OnKeyEvent k1 handler1 (combine cont1 p2)
+
+combine p1 (OnKeyEvent k2 handler2 cont2) =
+    OnKeyEvent k2 handler2 (combine p1 cont2)
+
+combine (OnTargetReached sp1 h1 c1) p2 =
+    OnTargetReached sp1 h1 (combine c1 p2)
+ 
+combine p1 (OnTargetReached sp2 h2 c2) =
+    OnTargetReached sp2 h2 (combine p1 c2)
+
+combine (OnTargetUpdated sp1 h1 c1) p2 =
+    OnTargetUpdated sp1 h1 (combine c1 p2)
+
+combine p1 (OnTargetUpdated sp2 h2 c2) =
+    OnTargetUpdated sp2 h2 (combine p1 c2)
+
+combine (OnBarrierHit sp1 h1 c1) p2 =
+    OnBarrierHit sp1 h1 (combine c1 p2)
+
+combine p1 (OnBarrierHit sp2 h2 c2) =
+    OnBarrierHit sp2 h2 (combine p1 c2)
+
+combine (After dur1 handler1 cont1) p2 =
+    After dur1 handler1 (combine cont1 p2)
+
+combine p1 (After dur2 handler2 cont2) =
+    After dur2 handler2 (combine p1 cont2)
+
+combine (NewSprite cell pic k1) p2 =
+    NewSprite cell pic (\sp -> combine (k1 sp) p2)
+
+combine p1 (NewSprite cell pic k2) =
+    NewSprite cell pic (combine p1 . k2)
+
+combine (SetColor sp c cont1) p2 =
+    SetColor sp c (combine cont1 p2)
+ 
+combine p1 (SetColor sp c cont2) =
+    SetColor sp c (combine p1 cont2)
+
+combine (SetTarget sp cell cont1) p2 =
+    SetTarget sp cell (combine cont1 p2)
+
+combine p1 (SetTarget sp cell cont2) =
+    SetTarget sp cell (combine p1 cont2)
+
+combine (GetTarget sp k1) p2 =
+    GetTarget sp (\cell -> combine (k1 cell) p2)
+ 
+combine p1 (GetTarget sp k2) =
+    GetTarget sp (combine p1 . k2)
+
+combine (SetBackgroundColor c cont1) p2 =
+    SetBackgroundColor c (combine cont1 p2)
+ 
+combine p1 (SetBackgroundColor c cont2) =
+    SetBackgroundColor c (combine p1 cont2)
+
+combine (InspectCell cell k1) p2 =
+    InspectCell cell (\result -> combine (k1 result) p2)
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