;;;; 14-canvas-paint.lisp

(defpackage #:ww.examples/14
  (:use #:cl)
  (:export #:start))

(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)
   (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)
      (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 (u h v)
      (multiple-value-bind
            (ox oy)
          (apply #'scale-pos-to-canvas u *last-mouse-pos*)
        (ww:scale-by u (if (plusp v) 1.1 0.9))
        (multiple-value-bind
              (nx ny)
            (apply #'scale-pos-to-canvas u *last-mouse-pos*)
          (incf (ww:x u) (* (ww:scale-x u) (- nx ox)))
          (incf (ww:y u) (* (ww:scale-x u) (- ny oy)))))))

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


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

(defvar *last-mouse-pos* (list 0 0))

(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))
          (: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 (canvas-size app)
                         :pixel-height (canvas-size app))))
    (setf *last-draw-time* 0)
    (ww:add-unit canvas)))



(defun start (&key (size 800) (window 800))
  (ww:start
   (make-instance
    'pixel-whomp
    :width window
    :height window
    :title "Not a Pixel Art Editor"
    :size size)
   :x 2350))