blob: ffeb32460dd32c39f11e465a8c581941b1617ff1 (
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
|
;;;; examples/09-ghoulspree.lisp
(defpackage #:ww.examples/9
(:use #:cl)
(:export #:start)
(:import-from #:defclass-std #:defclass/std))
(in-package #:ww.examples/9)
;;; CLASSES
(defclass/std ghoulspree (ww::application)
((ghouls-per-click :std 10)
(collision-on-p :std t)))
(defclass/std ghoul (ww:bitmap)
((dx dy dr :std)))
;;; UTILITY FUNCTIONS
(defun make-ghoul (x y)
(make-instance 'ghoul :texture (ww:get-asset "Fezghoul.png")
:x x :y y
:dr (random-velocity)
:dx (random-velocity 4)
:dy (random-velocity 4)))
(defun out-of-bounds-p (ghoul)
(not
(and
(< -50 (ww:x ghoul) 850)
(< -50 (ww:y ghoul) 650))))
(defun random-velocity (&optional (size 1.0))
(* size (if (zerop (random 2))
(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)))
(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)))
(defun sign (x)
(if (zerop x) 0
(/ x (abs x))))
(defmacro with-pairs ((a b) ls &rest body)
"run body with a and b bound to unique 2-sets of LS"
(let ((more-a (gensym)))
`(loop for (,a . ,more-a) on ,ls do
(loop for ,b in ,more-a do (progn ,@body)) )))
(defun handle-collision (g1 g2 &optional (friction 0.99))
(with-slots ((dx1 dx) (dy1 dy) (dr1 dr)) g1
(with-slots ((dx2 dx) (dy2 dy) (dr2 dr)) g2
(let ((tdx (* friction dx1))
(tdy (* friction dy1))
(tdr (* friction dr1)))
(setf dx1 (* friction dx2)
dy1 (* friction dy2)
dr1 (* friction dr2)
dx2 tdx
dy2 tdy
dr2 tdr)))))
(ww:defhandler moveghouls
(ww:on-perframe (app)
;; first handle collisions
(when (collision-on-p app)
(with-pairs
(g1 g2) (ww:container-units app)
(when (ww:units-intersect-p g1 g2)
(handle-collision g1 g2 1.0)
;; need a "bounce"
(advance-pos g1)
(advance-pos g1)
(advance-pos g2)
(advance-pos g2))))
;; then update positions and remove the out of bounds
(loop for ghoul in (ww:container-units app)
do (advance-pos ghoul)
when (out-of-bounds-p ghoul)
do (ww:drop-unit ghoul))))
(defun random-sign ()
(if (zerop (random 2)) -1 1))
(defun random-between (lo hi)
(+ lo (random (- hi lo))))
(ww:defhandler add-ghouls
(ww:on-mousedown (app x y)
(loop repeat (ghouls-per-click app)
for rx = (random 800); (+ x (* (random-sign) (random-between 30 60)))
for ry = (random 600); (+ y (* (random-sign) (random-between 30 60)))
do (ww:add-unit app (make-ghoul rx ry)))
(format t "~a ghouls on screen~%"
(length (ww:container-units app )))))
(ww:defhandler toggle-collision
(ww:on-keydown ()
(format t "collision: ~a~%"
(setf (collision-on-p target)
(not (collision-on-p target))))))
(defmethod ww::boot ((app ghoulspree))
"Adds the intro text and sets up the start button handler."
(format t "Click to add ghouls to the screen.~%Press any key to toggle collision detection.~%")
(ww:add-handler app #'add-ghouls)
(ww:add-handler app #'moveghouls)
(ww:add-handler app #'toggle-collision))
(defun start ()
(ww::start
(make-instance
'ghoulspree
:fps 60
:width 800
:height 600
:refocus-on-mousedown-p nil
:title "Click to add ghouls"
:asset-root
(merge-pathnames
"examples/"
(asdf:system-source-directory :wheelwork)))))
|
