blob: 00577c924c45e5986046f790929e886463021d02 (
plain)
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
|
;;;; examples/08-pong.lisp
(defpackage #:ww.examples/8
(:use #:cl)
(:export #:start)
(:import-from #:defclass-std #:defclass/std))
(in-package #:ww.examples/8)
(defclass/std solo-pong (ww::application)
((paddle ball game-over intro-text)))
(defclass/std mobile ()
((dx dy dr :std 0)))
(defclass/std paddle (ww::bitmap mobile) ())
(defclass/std ball (ww::bitmap mobile) ())
(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)
(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))
(cond
((zerop val)
val)
((plusp val)
(- val amount))
((minusp val)
(+ val amount))))
(defun avg (&rest args)
(loop for x in args
sum x into total
sum 1 into count
finally (return (/ total count))))
(defun sqrt+ (val)
(if (plusp val) (sqrt val)
(* -1 (sqrt (abs val)))))
(defun clamp (lo val hi)
(max lo (min val hi)))
(ww::defhandler pong-perframe
(ww::on-perframe (app)
(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)
bx (- 800 w))
(advance-pos ball))
((<= bx 0)
(setf dx (* -1 dx)
bx 0))
((<= by 0)
(setf (ww::unit-visiblep game-over) t)))
(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)
(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))
(ww::add-unit
app
(setf (intro-text app)
(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)))
(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)))))
|
