(ns glimmer-gfx.asteroids
  "Asteroids: vector art, which is the one kind of graphics a line routine and
   some trigonometry get you for free.

   Every shape here is a list of points in model space, rotated and translated
   each frame and drawn with `raster/poly!`. Nothing is a sprite, nothing is a
   bitmap, and the whole world is a map of plain vectors -- so `step` is pure
   and the loop is a `swap!` on it.

   Left/right or A/D turn, W or up thrusts, space fires."
  (:require [glimmer-gfx.raster :as r]
            [glimmer-gfx.x11 :as w]))

(def ^:private W 640)
(def ^:private H 480)
(def ^:private TURN 0.26)         ; radians per frame
(def ^:private COOLDOWN 4)        ; frames between shots while space is held
(def ^:private THRUST 0.18)
(def ^:private DRAG 0.99)
(def ^:private BULLET-SPEED 6.0)
(def ^:private BULLET-LIFE 60)    ; frames

;; keysyms, as XLookupKeysym reports them
(def ^:private LEFT #{0xff51 0x61}) (def ^:private RIGHT #{0xff53 0x64})
(def ^:private THRUSTK #{0xff52 0x77}) (def ^:private FIRE #{0x20})

;; --- geometry ---------------------------------------------------------------

(defn wrap [[x y]] [(mod x W) (mod y H)])

(defn- rotate [[x y] a]
  (let [c (Math/cos a) s (Math/sin a)] [(- (* x c) (* y s)) (+ (* x s) (* y c))]))

(defn- at [pts pos angle scale]
  (mapv (fn [p] (mapv + pos (rotate (mapv * p [scale scale]) angle))) pts))

(defn- dist2 [[ax ay] [bx by]]
  (let [dx (- ax bx) dy (- ay by)] (+ (* dx dx) (* dy dy))))

(defn hit?
  "Circle overlap, on a wrapped world: compare against the nearest image of b."
  [a b radius]
  (let [[bx by] b]
    (some #(< (dist2 a %) (* radius radius))
          (for [ox [(- W) 0 W] oy [(- H) 0 H]] [(+ bx ox) (+ by oy)]))))

(def ^:private ship-shape [[1 0] [-0.6 0.6] [-0.3 0] [-0.6 -0.6]])

(defn- rock-shape
  "A lumpy ring: eight points, each pushed out by a random amount."
  []
  (mapv (fn [i] (let [a (* i (/ (* 2 Math/PI) 8))
                      d (+ 0.7 (rand 0.5))]
                  [(* d (Math/cos a)) (* d (Math/sin a))]))
        (range 8)))

(defn- rock [size]
  {:pos [(rand W) (rand H)]
   :vel [(- (rand 2.4) 1.2) (- (rand 2.4) 1.2)]
   :size size :shape (rock-shape)})

(defn- rock-radius [size] (* 14 size))

;; --- one frame --------------------------------------------------------------

(defn- drift [o] (update o :pos #(wrap (mapv + % (:vel o)))))

(defn- fly [ship keys]
  (let [a (cond-> (:angle ship)
            (some LEFT keys)  (- TURN)
            (some RIGHT keys) (+ TURN))
        thrusting (boolean (some THRUSTK keys))
        vel (cond-> (mapv #(* DRAG %) (:vel ship))
              thrusting (->> (mapv + [(* THRUST (Math/cos a)) (* THRUST (Math/sin a))])))]
    (assoc (drift (assoc ship :angle a :vel vel)) :thrusting thrusting)))

(defn- split
  "A rock that was shot becomes two smaller ones, or nothing at size 1."
  [{:keys [pos size]}]
  (when (> size 1)
    (repeatedly 2 #(assoc (rock (dec size)) :pos pos))))

(defn- collide
  "Bullets against rocks: whatever each hit, gone; each rock hit, split."
  [bullets rocks]
  (let [struck (into {} (for [b bullets
                              rk rocks
                              :when (hit? (:pos b) (:pos rk) (rock-radius (:size rk)))]
                          [rk b]))]
    [(remove (set (vals struck)) bullets)
     (into (vec (remove struck rocks)) (mapcat split (keys struck)))
     (count struck)]))

(defn step
  "One frame. Pure: state and the keys held in, state out."
  [{:keys [ship bullets rocks score fired?] :as st} keys]
  (let [ship    (fly ship keys)
        firing? (boolean (some FIRE keys))
        ;; hold to auto-fire, but not every frame: COOLDOWN paces it
        cool    (if firing? (dec (or (:cool st) 0)) 0)
        shoot?  (and firing? (not (pos? cool)))
        bullets (cond->> (->> bullets
                              (map #(update (drift %) :life dec))
                              (filter #(pos? (:life %))))
                  shoot?
                  (cons {:pos (:pos ship) :life BULLET-LIFE
                         :vel [(* BULLET-SPEED (Math/cos (:angle ship)))
                               (* BULLET-SPEED (Math/sin (:angle ship)))]}))
        [bullets rocks n] (collide bullets (map drift rocks))
        dead?   (some #(hit? (:pos ship) (:pos %) (rock-radius (:size %))) rocks)]
    (assoc st :ship ship :bullets (vec bullets) :fired? firing?
              :cool (if shoot? COOLDOWN cool)
              :rocks (if (seq rocks) (vec rocks) (vec (repeatedly 5 #(rock 3))))
              :score (+ score (* 10 n))
              :lost? (boolean dead?))))

;; --- paint ------------------------------------------------------------------

(def ^:private colours {:bg 0x0b0d12 :ship 0xffffff :flame 0xd08050
                        :rock 0x9aa0b0 :shot 0x5a6ea0 :fg 0xffffff})

(defn- draw! [buf {:keys [ship bullets rocks score lost?]}]
  (r/clear buf (:bg colours))
  (doseq [rk rocks]
    (r/poly! buf (at (:shape rk) (:pos rk) 0 (rock-radius (:size rk))) (:rock colours)))
  (doseq [b bullets]
    (let [[x y] (:pos b)] (r/rect! buf (int x) (int y) 2 2 (:shot colours))))
  (when-not lost?
    (r/poly! buf (at ship-shape (:pos ship) (:angle ship) 10) (:ship colours))
    (when (:thrusting ship)
      (r/poly! buf (at [[-0.6 0.35] [-1.3 0] [-0.6 -0.35]] (:pos ship) (:angle ship) 10)
               (:flame colours))))
  (r/text! buf 8 8 (str "SCORE " score) (:fg colours) 2)
  (when lost?
    (r/text! buf (- (quot W 2) 60) (quot H 2) "GAME OVER" (:fg colours) 3)))

(defn new-game []
  {:ship {:pos [(/ W 2.0) (/ H 2.0)] :vel [0 0] :angle 0}
   :bullets [] :rocks (vec (repeatedly 5 #(rock 3))) :score 0 :fired? false :cool 0})

(defn -main [& _]
  (let [state (atom (new-game))]
    (w/run-window
      {:width W :height H :title "asteroids"}
      (fn [buf input]
        (draw! buf (swap! state
                          (fn [st]
                            ;; dead: space starts a new game rather than firing
                            (if (:lost? st)
                              (if (and (some FIRE (:keys input)) (not (:fired? st)))
                                (new-game)
                                (assoc st :fired? (boolean (some FIRE (:keys input)))))
                              (step st (:keys input))))))))))