;;; 01-bitmap-display.lisp

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

(in-package :ww.examples/2)

(defclass bitmap-display (ww::application ) ())

(defvar *shared-anim-table* (make-hash-table :synchronized t))

(ww::defhandler move-thing
    (ww::on-keydown ()
      "Move the target around, grow and shrink it. Print out its
       position no matter what happens."
      (case scancode
        (:scancode-left (decf (ww::unit-x target) (ww::unit-width target)))
        (:scancode-right (incf (ww::unit-x target) (ww::unit-width target)))
        (:scancode-down (decf (ww::unit-y target) (ww::unit-height target)))
        (:scancode-up (incf (ww::unit-y target) (ww::unit-height target)))
        (:scancode-equals
         (when (or (member :lshift modifiers) (member :rshift modifiers))
           (incf (ww::unit-height target) 20.0)
           (incf                  (ww::unit-width target) 20.0)))
        (:scancode-minus
         (decf (ww::unit-height target) 20.0)
         (decf                (ww::unit-width target) 20.0)))
      (format t "ghoul pos: ~a,~a~%"
              (ww::unit-x target) (ww::unit-y target))))

(ww::defhandler animate-move-thing
    (ww::on-keydown ()
      "If the target is not already involved in an animation, add a
       perframe handler to the target that animates it to a new position."
      (when (member scancode '(:scancode-left :scancode-right :scancode-down :scancode-up)) 
        (unless (gethash target *shared-anim-table*)
          (setf (gethash target *shared-anim-table*) t)
          (let* ((tx (ww::unit-x target))
                 (ty (ww::unit-y target))
                 (destx tx)
                 (desty ty)
                 (dx 0)
                 (dy 0))
            (case scancode
              (:scancode-down (setf dy -1 desty (- ty (ww::unit-height target))))
              (:scancode-up (setf dy 1 desty (+ ty (ww::unit-height target))))
              (:scancode-left (setf dx -1 destx (- tx (ww::unit-width target))))
              (:scancode-right (setf dx 1 destx (+ tx (ww::unit-width target)))))
            (ww::add-handler
             target
             (ww::on-perframe ()
               (with-slots ((cx ww::x) (cy ww::y)) target 
                 (if (and (= cx destx) (= cy desty))
                     (progn
                       (remhash target *shared-anim-table*)
                       (ww::remove-handler target 'ww::perframe))
                     (setf cx (+ cx dx)
                           cy (+ cy dy)))))))))))


(ww::defhandler thing-clicked
    (ww::on-mousedown ()
      (format t "~a was clicked at ~a,~a!~%" target x y)))

(ww::defhandler flip-on-click
    (ww::on-mousedown ()
      (incf (ww::unit-rotation target) (ww::radians 180) )))

(ww::defhandler mouse-over
    (ww::on-mousemotion ()
      (print (list target x y xrel yrel state))))

(ww::defhandler look-at-me 
  (ww::on-focus ()
    (format t "~a got focus~%" target)))

(ww::defhandler look-away 
  (ww::on-blur ()
    (format t "~a lost focus~%" target)))

(ww::defhandler wheelie
    (ww::on-mousewheel ()
      (print (list :mousewheel horiz vert dir))))

(defmethod ww::boot ((app bitmap-display))
  (let ((bm
          (make-instance 'ww::bitmap
                         :texture (ww::get-asset "Fezghoul.png")))
        (bm2
          (make-instance 'ww::bitmap
                         :texture (ww::get-asset "RootBear.png"))))

    (ww::add-handler app #'wheelie)

    ;; first 
    (ww::refocus-on bm)
    (ww::add-handler bm #'animate-move-thing )
    (ww::add-handler bm #'thing-clicked)
    (ww::add-handler bm #'mouse-over)
    (ww::add-unit app bm)
    ;;second
    (setf (ww::unit-x bm2) 90
          (ww::unit-y bm2) 90)
    (ww::add-handler bm2 #'move-thing)
    (ww::add-handler bm2 #'flip-on-click )
    (ww::add-handler bm2 #'look-at-me)
    (ww::add-handler bm2 #'look-away)
    (ww::add-handler bm2 #'wheelie)
    (ww::add-unit app bm2)))


(defun start ()
  (ww::start (make-instance 'bitmap-display
                            :scale 2.0
                            :fps 30
                            :asset-root #P"~/projects/wheelwork/examples/")))