Joseph Ferano
8eaeb992d6
Two sites, and the second is the subtle one: the let binds a local named length from (length coll), which reads because a sequential let checks an initialiser before the name it binds exists. That was the reason for the rename -- len is a variable now.
155 lines
4.6 KiB
Plaintext
155 lines
4.6 KiB
Plaintext
(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))))
|