commit 02359b379908e08853a335afa230f1d5f01cddb0 Author: Joseph Ferano Date: Sun Aug 16 14:41:47 2026 +0700 First commit diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..33d9e59 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,34 @@ +;;; Directory Local Variables -*- no-byte-compile: t -*- + +((clojure-mode + . ((cider-clojure-cli-parameters . "-M:common:dev") + ;; Otherwise cider-jack-in appends its own -Sdeps '{...}' blob with + ;; nrepl/cider-nrepl regardless of cli-parameters above -- deps.edn's + ;; :dev alias already provides those, so skip the duplicate injection. + (cider-inject-dependencies-at-jack-in . nil) + (eval + . (progn + (unless (fboundp 'clj-watch) + (load (expand-file-name + "watch.el" + (locate-dominating-file default-directory ".dir-locals.el")))) + + (defun siam-farmer-run-main () + "Send (future (-main)) to the REPL." + (interactive) + (cider-interactive-eval "(future (-main))")) + + (unless (boundp 'siam-farmer-mode-map) + (defvar siam-farmer-mode-map + (let ((m (make-sparse-keymap))) + (define-key m (kbd "C-c C-w") #'clj-watch) + (define-key m (kbd "C-c C-M-r") #'siam-farmer-run-main) + m))) + + (unless (fboundp 'siam-farmer-mode) + (define-minor-mode siam-farmer-mode + "Project keybindings for siam-farmer." + :lighter " SF" + :keymap siam-farmer-mode-map)) + + (siam-farmer-mode 1)))))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..613c299 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/.cpcache/ +/.nrepl-port diff --git a/deps.edn b/deps.edn new file mode 100644 index 0000000..bf3ff27 --- /dev/null +++ b/deps.edn @@ -0,0 +1,18 @@ +{:paths ["src"] + :deps {org.clojure/clojure {:mvn/version "1.12.1"} + org.suskalo/coffi {:mvn/version "1.0.615"}} + + :aliases + {:common + {:jvm-opts ["--enable-native-access=ALL-UNNAMED" + "-Draylib.path=/home/joe/.local/bin/odin/vendor/raylib/linux/libraylib.so.600"]} + :run + {:jvm-opts ["--enable-native-access=ALL-UNNAMED" + "-Draylib.path=/home/joe/.local/bin/odin/vendor/raylib/linux/libraylib.so.600"] + :main-opts ["-m" "game"]} + + :dev + {:extra-deps {nrepl/nrepl {:mvn/version "1.7.0"} + cider/cider-nrepl {:mvn/version "0.62.2"}} + :main-opts ["-m" "nrepl.cmdline" + "--middleware" "[cider.nrepl/cider-middleware]"]}}} diff --git a/game-config.edn b/game-config.edn new file mode 100644 index 0000000..cf1c0f0 --- /dev/null +++ b/game-config.edn @@ -0,0 +1 @@ +{:foo :bar} diff --git a/src/engine.clj b/src/engine.clj new file mode 100644 index 0000000..e7e84eb --- /dev/null +++ b/src/engine.clj @@ -0,0 +1,42 @@ +(ns engine + (:require + [clojure.edn :as edn] + [rl :as rl] + [watch :as w])) + +(defonce ^:private last-error (atom nil)) + +(reset! last-error (ex-info "something bad happened" {:reason "why"})) +(reset! last-error nil) + +(defn- draw-error! [err] + (rl/clear-background!* rl/cornflower-blue) + (rl/draw-rectangle!* 10 10 300 30 (rl/color-seg 0xFF0000)) + (rl/draw-text!* "Fix the code then left click anywhere with the mouse" 0 10 16 rl/white) + #_(rl/draw-text!* (str err) 50 100 20 rl/white) + (rl/draw-text!* "Error" 50 50 40 rl/white)) + +(defn run-game! + [{:keys [title width height config-path init input update draw watch-fn] + :or {title "Untitled" width 1200 height 900 watch-fn (constantly nil)}}] + (rl/set-trace-log-level! rl/log-warning) + (rl/init-window! width height title) + (rl/set-target-fps! 60) + (let [state (atom (init (edn/read-string (slurp config-path))))] + (while (not (rl/window-should-close?)) + (rl/with-drawing! + (if @last-error + (do + (draw-error! @last-error) + (when (rl/mouse-button-released? rl/mouse-button-left) + (reset! last-error nil))) + (try + (swap! state input) + (swap! state update) + (draw @state) + (w/watch! (watch-fn @state)) + ;; TODO: Have Cider report this exception + (catch Throwable t + (println t) + (reset! last-error t)))))) + (rl/close-window!))) diff --git a/src/game.clj b/src/game.clj new file mode 100644 index 0000000..8127d70 --- /dev/null +++ b/src/game.clj @@ -0,0 +1,40 @@ +(ns game + (:require + [engine] + [rl :as rl])) + +(set! *warn-on-reflection* true) +;; (set! *unchecked-math* :warn-on-boxed) + +(defn init-game [config] + {:color-idx 0}) + +(defn handle-game-input [game] + (when (rl/key-pressed? rl/key-r)) + (when (rl/mouse-button-down? rl/mouse-button-left)) + game) + +(defn update-game [game] + game) + +(defn draw-game [game] + (rl/clear-background!* rl/cornflower-blue)) + +(defn watch-game [game] + {:color-idx (:color-idx game)}) + +(defn -main [& _args] + (engine/run-game! + {:title "Siam Farmer" + :width 900 + :height 500 + :config-path "game-config.edn" + :init #'init-game + :input #'handle-game-input + :update #'update-game + :draw #'draw-game + :watch-fn #'watch-game})) + +(comment + ;; + :-) diff --git a/src/rl.clj b/src/rl.clj new file mode 100644 index 0000000..fc09863 --- /dev/null +++ b/src/rl.clj @@ -0,0 +1,207 @@ +(ns rl + "Hand-written raylib bindings via coffi/Panama. Only what sand needs. + + Struct layouts are written against raylib 6.0's raylib.h -- a mismatch here is + silent memory corruption, not an error, so check src/raylib.h before bumping." + (:require + [coffi.mem :as mem :refer [defalias]] + [coffi.ffi :as ffi :refer [defcfn]]) + (:import + (java.lang.foreign Arena MemorySegment))) + +(ffi/load-library (or (System/getProperty "raylib.path") + "libraylib.so.600")) + +;;; ---------------------------------------------------------------- primitives +;; coffi's ::mem/byte is signed; raylib's Color fields are unsigned char, so 230 +;; would overflow on the way in. Round-trip through unchecked-byte instead. + +(defmethod mem/primitive-type ::ubyte [_type] ::mem/byte) +(defmethod mem/serialize* ::ubyte [obj _type _scope] (unchecked-byte obj)) +(defmethod mem/deserialize* ::ubyte [obj _type] (Byte/toUnsignedLong obj)) + +;; C bool is one byte. +(defmethod mem/primitive-type ::bool [_type] ::mem/byte) +(defmethod mem/serialize* ::bool [obj _type _scope] (byte (if obj 1 0))) +(defmethod mem/deserialize* ::bool [obj _type] (not (zero? obj))) + +;;; ------------------------------------------------------------------- structs + +(defalias ::color + [::mem/struct [[:r ::ubyte] [:g ::ubyte] [:b ::ubyte] [:a ::ubyte]]]) + +(defalias ::vector-2 + [::mem/struct [[:x ::mem/float] [:y ::mem/float]]]) + +(defalias ::rectangle + [::mem/struct [[:x ::mem/float] [:y ::mem/float] + [:width ::mem/float] [:height ::mem/float]]]) + +(defalias ::texture + [::mem/struct [[:id ::mem/int] [:width ::mem/int] [:height ::mem/int] + [:mipmaps ::mem/int] [:format ::mem/int]]]) + +(defalias ::image + [::mem/struct [[:data ::mem/pointer] [:width ::mem/int] [:height ::mem/int] + [:mipmaps ::mem/int] [:format ::mem/int]]]) + +(defalias ::font + [::mem/struct [[:base-size ::mem/int] [:glyph-count ::mem/int] [:glyph-padding ::mem/int] + [:texture ::texture] [:recs ::mem/pointer] [:glyphs ::mem/pointer]]]) + +;;; ----------------------------------------------------------------- constants + +(def ^:const key-r 82) +(def ^:const mouse-button-left 0) +(def ^:const log-warning 4) +(def ^:const pixelformat-r8g8b8a8 7) +(def ^:const texture-filter-point 0) + +;;; ----------------------------------------------------------------- functions + +(defcfn init-window! "InitWindow" [::mem/int ::mem/int ::mem/c-string] ::mem/void) +(defcfn close-window! "CloseWindow" [] ::mem/void) +(defcfn set-target-fps! "SetTargetFPS" [::mem/int] ::mem/void) +(defcfn set-trace-log-level! "SetTraceLogLevel" [::mem/int] ::mem/void) +(defcfn window-should-close? "WindowShouldClose" [] ::bool) + +(defcfn begin-drawing! "BeginDrawing" [] ::mem/void) +(defcfn end-drawing! "EndDrawing" [] ::mem/void) + +(defcfn draw-fps "DrawFPS" [::mem/int ::mem/int] ::mem/void) +(defcfn get-fps "GetFPS" [] ::mem/int) + +(defcfn key-pressed? "IsKeyPressed" [::mem/int] ::bool) +(defcfn mouse-button-down? "IsMouseButtonDown" [::mem/int] ::bool) +(defcfn mouse-button-released? "IsMouseButtonReleased" [::mem/int] ::bool) +(defcfn get-mouse-position "GetMousePosition" [] ::vector-2) + +;; The !* forms take pre-serialized struct segments and allocate nothing per +;; call. Everything in a per-frame path uses these. +(def clear-background!* + (ffi/make-downcall "ClearBackground" [::color] ::mem/void)) + +(def ^:private draw-rectangle-raw!* + (ffi/make-downcall "DrawRectangle" + [::mem/int ::mem/int ::mem/int ::mem/int ::color] ::mem/void)) + +(defn draw-rectangle!* + [x y w h color] + (draw-rectangle-raw!* (int x) (int y) (int w) (int h) color)) + +(def update-texture!* + (ffi/make-downcall "UpdateTexture" [::texture ::mem/pointer] ::mem/void)) + +(def draw-texture-pro!* + (ffi/make-downcall "DrawTexturePro" + [::texture ::rectangle ::rectangle ::vector-2 ::mem/float ::color] + ::mem/void)) + +;; Called once at startup, so the map-taking form is fine. +(defcfn load-texture-from-image "LoadTextureFromImage" [::image] ::texture) +(defcfn unload-texture! "UnloadTexture" [::texture] ::mem/void) +(defcfn set-texture-filter! "SetTextureFilter" [::texture ::mem/int] ::mem/void) +(defcfn get-font-default "GetFontDefault" [] ::font) + +(defcfn measure-text "MeasureText" [::mem/c-string ::mem/int] ::mem/int) + +(def ^:private draw-text-raw!* + (ffi/make-downcall "DrawText" + [::mem/c-string ::mem/int ::mem/int ::mem/int ::color] ::mem/void)) + +(def ^:private draw-text-ex-raw!* + (ffi/make-downcall "DrawTextEx" + [::font ::mem/c-string ::vector-2 ::mem/float ::mem/float ::color] + ::mem/void)) + +(def ^:private measure-text-ex-raw!* + (ffi/make-downcall "MeasureTextEx" + [::font ::mem/c-string ::mem/float ::mem/float] ::vector-2)) + +;;; --------------------------------------------------- macros + +(defmacro with-drawing! [& body] + `(do + (try + (begin-drawing!) + ~@body + (end-drawing!)))) + +;;; --------------------------------------------------- native value allocation + +(defonce ^Arena arena (Arena/ofAuto)) + +(defn color-seg + "Serialize a packed 0xRRGGBB int into a reusable native Color, once." + [^long hex] + (mem/serialize {:r (bit-and (bit-shift-right hex 16) 0xFF) + :g (bit-and (bit-shift-right hex 8) 0xFF) + :b (bit-and hex 0xFF) + :a 255} + ::color arena)) + +(def black (color-seg 0x000000)) +(def white (color-seg 0xFFFFFF)) +(def cornflower-blue (color-seg 0x6495ED)) + +(defn rect-seg [x y w h] + (mem/serialize {:x (float x) :y (float y) :width (float w) :height (float h)} + ::rectangle arena)) + +(defn vec2-seg [x y] + (mem/serialize {:x (float x) :y (float y)} ::vector-2 arena)) + +(defn texture-seg [tex] + (mem/serialize tex ::texture arena)) + +(defn font-seg [font] + (mem/serialize font ::font arena)) + +;; GetFontDefault needs a window/GL context, so this is a fn, not a def -- +;; call it once after init-window! and hang onto the result. +(defn default-font-seg [] + (font-seg (get-font-default))) + +;; The raw !* downcalls above take fully native args -- no auto marshaling, +;; unlike defcfn. text/x/y change every call anyway (so a per-call c-string +;; alloc is unavoidable), but color/font are expected pre-serialized (rl/white, +;; a font-seg) same as the other !* draw calls. + +(defn draw-text!* + [text x y font-size color] + (draw-text-raw!* (mem/serialize text ::mem/c-string arena) + (int x) (int y) (int font-size) color)) + +(defn draw-text-ex!* + [font text x y font-size spacing color] + (draw-text-ex-raw!* font + (mem/serialize text ::mem/c-string arena) + (vec2-seg x y) + (float font-size) (float spacing) color)) + +(defn measure-text-ex!* + "Returns a struct by value, so the raw downcall needs an allocator (arena) + as its first arg to write the result into, and the segment it hands back + needs an explicit deserialize -- unlike defcfn, make-downcall doesn't do + either automatically." + [font text font-size spacing] + (mem/deserialize + (measure-text-ex-raw!* arena font + (mem/serialize text ::mem/c-string arena) + (float font-size) (float spacing)) + ::vector-2)) + +(defn alloc-pixels + "An RGBA8888 pixel buffer, native so UpdateTexture can read it directly." + ^MemorySegment [^long n-pixels] + (.allocate arena (* 4 n-pixels) 4)) + +(defn rgba-le + "0xRRGGBB -> an int whose little-endian bytes are R,G,B,A, matching + PIXELFORMAT_UNCOMPRESSED_R8G8B8A8 in memory." + ^long [^long hex] + (unchecked-int + (bit-or (bit-and (bit-shift-right hex 16) 0xFF) + (bit-shift-left (bit-and (bit-shift-right hex 8) 0xFF) 8) + (bit-shift-left (bit-and hex 0xFF) 16) + (bit-shift-left 0xFF 24)))) diff --git a/src/watch.clj b/src/watch.clj new file mode 100644 index 0000000..b340130 --- /dev/null +++ b/src/watch.clj @@ -0,0 +1,121 @@ +(ns watch + "A pull-based watch: the game drops a snapshot into an atom, Emacs polls it on + its own timer. Nothing is pushed over nREPL, so the REPL stays clean and the + watch rate is decoupled from the frame rate." + (:require [clojure.string :as str]) + (:import (java.util.concurrent ConcurrentHashMap))) + +(set! *warn-on-reflection* true) + +;; Compile-time flag. -Dwatch.dev=false makes every macro here expand to nothing +;; (spy forms collapse back to the bare expression), so a production build +;; carries no cost at all. +(def ^:const enabled? (not= "false" (System/getProperty "watch.dev" "true"))) + +(defonce values (atom {})) + +(defmacro watch! + "Publish a map of label -> value for the pinned watch buffer. + + Call this once per frame, never inside a hot inner loop -- one reset! of the + whole map is 120/sec and free, while per-key swap!s both allocate in the loop + and let the reader see a torn, half-updated frame." + [m] + (when enabled? + `(reset! values ~m))) + +;;; --------------------------------------------------------------------- spy + +(defonce ^ConcurrentHashMap spied (ConcurrentHashMap.)) + +(defn spy* [label v] + (.put spied label v) + v) + +(defmacro spy + "Record the value of expr under label and return it unchanged, so you can wrap + an expression in place without restructuring the code: + + (let [target (spy :target (min (dec rows) (+ row (long vv))))] + ...) + + Last write wins. That is fine per frame, but from a hot loop you only ever see + whichever cell happened to run last -- use spy-long there instead." + [label expr] + (if enabled? + `(spy* ~label ~expr) + expr)) + +;;; Numeric spy for hot loops. State lives in a double-array per label -- no +;;; boxing, no allocation, so this survives being called thousands of times a +;;; frame. Slots: 0 count, 1 min, 2 max, 3 last, 4 sum. +(defonce ^ConcurrentHashMap counters (ConcurrentHashMap.)) + +(defn slot ^doubles [label] + (or (.get counters label) + (.computeIfAbsent counters label + (reify java.util.function.Function + (apply [_ _] + (double-array [0 Double/POSITIVE_INFINITY + Double/NEGATIVE_INFINITY 0 0])))))) + +(defn record! [^doubles s ^double v] + (aset s 0 (unchecked-inc (aget s 0))) + (when (< v (aget s 1)) (aset s 1 v)) + (when (> v (aget s 2)) (aset s 2 v)) + (aset s 3 v) + (aset s 4 (unchecked-add (aget s 4) v)) + nil) + +(defmacro spy-num + "Like spy, but for a numeric expression in a hot loop. Accumulates + count/min/max/last/mean instead of keeping one sample, which is what you + actually want when the expression runs thousands of times per frame. + + Works on longs, doubles and floats alike. Note it returns the *original* + value, not a coerced one -- wrapping a float in something that hands back a + long silently truncates it and changes what the surrounding code computes." + [label expr] + (if enabled? + `(let [v# ~expr] + (record! (slot ~label) (double v#)) + v#) + expr)) + +(defn reset-spies! + "Clear accumulated spy state. Stats are cumulative until you call this." + [] + (.clear spied) + (.clear counters)) + +;;; ------------------------------------------------------------------ render + +(defn- fmt-num [^double d] + ;; Print whole numbers as integers so a spy on an index doesn't read as 66.00. + (if (== d (Math/rint d)) (str (long d)) (format "%.4f" d))) + +(defn- fmt-slot [^doubles s] + (let [n (aget s 0)] + (if (zero? n) + "(no samples)" + (format "n=%d min=%s max=%s last=%s mean=%s" + (long n) (fmt-num (aget s 1)) (fmt-num (aget s 2)) + (fmt-num (aget s 3)) (fmt-num (/ (aget s 4) n)))))) + +(defn render + "Format the current snapshot as plain text. Emacs calls this, not you." + [] + ;; grid is 91,200 ints -- watch it by accident without these bound and the + ;; render hangs instead of printing. + (binding [*print-length* 20 + *print-level* 3] + (let [rows (concat (for [[k v] @values] [(str k) (pr-str v)]) + (for [[k v] (into {} spied)] [(str k) (pr-str v)]) + (for [[k v] (into {} counters)] [(str k) (fmt-slot v)])) + rows (sort-by first rows) + w (reduce max 1 (map (comp count first) rows))] + (if (empty? rows) + "(nothing watched)" + (str/join "\n" + (for [[k v] rows] + (format (str "%-" w "s %s") k v))))))) diff --git a/watch.el b/watch.el new file mode 100644 index 0000000..7fb4124 --- /dev/null +++ b/watch.el @@ -0,0 +1,76 @@ +;;; clj-watch.el --- A pinned, self-overwriting watch buffer -*- lexical-binding: t -*- + +;;; Commentary: + +;; Polls `watch/render' on a timer and replaces the buffer contents in +;; place. Unlike `cider-tap', nothing is appended -- the buffer always shows +;; the current frame's snapshot and nothing else. +;; +;; Usage: M-x clj-watch / M-x clj-watch-stop +;; +;; Load with: (load "/home/joe/Development/siam-farmer/watch.el") + +;;; Code: + +(require 'cider-client) + +(defvar clj-watch-buffer "*clj-watch*") +(defvar clj-watch-interval 0.2 + "Seconds between polls. This is the watch rate, not the frame rate.") + +(defvar clj-watch--timer nil) + +(defun clj-watch--paint (text) + "Replace the watch buffer's contents with TEXT." + (when-let* ((buf (get-buffer clj-watch-buffer))) + (let ((tmp (get-buffer-create " *clj-watch-src*"))) + (with-current-buffer tmp + (erase-buffer) + (insert text)) + (with-current-buffer buf + (let ((inhibit-read-only t)) + ;; replace-buffer-contents diffs rather than erasing, so point and + ;; scroll position survive every tick. erase-buffer + insert would + ;; yank the cursor back to the top five times a second. + (replace-buffer-contents tmp)))))) + +(defun clj-watch--tick () + "Poll the snapshot once, asynchronously." + (if (not (get-buffer clj-watch-buffer)) + (clj-watch-stop) + ;; Async, not `cider-nrepl-sync-request': a sync request on a timer blocks + ;; Emacs's UI thread every tick. + (cider-nrepl-request:eval + "(watch/render)" + (lambda (response) + (nrepl-dbind-response response (value err) + (cond + (err (clj-watch--paint (format "error:\n%s" err))) + (value (clj-watch--paint (car (read-from-string value)))))))))) + +(define-derived-mode clj-watch-mode special-mode "clj-watch" + "Major mode for the pinned watch buffer." + (setq-local truncate-lines t)) + +;;;###autoload +(defun clj-watch () + "Open the pinned watch buffer and start polling." + (interactive) + (cider-current-repl nil 'ensure) + (with-current-buffer (get-buffer-create clj-watch-buffer) + (unless (eq major-mode 'clj-watch-mode) + (clj-watch-mode))) + (when clj-watch--timer (cancel-timer clj-watch--timer)) + (setq clj-watch--timer + (run-with-timer 0 clj-watch-interval #'clj-watch--tick)) + (display-buffer clj-watch-buffer)) + +(defun clj-watch-stop () + "Stop polling." + (interactive) + (when clj-watch--timer + (cancel-timer clj-watch--timer) + (setq clj-watch--timer nil))) + +(provide 'clj-watch) +;;; clj-watch.el ends here