1 files changed, 117 insertions, 0 deletions
diff --git a/examples/10-canvas-sneks.lisp b/examples/10-canvas-sneks.lisp
new file mode 100644
index 0000000..453ef0e
--- /dev/null
+++ b/examples/10-canvas-sneks.lisp
@@ -0,0 +1,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)
+   (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)))))
+
+