;;
;; ~/projects/games/mc/mc-sim.cl ---
;;
;; $Id: mc-sim.cl,v 1.11 2006/01/30 18:30:19 harley Exp $
;;

(in-package "MC")

;;
(defvar *b* nil)
(defvar *e* nil)
(defvar *city* nil)
(defvar *missle* nil)
(defvar *radar* nil)
(defvar *world* nil)

;;
(defvar *opt-wind-speed* -1)
(defvar *opt-missle-speed* 6)
(defvar *opt-missle-burn-ticks* 25)
(defvar *opt-exhaust-ticks* 10)

;;;;;

;; note: this is for when y is reversed.
;; from P1 to P2
(defun p-theta (x1 y1 x2 y2)
 (atan (- x2 x1) (- y1 y2)))
;; (p-theta 0 0 0 100)
;; (p-theta 100 100 0 0)
(defun p-theta-b (b1 b2)
  (p-theta (pos-x b1) (pos-y b1) (pos-x b2) (pos-y b2)))

(defun p-dist (x1 y1 x2 y2)
  (let ((xd (- x1 x2))
        (yd (- y1 y2)))
    (sqrt (+ (* xd xd) (* yd yd)))))
;; (p-dist 0 0 0 100)

(defun p-dist-b (b1 b2)
  (p-dist (pos-x b1) (pos-y b1) (pos-x b2) (pos-y b2)))

;; inside or on the edge
(defun blips-in-circle-func (blip-vec c-x c-y c-size func)
  (let ((x-min (- c-x c-size))
        (x-max (+ c-x c-size)))
    (loop for b across blip-vec
        do (if (and b ;; set?
                    (<= x-min (pos-x b) x-max) ;; close?
                    (<= (p-dist c-x c-y (pos-x b) (pos-y b)) c-size))
               (funcall func b)))))

