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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
module Scratchy.Syntax where
import Graphics.Gloss.Interface.Pure.Game
-- Types
------------------------------------------------------------
type Duration = Int
type Pos = (Float, Float)
type Cell = (Int, Int)
type SpritePtr = Int
-- Constants
------------------------------------------------------------
cellsPerSec :: Float
cellsPerSec = 5
gridW, gridH :: Int
gridW = 30
gridH = 30 -- FIXME: move.
inBounds :: (Int,Int) -> Bool
inBounds (x,y) = x >= 0 && x < gridW && y >= 0 && y < gridH
cellSize :: Float
cellSize = 30
winW, winH :: Int
winW = round (fromIntegral gridW * cellSize)
winH = round (fromIntegral gridH * cellSize)
-- Direction
------------------------------------------------------------
data Dir = U | D | L | R deriving (Eq,Ord,Show)
dirVec :: Dir -> (Int, Int)
dirVec U = (0, 1)
dirVec D = (0,-1)
dirVec L = (-1,0)
dirVec R = (1, 0)
nextCell :: Dir -> (Int, Int) -> (Int, Int)
nextCell d (cx,cy) =
let (dx,dy) = dirVec d
in (cx + dx, cy + dy)
-- Syntax
------------------------------------------------------------
data InspectionResult
= HasBarrier | HasSprite | IsFree
data SProg a
= Pure a
-- Event listening
| OnKeyEvent Key (SProg ()) (SProg a) -- Listener for a specific key
| OnTargetReached SpritePtr (Cell -> SProg ()) (SProg a) -- Listener for a specific sprite
| OnTargetUpdated SpritePtr (Cell -> Cell -> SProg ()) (SProg a) -- Listener for a specific sprite
| OnBarrierHit SpritePtr (Cell -> Cell -> SProg ()) (SProg a)
-- Sprite and grid actions
| NewSprite Cell Picture (SpritePtr -> SProg a)
| SetColor SpritePtr Color (SProg a)
| SetTarget SpritePtr Cell (SProg a)
| GetTarget SpritePtr (Cell -> SProg a)
| SetBackgroundColor Color (SProg a)
| InspectCell Cell (InspectionResult -> SProg a)
-- Timer
| After Duration (SProg ()) (SProg a)
deriving Functor
-- Combining programs
------------------------------------------------------------
combine :: SProg () -> SProg () -> SProg ()
-- Base cases
combine (Pure ()) p2 = p2
combine p1 (Pure ()) = p1
combine (OnKeyEvent k1 handler1 cont1) p2 =
OnKeyEvent k1 handler1 (combine cont1 p2)
combine p1 (OnKeyEvent k2 handler2 cont2) =
OnKeyEvent k2 handler2 (combine p1 cont2)
combine (OnTargetReached sp1 h1 c1) p2 =
OnTargetReached sp1 h1 (combine c1 p2)
combine p1 (OnTargetReached sp2 h2 c2) =
OnTargetReached sp2 h2 (combine p1 c2)
combine (OnTargetUpdated sp1 h1 c1) p2 =
OnTargetUpdated sp1 h1 (combine c1 p2)
combine p1 (OnTargetUpdated sp2 h2 c2) =
OnTargetUpdated sp2 h2 (combine p1 c2)
combine (OnBarrierHit sp1 h1 c1) p2 =
OnBarrierHit sp1 h1 (combine c1 p2)
combine p1 (OnBarrierHit sp2 h2 c2) =
OnBarrierHit sp2 h2 (combine p1 c2)
combine (After dur1 handler1 cont1) p2 =
After dur1 handler1 (combine cont1 p2)
combine p1 (After dur2 handler2 cont2) =
After dur2 handler2 (combine p1 cont2)
combine (NewSprite cell pic k1) p2 =
NewSprite cell pic (\sp -> combine (k1 sp) p2)
combine p1 (NewSprite cell pic k2) =
NewSprite cell pic (combine p1 . k2)
combine (SetColor sp c cont1) p2 =
SetColor sp c (combine cont1 p2)
combine p1 (SetColor sp c cont2) =
SetColor sp c (combine p1 cont2)
combine (SetTarget sp cell cont1) p2 =
SetTarget sp cell (combine cont1 p2)
combine p1 (SetTarget sp cell cont2) =
SetTarget sp cell (combine p1 cont2)
combine (GetTarget sp k1) p2 =
GetTarget sp (\cell -> combine (k1 cell) p2)
combine p1 (GetTarget sp k2) =
GetTarget sp (combine p1 . k2)
combine (SetBackgroundColor c cont1) p2 =
SetBackgroundColor c (combine cont1 p2)
combine p1 (SetBackgroundColor c cont2) =
SetBackgroundColor c (combine p1 cont2)
combine (InspectCell cell k1) p2 =
InspectCell cell (\result -> combine (k1 result) p2)
|