diff options
| -rw-r--r-- | CHANGELOG.md | 6 | ||||
| -rw-r--r-- | app/Scratchy.hs | 7 | ||||
| -rw-r--r-- | app/Snakey/TwoSnakes.hs | 76 | ||||
| -rw-r--r-- | scratchy.cabal | 2 |
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 |