blob: 5539bdfb1d18ca10cdfb3f55b155d273142542c0 (
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
|
;;;; examples/10-canvas.lisp
(defpackage #:ww.examples/10
(:use #:cl)
(:export #:start)
(:import-from #:defclass-std #:defclass/std))
(in-package #:ww.examples/10)
;;; CLASSES
(defclass/std sneking (ww::application)
((sneks snek-pit)))
(defclass/std snek ()
((x y)
(dx dy :std 1)
(brain :std 0.0)
(bod :std (list))
(len :std 4)
(color :std (list 255 255 255))
(home :std (list 0 0 100 100))))
(defun snek-is-home-p (snek)
(with-slots (x y home) snek
(destructuring-bind (left bottom right top) home
(and (<= left x (1- right))
(<= bottom y (1- top))))))
(defun snek-change-mind (snek)
(when (zerop (random 2))
(setf (dx snek) (* -1 (dx snek))))
(when (zerop (random 2))
(setf (dy snek) (* -1 (dy snek)))))
(defun advance-snek-pos (snek)
(with-slots (x y dx dy home bod len) snek
(incf x dx)
(incf y dy)
(unless (snek-is-home-p snek)
(decf y dy)
(decf x dx)
(snek-change-mind snek))
(push y bod)
(push x bod)
(when (< len (length bod))
(setf bod (nreverse (cddr (nreverse bod)))))))
(defun snek-thots (snek)
(incf (brain snek) 0.01)
(when (< (random 1.0) (brain snek))
(setf (brain snek) 0.0)
(snek-change-mind snek)))
(defun update-snek (snek)
(advance-snek-pos snek)
(snek-thots snek))
(defun draw-snek (snek canvas)
(with-slots (bod color) snek
(destructuring-bind (red green blue) color
(let ((alpha 255))
(loop
for (x y . more) on bod by #'cddr
do (ww::with-pixel (r g b a) (ww::pixel canvas x y)
(setf r red g green b blue a alpha))
(setf alpha (max 0 (- alpha 10))))))))
(defun random-between (lo hi)
(+ lo (random (- hi lo))))
(defun random-snek (&optional (boundx 100) (boundy 100))
(make-instance 'snek
:color (list (random 256) (random 256) (random 256))
:dy (random-between -1 1)
:dx (random-between -1 1)
:len (random-between 50 70)
:home (list 0 0 boundx boundy)
:x (random boundx)
:y (random boundy)))
(ww:defhandler sneks-a-go-go
(ww::on-perframe (app ticks)
(with-slots (sneks snek-pit) app
(ww::clear-canvas snek-pit)
(dolist (snek sneks)
(update-snek snek)
(draw-snek snek snek-pit))
(ww::blit snek-pit))))
(defmethod ww::boot ((app sneking ))
"Adds the intro text and sets up the start button handler."
(setf (snek-pit app)
(make-instance 'ww:canvas :pixel-width 100 :pixel-height 100)
(sneks app)
(loop repeat 60 collect (random-snek 100 100)))
(setf (ww:width (snek-pit app)) 800
(ww:height (snek-pit app)) 800)
(ww::add-unit app (snek-pit app))
(ww:add-handler app #'sneks-a-go-go))
(defun start ()
(ww::start
(make-instance
'sneking
:fps 20
:width 800
:height 800
:refocus-on-mousedown-p nil
:title "sneks"
:asset-root
(merge-pathnames
"examples/"
(asdf:system-source-directory :wheelwork)))))
|
