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


(ww::defhandler pong-perframe
    (ww::on-perframe (app)
      (with-slots (paddle ball game-over) app

        (when (ww::units-intersect-p paddle ball)
          (setf (dy ball) (* -1 (dy ball))
                (dr ball) (* -1 (dr ball)))
          (incf (ww::x ball) (dx ball))
          (incf (ww::y ball) (dy ball)))

        (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))
             (advance-pos ball))

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

            ((<= by 0)
             (setf (ww::unit-visiblep game-over) t)))

          (advance-pos ball)))))

(ww::defhandler pong-mousemove
    (ww::on-mousemotion (app x)
      (setf (ww::x (paddle app))
            (- x (* 0.5 (ww::width (paddle app)))))))

(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 (random-velocity 10)))
         (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)))))