aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--examples/14-canvas-paint.lisp65
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))