From 24b0c51a3b51c52dbba855787170107a6a7e47fb Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Tue, 19 Jul 2022 10:44:16 -0500
Subject: [add] canvas language and [example]

---
 examples/12-canvas-drawing-language.lisp | 64 ++++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)
 create mode 100644 examples/12-canvas-drawing-language.lisp

(limited to 'examples')

diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp
new file mode 100644
index 0000000..526ec2d
--- /dev/null
+++ b/examples/12-canvas-drawing-language.lisp
@@ -0,0 +1,64 @@
+;;;; examples/13-canvas-drawing-language.lisp
+
+(defpackage #:ww.examples/12
+  (:use #:cl)
+  (:export #:start))
+
+(in-package :ww.examples/12)
+
+(defclass canvas-lang-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 :r 255 :g 255 :b 255)
+      (draw-stuff canvas time)
+      (ww::blit canvas)))
+
+(defun triangle-at (x y)
+    (ww::move-to x y)
+    (ww::stroke-rel 150 0)
+    (ww::stroke-rel 0 130)
+    (ww::stroke-rel -150 -130))
+
+(defun filled-triangle-at (x y)
+  (ww::move-to x y)
+  (ww::fill-rel-path
+   '((-10 100)
+     (10 -30))))
+
+(defun draw-stuff (canvas time)
+  (declare (ignorable time))
+  (ww::with-canvas canvas
+    (triangle-at 100 100)
+    (filled-triangle-at 200 200)))
+
+(defmethod ww:boot ((app canvas-lang-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 app 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
+    'canvas-lang-demo
+    :fps 10
+    :width side
+    :height side
+    :title "Canvas demo")))
-- 
cgit v1.2.3