Make sure everything is committed

.gitignore

@@ -4,3 +4,4 @@
 /target/
 /.clj-kondo/
 /.lsp/
+*.fasl

assets/Mushrooms, Flowers, Stones.data

@@ -0,0 +1,55 @@
+(:texture-path "source-assets/Sprout Lands Premium/Objects/Mushrooms, Flowers, Stones.png"
+ :selected-cells ((0 0)
+                  (0 1)
+                  (0 2)
+                  (0 3)
+                  (0 4)
+                  (0 5)
+                  (0 6)
+                  (0 10)
+                  (1 0)
+                  (1 1)
+                  (1 2)
+                  (1 3)
+                  (1 4)
+                  (1 5)
+                  (1 6)
+                  (1 7)
+                  (1 8)
+                  (1 9)
+                  (1 10)
+                  (1 11)
+                  (2 0)
+                  (2 1)
+                  (2 2)
+                  (2 3)
+                  (2 6)
+                  (2 7)
+                  (2 8)
+                  (2 9)
+                  (2 10)
+                  (2 11)
+                  (3 0)
+                  (3 1)
+                  (3 2)
+                  (3 3)
+                  (3 4)
+                  (3 5)
+                  (3 6)
+                  (3 7)
+                  (3 8)
+                  (3 9)
+                  (3 10)
+                  (3 11)
+                  (4 0)
+                  (4 1)
+                  (4 2)
+                  (4 3)
+                  (4 4)
+                  (4 5)
+                  (4 6)
+                  (4 7)
+                  (4 8)
+                  (4 9)
+                  (4 10)
+                  (4 11)))

game-config.data

@@ -0,0 +1 @@
+(:foo :bar)

siam-farmer.asd

@@ -0,0 +1,13 @@
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  ;; raylib hands back floats that trip SBCL's FP traps otherwise.
+  (sb-int:set-floating-point-modes :traps nil))
+
+(asdf:defsystem #:siam-farmer
+  :description "Tile-based farming game"
+  :author "Joseph Ferano"
+  :depends-on (#:cl-raylib #:livesupport)
+  :serial t
+  :pathname "src"
+  :components ((:file "engine")
+               (:file "game")))

src/engine.clj

@@ -4,11 +4,32 @@
    [rl :as rl]
    [watch :as w]))
 
+(defprotocol IBuffered
+  (cells [this])
+  (snapshot! [this])
+  (restore! [this]))
+
+(deftype IntGrid [^ints cells ^ints backup]
+  IBuffered
+  (cells [_] cells)
+  (snapshot! [_] (System/arraycopy cells 0 backup 0 (alength cells)))
+  (restore! [_] (System/arraycopy backup 0 cells 0 (alength cells))))
+
+(deftype RawIntGrid [^ints cells]
+  IBuffered
+  (cells [_] cells)
+  (snapshot! [_])
+  (restore! [_]))
+
 (defonce last-error (atom nil))
 (defonce game-state (atom nil))
 (defonce game-config (atom nil))
 (defonce texture-cache (atom {}))
 ;; (reset! texture-cache {})
+(defonce buffered-objs (atom []))
+
+;; TODO: Setup release flags and get this to work with make-int-grid
+;; (def debug? (not= "false" (System/getProperty "siam.debug")))
 
 (defn load-texture-once [id path]
   (or (@texture-cache path)
@@ -16,11 +37,10 @@
         (swap! texture-cache assoc path t)
         t)))
 
