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
|
;;;; examples/08-pong.lisp
(defpackage #:ww.examples/8
(:use #:cl)
(:export #:start)
(:import-from #:defclass-std #:defclass/std))
(in-package #:ww.examples/8)
;;; CLASSES
(defclass/std solo-pong (ww::application)
((paddle ball game-over intro-text)))
(defclass/std mobile ()
((dx dy dr :std 0)))
(defclass/std paddle (ww::image mobile) ())
(defclass/std ball (ww::image mobile) ())
;;; UTILITY FUNCTIONS
(defun random-velocity (&optional (size 1.0))
(* size (if (< 0.5 (random 1.0))
(random 1.0)
(* -1 (random 1.0)))))
(defun advance-pos (thing)
"THING is expected to have the affine protocol implemented on it,
and to be an instance of MOBILE.
In this game, this will only ever be called on the ball."
(with-accessors ((dr dr) (dx dx) (dy dy) (x ww::x) (y ww::y) (r ww::rotation)) thing
(incf x dx)
(incf y dy)
(incf r dr)
(setf dr (decay dr)))) ;; rotation diminishes every round, just aesthetic.
(defun decay (val &optional (amount 0.01))
"Returns a value that is VAL reduced in magnitude by AMOUNT, or zero
of VAL is already zero."
(cond
((zerop val)
val)
((plusp val)
(- val amount))
((minusp val)
(+ val amount))))
(defun avg (&rest args)
"Just averages values"
(loop for x in args
sum x into total
sum 1 into count
finally (return (/ total count))))
(defun sqrt+ (val)
"Returns a value with the same sign as VAL, but whose magnitude is
the sqrt of the magintude of VAL."
(if (plusp val) (sqrt val)
(* -1 (sqrt (abs val)))))
(defun clamp (lo val hi)
"Returns VAL if (< LO VAL HI), otherwise returns LO or HI depending
on which boundary VAL is outside of."
(max lo (min val hi)))
(ww::defhandler pong-perframe
(ww::on-perframe (app)
"Called on the app once per frame. Responsible for checking
collisions and adjusting the ball's properties. And for
checking for and handling gameover conditions."
(with-slots (paddle ball game-over) app
(when (ww::units-intersect-p paddle ball)
(setf
;; dy just reverses direction
(dy ball) (* -1 (dy ball))
;; average dx of the two
(dx ball) (avg (dx ball) (dx paddle))
;; no logic to it dr change, just aesthetic
(dr ball) (avg (sqrt+ (sqrt+ (dx paddle))) (dr ball)))
;; its a good idea to advance the ball position after every collision
;; this prevents the ball from "getting stuck" contstantly colliding
;; with an object / wall.
(advance-pos ball))
;; since the dx of the paddle only changes when the paddle
;; moves we should have it decay if its just been sitting
;; still. Mostly for aesthetics. It looks funny if a
;; stationary paddle speeds up the ball.
(setf (dx paddle) (decay (dx paddle) 1))
;; here we just check the bounds, bounce when the ball hits the top left or right
;; and signal game over if it hits the bottom.
(with-accessors
((dx dx) (dy dy) (bx ww::x) (by ww::y) (w ww::width) (h ww::height)) ball
(cond
((<= 600 (+ by h))
(setf dy (* -1 dy)
by (- 600 h))
(advance-pos ball))
((<= 800 (+ bx w))
(setf dx (* -1 dx))
(advance-pos ball))
((<= bx 0)
(setf dx (* -1 dx)))
;; game over
((<= by 0)
(setf (ww::unit-visiblep game-over) t)))
;; just to be safe, dx can get pretty fast
(setf bx (clamp 0.0 bx (- 800 w)))
;; and whatever else happens, advance the ball position.
(advance-pos ball)))))
(ww::defhandler pong-mousemove
(ww::on-mousemotion (app)
"Just sets the position of the paddle, and updates the paddles dx"
(setf (ww::x (paddle app))
(- x (* 0.5 (ww::width (paddle app))))
;; using dx to store some motion informaton
;; used to chagne dx and dr in the ball
(dx (paddle app)) xrel))) ; xrel is supplied by default by on-mousemotion
(ww::defhandler press-to-start
(ww::on-keydown (app)
"Sets up the ball, paddle, and game over text."
;; first remove the intro text and keydown handler.
(ww::drop-unit (intro-text app))
(ww::remove-handler app #'press-to-start)
(let* ((ball
(make-instance
'ball
:texture (ww::get-asset "Fezghoul.png")
:x 400 :y 300
:dr (random-velocity)
:dx (random-velocity 10)
:dy 8))
(paddle
(make-instance
'paddle
:texture (ww::get-asset "GelatinousCube.png")
:x 400
:y 0))
(game-over
(make-instance
'ww::text
:font (ww::get-asset "Ticketing.ttf")
:content "Game Over"
:visiblep nil
:x 300
:y 300
:scale-x 3.0
:scale-y 3.0)))
(setf (ww::width paddle) 120
(ww::height paddle) 20
(paddle app) paddle
(ball app) ball
(game-over app) game-over)
(ww::add-unit app ball)
(ww::add-unit app paddle)
(ww::add-unit app game-over)
(ww::add-handler app #'pong-mousemove)
(ww::add-handler app #'pong-perframe))))
(defmethod ww::boot ((app solo-pong))
"Adds the intro text and sets up the start button handler."
(sdl2:hide-cursor)
(let ((intro-text
(make-instance
'ww:text
:content "Press any key to start"
:font (ww::get-asset "Ticketing.ttf")
:x 160
:y 300
:scale-x 3.0
:scale-y 3.0)))
(setf (intro-text app) intro-text)
(ww:add-unit app intro-text))
(ww:add-handler app #'press-to-start))
(defun start ()
(ww::start
(make-instance
'solo-pong
:fps 60
:width 800
:height 600
:refocus-on-mousedown-p nil
:title "Now the lonely can enjoy pong."
:asset-root
(merge-pathnames
"examples/"
(asdf:system-source-directory :wheelwork)))))
|
