Feat(Snakey): Added implementation for Snakey game

1 files changed, 76 insertions, 0 deletions

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