blob: bca6a138347126f417c6b3fc83d02c1f98196bc0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
;;;; 14-canvas-paint.lisp
(defpackage #:ww.examples/14
(:use #:cl)
(:export #:start))
(in-package #:ww.examples/14)
(defclass pixel-whomp (ww:application) ())
(defclass pwcanvas (ww:canvas)
((pen-down-p :accessor pen-down-p :initform nil)))
(ww:defhandler canvas-mousebutton-down
(ww:on-mousedown (target x y clicks button winx winy)
(format t "(~a,~a) :clicks ~a :button ~a :winx ~a :winy ~a~%"
x y clicks button winx winy)
(unless (pen-down-p target)
(setf (pen-down-p target) (list x y)))))
(ww::defhandler canvas-mousebutton-up
(ww::on-mouseup (target)
(setf (pen-down-p target) nil)))
(ww::defhandler canvas-mouse-move
(ww::on-mousemotion (target x y xrel yrel state)
(with-slots (pen-down-p) target
(when pen-down-p
(ww:with-canvas target
(ww:with-pen (:position pen-down-p)
(ww:stroke-to x y)))
(setf (car pen-down-p) x (cadr pen-down-p) y)
(ww:blit target)))))
(defmethod initialize-instance :after ((ob pwcanvas) &key)
(ww:add-handler ob #'canvas-mousebutton-down)
(ww:add-handler ob #'canvas-mousebutton-up)
(ww:add-handler ob #'canvas-mouse-move))
(defmethod ww:boot ((app pixel-whomp))
(let ((canvas
(make-instance 'pwcanvas
:pixel-width 800
:pixel-height 800)))
(ww:add-unit canvas)))
(defun start ()
(ww:start
(make-instance 'pixel-whomp)
:x 2350))
|
