(import rl  "vendor:raylib")
(import agent "vendor:agent")
(import edn "vendor:edn")

(defconst screen-width  900)
(defconst screen-height 600)
(defconst cell-size     5)
(defconst rows          (/ screen-height cell-size))
(defconst cols          (/ screen-width  cell-size))
(defconst brush-size    10)

(defn dyn->f64 [v f64] f64 v)
(defn dyn->u32 [v i64] u32 (u32 v))

(def gravity dyn 0.05)
(def colors dyn
  (let [v (vec-new dyn)]
    (push v 0xFFF00FFF)
    (push v 0x3B6E8CFF)
    (push v 0xA83232FF)
    (push v 0xCC6B1FFF)
    v))

(defonce grid     [rows [cols u32]])
(defonce velocity [rows [cols f32]])
(defonce current-color dyn 0)

(defn insertion-sort [coll [$t]] ()
  {:where (ordered? $t)}
  (let [i 1
        length (length coll)]
    (while (and (< i length))
      (let [j i]
        (while (and (> j 0)
                    (< (at coll j) (at coll (dec j))))
          (let [temp (at coll j)]
            (set (at coll j) (at coll (dec j)))
            (set (at coll (dec j)) temp))
          (-- j)))
      (++ i))))

(comment
  (insertion-sort [\I \N \S \E \R \T \I \O \N \S \O \R \T])
  (insertion-sort (slice [6 2 4 9 1 9 4 5] 0 8))
  (let [str (bytes "INSERTIONSORT")]
    (insertion-sort str)
    (println str))
  :-)

(defn clear-grid [] ()
  (set grid     (zeroed))
  (set velocity (zeroed)))

(defn next-color [] ()
  (set current-color (% (+ current-color 1) (length colors))))

(defn paint-at [row i32  col i32] ()
  (let [half (/ brush-size 2)]
    (dotimes [x brush-size]
      (dotimes [y brush-size]
        (let [r (+ y (- row half))
              c (+ x (- col half))]
          (when (and (>= r 0) (< r (- rows 1))
                     (>= c 0) (< c (- cols 1))
                     (= 0 (at grid r c))
                     (< (f32 (rand)) 0.5))
            (set (at grid r c) (dyn->u32 (at colors current-color)))
            (set (at velocity r c) 1.0)))))))

(defn settle [row i32  col i32] ()
  (let [vel (+ (f32 (dyn->f64 gravity)) (at velocity row col))
        y   (min (- rows 1) (+ row (i32 vel)))]
    (while (> y row)
      (when (= 0 (at grid y col))
        (set (at grid y col)         (at grid row col))
        (set (at grid row col)       0)
        (set (at velocity y col)     vel)
        (set (at velocity row col)   0.0)
        (return))
      (let [left?  (and (> col 0)          (= 0 (at grid y (- col 1))))
            right? (and (< col (- cols 1)) (= 0 (at grid y (+ col 1))))]
        (when (or left? right?)
          (let [side (cond
                       (not left?)  1
                       (not right?) -1
                       :else        (if (< (f32 (rand)) 0.5) 1 -1))]
            (set (at grid y (+ col side))       (at grid row col))
            (set (at grid row col)              0)
            (set (at velocity y (+ col side))   vel)
            (set (at velocity row col)          0.0)
            (return))))
      (set y (- y 1)))
    (set (at velocity row col) 0.0)))

(defn step [] ()
  (let [row (- rows 2)]
    (while (>= row 0)
      (dotimes [col cols]
        (unless (= 0 (at grid row col))
          (settle row col)))
      (set row (- row 1)))))

(defconst fnv-offset u64 0xcbf29ce484222325)
(defconst fnv-prime  u64 1099511628211)

(defn hash-grid [] u64
  (let [h fnv-offset]
    (dotimes [row rows]
      (dotimes [col cols]
        (let [c (at grid row col)]
          (dotimes [b 4]
            (set h (bit-xor h (u64 (bit-and (>> c (u32 (* b 8))) 255))))
            (set h (* h fnv-prime))))))
    h))

(defn game-update [] ()
  (when (rl/key-pressed? :key-r) (clear-grid))
  (when (rl/mouse-button-down? :mouse-left)
    (let [m (rl/get-mouse-position)]
      (paint-at (/ (i32 (.y m)) cell-size)
                (/ (i32 (.x m)) cell-size))))
  (when (rl/mouse-button-released? :mouse-left) (next-color))
  (step))

(defn game-draw [] ()
  (rl/clear-background rl/black)
  (dotimes [row rows]
    (dotimes [col cols]
      (let [c (at grid row col)]
        (unless (= 0 c)
          (rl/draw-rectangle (i32 (* col cell-size))
                             (i32 (* row cell-size))
                             cell-size cell-size
                             (rl/get-color c))))))
  (rl/draw-fps 20 20))

(defonce frame Allocator (arena-new 262144))
(def game-data dyn
  (handler-case (edn/read-file "game-data.edn")
    [(FileError [c] nil)]))

(defn main [] ()
  (rl/set-trace-log-level :log-warning)
  (rl/init-window screen-width screen-height "SAND")
  (defer (rl/close-window))
  (rl/set-target-fps 120)
  (agent/start "/tmp/flan-sand.sock")
  (until (rl/window-should-close?)
    (restart-case
      (do (agent/poll)
          (game-update))
      (continue [] (do)))
    (rl/with-drawing
      (game-draw))))