blob: 1eed26048ed948cfbaf5e2363c4926d363315eca (
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
|
;;;; 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)))
(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)))
(ww::defhandler pong-perframe
(ww::on-perframe (app)
(with-slots (paddle ball game-over) app
(when (ww::units-intersect-p paddle ball)
(setf (dy ball) (* -1 (dy ball))
(dr ball) (* -1 (dr ball)))
(incf (ww::x ball) (dx ball))
(incf (ww::y ball) (dy ball)))
(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))
(advance-pos ball))
((or (<= 800 (+ bx w)) (<= bx 0))
(setf dx (* -1 dx))
(advance-pos ball))
((<= by 0)
(setf (ww::unit-visiblep game-over) t)))
(advance-pos ball)))))
(ww::defhandler pong-mousemove
(ww::on-mousemotion (app x)
(setf (ww::x (paddle app))
(- x (* 0.5 (ww::width (paddle app)))))))
(defmethod ww::boot ((app solo-pong))
(let* ((ball
(make-instance
'ball
:texture (ww::get-asset "Fezghoul.png")
:x 400 :y 300
:dr (random-velocity)
:dx (random-velocity 10)
:dy (random-velocity 10)))
(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 )))
(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)))))
|
