From 3a44249f757e40c456426244cbf6475ddbdfc776 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Thu, 28 Jul 2022 12:45:57 -0500
Subject: [example] hacking to improve draw speed

---
 examples/14-canvas-paint.lisp | 65 ++++++++++++++++++++++++-------------------
 1 file changed, 36 insertions(+), 29 deletions(-)

diff --git a/examples/14-canvas-paint.lisp b/examples/14-canvas-paint.lisp
index 3db904e..737c12d 100644
--- a/examples/14-canvas-paint.lisp
+++ b/examples/14-canvas-paint.lisp
@@ -7,7 +7,7 @@
 (in-package #:ww.examples/14)
 
 (defclass pixel-whomp (ww:application)
-  ())
+  ((canvas-size :initarg :size :initform 800 :reader canvas-size)))
 
 (defclass pwcanvas (ww:canvas)
   ((pen-down-pos :accessor pen-down-pos :initform nil)
@@ -42,8 +42,6 @@
 
 (ww::defhandler keyboard-commands
     (ww::on-keydown (target scancode mods)
-      (format t "~a~%"
-              (list :code scancode :mods mods))
       (case scancode
         (:scancode-equals
          (when (shift-mod-p mods)
@@ -62,7 +60,6 @@
     (ww::on-keyup ()
       (setf (mode target) :draw)))
 
-
 (ww::defhandler zoom
     (ww::on-mousewheel (u h v)
       (multiple-value-bind
@@ -78,27 +75,36 @@
 (ww:defhandler canvas-mousebutton-down
     (ww:on-mousedown (target x y clicks button winx winy)
       (unless (pen-down-pos target)
-        (set-pen-position target x y)
-        (when (eq :draw (mode target))
-          (ww::with-canvas target
-            (ww:with-pen (:width (pen-width target))
-              (apply 'ww:apply-pen-at (mapcar #'floor (pen-down-pos target))))
-            (ww:blit target))))))
+        (set-pen-position target x y))))
 
 
 (ww::defhandler canvas-mousebutton-up
     (ww::on-mouseup (target)
+      (when (eq :draw (mode target))
+        (ww::with-canvas target
+          (ww:with-pen (:width (pen-width target))
+            (apply 'ww:apply-pen-at (mapcar #'floor (pen-down-pos target))))
+          (ww:blit target)))
       (setf (pen-down-pos target) nil)))
 
+(defvar *last-draw-time* 0)
+(defvar *draw-sample-pause* 40)
+
+(setf *draw-sample-pause* 40)
 
+(defun is-time-to-draw-p ()
+  (let ((ticks (sdl2:get-ticks)))
+    (when (<= (+ *last-draw-time* *draw-sample-pause*) ticks)
+      (setf *last-draw-time* ticks))))
 
 (defun draw (canvas x y)
-  (let ((old-pos (copy-seq (pen-down-pos canvas))))
-    (destructuring-bind (nx ny) (set-pen-position canvas x y)  
-      (ww:with-canvas canvas 
-        (ww:with-pen (:position old-pos :width (pen-width canvas))
-          (ww:stroke-to nx ny))))
-    (ww:blit canvas)))
+  (when (is-time-to-draw-p)
+    (let ((old-pos (copy-seq (pen-down-pos canvas))))
+      (destructuring-bind (nx ny) (set-pen-position canvas x y)  
+        (ww:with-canvas canvas 
+          (ww:with-pen (:position old-pos :width (pen-width canvas))
+            (ww:stroke-to nx ny))))
+      (ww:blit canvas))))
 
 (defun drag (canvas x y)
   (multiple-value-bind (cx cy) (scale-pos-to-canvas canvas x y)
@@ -112,15 +118,10 @@
 
 (defvar *last-mouse-pos* (list 0 0))
 
-
-
-(ww::defhandler moust-tracker 
-    (ww::on-mousemotion (target x y)
-      (setf (car *last-mouse-pos*) x
-            (cadr *last-mouse-pos*) y)))
-
 (ww::defhandler canvas-mouse-move
     (ww::on-mousemotion (target x y)
+      (setf (car *last-mouse-pos*) x
+            (cadr *last-mouse-pos*) y)
       (when (pen-down-pos target) 
         (ecase (mode target)
           (:draw (draw target x y))
@@ -138,13 +139,19 @@
 (defmethod ww:boot ((app pixel-whomp))
   (let ((canvas
           (make-instance 'pwcanvas
-                         :pixel-width 800
-                         :pixel-height 800)))
-    (ww:add-handler app #'moust-tracker)
-    (ww:add-handler canvas #'moust-tracker)
+                         :pixel-width (canvas-size app)
+                         :pixel-height (canvas-size app))))
+    (setf *last-draw-time* 0)
     (ww:add-unit canvas)))
 
-(defun start ()
+
+
+(defun start (&key (size 800) (window 800))
   (ww:start
-   (make-instance 'pixel-whomp)
+   (make-instance
+    'pixel-whomp
+    :width window
+    :height window
+    :title "Not a Pixel Art Editor"
+    :size size)
    :x 2350))
-- 
cgit v1.2.3