From b70a404c640785010ecad52af29b4a96184b2c7e Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 15 Jul 2022 16:35:06 -0500 Subject: [add] working canvas demo! --- examples/10-canvas.lisp | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 examples/10-canvas.lisp (limited to 'examples/10-canvas.lisp') diff --git a/examples/10-canvas.lisp b/examples/10-canvas.lisp new file mode 100644 index 0000000..cdade2b --- /dev/null +++ b/examples/10-canvas.lisp @@ -0,0 +1,47 @@ +;;;; 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 canvas-example (ww::application) + ()) + +(defmethod ww::boot ((app canvas-example)) + "Adds the intro text and sets up the start button handler." + (let ((c (make-instance + 'ww::canvas + :x 100 :y 100 + :pixel-height 100 + :pixel-width 100))) + + (ww::with-pixels-rect (x y r g b a) (c) + (setf r (- 255 x) + g (- 255 y) + b (+ x y))) + + (ww::blit c) + ;(ww:scale-by c 100) + (ww:add-unit app c))) + +(defun start (&optional (scale 1.0)) + (ww::start + (make-instance + 'canvas-example + :fps 30 + :width (round (* 800 scale)) + :height (round (* 600 scale)) + :scale scale + :refocus-on-mousedown-p nil + :title "canvas demo" + :asset-root + (merge-pathnames + "examples/" + (asdf:system-source-directory :wheelwork))))) + + -- cgit v1.2.3