;;;; examples/09-ghoulspree.lisp

(defpackage #:ww.examples/9
  (:use #:cl)
  (:export #:start)
  (:import-from #:defclass-std #:defclass/std))

(in-package #:ww.examples/9)

;;; CLASSES

(defclass/std  ghoulspree (ww::application)
  ((ghouls-per-click :std 10)
   (collision-on-p :std t)))

(defclass/std ghoul (ww:bitmap)
  ((dx dy dr :std)))

;;; UTILITY FUNCTIONS

(defun make-ghoul (x y)
  (make-instance 'ghoul :texture (ww:get-asset "Fezghoul.png")
                        :x x :y y
                        :dr (random-velocity)
                        :dx (random-velocity 4)
                        :dy (random-velocity 4)))

(defun out-of-bounds-p (ghoul)
  (not
   (and
    (< -50 (ww:x ghoul) 850)
    (< -50 (ww:y ghoul) 650))))

(defun random-velocity (&optional (size 1.0))
  (* size (if (zerop (random 2))
              (random 1.0)
              (* -1 (random 1.0)))))

(defun advance-pos (thing)
  (with-accessors ((dr dr) (dx dx) (dy dy) (x ww::x) (y ww::y) (r ww::rotation)) thing
    (incf x dx)
    (incf y dy)
    (incf r dr))) 

(defun clamp (lo val hi)
  "Returns VAL if (< LO VAL HI), otherwise returns LO or HI depending
on which boundary VAL is outside of."
  (max lo (min val hi)))

(defun sign (x)
  (if (zerop x) 0
      (/ x (abs x))))

(defmacro with-pairs ((a b) ls &rest body)
  "run body with a and b bound to unique 2-sets of LS"
  (let ((more-a (gensym)))
    `(loop for (,a . ,more-a) on ,ls do
      (loop for ,b in ,more-a do (progn ,@body)) )))

(defun handle-collision (g1 g2 &optional (friction 0.99))
  (with-slots ((dx1 dx) (dy1 dy) (dr1 dr)) g1
    (with-slots ((dx2 dx) (dy2 dy) (dr2 dr)) g2
      (let ((tdx (* friction dx1))
            (tdy (* friction dy1))
            (tdr (* friction dr1)))
        (setf dx1 (* friction dx2)
              dy1 (* friction dy2)
              dr1 (* friction dr2)
              dx2 tdx
              dy2 tdy
              dr2 tdr)))))

(ww:defhandler moveghouls
    (ww:on-perframe (app)
      ;; first handle collisions
      (when (collision-on-p app)
        (with-pairs
            (g1 g2) (ww:container-units app)
            (when (ww:units-intersect-p g1 g2)
              (handle-collision g1 g2 1.0)
              ;; need a "bounce" 
              (advance-pos g1)
              (advance-pos g1)
              (advance-pos g2)
              (advance-pos g2))))
      
      ;; then update positions and remove the out of bounds
      (loop for ghoul in (ww:container-units app)
            do (advance-pos ghoul)
            when (out-of-bounds-p ghoul)
              do (ww:drop-unit ghoul))))

(defun random-sign ()
  (if (zerop (random 2)) -1 1))

(defun random-between (lo hi)
  (+ lo (random (- hi lo))))

(ww:defhandler add-ghouls
    (ww:on-mousedown (app x y)
      (loop repeat (ghouls-per-click app)
            for rx = (random 800); (+ x (* (random-sign) (random-between 30 60)))
            for ry = (random 600); (+ y (* (random-sign) (random-between 30 60)))
            do (ww:add-unit app (make-ghoul rx ry)))
      (format t "~a ghouls on screen~%"
              (length (ww:container-units app )))))


(ww:defhandler toggle-collision
    (ww:on-keydown ()
      (format t "collision: ~a~%"
              (setf (collision-on-p target)
                    (not (collision-on-p target))))))

(defmethod ww::boot ((app ghoulspree))
  "Adds the intro text and sets up the start button handler."
  (format t "Click to add ghouls to the screen.~%Press any key to toggle collision detection.~%")

  (ww:add-handler app #'add-ghouls)
  (ww:add-handler app #'moveghouls)
  (ww:add-handler app #'toggle-collision))

(defun start ()
  (ww::start
   (make-instance
    'ghoulspree
    :fps 60
    :width 800
    :height 600
    :refocus-on-mousedown-p nil
    :title "Click to add ghouls"
    :asset-root
    (merge-pathnames
     "examples/"
     (asdf:system-source-directory :wheelwork)))))