From beace9955a6c41b85358975a5d93c35fd16043e9 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Sat, 16 Jul 2022 09:39:47 -0500 Subject: [rename] example 10; [add] example readme --- examples/10-canvas-sneks.lisp | 117 ++++++++++++++++++++++++++++++++++++++++++ examples/10-canvas.lisp | 117 ------------------------------------------ examples/README.txt | 78 ++++++++++++++++++++++++++++ wheelwork-examples.asd | 2 +- 4 files changed, 196 insertions(+), 118 deletions(-) create mode 100644 examples/10-canvas-sneks.lisp delete mode 100644 examples/10-canvas.lisp create mode 100644 examples/README.txt 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))))) + + 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))))) - - diff --git a/examples/README.txt b/examples/README.txt new file mode 100644 index 0000000..c4100eb --- /dev/null +++ b/examples/README.txt @@ -0,0 +1,78 @@ +EXAMPLES + ++---------------------------------- +| 01-bitmap-display.lisp + +This is the "sanity check" example. It ensures that basic things can +happen like "loading textures from disk" and "displaying textures". + + ++---------------------------------- +| 02-moving-bitmp.lisp ++---------------------------------- + +This is a grab bag of various features. You should just look at the +source. Try clicking on different objects, pressing arrow keys, +rolling the mouse etc. + ++---------------------------------- +| 03-font-render.lisp ++---------------------------------- + +An example of some text being rendered to a clickable unit. + ++---------------------------------- +| 04-a-button.lisp ++---------------------------------- + +A button class I made for no good reason. Just click on the two images. + ++---------------------------------- +| 05-frameset-animation.lisp ++---------------------------------- + +A frameset is just a collection of images to display, one after the +other, at a particular rate. You can do normal affine things to a +frameset. + ++---------------------------------- +| 06-sprite.lisp ++---------------------------------- + +A sprite is a collection of named framesets. Each name represents a +"view" of the sprite. For example: one view might have a character +looking forward, the ohter looking to the left. + +You can move a little character around on the screen. + + ++---------------------------------- +| 07-renderarea.lisp ++---------------------------------- + +An example of containing the dispaly of an object within a particular screen region. + ++---------------------------------- +| 08-pong.lisp ++---------------------------------- + +Pong for one. + ++---------------------------------- +| 09-ghoulspree.lisp ++---------------------------------- + +An example where loads of sprites are rendered an animted to the screen. +You can switch gravity on and off. +You can switch collissions on and off. +You can click to add more sprites. + ++---------------------------------- +| 10-canvas-sneks.lisp ++---------------------------------- + +A demo that shows how you can draw pixels to a canvas object, updating +that canvas each frame. + +Though canvas objects are not meant for per-frame animations, you can do +simple things like this without much trouble. diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd index 80fd4a6..862358c 100644 --- a/wheelwork-examples.asd +++ b/wheelwork-examples.asd @@ -15,4 +15,4 @@ (:file "07-renderarea") (:file "08-pong") (:file "09-ghoulspree") - (:file "10-canvas"))) + (:file "10-canvas-sneks"))) -- cgit v1.2.3