summaryrefslogtreecommitdiff
path: root/app/Snakey/TwoSnakes.hs
blob: 2f02a99fb55323e9842ec142c3dfa4cb2a73f1ec (plain)
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
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
            HasSprite   ->
                SetBackgroundColor black $
                After 1 (SetBackgroundColor white $ Pure ()) $
                Pure ()
            HasBarrier  ->
                SetBackgroundColor red $
                After 1 (SetBackgroundColor white $ Pure ()) $
                Pure ()
            IsFree      ->
                SetTarget h newPos $
                moveTail pos tailSeg $
                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
   )

twoSnakes :: SProg ()
twoSnakes = 
    -- Green snake
    NewSprite (5, 5) (Color green $ circleSolid (cellSize * 0.6)) $ \greenH ->
    NewSprite (4, 5) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT1 ->
    NewSprite (3, 5) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT2 ->
    NewSprite (2, 5) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT3 ->
    NewSprite (1, 5) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT4 ->
    NewSprite (0, 5) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT5 ->
    NewSprite (0, 4) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT6 ->
    NewSprite (0, 3) (Color green $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \greenT7 ->
    let greenTail = [greenT1,greenT2,greenT3,greenT4,greenT5,greenT6,greenT7] in

    -- Blue snake
    NewSprite (15, 15) (Color blue $ circleSolid (cellSize * 0.6)) $ \blueH ->
    NewSprite (16, 15) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT1 ->
    NewSprite (17, 15) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT2 ->
    NewSprite (18, 15) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT3 ->
    NewSprite (19, 15) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT4 ->
    NewSprite (19, 16) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT5 ->
    NewSprite (19, 17) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT6 ->
    NewSprite (19, 18) (Color blue $ rectangleSolid (cellSize * 0.9) (cellSize * 0.9)) $ \blueT7 ->
    let blueTail = [blueT1,blueT2,blueT3,blueT4,blueT5,blueT6,blueT7] in

    -- 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) $

    -- 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) $

    Pure ()