;;;; 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 intro-text)))

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

(defun clamp (lo val hi)
  (max lo (min val hi)))

(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)
                   bx 0))
            
            ((<= by 0)
             (setf (ww::unit-visiblep game-over) t)))

          (setf bx (clamp 0.0 bx (- 800 w)))

          ;; 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-mousemotion

(ww::defhandler press-to-start
    (ww::on-keydown (app)
      "Sets up the ball, paddle, and game over text."
      ;; first remove the intro text and keydown handler.
      (ww::drop-unit (intro-text app))
      (ww::remove-handler app #'press-to-start)
      (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))))


(defmethod ww::boot ((app solo-pong))
  (ww::add-unit
   app
   (setf (intro-text app)
         (make-instance
          'ww::text
          :content "Press any key to start"
          :font (ww::get-asset "Ticketing.ttf")
          :x 160
          :y 300
          :scale-x 3.0
          :scale-y 3.0)))

  (ww::add-handler app #'press-to-start))

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