(defun blips-in-circle (blip-vec c-x c-y c-size)
  (let ((vec (make-array 100 :adjustable t :fill-pointer 0)))
    (blips-in-circle-func blip-vec c-x c-y c-size
                          #'(lambda (b) (vector-push-extend b vec)))
    vec))
;; (blips-in-circle *test-vec* 100 0 1)

;;;;;

(defclass world ()
  ((tickcnt    :accessor tickcnt :initform 0)
   (cities     :accessor cities)
   (clouds     :accessor clouds)
   (explosions :accessor explosions)
   (missles    :accessor missles)))

(defun make-world ()
  (let ((world (make-instance 'world)))
    (setf *world* world)
    ;;
    (setf (cities  world)    (make-array  10 :adjustable t :fill-pointer 0))
    (setf (clouds  world)    (make-array 100 :adjustable t :fill-pointer 0))
    (setf (missles world)    (make-array 100 :adjustable t :fill-pointer 0))
    (setf (explosions world) (make-array 100 :adjustable t :fill-pointer 0))
    ;;
    (make-world-cities)
    ;;
    (make-cloud 700 260)
    (make-cloud 300 340)
    ;;
    (loop for i from 0 below 30
          do (make-missle :x (+ 100 (random 100))
                          :y 450
                          :aim-x (+ 200 (random 600))
                          :aim-y (+  10 (random 150)) ))
    ;;
    world))

;;
(defmethod push-city (x (world world))
  (vector-push-extend x (cities world)))
(defmethod push-cloud (x (world world))
  (vector-push-extend x (clouds world)))
(defmethod push-missle (x (world world))
  (vector-push-extend x (missles world)))
(defmethod push-explosion (x (world world))
  (vector-push-extend x (explosions world)))

;;;;;

(defun blipvec-remove-dead (vec)
  (sort vec #'blip-pos-x-<)
  ;;
  (loop for i from (- (fill-pointer vec) 1) downto 0
        for b = (aref vec i)
        do (if (or (not b) (not (b-alive b)))
               (setf (fill-pointer vec) i)
             (loop-finish)))
  vec)
;; (fill-pointer (clouds *world*))
;; (fill-pointer (missles *world*))
;; (sort (missles *world*) #'blip-pos-x-<)
;; (vector-push-extend nil (missles *world*))
;; (time (blipvec-remove-dead (missles *world*)))

;;
(defmethod do-tick ((world world))
  ;; a base shooting...
  (when (= 0 (mod (tickcnt world) 4))
    (make-missle :x 500 :y 450
                 :aim-x (+ 400 (random 400))
                 :aim-y (+  10 (random 150))))

  ;; Move all the blips in order in level of activity
  (loop for vec in (list (missles world) (explosions world) 
                         (clouds world) (cities world))
        do
        ;; update them
        (loop for i across vec do (do-tick i))
        ;; sort the vec
        (blipvec-remove-dead vec)
        )
  
  ;; Do secondary explosions
  (loop for e across (explosions world)
        do (loop for m across (blips-in-circle (missles world) (pos-x e) (pos-y e) (b-size e))
                 do
                 (when (b-alive m)
                   (setf (b-alive m) nil)
                   (make-explosion :pos-x (pos-x m) :pos-y (pos-y m)))))
  ;;
  (incf (tickcnt world))
  nil)

(defun make-world-cities (&key (world *world*))
  (loop for i from 0 below 6
        for x from 200 by 100
        for c = (make-city :pos-x x :pos-y 490)
        do (push-city c world)))

;;;;;;;;;;

(defclass blip ()
  ((pos-x   :accessor pos-x   :initform 0)
   (pos-y   :accessor pos-y   :initform 0)
   (vel-x   :accessor vel-x   :initform 0)
   (vel-y   :accessor vel-y   :initform 0)
   (b-theta :accessor b-theta :initform 0)
   (b-size  :accessor b-size  :initform 0)
   (b-color :accessor b-color :initform :black)
   ;;
   (b-alive :accessor b-alive :initform t)
   (b-ticks :accessor b-ticks :initform 0)
   (b-world :accessor b-world :initform nil :initarg :world)
   ))

(defun make-blip (&key (pos-x 0) (pos-y 0)
                       (vel-x 0) (vel-y 0)
                       (theta 0)
                       (size  0)
                       (world *world*)
                       (color :black))
  (let ((blip (make-instance 'blip)))
    (setf (pos-x blip) pos-x
          (pos-y blip) pos-y
          (vel-x blip) vel-x
          (vel-y blip) vel-y
          (b-size blip) size
          (b-world blip) world
          (b-theta blip) theta
          (b-color blip) color)
    ;; keep a ref for debugging
    (setf *b* blip)
    blip))
;; (make-blip)

;;
(defmethod do-update-xy ((blip blip))
  (incf (pos-x blip) (vel-x blip))
  (incf (pos-y blip) (vel-y blip))
  (incf (b-ticks blip))
  nil)

(defmethod do-tick ((blip blip))
  (if (b-alive blip)
    (do-update-xy blip)))

(defun blip-pos-x-< (b1 b2)
  ;; not alive is nil
  (if (not (b-alive b1))
      (setf b1 nil))
  (if (not (b-alive b2))
      (setf b2 nil))
  ;;
  (if (and b1 b2)
      (< (pos-x b1) (pos-x b2))
    (if b1
        t
      nil)))

;;;;;;;;;;

;;
(defclass city (blip)
  ((skyline-h :accessor skyline-h :initform (make-array 10))
   (skyline-c :accessor skyline-c :initform (make-array 10))))

(defmethod city-random-skyline ((city city))
  (let ((city-colors '(:grey10 :grey20 :grey30 :grey40)))
    (with-slots (skyline-h skyline-c) city
                (loop for i from 0 below (array-dimension skyline-h 0)
                      for c = (nth (random (length city-colors)) city-colors)
                      do (setf (aref skyline-h i) (+ 5 (random 30))
                               (aref skyline-c i) c))))
  city)

(defun make-city (&key (pos-x 500) (pos-y 480))
  (let ((city (make-instance 'city)))
    (setf (pos-x city) pos-x)
    (setf (pos-y city) pos-y)
    ;;
    (city-random-skyline city)
    ;;
    (setf *city* city)
    city))

;;;;;;;;;;

;; clouds
(defun make-cloud (c-x c-y &key (world *world*))
  (let ((cloud-colors '(:grey80 :grey85 :grey90 :grey95 :white)))
    (loop for i from 0 below 8
          for c = (nth (random (length cloud-colors)) cloud-colors)
          for x = (+ c-x (random 80))
          for y = (+ c-y (random 10))
          for s = (+ 4 (random 8))
          for cloud = (make-blip :pos-x x :pos-y y :vel-x -1 :size s :color c)
          collect cloud
          do (push-cloud cloud world))))

;; (make-cloud 500 200)
;; *radar*

;;;;;;;;;;

(defclass missle (blip)
  ((aim-x  :accessor aim-x)
   (aim-y  :accessor aim-y)))

(defun make-missle (&key x y
                         aim-x aim-y
                         (b-color :red) (world *world*))
  (let ((missle (make-instance 'missle)))
    (setf (pos-x missle) x
          (pos-y missle) y
          (aim-x missle) aim-x
          (aim-y missle) aim-y
          (b-world missle) world
          (b-color missle) b-color)
    (push-missle missle world)
    (setf *missle* missle)
    missle))

(defmethod do-tick ((missle missle))
  (when (not (b-alive missle))
    (return-from do-tick nil))
  ;;
  (with-slots (pos-x pos-y aim-x aim-y b-world b-ticks) missle
    (when aim-x
      ;; explode?
      (when (< (p-dist pos-x pos-y aim-x aim-y) *opt-missle-speed*)
        (make-explosion :pos-x aim-x :pos-y aim-y :world b-world) ;; boom
        (setf (b-alive missle) nil)
        (return-from do-tick nil))
      ;; face the aim point
      (setf (b-theta missle) (p-theta pos-x pos-y aim-x aim-y))
      (setf (vel-x missle) (* *opt-missle-speed* (sin (b-theta missle))))
      (setf (vel-y missle) (- (* *opt-missle-speed* (cos (b-theta missle)))))
      nil)
    ;;
    (when (and (< b-ticks *opt-missle-burn-ticks*)) ;; (= 0 (mod b-ticks 1)))
      (let ((e (make-missle-exhaust :pos-x pos-x :pos-y pos-y)))
        (push-cloud e *world*))))
  (do-update-xy missle))

;; (defun p-dist)
;; (defun p-theta x1 y1 x2 y2)

(defclass missle-exhaust (blip)
  ())

(defun make-missle-exhaust (&key (pos-x 0) (pos-y 0)
                                 (vel-x *opt-wind-speed*) (vel-y 0))
  (let ((exhaust (make-instance 'missle-exhaust)))
    (setf (pos-x exhaust) pos-x
          (pos-y exhaust) pos-y
          (vel-x exhaust) vel-x ;; (+ vel-x (- 1.0 (random 2.0)))
          (vel-y exhaust) vel-y
          (b-color exhaust) :white
          (b-size exhaust) 1)
    exhaust))

(defmethod do-tick ((exhaust missle-exhaust))
  (when (not (b-alive exhaust))
    (return-from do-tick nil))
  ;;
  (let ((tick (b-ticks exhaust)))
    (setf (b-color exhaust)
          (or #+lispworks (make-gray (+ (- 1.0 (/ tick 16.0)) 0.4))
              :grey))
    (cond
;;     ((< tick 1)
;;      (setf (b-size exhaust) 2
;;            (b-color exhaust) :yellow))
     ((< tick 10)
      (setf (b-size exhaust) (max 2 (/ tick 2))))
     ((< tick 16)
      t)
     (t
      (setf (b-alive exhaust) nil)))
    nil)
  ;;
  (do-update-xy exhaust))

;;;;;;;;;;

(defclass explosion (blip)
  ())

(defun make-explosion (&key pos-x pos-y (world *world*)) ;; size)
  (assert pos-x)
  (assert pos-y)
  (let ((explosion (make-instance 'explosion)))
    (setf (pos-x   explosion) pos-x
          (pos-y   explosion) pos-y
          (b-color explosion) :white
          (b-world explosion) world)
    (when *world*
      (push-explosion explosion world))
    (setf *e* explosion)
    explosion))

(defmethod do-tick ((explosion explosion))
  (when (not (b-alive explosion))
    (return-from do-tick nil))
  ;;
  (let ((tick (b-ticks explosion)))
    (let ((size  (nth tick '(     6     12     18     18   18   18   12    6    3)))
          (color (nth tick '(:white :white :white :white :red :red :red :red :red))))
      (if (null size)
          (setf (b-alive explosion) nil)
        (setf (b-size explosion) size
              (b-color explosion) color))))
  (do-update-xy explosion))
  

;; (make-explosion :pos-x 0 :pos-y 0)
;; (do-tick *e*)
;; *world*
;; (test)