blob: 9b40605a5720ff149478cb607fab546b635fcc4c (
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
|
;;;; 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))) ;; rotation diminishes every round, just aesthetic.
(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)) g1
(with-slots ((dx2 dx) (dy2 dy)) g2
(let ((tdx (* friction dx1))
(tdy (* friction dy1)))
(setf dx1 (* friction dx2)
dy1 (* friction dy2)
dx2 tdx
dy2 tdy)))))
(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 0.99)
;; 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."
(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)))))
|
