First commit

.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))))))

.gitignore

@@ -0,0 +1,2 @@
+/.cpcache/
+/.nrepl-port

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]"]}}}

game-config.edn

@@ -0,0 +1 @@
+{:foo :bar}

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!)))

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
+  ;;
+  :-)

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))))

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)))))))

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