-(defn load-texture-once [id path]
+(defn make-int-grid [n empty-val]
-  (or (@texture-cache path)
+  (let [g (->IntGrid (int-array n empty-val) (int-array n empty-val))]
-      (let [t (assoc (rl/load-texture path) :name id)]
+    (swap! buffered-objs conj g)
-        (swap! texture-cache assoc path t)
+    g))
-        t)))
 
 (defn report-exception!
   "Stash the exception and print a marker line. Emacs watches the REPL output
@@ -59,16 +79,20 @@
             (report-exception! t)))
         (while (not (rl/window-should-close?))
           (if @last-error
-            (Thread/sleep 50)
+            (do (rl/with-drawing!)
+                (Thread/sleep 50))
             (let [config (:config @game-config)]
-              (rl/with-drawing!
+              (try
-                (try
+                (doseq [buf @buffered-objs] (snapshot! buf))
-                  (swap! game-state #(update config %))
+                (let [updated-state (update config @game-state)]
-                  (draw config @game-state)
+                  (rl/with-drawing!
-                  (w/watch! (watch-fn config @game-state))
+                    (draw config updated-state)
-                  (catch Throwable t
+                    (w/watch! (watch-fn config updated-state))
-                    (report-exception! t)
+                    (reset! game-state updated-state)))
-                    (w/watch! (merge (watch-fn config @game-state) {:error t}))))))))
+                (catch Throwable t
+                  (doseq [buf @buffered-objs]
+                      (when buf (restore! buf)))
+                  (report-exception! t))))))
         (try
           (when unload
             (doseq [[_ tex] @texture-cache]
@@ -77,6 +101,7 @@
           (catch Throwable t
             (report-exception! t)))
         (rl/close-window!)
+        (reset! buffered-objs [])
         (reset! texture-cache {})
         (reset! last-error nil)
         (reset! game-state nil)

src/engine.lisp

@@ -0,0 +1,169 @@
+(defpackage #:engine
+  (:use #:cl)
+  (:local-nicknames (#:rl #:raylib)
+                    (#:v #:3d-vectors))
+  (:export #:run-game
+           #:*game-state* #:*game-config*
+           #:read-data #:data-field #:reload-config #:resource-path
+           #:load-texture-once
+           #:make-int-grid
+           #:copy-slots))
+
+(in-package #:engine)
+
+(defvar *game-state* nil)
+(defvar *game-config* nil)
+(defvar *config-path* nil)
+
+(defvar *texture-cache* (make-hash-table :test #'equal)
+  "Path -> rl:texture. Keyed by string, hence :test equal.")
+
+(defvar *buffers* nil
+  "List of (live . backup) int-grid pairs, snapshotted at the top of each frame
+   so a failed frame can be rolled back. See snapshot-state / restore-state.")
+
+(defvar *state-backup* nil
+  "Shallow copy of *game-state*, refreshed every frame alongside *buffers*.")
+
+;;; ------------------------------------------------------------------- assets
+
+(defun resource-path (relative)
+  "Resolve a project-relative path against the system's source directory.
+
+   Everything that touches an asset goes through this. Raylib resolves paths
+   against the *process* working directory, which under SLY is wherever the
+   inferior Lisp happened to start -- and a miss there is silent, LoadTexture
+   just hands back a texture with id 0."
+  (let ((path (asdf:system-relative-pathname :siam-farmer relative)))
+    (unless (probe-file path)
+      (error "Missing resource ~s~%  resolved to: ~a~%  project root: ~a"
+             relative path (asdf:system-source-directory :siam-farmer)))
+    (namestring path)))
+
+(defun read-data (path)
+  "Read one s-expression from PATH, taken relative to the project root. The
+   .data files are plists; *read-eval* is off so a data file can never execute
+   code at load time."
+  (with-open-file (s (resource-path path))
+    (let ((*read-eval* nil))
+      (read s))))
+
+(defun data-field (plist key source)
+  "GETF that refuses to come back empty. A key typo'd in a .data file should
+   fail at the file it was read from, not silently three calls later as an
+   empty palette."
+  (or (getf plist key)
+      (error "Missing ~s in ~a" key source)))
+
+(defun reload-config ()
+  (when *config-path*
+    (setf *game-config* (read-data *config-path*))))
+
+(defun load-texture-once (path)
+  "Load a texture once per path, PATH being relative to the project root."
+  (or (gethash path *texture-cache*)
+      (let ((texture (rl:load-texture (resource-path path))))
+        ;; Raylib only logs a failed load, so check rather than draw nothing.
+        (when (zerop (rl:texture-id texture))
+          (warn "Failed to load texture: ~a" (resource-path path)))
+        (setf (gethash path *texture-cache*) texture))))
+
+;;; ---------------------------------------------------------------- buffering
+
+(defun make-int-grid (n &optional (initial -1))
+  (let ((grid (make-array n :element-type '(signed-byte 32) :initial-element initial)))
+    (push (cons grid (make-array n :element-type '(signed-byte 32) :initial-element initial))
+          *buffers*)
+    grid))
+
+(defun copy-slots (from to)
+  "Shallow-copy every bound slot of FROM onto TO. Walks the class rather than
+   naming slots, so adding a slot to the game class needs no change here."
+  (loop for slot in (sb-mop:class-slots (class-of from))
+        for name = (sb-mop:slot-definition-name slot)
+        when (slot-boundp from name)
+          do (setf (slot-value to name) (slot-value from name)))
+  to)
+
+(defun snapshot-state ()
+  (when *game-state*
+    (unless (and *state-backup*
+                 (eq (class-of *state-backup*) (class-of *game-state*)))
+      (setf *state-backup* (allocate-instance (class-of *game-state*))))
+    (copy-slots *game-state* *state-backup*))
+  (loop for (live . backup) in *buffers*
+        do (replace backup live)))
+
+(defun restore-state ()
+  "Roll the frame back. Copies *into* the existing state object rather than
+   allocating a new one, so any reference held at the REPL stays live."
+  (when (and *game-state* *state-backup*)
+    (copy-slots *state-backup* *game-state*))
+  (loop for (live . backup) in *buffers*
+        do (replace live backup)))
+
+;;; ------------------------------------------------------------------- loop
+
+(defun init-state (init)
+  (setf *buffers*      nil
+        *state-backup* nil
+        *game-state*   (funcall init)))
+
+(defun run-frame (init update draw)
+  "Run one frame. Returns NIL to ask for a re-run, T to move on."
+  (restart-case
+      (progn
+        (funcall update *game-state*)
+        (rl:with-drawing (funcall draw *game-state*))
+        t)
+    (retry-frame ()
+      :report "Roll back this frame and run it again"
+      (restore-state)
+      nil)
+    (skip-frame ()
+      :report "Roll back this frame and continue to the next"
+      (restore-state)
+      t)
+    (reinit ()
+      :report "Throw the state away and re-run the game's init"
+      (init-state init)
+      t)))
+
+(defun cleanup ()
+  (loop for tex being the hash-values of *texture-cache*
+        do (rl:unload-texture tex))
+  (clrhash *texture-cache*)
+  (setf *buffers*      nil
+        *state-backup* nil
+        *game-state*   nil
+        *game-config*  nil
+        *config-path*  nil))
+
+(defun run-game (&key (title "Untitled") (width 1200) (height 900)
+                   config-path init update draw unload)
+  (if (rl:is-window-ready)
+      (warn "Existing raylib window open, ignoring!")
+      (progn
+        (rl:set-trace-log-level :log-warning)
+        ;; Decide the REPL backend now, at game start, rather than inheriting
+        ;; whatever was loaded when livesupport itself was.
+        (livesupport:reset-livecoding)
+        (rl:with-window (width height title)
+          ;; cleanup has to run inside with-window -- unload-texture needs a
+          ;; live GL context -- and it has to run on an abort out of the
+          ;; debugger too, or the next (main) reuses dead texture ids.
+          (unwind-protect
+               (progn
+                 (rl:set-target-fps 30)
+                 (setf *config-path* config-path)
+                 (reload-config)
+                 (init-state init)
+                 (loop until (rl:window-should-close)
+                       do (snapshot-state)
+                          (loop until (run-frame init update draw))
+                          ;; Services SLY between frames, so redefining a
+                          ;; function at the REPL takes effect on the next one
+                          ;; without restarting the game.
+                          (livesupport:update-repl-link))
+                 (when unload (funcall unload *game-state*)))
+            (cleanup))))))

src/game.clj

@@ -8,8 +8,8 @@
    [clojure.edn :as edn]
    [rl :as rl]))
 
-(def ^:const screen-width 1280)
+(def screen-width 1280)
-(def ^:const screen-height 630)
+(def screen-height 630)
 ;; (def ^:const screen-width 970)
 ;; (def ^:const screen-height 530)
 (def ^:const cell-size 16)
@@ -19,6 +19,7 @@
 
 (def scale 4.0)
 (def num-layers 5)
+(def ^:const stride 3)
 
 (set! *warn-on-reflection* true)
 ;; (set! *unchecked-math* :warn-on-boxed)
@@ -27,10 +28,24 @@
 (def color-ground (rl/color-seg 0xE8CFA6))
 (def color-tint-gray (rl/color-seg 0 0 0 100))
 
-(defn idx [row col] (+ (* row cols) col))
+(defn idx [row col] (* (+ (* row cols) col) stride))
-(defn tile-at [game layer r c] (aget ^objects (get (:layers game) layer) (idx r c)))
+
-(defn tile-at-idx [game layer idx] (aget ^objects (get (:layers game) layer) idx))
+(defn tile-at [game layer r c]
-(defn set-tile! [game layer r c tile] (aset ^objects (get (:layers game) layer) (idx r c) tile))
+  (let [grid ^ints (e/cells (get (:layers game) layer))
+        i (idx r c)]
+    [(aget grid i) (aget grid (+ i 1)) (aget grid (+ i 2))]))
+
+(defn tile-at-idx [game layer i]
+  (let [grid ^ints (e/cells (get (:layers game) layer))]
+    [(aget grid i) (aget grid (+ i 1)) (aget grid (+ i 2))]))
+
+(defn set-tile! [game layer atlas-id tr tc cr cc]
+  (let [i (idx cr cc)]
+    (doto ^ints (e/cells (get (:layers game) layer))
+      (aset i (int atlas-id))
+      (aset (+ i 1) (int tr))
+      (aset (+ i 2) (int tc)))))
+
 (defn cell-at-mouse-pos [game]
   (let [{mx :x my :y} (rl/get-mouse-position)
         row (quot my (* cell-size scale))
@@ -41,11 +56,10 @@
   (let [tileset-path "./source-assets/Sprout Lands Premium/Tilesets/ground tiles/New tiles/"]
     {:editor-mode false
      :color-idx 0
-     ;; :event-queue []
+     :layers (vec (repeatedly num-layers #(e/make-int-grid (* rows cols stride) -1)))
-     ;; TODO: Once we have a proper ID system for the cells, use int-array for performance
-     :layers (vec (repeatedly num-layers #(object-array (* rows cols))))
      :current-layer 0
      :current-tilemap 0
+     :selected-tile [-1 -1 -1]
      :atlases
      ;; (edn/read-string (slurp "./assets/Mushrooms, Flowers, Stones.edn"))
      (let [path "./assets/Mushrooms, Flowers, Stones.edn"
@@ -159,9 +173,12 @@
 
 (defn set-random-tile! [game layer row col]
   (let [tile (edge-set (tile-bitset game layer row col))
-        tilemap (get (:tilemaps game) (:current-tilemap game))]
+        atlas-id (:current-tilemap game)
-    (if (vector? tile)
+        tilemap (get (:tilemaps game) atlas-id)]
-      (set-tile! game layer row col [tilemap tile])
+    (set-tile! game layer atlas-id row col #_[tilemap tile])
+    #_(if (vector? tile)
+      (set-tile! game layer atlas-id row col #_[tilemap tile])
+      ;; TODO: This is still calling the old API
       (set-tile! game layer row col
                  (reduce (fn [acc [tile weight]]
                            (if (< acc weight) (reduced [tilemap tile]) (- acc weight)))
@@ -185,18 +202,12 @@
 
                      ;; (when (contains? (:tags tile) :randomized)
 
-(defn set-tile2! [game layer row col tile]
- )
-
 (defn handle-game-input [config game]
   (update-as-> [g game]
     (assoc g :event-queue [])
 
     (when (not (:editor-mode game))
       (cond-> g
-        (rl/key-pressed? rl/key-space)
-        (update :editor-mode not)
-
         ;; (rl/key-pressed? rl/key-r)
         ;; (assoc :layers (object-array (* rows cols)))
 
@@ -210,12 +221,15 @@
             (rl/mouse-button-released? rl/mouse-button-right))
         (dissoc :drag-mode)))
 
+    (when (rl/key-pressed? rl/key-space)
+      (update g :editor-mode not))
+
     #_(when (and (:editor-mode game)
                  (rl/mouse-button-pressed? rl/mouse-button-left))
         (let [{mx :x my :y} (rl/get-mouse-position)]
           (doseq)))
 
-    (when (rl/mouse-button-pressed? rl/mouse-button-middle)
+    #_(when (rl/mouse-button-pressed? rl/mouse-button-middle)
       (do-grid [r 10 c 20]
         (auto-tile! g r c)))
 
@@ -244,12 +258,19 @@
         (when (and existing (= mode :erase))
           (delete-tile! game (:current-layer game) row col))
         (when (and (= mode :draw)
+                   (not= -1 (first (:selected-tile game)))
+                   (not= (cell-at-mouse-pos game) (:last-filled-cell game)))
+          (let [[atlas-id tr tc] (:selected-tile game)]
+            (set-tile! game (:current-layer game) atlas-id tr tc row col))
+          (assoc game :last-filled-cell [row col]))
+        ;; TODO: Add single vs auto mode
+        #_(when (and (= mode :draw)
                    (not= (cell-at-mouse-pos game) (:last-filled-cell game)))
           (auto-tile! game (:current-layer game) row col)
           (assoc game :last-filled-cell [row col]))))))
 
-(defn draw-tile! [game tilemap row-idx col-idx x y scale]
+(defn draw-tile! [game tilemap row col x y scale]
-  (let [src-rect (rl/rect-seg (* col-idx cell-size) (* row-idx cell-size) cell-size cell-size)
+  (let [src-rect (rl/rect-seg (* col cell-size) (* row cell-size) cell-size cell-size)
         dst-x (* (quot x (* cell-size scale)) cell-size scale)
         dst-y (* (quot y (* cell-size scale)) cell-size scale)
         dst-rect (rl/rect-seg dst-x dst-y (* cell-size scale) (* cell-size scale))]
@@ -258,14 +279,18 @@
 (defn draw-game [config game]
   (rl/clear-background!* color-ground)
   (dotimes [layer num-layers]
-    (do-grid [row rows col cols]
+    (do-grid [cr rows cc cols]
-      (when-let [[tilemap [tx ty]] (tile-at game layer row col)]
+      (let [[aid tr tc] (tile-at game layer cr cc)]
-        (draw-tile! game tilemap tx ty (* col cell-size scale) (* row cell-size scale) scale))))
+        (when (and (not= aid -1)
-  (when (and (not (contains? game :draw-drag))
+                   (get (:atlases game) aid))
+          (draw-tile! game (second (get (:atlases game) aid)) tr tc (* cc cell-size scale) (* cr cell-size scale) scale)))))
+  #_(when (and (not= (first (:selected-tile game)) -1)
+             (not (contains? game :draw-drag))
              (not (:editor-mode game)))
-    (let [{mx :x my :y :as mouse-pos} (rl/get-mouse-position)]
+    (let [{mx :x my :y :as mouse-pos} (rl/get-mouse-position)
+          [aid tr tc] (:selected-tile game)]
       ;; TODO: Maybe better if we create a get-tilemap-by-name
-      (draw-tile! game (get (:tilemaps game) 0) 3 3 mx my scale)))
+      (draw-tile! game (second (get (:atlases game) aid)) tr tc mx my scale)))
   #_(rl/draw-texture-pro!* (:seg (:bush (:tilemaps game)))
                            (rl/rect-seg 0 0 54 35)
                            (rl/rect-seg 600 180 (* 54 2) (* 35 2))
@@ -293,7 +318,8 @@
           (when (rl/collision-point-rec? mouse-pos {:x pos-x :y pos-y :width curr-size :height curr-size})
             (rl/draw-rectangle-lines!* pos-x pos-y curr-size curr-size rl/green)
             (when (rl/mouse-button-pressed? rl/mouse-button-left)
-              (swap! e/game-state assoc :selected-tile [r c])
+              ;; TODO: For the love of god fix this
+              (swap! e/game-state assoc :selected-tile [(:current-tilemap game) r c])
               (swap! e/game-state dissoc :editor-mode))))))
     #_(doseq [[idx [k {:keys [width height seg]}]] (into [] (map-indexed vector) (:tilemaps game))
             :let [padding 10]]
@@ -326,7 +352,8 @@
   (future (-main))
   ;; TODO: I hate this, terrible way to read game state, maybe pass an atom in?
   (reset! e/game-state (init-game {}))
-  (swap! e/game-state :assoc {})
+  (swap! e/game-state :assoc :selected-tile [0 0 6])
+  e/game-state
 
   (:tilemaps @e/game-state)
 

src/game.lisp

@@ -0,0 +1,311 @@
+(defpackage #:game
+  (:use #:cl)
+  (:local-nicknames (#:rl #:raylib)
+                    (#:v #:3d-vectors)
+                    (#:e #:engine))
+  (:export #:main))
+
+(in-package #:game)
+
+(defconstant +screen-width+ 1280)
+(defconstant +screen-height+ 630)
+(defconstant +cell-size+ 16)
+(defconstant +rows+ (floor +screen-height+ +cell-size+))
+(defconstant +cols+ (floor +screen-width+ +cell-size+))
+(defconstant +scale+ 4.0)
+(defconstant +num-layers+ 5)
+
+;; A cell is three ints wide: atlas-id, tile-row, tile-col.
+(defconstant +stride+ 3)
+(defconstant +grid-len+ (* +rows+ +cols+ +stride+))
+
+(defparameter *color-ground* '(232 207 166 255))
+(defparameter *color-tint-gray* '(0 0 0 100))
+
+(defparameter *origin* (v:vec 0 0)
+  "Reused rotation origin -- draw-texture-pro takes one on every call.")
+
+(defparameter *num-keys*
+  #(:key-zero :key-one :key-two :key-three :key-four
+    :key-five :key-six :key-seven :key-eight :key-nine))
+
+;;; ------------------------------------------------------------------- state
+
+(defclass game ()
+  ((editor-mode      :initform nil :accessor editor-mode)
+   (color-idx        :initform 0   :accessor color-idx)
+   (layers           :initform nil :accessor layers)
+   (current-layer    :initform 0   :accessor current-layer)
+   (current-tilemap  :initform 0   :accessor current-tilemap)
+   (selected-tile    :initform (list -1 -1 -1) :accessor selected-tile)
+   (hovered-tile     :initform nil :accessor hovered-tile)
+   (drag-mode        :initform nil :accessor drag-mode)
+   (last-filled-cell :initform nil :accessor last-filled-cell)
+   (tilesets         :initform #() :accessor tilesets)
+   (tilemaps         :initform #() :accessor tilemaps)))
+
+;; Plain data, rebuilt wholesale by the reinit restart, so a struct is fine
+;; here -- unlike the game object, nothing needs to survive its redefinition.
+(defstruct tileset
+  id texture tiles src-rects dst-rects)
+
+;;; -------------------------------------------------------------------- grid
+
+;; (declaim (ftype (function (fixnum fixnum) fixnum) idx)
+;;          (inline idx))
+(defun idx (row col)
+  (* (+ (* row +cols+) col) +stride+))
+
+;; (declaim (ftype (function (row-index col-index) fixnum) test-idx))
+;; (defun test-idx (row col bump)
+;;   (declare (optimize (speed 3) (safety 0)))
+;;   (let ((i (idx row col)))
+;;     (+ i bump)))
+
+(defun tile-at (game layer row col)
+  "Returns (values atlas-id tile-row tile-col). atlas-id is -1 when empty."
+  (let ((grid (aref (layers game) layer))
+        (i (idx row col)))
+    (declare (type (simple-array (signed-byte 32) (*)) grid))
+    (values (aref grid i) (aref grid (+ i 1)) (aref grid (+ i 2)))))
+
+(defun tile-at-p (game layer row col)
+  (/= -1 (aref (the (simple-array (signed-byte 32) (*)) (aref (layers game) layer))
+               (idx row col))))
+
+(defun set-tile (game layer atlas-id tile-row tile-col row col)
+  (let ((grid (aref (layers game) layer))
+        (i (idx row col)))
+    (declare (type (simple-array (signed-byte 32) (*)) grid))
+    (setf (aref grid i)       atlas-id
+          (aref grid (+ i 1)) tile-row
+          (aref grid (+ i 2)) tile-col)))
+
+(defun delete-tile (game layer row col)
+  (let ((grid (aref (layers game) layer))
+        (i (idx row col)))
+    (declare (type (simple-array (signed-byte 32) (*)) grid))
+    (setf (aref grid i) -1 (aref grid (+ i 1)) -1 (aref grid (+ i 2)) -1)))
+
+(defun cell-at-mouse-pos ()
+  (let ((pos (rl:get-mouse-position))
+        (size (* +cell-size+ +scale+)))
+    (values (floor (v:vy pos) size)
+            (floor (v:vx pos) size))))
+
+(defun in-bounds-p (row col)
+  (and (< -1 row +rows+) (< -1 col +cols+)))
+
+;;; ------------------------------------------------------------------- setup
+
+(defun compute-tileset-rects (tiles)
+  "Lay the palette out in a padded grid, in the same order as TILES so a
+   dst-rect and its src-rect share an index."
+  (let ((padding 10)
+        (size (* +cell-size+ +scale+)))
+    (map 'vector
+         (lambda (rc)
+           (destructuring-bind (r c) rc
+             (rl:make-rectangle :x (+ (* padding (1+ c)) (* c size))
+                                :y (+ (* padding (1+ r)) (* r size))
+                                :width size :height size)))
+         tiles)))
+
+(defun load-tileset (path)
+  (let* ((data (e:read-data path))
+         (tiles (e:data-field data :selected-cells path)))
+    (make-tileset
+     :id :level-props
+     :texture (e:load-texture-once (e:data-field data :texture-path path))
+     ;; TODO: needs to become a rect once multi-tile sprites land
+     :tiles tiles
+     :src-rects (map 'vector
+                     (lambda (rc)
+                       (destructuring-bind (r c) rc
+                         (rl:make-rectangle :x (* c +cell-size+) :y (* r +cell-size+)
+                                            :width +cell-size+ :height +cell-size+)))
+                     tiles)
+     :dst-rects (compute-tileset-rects tiles))))
+
+(defun init-game ()
+  (let ((tileset-path "assets/")
+        (game (make-instance 'game)))
+    (setf (layers game)
+          (coerce (loop repeat +num-layers+ collect (e:make-int-grid +grid-len+ -1))
+                  'vector)
+          (tilesets game)
+          (vector (load-tileset "assets/Mushrooms, Flowers, Stones.data"))
+          ;; TODO: raylib fails silently when an image is missing
+          (tilemaps game)
+          (map 'vector
+               (lambda (name) (e:load-texture-once (concatenate 'string tileset-path name)))
+               #("Grass_Hill_Tiles_v2.png"
+                 "Darker_Grass_Tiles_v2.png"
+                 "Soil_Ground_Tiles.png"
+                 "Grass_Tile_Layers.png")))
+    game))
+
+;;; ------------------------------------------------------------------- input
+
+(defun handle-game-input (game)
+  (unless (editor-mode game)
+    (when (rl:is-mouse-button-pressed :mouse-button-left)
+      (setf (drag-mode game) :draw))
+    (when (rl:is-mouse-button-pressed :mouse-button-right)
+      (setf (drag-mode game) :erase))
+    (when (or (rl:is-mouse-button-released :mouse-button-left)
+              (rl:is-mouse-button-released :mouse-button-right))
+      (setf (drag-mode game) nil)))
+
+  (when (rl:is-key-pressed :key-space)
+    ;; Drop any drag along with the toggle: its release arrives while the
+    ;; editor is open, where it is not read, and the drag would otherwise
+    ;; go on painting behind the palette.
+    (setf (editor-mode game) (not (editor-mode game))
+          (drag-mode game) nil))
+
+  ;; Deliberate blow-up, for exercising the frame restarts.
+  (when (rl:is-key-pressed :key-e)
+    (dolist (i (append (loop for n below 10 collect n) (list :asdf)))
+      (+ 1 i)))
+
+  ;; 1-5 pick the layer, shift+1-5 the tilemap.
+  (loop for n from 1 to +num-layers+
+        when (rl:is-key-pressed (aref *num-keys* n))
+          do (if (rl:is-key-down :key-left-shift)
+                 (setf (current-tilemap game) (1- n))
+                 (setf (current-layer game) (1- n)))
+             (return)))
+
+;;; ------------------------------------------------------------------ update
+
+(defun update-drag (game)
+  (let ((mode (drag-mode game)))
+    (when mode
+      (multiple-value-bind (row col) (cell-at-mouse-pos)
+        (when (in-bounds-p row col)
+          (when (and (eq mode :erase) (tile-at-p game (current-layer game) row col))
+            (delete-tile game (current-layer game) row col))
+          ;; TODO: single vs auto tiling mode
+          (when (and (eq mode :draw)
+                     (/= -1 (first (selected-tile game)))
+                     (not (equal (list row col) (last-filled-cell game))))
+            (destructuring-bind (atlas-id tile-row tile-col) (selected-tile game)
+              (set-tile game (current-layer game) atlas-id tile-row tile-col row col))
+            (setf (last-filled-cell game) (list row col))))))))
+
+(defun update-palette-pick (game)
+  "Hover or click a tile in the palette overlay."
+  (when (editor-mode game)
+    (let ((tileset (aref (tilesets game) 0))
+          (mouse (rl:get-mouse-position)))
+      ;; Cleared every frame, or the last tile stays highlighted after the
+      ;; cursor has left the palette.
+      (setf (hovered-tile game) nil)
+      (loop for i from 0
+            for rect across (tileset-dst-rects tileset)
+            when (rl:check-collision-point-rec mouse rect)
+              do (if (rl:is-mouse-button-pressed :mouse-button-left)
+                     (let ((src (aref (tileset-src-rects tileset) i)))
+                       (setf (selected-tile game)
+                             (list 0
+                                   (floor (rl:rectangle-y src) +cell-size+)
+                                   (floor (rl:rectangle-x src) +cell-size+))
+                             (editor-mode game) nil
+                             (hovered-tile game) nil))
+                     (setf (hovered-tile game) rect))
+                 (return)))))
+
+(defun update-game (game)
+  (handle-game-input game)
+  (update-drag game)
+  (update-palette-pick game))
+
+;;; -------------------------------------------------------------------- draw
+
+(defun draw-tile (texture tile-row tile-col x y)
+  "Draw one cell of TEXTURE, snapping the destination to the cell grid."
+  (let* ((size (* +cell-size+ +scale+))
+         (dst-x (* (floor x size) size))
+         (dst-y (* (floor y size) size)))
+    (rl:draw-texture-pro
+     texture
+     (rl:make-rectangle :x (* tile-col +cell-size+) :y (* tile-row +cell-size+)
+                        :width +cell-size+ :height +cell-size+)
+     (rl:make-rectangle :x dst-x :y dst-y :width size :height size)
+     *origin* 0.0 :white)))
+
+(defun draw-layers (game)
+  (let ((tilesets (tilesets game)))
+    (dotimes (layer +num-layers+)
+      (dotimes (row +rows+)
+        (dotimes (col +cols+)
+          (multiple-value-bind (atlas-id tile-row tile-col) (tile-at game layer row col)
+            (when (and (/= atlas-id -1) (< atlas-id (length tilesets)))
+              (draw-tile (tileset-texture (aref tilesets atlas-id))
+                         tile-row tile-col
+                         (* col +cell-size+ +scale+)
+                         (* row +cell-size+ +scale+)))))))))
+
+(defun draw-cursor-tile (game)
+  "The tile riding the mouse cursor while painting."
+  (destructuring-bind (atlas-id tile-row tile-col) (selected-tile game)
+    (when (and (/= atlas-id -1)
+               (not (editor-mode game))
+               (not (eq (drag-mode game) :erase)))
+      (let ((pos (rl:get-mouse-position)))
+        (draw-tile (tileset-texture (aref (tilesets game) atlas-id))
+                   tile-row tile-col (v:vx pos) (v:vy pos))))))
+
+(defun draw-palette (game)
+  (rl:draw-rectangle-lines-ex
+   (rl:make-rectangle :x 0 :y 0 :width +screen-width+ :height +screen-height+)
+   5.0 :green)
+  (rl:draw-rectangle 0 0 +screen-width+ +screen-height+ *color-tint-gray*)
+  (let ((tileset (aref (tilesets game) 0)))
+    (loop for src across (tileset-src-rects tileset)
+          for dst across (tileset-dst-rects tileset)
+          do (rl:draw-texture-pro (tileset-texture tileset) src dst *origin* 0.0 :white)
+             (rl:draw-rectangle-lines (floor (rl:rectangle-x dst))
+                                      (floor (rl:rectangle-y dst))
+                                      (floor (rl:rectangle-width dst))
+                                      (floor (rl:rectangle-height dst))
+                                      :white))
+    (let ((hovered (hovered-tile game)))
+      (when hovered
+        (rl:draw-rectangle-lines (floor (rl:rectangle-x hovered))
+                                 (floor (rl:rectangle-y hovered))
+                                 (floor (rl:rectangle-width hovered))
+                                 (floor (rl:rectangle-height hovered))
+                                 :green))))
+  (rl:draw-text "EDIT MODE" (- +screen-width+ 100) 10 16 :green))
+
+(defun draw-game (game)
+  (rl:clear-background *color-ground*)
+  (draw-layers game)
+  (draw-cursor-tile game)
+  (when (editor-mode game)
+    (draw-palette game)))
+
+(defun unload-game (game)
+  (declare (ignore game)))
+
+;;; -------------------------------------------------------------------- main
+
+(defun main ()
+  ;; Symbols, not #'functions -- run-game funcalls them every frame, so
+  ;; redefining one at the REPL takes effect without restarting the game.
+  (e:run-game :title "Siam Farmer"
+              :width +screen-width+
+              :height +screen-height+
+              :config-path "game-config.data"
+              :init 'init-game
+              :update 'update-game
+              :draw 'draw-game
+              :unload 'unload-game))
+
+#+(or)
+(progn
+  (main)
+  (setf (game::editor-mode engine:*game-state*) t)
+  :-)