badraingames/siam-farmer
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

First commit

Browse Source
This commit is contained in:
Joseph Ferano 2026-08-16 14:41:47 +07:00
commit 02359b3799
9 changed files with 541 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
.dir-locals.el Normal file
View File

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

2
.gitignore vendored Normal file
View File

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

18
deps.edn Normal file
View File

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

1
game-config.edn Normal file
View File

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

42
src/engine.clj Normal file
View File

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

40
src/game.clj Normal file
View File

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

207
src/rl.clj Normal file
View File

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

121
src/watch.clj Normal file
View File

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

76
watch.el Normal file
View File

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