From 3dde4cbbc6ba818b7cda57a68db9c2036a4480ab Mon Sep 17 00:00:00 2001 From: Mikkel Thestrup Date: Thu, 25 Dec 2025 17:57:23 +0100 Subject: Still has blinking concurrency issue, but prettier code --- app/Snakey/TwoSnakes.hs | 93 ++++++++++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 52 deletions(-) mode change 100644 => 100755 app/Snakey/TwoSnakes.hs (limited to 'app') diff --git a/app/Snakey/TwoSnakes.hs b/app/Snakey/TwoSnakes.hs old mode 100644 new mode 100755 index f8c3e95..7358eb5 --- 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 () -- cgit v1.2.3-70-g09d2