Feat(Snakey): Added implementation for Snakey game

4 files changed, 86 insertions, 5 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 71356d4..76b7413 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Revision history for scratchy
 
+## 1.0.0.0 -- 2025-12-25
+* MVP for Scratchy DSL and Snakey game.
+* TODO! Centralize collision detection,
+        to avoid 'blinking' when more than one
+        event occurs at a time
+
 ## 0.1.0.0 -- 2025-12-15
 
 * Initial state of the project. Only includes the given files.
diff --git a/app/Scratchy.hs b/app/Scratchy.hs
index cea910d..f2ac9a2 100644
--- a/app/Scratchy.hs
+++ b/app/Scratchy.hs
@@ -5,7 +5,7 @@ import Graphics.Gloss.Interface.Pure.Game
 import Scratchy.World
 import Scratchy.Syntax
 
-import Example.CircleThatMoves
+import Snakey.TwoSnakes
 
 -- Main
 ------------------------------------------------------------
@@ -19,7 +19,7 @@ main = play
     white
     []
     []
-    circSprite
+    twoSnakes
     []
     []
     []
@@ -32,7 +32,6 @@ main = play
                      >> moveSprites tick
                      >> handleKeyEvents
                      >> tickTimers
-                     >> runProg
                    ) )
 
 
@@ -72,5 +71,3 @@ toScreen (gx, gy) =
   let fx = gx - (fromIntegral gridW - 1) / 2
       fy = gy - (fromIntegral gridH - 1) / 2
   in (fx * cellSize, fy * cellSize)
-
-
diff --git a/app/Snakey/TwoSnakes.hs b/app/Snakey/TwoSnakes.hs
new file mode 100644
index 0000000..f8c3e95
--- /dev/null
+++ b/app/Snakey/TwoSnakes.hs
@@ -0,0 +1,76 @@
+module Snakey.TwoSnakes where
+import Graphics.Gloss.Interface.Pure.Game
+import Scratchy.Syntax
+
+-- Helper functions
+moveSnake :: SpritePtr -> [SpritePtr] -> Dir -> SProg ()
+moveSnake h tailSeg dir =
+    OnTargetReached h (\pos ->
+        let newPos = nextCell dir pos in
+        InspectCell newPos
+        (\case
+            HasBarrier -> SetBackgroundColor red $ Pure ()
+            HasSprite  -> SetBackgroundColor black $ Pure ()
+            IsFree     ->
+                    SetTarget h newPos $
+                    moveTail pos tailSeg $
+                    SetBackgroundColor white $
+                    Pure ()
+        )
+    ) $ Pure ()
+
+moveTail :: (Int,Int) -> [SpritePtr] -> SProg () -> SProg ()
+moveTail _ [] cont = cont
+moveTail prevPos (t:ts) cont =
+    GetTarget t (\curPos ->
+        SetTarget t prevPos $
+            moveTail curPos ts cont
+   )
+
+-- Green snake
+greenSnake :: SProg ()
+greenSnake = 
+    -- Create head
+    NewSprite (5, 5) (Color green $ circleSolid (cellSize * 0.6)) $ \h ->
+    -- Create 7 tail segments
+    NewSprite (4, 5) (Color green $ rectangleSolid cellSize cellSize) $ \t1 ->
+    NewSprite (3, 5) (Color green $ rectangleSolid cellSize cellSize) $ \t2 ->
+    NewSprite (2, 5) (Color green $ rectangleSolid cellSize cellSize) $ \t3 ->
+    NewSprite (1, 5) (Color green $ rectangleSolid cellSize cellSize) $ \t4 ->
+    NewSprite (0, 5) (Color green $ rectangleSolid cellSize cellSize) $ \t5 ->
+    NewSprite (0, 4) (Color green $ rectangleSolid cellSize cellSize) $ \t6 ->
+    NewSprite (0, 3) (Color green $ rectangleSolid cellSize cellSize) $ \t7 ->
+    
+    -- Movement
+    OnKeyEvent (Char 'w') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] U) $
+    OnKeyEvent (Char 's') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] D) $
+    OnKeyEvent (Char 'a') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] L) $
+    OnKeyEvent (Char 'd') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] R) $
+
+    Pure ()
+
+-- Blue snake
+blueSnake :: SProg ()
+blueSnake = 
+    -- Create head
+    NewSprite (15, 15) (Color blue $ circleSolid (cellSize * 0.6)) $ \h ->
+    -- Create 7 tail segments
+    NewSprite (16, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \t1 ->
+    NewSprite (17, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \t2 ->
+    NewSprite (18, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \t3 ->
+    NewSprite (19, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \t4 ->
+    NewSprite (19, 16) (Color blue $ rectangleSolid cellSize cellSize) $ \t5 ->
+    NewSprite (19, 17) (Color blue $ rectangleSolid cellSize cellSize) $ \t6 ->
+    NewSprite (19, 18) (Color blue $ rectangleSolid cellSize cellSize) $ \t7 ->
+    
+    -- Movement
+    OnKeyEvent (Char 'i') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] U) $
+    OnKeyEvent (Char 'k') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] D) $
+    OnKeyEvent (Char 'j') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] L) $
+    OnKeyEvent (Char 'l') (moveSnake h [t1,t2,t3,t4,t5,t6,t7] R) $
+
+    Pure ()
+
+-- Combine game
+twoSnakes :: SProg ()
+twoSnakes = combine greenSnake blueSnake
diff --git a/scratchy.cabal b/scratchy.cabal
index ac89980..739df53 100644
--- a/scratchy.cabal
+++ b/scratchy.cabal
@@ -63,6 +63,7 @@ executable scratchy
                     , Scratchy.Syntax
                     , Scratchy.World
                     , Example.CircleThatMoves
+                    , Snakey.TwoSnakes
                         
 
     -- LANGUAGE extensions used by modules in this package.
@@ -70,6 +71,7 @@ executable scratchy
 
     default-extensions: RecordWildCards
                       , DeriveFunctor
+                      , LambdaCase
     
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.18.0.0, gloss