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 Scratchy where
import Graphics.Gloss.Interface.Pure.Game
import Scratchy.World
import Scratchy.Syntax
import Example.CircleThatMoves
-- Main
------------------------------------------------------------
main :: IO ()
main = play
(InWindow "Scratchy" (winW, winH) (100, 100))
white
120
(World
white
[]
[]
circSprite
[]
[]
[]
[]
[])
drawWorld
(\e -> fst . runGame (handleEvent e))
(\tick ->
fst . runGame ( runProg
>> moveSprites tick
>> handleKeyEvents
>> tickTimers
>> runProg
) )
-- Rendering
------------------------------------------------------------
drawWorld :: World -> Picture
drawWorld World{..} =
Pictures
( backgroundFrom bg
: drawGrid
: map drawSprite sprites )
backgroundFrom :: Color -> Picture
backgroundFrom c =
let w' = fromIntegral gridW * cellSize
h' = fromIntegral gridH * cellSize
in Color c (rectangleSolid w' h')
drawGrid :: Picture
drawGrid =
let halfW = fromIntegral gridW * cellSize / 2
halfH = fromIntegral gridH * cellSize / 2
xs = [(-halfW), (-halfW + cellSize) .. halfW]
ys = [(-halfH), (-halfH + cellSize) .. halfH]
vlines = [ Line [ (x, -halfH), (x, halfH) ] | x <- xs ]
hlines = [ Line [ (-halfW, y), ( halfW, y) ] | y <- ys ]
in Color (greyN 0.85) (Pictures (vlines ++ hlines))
drawSprite :: Sprite -> Picture
drawSprite Sprite{..} =
let (x, y) = toScreen pos
in Translate x y $ pic
toScreen :: (Float, Float) -> (Float, Float)
toScreen (gx, gy) =
let fx = gx - (fromIntegral gridW - 1) / 2
fy = gy - (fromIntegral gridH - 1) / 2
in (fx * cellSize, fy * cellSize)
|