;;;; 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-pos :accessor pen-down-pos :initform nil)
   (mode :initform :draw :accessor mode)
   (pen-width :initform 1 :accessor pen-width)))

(defun scale-pos-to-canvas (can ex ey)
  (let
      ((scale (ww::scale-x can))
       (x (ww:x can))
       (y (ww:y can)))
    (values (/ (- ex x) scale)
            (/ (- ey y) scale))))

(defun set-pen-position (can ex ey)
  "x and y are as received from mouse events. adjust the pen position
   to account for scale, or set to nil of x and y are curren toff the
   canvas"
  (let
      ((pos
         (or (pen-down-pos can)
             (list 0 0))))
    (multiple-value-bind (nx ny) (scale-pos-to-canvas can ex ey) 
      (setf (car pos) nx
            (cadr pos) ny
            (pen-down-pos can) pos))
    pos))

(defun shift-mod-p (mods)
  (or (member :rshift mods)
      (member :lshift mods)))

(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)
           (incf (pen-width target))))
        (:scancode-minus
         (setf (pen-width target)
               (max 0 (1- (pen-width target))))))))

(ww::defhandler change-mode-start
 (ww::on-keydown ()
   (case scancode
     ((:scancode-lshift :scancode-rshift)
      (setf (mode target) :drag)))))

(ww::defhandler change-mode-stop
    (ww::on-keyup ()
      (setf (mode target) :draw)))

(ww::defhandler zoom
    (ww::on-mousewheel (target h v)
      (format t "v: ~a~% " v)
      (ww:scale-by target
                   (if (plusp v) 1.1 0.9))))

(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))
          (format t "foo")
          (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))))))

(ww::defhandler canvas-mousebutton-up
    (ww::on-mouseup (target)
      (setf (pen-down-pos target) nil)))

(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)))

(defun drag (canvas x y)
  (multiple-value-bind (cx cy) (scale-pos-to-canvas canvas x y)
    (destructuring-bind (px py) (pen-down-pos canvas) 
      (let ((tx (* (ww:scale-x canvas)
                   (- cx px)))
            (ty (* (ww:scale-x canvas)
                   (- cy py))))
        (incf (ww:x canvas) tx)
        (incf (ww:y canvas) ty)))))

(ww::defhandler canvas-mouse-move
    (ww::on-mousemotion (target x y)
      (when (pen-down-pos target) 
        (ecase (mode target)
          (:draw (draw target x y))
          (:drag (drag target x y))))))

(defmethod initialize-instance :after ((ob pwcanvas) &key)
  (ww:add-handler ob #'keyboard-commands)
  (ww:add-handler ob #'change-mode-start)
  (ww:add-handler ob #'change-mode-stop)
  (ww:add-handler ob #'zoom)
  (ww:add-handler ob #'canvas-mousebutton-up)
  (ww:add-handler ob #'canvas-mousebutton-down)
  (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))