-
Notifications
You must be signed in to change notification settings - Fork 3
/
main.scm
213 lines (187 loc) · 6.86 KB
/
main.scm
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
(use-modules (chickadee)
(chickadee scripting)
(chickadee math)
(chickadee audio)
(chickadee math vector)
(chickadee math matrix)
(chickadee math rect)
(chickadee graphics font)
(chickadee graphics sprite)
(chickadee graphics texture)
(system repl coop-server))
(define repl (spawn-coop-repl-server))
;; Constants
(define WINDOW-WIDTH 288)
(define WINDOW-HEIGHT 512)
(define GROUND-WIDTH 336)
(define GROUND-HEIGHT 112)
(define TUBE-WIDTH 52)
(define TUBE-HEIGHT 320)
(define BIRD-WIDTH 34)
(define BIRD-HEIGHT 24)
(define IDENTITY-MATRIX (make-identity-matrix4))
;; Textures
(define background-sprite #f)
(define flappy-bird-sprite #f)
(define ground-sprite #f)
(define ground-texture #f)
(define tube-sprite #f)
(define flappy-bird-up-flap-tex #f)
(define flappy-bird-mid-flap-tex #f)
(define flappy-bird-down-flap-tex)
;; Texture Coodinates
(define ground-tex-rect (make-rect 0.0 0.0 GROUND-WIDTH GROUND-HEIGHT))
(define ground-tex-coords (make-rect 0.0 0.0 1.0 1.0))
;; Audio
(define die-sfx #f)
(define wing-sfx #f)
;; State
(define flappy-bird-x #f)
(define flappy-bird-y #f)
(define flappy-bird-drop-velocity #f)
(define flappy-bird-flap-velocity #f)
(define ground-x #f)
(define ground-x-offset #f)
(define ground-velocity #f)
(define tube-x-distance #f)
(define tube-y-distance #f)
(define paused #f)
(define flappy-bird-rect #f)
(define ground-rect #f)
(define list-of-tube-rects '())
(define (generate-tube-rect-pair distance)
(let ([offset (random GROUND-HEIGHT)])
`(,(make-rect WINDOW-WIDTH (- offset) TUBE-WIDTH TUBE-HEIGHT)
.
,(make-rect WINDOW-WIDTH (- (+ TUBE-HEIGHT distance) offset)
TUBE-WIDTH TUBE-HEIGHT))))
;; Initialize State
(define (init-new-game)
(set! flappy-bird-x (/ WINDOW-WIDTH 2.0))
(set! flappy-bird-y (/ WINDOW-HEIGHT 2.0))
(set! flappy-bird-drop-velocity 4.0)
(set! flappy-bird-flap-velocity 50.0)
(set! ground-x 0.0)
(set! ground-x-offset GROUND-WIDTH)
(set! ground-velocity 3.0)
(set! tube-x-distance 250.0)
(set! tube-y-distance 150.0)
(set! paused #f)
(set! list-of-tube-rects `(,(generate-tube-rect-pair tube-y-distance)))
(set! flappy-bird-rect (make-rect flappy-bird-x flappy-bird-y BIRD-WIDTH BIRD-HEIGHT))
(set! ground-rect (make-rect 0 0 GROUND-WIDTH GROUND-HEIGHT)))
(init-new-game)
;; Helpers
(define (reset-y-pos)
(set-rect-y! flappy-bird-rect (/ WINDOW-HEIGHT 2.0)))
(define (lastt lst)
(car (last-pair lst)))
;; Declare Continuations
(define flap/c #f)
(define (load)
(set! background-sprite (load-image "./assets/sprites/background-day.png"))
(set! ground-sprite (load-image "./assets/sprites/base.png"))
(set! ground-texture (load-image "./assets/sprites/base.png"))
(set! tube-sprite (load-image "./assets/sprites/pipe-green.png"))
(set! flappy-bird-up-flap-tex (load-image "./assets/sprites/bluebird-upflap.png"))
(set! flappy-bird-mid-flap-tex (load-image "./assets/sprites/bluebird-midflap.png"))
(set! flappy-bird-down-flap-tex (load-image "./assets/sprites/bluebird-downflap.png"))
(set! flappy-bird-sprite flappy-bird-up-flap-tex)
(set! die-sfx (load-audio "./assets/audio/die.ogg"))
(set! wing-sfx (load-audio "./assets/audio/wing.ogg"))
(spawn-script collision-check)
(spawn-script tube-generation)
(spawn-script offset-ground-texture)
(spawn-script gravity)
(spawn-script flap-bird))
(define (draw alpha)
(draw-sprite background-sprite #v(0.0 0.0))
;; Draw tubes so they're behind the ground
(let loop ([lst list-of-tube-rects])
(if (null? lst)
0
(begin
(draw-sprite tube-sprite #v((rect-x (caar lst)) (rect-y (caar lst))))
(draw-sprite tube-sprite
#v((rect-x (cdar lst)) (+ TUBE-HEIGHT (rect-y (cdar lst))))
#:scale #v(1.0 -1.0))
(loop (cdr lst)))))
(draw-sprite* ground-texture ground-tex-rect IDENTITY-MATRIX #:texcoords ground-tex-coords)
(draw-sprite flappy-bird-sprite #v((rect-x flappy-bird-rect) (rect-y flappy-bird-rect))))
(define (update elapsed-time)
(update-agenda (if paused 0 1))
;; Update REPL and Agenda
(poll-coop-repl-server repl))
(define (handle-mouse-press button clicks x-pos y-pos)
(if (eqv? button 'left)
(flap/c))
(if (eqv? button 'right)
(init-new-game)))
(define gravity
(lambda ()
(forever
(set-rect-y! flappy-bird-rect (- (rect-y flappy-bird-rect) flappy-bird-drop-velocity))
(sleep 1))))
(define flap-bird
(lambda()
(yield (lambda (c) (set! flap/c c)))
(audio-play wing-sfx)
(set! flappy-bird-sprite flappy-bird-down-flap-tex)
(tween 10 (rect-y flappy-bird-rect) (+ flappy-bird-flap-velocity (rect-y flappy-bird-rect))
(lambda (y)
(set-rect-y! flappy-bird-rect y)))
(set! flappy-bird-sprite flappy-bird-up-flap-tex)))
(define offset-ground-texture
(lambda ()
(forever
(begin
(rect-move-by! ground-tex-coords 10 0.0)
(sleep 1)))))
(define tube-generation
(lambda ()
(at 60
(script
(forever
(begin (let loop ([lst list-of-tube-rects])
(if (null? lst)
0
(begin
(let ([tube-pair (car lst)]
[new-value (- (rect-x (caar lst)) ground-velocity)])
(if (<= new-value (- TUBE-WIDTH))
;; remove offscreen tube from list
(begin
(set! list-of-tube-rects (cdr lst))
(loop list-of-tube-rects))
;; move tube over
(begin
(set-rect-x! (car tube-pair) new-value)
(set-rect-x! (cdr tube-pair) new-value)
(loop (cdr lst))))))))
;;Generate New Tubes
(if (<= (rect-x (car (lastt list-of-tube-rects)))
(- WINDOW-WIDTH tube-x-distance))
(append! list-of-tube-rects `(,(generate-tube-rect-pair tube-y-distance))))
(sleep 1)))))))
(define collision-check
(lambda ()
(forever
(begin
(let loop ([lor list-of-tube-rects])
(if (null? lor)
0
(if (or (rect-intersects? (caar lor) flappy-bird-rect)
(rect-intersects? (cdar lor) flappy-bird-rect)
(rect-intersects? ground-rect flappy-bird-rect))
(begin (set! paused #t)
(audio-play die-sfx))
(loop (cdr lor)))))
(sleep 1)))))
(run-game
#:load load
#:draw draw
#:update update
#:window-title "Flappy Bird!"
#:window-width WINDOW-WIDTH
#:window-height WINDOW-HEIGHT
#:mouse-press handle-mouse-press)