aboutsummaryrefslogtreecommitdiffhomepage
path: root/examples/10-canvas.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'examples/10-canvas.lisp')
-rw-r--r--examples/10-canvas.lisp117
1 files changed, 0 insertions, 117 deletions
diff --git a/examples/10-canvas.lisp b/examples/10-canvas.lisp
deleted file mode 100644
index 453ef0e..0000000
--- a/examples/10-canvas.lisp
+++ /dev/null
@@ -1,117 +0,0 @@
-;;;; 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)
- (population :std 10)))
-
-(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 random-between (lo hi)
- (+ lo (random (1+ (- hi lo)))))
-
-(defun snek-change-mind (snek)
- (if (zerop (random 2))
- (setf (dx snek) (random-between -1 1))
- (setf (dy snek) (random-between -1 1))))
-
-(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-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 100)
- :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 (population app) collect (random-snek 100 100)))
- (setf (ww:width (snek-pit app)) (ww::application-width app)
- (ww:height (snek-pit app)) (ww::application-width app))
- (ww::add-unit app (snek-pit app))
- (ww:add-handler app #'sneks-a-go-go))
-
-(defun start (&key (side 800) (population 50))
- (ww::start
- (make-instance
- 'sneking
- :population population
- :fps 60
- :width side
- :height side
- :refocus-on-mousedown-p nil
- :title "sneks"
- :asset-root
- (merge-pathnames
- "examples/"
- (asdf:system-source-directory :wheelwork)))))
-
-