;;;; examples/11-canvas-geometry.lisp (defpackage #:ww.examples/11 (:use #:cl) (:export #:start)) (in-package :ww.examples/11) (defclass geo-demo (ww:application) ()) (ww:defhandler quit (ww::on-keydown (app scancode) (when (eql :scancode-q scancode) (ww::stop)))) (ww:defhandler clear-and-draw (ww::on-perframe (canvas time) (ww::clear-canvas canvas) (draw-stuff canvas time) (ww::blit canvas))) (defun draw-stuff (canvas &optional time) ;; draw a circle (ww::with-grid-circle (x y) (350 100 90 :interiorp t) (ww::with-pixel (r g b a) (ww::pixel canvas x y) (setf r (mod (* 3 x y time) 256) g (mod x 256) b (mod y 256)))) ;; draw a bunch of circles (loop for cx from 0 to 50 for cy from 0 to 50 do (ww::with-grid-circle (x y) ((+ 300 cx) (+ 300 cy) 80) (ww::with-pixel (r g b a) (ww::pixel canvas x y) (setf r (mod (* x y) 256) g (mod time 256) b (mod (* y x) 256))))) ;; draw a random thing (let ((path (loop repeat 7 collect (list (+ 10 (random 240)) (+ 10 (random 240)))))) (ww::with-grid-path (x y) (path :autoclosep t :interiorp t) (ww::with-pixel (r g b a) (ww::pixel canvas x y) (setf r (mod (* 2 y) 256) g (mod (* 3 x) 256) b (mod (* x y) 256))))) (let ((control-points `((100 250) (,(+ (mod time 20) -10 -100) 490) (,(+ (mod time 20) -10 300) 490) (100 250))) (path nil)) ;; collect the points along the curve (ww::with-grid-bezier (x y) (control-points :count 16) (push (list x y) path)) ;; and then treat them as a closed path, which is filled. (ww::with-grid-path (x y) (path :interiorp t) (ww::with-pixel (r g b a) (ww::pixel canvas x y) (setf r 200 b 120 g 30))))) (defmethod ww:boot ((app geo-demo)) (let ((canvas (make-instance 'ww:canvas :pixel-width 500 :pixel-height 500))) ;; stretch canvas over the whole app (setf (ww:width canvas) (ww::application-width app) (ww:height canvas) (ww::application-height app)) ;; add it to the display tree (ww:add-unit canvas) ;; handlers (ww::add-handler canvas #'clear-and-draw) (ww:add-handler app #'quit) (ww:add-handler canvas #'quit))) (defun start (&optional (side 500)) (ww::start (make-instance 'geo-demo :fps 10 :width side :height side :title "Pixels Geometry")))