Still has blinking concurrency issue, but prettier code

1 files changed, 41 insertions, 52 deletions

diff --git a/app/Snakey/TwoSnakes.hs b/app/Snakey/TwoSnakes.hs
index f8c3e95..7358eb5 100644..100755
--- a/app/Snakey/TwoSnakes.hs
+++ b/app/Snakey/TwoSnakes.hs
@@ -7,15 +7,14 @@ 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 ()
+        InspectCell newPos (\case
+            HasBarrier  -> SetBackgroundColor red $ Pure ()
+            HasSprite   -> SetBackgroundColor black $ Pure ()
+            IsFree      ->
+                SetBackgroundColor white $
+                SetTarget h newPos $
+                moveTail pos tailSeg $
+                Pure ()
         )
     ) $ Pure ()
 
@@ -27,50 +26,40 @@ moveTail prevPos (t:ts) cont =
             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) $
+twoSnakes :: SProg ()
+twoSnakes = 
+    -- Green snake
+    NewSprite (5, 5) (Color green $ circleSolid (cellSize * 0.6)) $ \greenH ->
+    NewSprite (4, 5) (Color green $ rectangleSolid cellSize cellSize) $ \greenT1 ->
+    NewSprite (3, 5) (Color green $ rectangleSolid cellSize cellSize) $ \greenT2 ->
+    NewSprite (2, 5) (Color green $ rectangleSolid cellSize cellSize) $ \greenT3 ->
+    NewSprite (1, 5) (Color green $ rectangleSolid cellSize cellSize) $ \greenT4 ->
+    NewSprite (0, 5) (Color green $ rectangleSolid cellSize cellSize) $ \greenT5 ->
+    NewSprite (0, 4) (Color green $ rectangleSolid cellSize cellSize) $ \greenT6 ->
+    NewSprite (0, 3) (Color green $ rectangleSolid cellSize cellSize) $ \greenT7 ->
+    let greenTail = [greenT1,greenT2,greenT3,greenT4,greenT5,greenT6,greenT7] in
 
-    Pure ()
+    -- Blue snake
+    NewSprite (15, 15) (Color blue $ circleSolid (cellSize * 0.6)) $ \blueH ->
+    NewSprite (16, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT1 ->
+    NewSprite (17, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT2 ->
+    NewSprite (18, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT3 ->
+    NewSprite (19, 15) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT4 ->
+    NewSprite (19, 16) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT5 ->
+    NewSprite (19, 17) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT6 ->
+    NewSprite (19, 18) (Color blue $ rectangleSolid cellSize cellSize) $ \blueT7 ->
+    let blueTail = [blueT1,blueT2,blueT3,blueT4,blueT5,blueT6,blueT7] in
 
--- 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) $
+    -- Green snake movement
+    OnKeyEvent (Char 'w') (moveSnake greenH greenTail U) $
+    OnKeyEvent (Char 's') (moveSnake greenH greenTail D) $
+    OnKeyEvent (Char 'a') (moveSnake greenH greenTail L) $
+    OnKeyEvent (Char 'd') (moveSnake greenH greenTail R) $
 
-    Pure ()
+    -- Blue snake movement
+    OnKeyEvent (Char 'i') (moveSnake blueH blueTail U) $
+    OnKeyEvent (Char 'k') (moveSnake blueH blueTail D) $
+    OnKeyEvent (Char 'j') (moveSnake blueH blueTail L) $
+    OnKeyEvent (Char 'l') (moveSnake blueH blueTail R) $
 
--- Combine game
-twoSnakes :: SProg ()
-twoSnakes = combine greenSnake blueSnake
+    Pure ()