1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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
|