diff options
Diffstat (limited to 'examples/10-canvas.lisp')
-rw-r--r-- | examples/10-canvas.lisp | 117 |
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))))) - - |