;;;; 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)
   (gravity-on-p :std nil)))

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

(defun apply-gravity-to (thing acc)
  (with-slots (dx dy) thing
    (decf dy acc)))

(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
      (let ((gravity
              (gravity-on-p app))
            (accelleration
              (/ 9.8 (ww:fps app)))) 
        (loop for ghoul in (ww:container-units app)
              do (advance-pos ghoul)
              when gravity
                do (apply-gravity-to ghoul accelleration)
              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 (app scancode)
      (case scancode
        (:scancode-c 
         (format t "collision: ~a~%"
                 (setf (collision-on-p app)
                       (not (collision-on-p app)))))
        (:scancode-g
         (format t "gravity: ~a~%"
                 (setf (gravity-on-p app)
                       (not (gravity-on-p app))))))))


(defmethod ww::boot ((app ghoulspree))
  "Adds the intro text and sets up the start button handler."
  (format t "Click to add ~a ghouls to the screen.~%" (ghouls-per-click app))
  (format t "Press c to toggle collision handling.~%")
  (format t "Press g to toggle gravity.~%")

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