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
|
module LanguageHeads where
import Keyboard
import Mouse
import Random
data State = Play | Pause | GameOver
type Input = { space : Bool , x : Int
, delta : Time , rand : Int }
type Head = { x : Float, y : Float, vx : Float, vy : Float, img : String }
type Player = { x : Float, score : Int }
type Game = { state : State, heads : [Head], player : Player }
defaultHead : Int -> Head
defaultHead n = { x = 100, y = 75, vx = 60, vy = 0, img = headImage n }
defaultGame : Game
defaultGame = { state = Pause, heads = [], player = { x = 0, score = 0 } }
headImage : Int -> String
headImage n =
if | n == 0 -> "img/brucetate.png"
| n == 1 -> "img/davethomas.png"
| n == 2 -> "img/evanczaplicki.png"
| n == 3 -> "img/joearmstrong.png"
| n == 4 -> "img/josevalim.png"
| otherwise -> ""
bottom = 550
secsPerFrame = 1 / 50
delta = inSeconds <~ fps 50
input = sampleOn delta (Input <~ Keyboard.space
~ Mouse.x
~ delta
~ Random.range 0 4 (every secsPerFrame))
main = lift display gameState
gameState = foldp stepGame defaultGame input
stepGame input game =
case game.state of
Play -> stepGamePlay input game
Pause -> stepGamePaused input game
GameOver -> stepGameFinished input game
stepGamePlay { space, x, delta, rand } ({ state, heads, player } as game) =
{ game | state <- stepGameOver x heads
, heads <- stepHeads heads delta x player.score rand
, player <- stepPlayer player x heads }
stepGameOver x heads =
if all (headSafe (toFloat x)) heads then Play else GameOver
headSafe x head = head.y < bottom || abs (head.x - x) < 50
stepHeads heads delta x score rand =
spawnHead score heads rand
|> map bounce
|> removeComplete
|> map moveHead
spawnHead score heads rand =
let addHead = length heads < (score `div` 5000+1)
&& all (\h -> h.x > 107.0) heads in
if addHead then defaultHead rand :: heads else heads
bounce head = { head | vy <- if head.y > bottom && head.vy > 0
then -head.vy * 0.95
else head.vy }
removeComplete = filter (not . complete)
complete {x} = x > 750
moveHead ({x, y, vx, vy} as head) =
{ head | x <- x + vx * secsPerFrame
, y <- y + vy * secsPerFrame
, vy <- vy + secsPerFrame * 400 }
stepPlayer player mouseX heads =
{ player | score <- stepScore player heads
, x <- toFloat mouseX }
stepScore player heads = player.score + 1 +
1000 * (length (filter complete heads))
stepGamePaused {space, x, delta} ({state, heads, player} as game) =
{ game | state <- stepState space state
, player <- { player | x <- toFloat x } }
stepState space state = if space then Play else state
stepGameFinished {space, x, delta} ({state, heads, player} as game) =
if space then defaultGame
else { game | state <- GameOver
, player <- { player | x <- toFloat x } }
display ({state, heads, player} as game) =
let (w, h) = (800, 600)
in collage w h ([ drawRoad w h
, drawBuilding w h
, drawPaddle w h player.x
, drawScore w h player
, drawMessage w h state] ++
(map (drawHead w h) heads))
drawRoad w h = filled gray (rect (toFloat w) 100) |> moveY (-(half h) + 50)
drawBuilding w h = filled red (rect 100 (toFloat h)) |> moveX (-(half w) + 50)
drawHead w h head = let x = half w - head.x
y = half h - head.y
src = head.img
in toForm (image 75 75 src)
|> move (-x, y)
|> rotate (degrees (x*2 - 100))
drawPaddle w h x = filled black (rect 80 10)
|> moveX (x + 10 - half w)
|> moveY (-(half h - 30))
half x = toFloat x / 2
drawScore w h player = toForm (fullScore player)
|> move (half w - 150, half h - 40)
fullScore player = txt (Text.height 50) (show player.score)
txt f = asText . f . monospace . Text.color blue . toText
drawMessage w h state = toForm (txt (Text.height 50) (stateMessage state))
|> move (50, 50)
stateMessage state = if state == GameOver then "Game Over" else "Language Heads"
|
