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
77
78
|
module Snakey.TwoSnakes where
import Graphics.Gloss.Interface.Pure.Game
import Scratchy.Syntax
-- Helper functions
moveSnake :: SpritePtr -> [SpritePtr] -> Dir -> SProg ()
moveSnake h t d =
OnTargetReached h (\pos ->
let newPos = nextCell d pos in
InspectCell newPos (\case
HasSprite ->
SetBackgroundColor black $
After 1 (SetBackgroundColor white $ Pure ()) $
Pure ()
HasBarrier ->
SetBackgroundColor red $
After 1 (SetBackgroundColor white $ Pure ()) $
Pure ()
IsFree ->
SetTarget h newPos $
moveTail pos t $
Pure ()
)
) $
Pure ()
moveTail :: Cell -> [SpritePtr] -> SProg () -> SProg ()
moveTail _ [] cont = cont
moveTail prevPos (t:ts) cont =
GetTarget t (\curPos ->
SetTarget t prevPos $
moveTail curPos ts cont
)
twoSnakes :: SProg ()
twoSnakes =
let headRadius = cellSize * 0.6
tailSize = cellSize * 0.9
in
-- Green snake
NewSprite (5, 5) (Color green $ circleSolid headRadius) $ \gHead ->
NewSprite (4, 5) (Color green $ rectangleSolid tailSize tailSize) $ \gt1 ->
NewSprite (3, 5) (Color green $ rectangleSolid tailSize tailSize) $ \gt2 ->
NewSprite (2, 5) (Color green $ rectangleSolid tailSize tailSize) $ \gt3 ->
NewSprite (1, 5) (Color green $ rectangleSolid tailSize tailSize) $ \gt4 ->
NewSprite (0, 5) (Color green $ rectangleSolid tailSize tailSize) $ \gt5 ->
NewSprite (0, 4) (Color green $ rectangleSolid tailSize tailSize) $ \gt6 ->
NewSprite (0, 3) (Color green $ rectangleSolid tailSize tailSize) $ \gt7 ->
-- Blue snake
NewSprite (15, 15) (Color blue $ circleSolid headRadius) $ \bHead ->
NewSprite (16, 15) (Color blue $ rectangleSolid tailSize tailSize) $ \bt1 ->
NewSprite (17, 15) (Color blue $ rectangleSolid tailSize tailSize) $ \bt2 ->
NewSprite (18, 15) (Color blue $ rectangleSolid tailSize tailSize) $ \bt3 ->
NewSprite (19, 15) (Color blue $ rectangleSolid tailSize tailSize) $ \bt4 ->
NewSprite (19, 16) (Color blue $ rectangleSolid tailSize tailSize) $ \bt5 ->
NewSprite (19, 17) (Color blue $ rectangleSolid tailSize tailSize) $ \bt6 ->
NewSprite (19, 18) (Color blue $ rectangleSolid tailSize tailSize) $ \bt7 ->
-- List of tail sprites
let bTail = [bt1, bt2, bt3, bt4, bt5, bt6, bt7]
gTail = [gt1, gt2, gt3, gt4, gt5, gt6, gt7]
in
-- Green snake movement
OnKeyEvent (Char 'w') (moveSnake gHead gTail U) $
OnKeyEvent (Char 's') (moveSnake gHead gTail D) $
OnKeyEvent (Char 'a') (moveSnake gHead gTail L) $
OnKeyEvent (Char 'd') (moveSnake gHead gTail R) $
-- Blue snake movement
OnKeyEvent (Char 'i') (moveSnake bHead bTail U) $
OnKeyEvent (Char 'k') (moveSnake bHead bTail D) $
OnKeyEvent (Char 'j') (moveSnake bHead bTail L) $
OnKeyEvent (Char 'l') (moveSnake bHead bTail R) $
Pure ()
|