;;;; examples/08-pong.lisp

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

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

(defclass/std solo-pong (ww::application)
  ((paddle ball game-over)))

(defclass/std mobile ()
  ((dx dy dr :std 0)))

(defclass/std paddle (ww::bitmap mobile) ())
(defclass/std ball (ww::bitmap mobile) ())

(defun random-velocity (&optional (size 1.0))
  (* size (if (< 0.5 (random 1.0))
              (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)
    (setf dr (decay dr)))) ;; rotation diminishes every round, just aesthetic.

(defun decay (val &optional (amount 0.01))
  (cond
    ((zerop val)
     val)
    ((plusp val)
     (- val amount))
    ((minusp val)
     (+ val amount))))

(defun avg (&rest args)
  (loop for x in args
        sum x into total
        sum 1 into count
        finally (return (/ total count))))

(defun sqrt+ (val)
  (if (plusp val) (sqrt val)
      (* -1 (sqrt (abs val)))))

(ww::defhandler pong-perframe
    (ww::on-perframe (app)
      (with-slots (paddle ball game-over) app
        (when (ww::units-intersect-p paddle ball)
          (setf
           ;; dy just reverses direction
           (dy ball) (* -1 (dy ball)) 
           ;; average dx of the two
           (dx ball) (avg (dx ball) (dx paddle)) 
           ;; no logic to it dr change, just aesthetic
           (dr ball) (avg (sqrt+ (sqrt+ (dx paddle))) (dr ball))) 

          ;; its a good idea to advance the ball position after every collision
          ;; this prevents the ball from "getting stuck" contstantly colliding
          ;; with an object / wall.
          (advance-pos ball))

        ;; since the dx of the paddle only changes when the paddle
        ;; moves we should have it decay if its just been sitting
        ;; still. Mostly for aesthetics. It looks funny if a
        ;; stationary paddle speeds up the ball.
        (setf (dx paddle) (decay (dx paddle) 1))

        ;; here we just check the bounds, bounce when the ball hits the top left or right
        ;; and signal game over if it hits the bottom.
        (with-accessors
              ((dx dx) (dy dy) (bx ww::x) (by ww::y) (w ww::width) (h ww::height)) ball
          (cond
            ((<= 600 (+ by h))
             (setf dy (* -1 dy)
                   by (- 600 h))
             (advance-pos ball))

            ((<= 800 (+ bx w))
             (setf dx (* -1 dx)
                   bx (- 800 w))
             (advance-pos ball))

            ((<= bx 0)
             (setf dx (* -1 dx)
                   x 0))
            
            ((<= by 0)
             (setf (ww::unit-visiblep game-over) t)))

          ;; and whatever else happens, advance the ball position.
          (advance-pos ball)))))

(ww::defhandler pong-mousemove
    (ww::on-mousemotion (app)
      (setf (ww::x (paddle app))
            (- x (* 0.5 (ww::width (paddle app))))
            ;; using dx to store some motion informaton
            ;; used to chagne dx and dr in the ball
            (dx (paddle app)) xrel)))   ; xrel is supplied by default by on-mousedown

(defmethod ww::boot ((app solo-pong))
  (let* ((ball
           (make-instance
            'ball
            :texture (ww::get-asset "Fezghoul.png")
            :x 400 :y 300
            :dr (random-velocity)
            :dx (random-velocity 10)
            :dy 8))
         (paddle
           (make-instance
            'paddle
            :texture (ww::get-asset "GelatinousCube.png")
            :x 400
            :y 0))
         (game-over
           (make-instance
            'ww::text
            :font (ww::get-asset "Ticketing.ttf")
            :content "Game Over"
            :visiblep nil
            :x 300
            :y 300
            :scale-x 3.0
            :scale-y 3.0)))
    (setf (ww::width paddle) 120
          (ww::height paddle) 20
          (paddle app) paddle
          (ball app) ball
          (game-over app) game-over)

    (ww::add-unit app ball)
    (ww::add-unit app paddle)
    (ww::add-unit app game-over)
    (ww::add-handler app #'pong-mousemove)
    (ww::add-handler app #'pong-perframe )))

(defun start ()
  (ww::start
   (make-instance
    'solo-pong
    :fps 60
    :width 800
    :height 600
    :refocus-on-mousedown-p nil
    :title "Now the lonely can enjoy pong."
    :asset-root
    (merge-pathnames
     "examples/"
     (asdf:system-source-directory :wheelwork)))))