Joseph Ferano
10b1abbf09
TraceLogLevel carried `warning` beside `log-warning` so that sand.flan's one call kept working while the rename landed. The review found it was not inert: render.ml folds members last-wins, so a 4 read back as :warning in the break loop, the did-you-mean offered it, and every TraceLogLevel error listed it. A spelling nobody should write was the one the compiler taught. So the call is respelled and the alias is gone. Every member of every mapped enum carries its enum's prefix now, with no exception to explain.
133 lines
4.0 KiB
Plaintext
133 lines
4.0 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 clear-grid [] ()
|
|
(set grid (zeroed))
|
|
(set velocity (zeroed)))
|
|
|
|
(defn next-color [] ()
|
|
(set current-color (% (+ current-color 1) (len 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))
|
|
(< (rand-f32) 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 (< (rand-f32) 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))))
|