diff options
| -rw-r--r-- | examples/14-canvas-paint.lisp | 65 |
1 files 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)) |