diff options
Diffstat (limited to 'examples/10-canvas.lisp')
| -rw-r--r-- | examples/10-canvas.lisp | 142 |
1 files changed, 96 insertions, 46 deletions
diff --git a/examples/10-canvas.lisp b/examples/10-canvas.lisp index 7d701df..5539bdf 100644 --- a/examples/10-canvas.lisp +++ b/examples/10-canvas.lisp @@ -9,56 +9,106 @@ ;;; CLASSES -(defclass/std canvas-example (ww::application) - ()) - -(defun color-clamp ( x) - (max (min (round x) 255) 0)) - -(ww:defhandler color-shifts - (ww:on-perframe () - (let ((time-class (1+ (mod time 256)))) - (ww::with-pixels-rect (x y r g b a) (target) - (if (or (zerop (mod time-class (1+ x))) - (zerop (mod time-class (1+ y)))) - - (setf - r (mod (* x time) time-class) - g (mod (* y time) time-class) - b (mod time time-class) - a 255) - (ww::setf-many r g b a 0)))) - (ww::blit target))) - -(defmethod ww::boot ((app canvas-example)) +(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." - (let ((c (make-instance - 'ww::canvas - :pixel-height 10 - :pixel-width 10))) - - (ww::with-pixels-rect (x y r g b a) (c) - (setf r (- 255 (* 25 x)) - g (- 255 (* 25 y)) - b (color-clamp (* 25 (+ x y))))) - - (ww::blit c) - (setf (ww:width c) 800 - (ww:height c) 600) - - (ww:add-unit app c) - (ww:add-handler c #'color-shifts ))) - -(defun start (&optional (scale 1.0)) + (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 - 'canvas-example - :fps 30 - :width (round (* 800 scale)) - :height (round (* 600 scale)) - :scale scale + 'sneking + :fps 20 + :width 800 + :height 800 :refocus-on-mousedown-p nil - :title "canvas demo" + :title "sneks" :asset-root (merge-pathnames "examples/" |