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

Store the tilemap along with the tile, introduce layers, update-as-> macro

Browse Source
This commit is contained in:
Joseph Ferano 2026-08-28 11:47:47 +07:00
parent 45ef9f3cda
commit a9424226ba
3 changed files with 107 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
src/game.clj
View File

@ -17,6 +17,7 @@
(def ^:const grid-len (* rows cols))
(def scale 4.0)
(def num-layers 5)
(set! *warn-on-reflection* true)
;; (set! *unchecked-math* :warn-on-boxed)
@ -34,9 +35,14 @@
t)))
(defn idx [row col] (+ (* row cols) col))
(defn tile-at [game r c] (aget ^objects (:grid game) (idx r c)))
(defn tile-at-idx [game idx] (aget ^objects (:grid game) idx))
(defn set-tile! [game r c tile] (aset ^objects (:grid game) (idx r c) tile))
(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 set-tile! [game layer r c tile] (aset ^objects (get (:layers game) layer) (idx r c) tile))
(defn cell-at-mouse-pos [game]
(let [{mx :x my :y} (rl/get-mouse-position)
row (quot my (* cell-size scale))
col (quot mx (* cell-size scale))]
[row col]))
(defn init-game [config]
(let [tileset-path "./source-assets/Sprout Lands Premium/Tilesets/ground tiles/New tiles/"]
@ -44,11 +50,17 @@
:color-idx 0
;; :event-queue []
;; TODO: Once we have a proper ID system for the cells, use int-array for performance
:grid (object-array (* rows cols))
:layers (vec (repeatedly num-layers #(object-array (* rows cols))))
:current-layer 0
:current-tilemap 0
;; TODO: When we cannot find the image, no errors are being reported. Likely because raylib is failing silently
;; TODO: How do we get Raylib to reload images on the fly
:tilemaps
{:grass-hill (load-texture-once (str tileset-path "Grass_Hill_Tiles_v2.png"))
:grass-stone (load-texture-once (str tileset-path "Darker_Grass_Tiles_v2.png"))
;; :soil (load-texture-once (str tileset-path "Soil_Ground_HiIls_Tiles.png"))
:soil (load-texture-once (str tileset-path "Soil_Ground_Tiles.png"))
:grass-top (load-texture-once (str tileset-path "Grass_Tile_Layers.png"))
#_#_:bush (load-texture-once "/home/joe/Downloads/Try1.png")}}))
(def edge-set
@ -130,62 +142,60 @@
(not (and (bit-test m 2) (bit-test m 3))) (bit-clear 7)))
;; TODO: Is this working? Diagonals don't seem to be working
(defn surrounding-tiles [game at-row at-col]
(defn tile-bitset [game layer at-row at-col]
(normalize-mask
(reduce-kv (fn [acc i [_ [dy dx]]]
(let [r (+ at-row dy)
c (+ at-col dx)]
(if (and (>= r 0) (>= c 0)
(tile-at game r c))
(tile-at game layer r c))
(bit-set acc i)
acc)))
0
directions)))
(defn do-neighbors! [row col do-fn]
(defn do-neighbors! [layer row col do-fn]
(doseq [[_ [dy dx]] directions
:let [r (+ row dy)
c (+ col dx)]]
(when (and (< -1 r rows) (< -1 c cols))
(do-fn r c))))
(do-fn layer r c))))
;; rows ;; => 80
;; cols ;; => 39
;; grid-len ;; => 3120
(defn set-random-tile! [game row col]
(let [tile (edge-set (surrounding-tiles game row col))]
(defn set-random-tile! [game layer row col]
(let [tile (edge-set (tile-bitset game layer row col))
tilemap (second (get (vec (:tilemaps game)) (:current-tilemap game)))]
(if (vector? tile)
(set-tile! game row col tile)
;; It's a map, should have the ratios
(set-tile! game row col
(set-tile! game layer row col [tilemap tile])
(set-tile! game layer row col
(reduce (fn [acc [tile weight]]
(if (< acc weight) (reduced tile) (- acc weight)))
(if (< acc weight) (reduced [tilemap tile]) (- acc weight)))
(rand (reduce + (vals tile)))
tile)))))
(defn auto-tile! [game at-row at-col]
(set-random-tile! game at-row at-col)
(do-neighbors! at-row at-col
(fn [r c]
(when (tile-at game r c)
(defn auto-tile! [game layer at-row at-col]
(set-random-tile! game layer at-row at-col)
(do-neighbors! layer at-row at-col
(fn [l r c]
(when (tile-at game l r c)
(defn delete-tile! [game at-row at-col]
(set-tile! game at-row at-col nil)
(do-neighbors! at-row at-col
(fn [r c]
(when (tile-at game r c)
(set-random-tile! game r c)))))
(set-random-tile! game r c)))))
(defn delete-tile! [game layer at-row at-col]
(set-tile! game layer at-row at-col nil)
(do-neighbors! layer at-row at-col
(fn [l r c]
(when (tile-at game l r c)
(set-random-tile! game l r c)))))
(set-random-tile! game l r c)))))
(defn handle-game-input [config game]
(let [game (assoc game :event-queue [])
game (cond-> game
(update-as-> [game game]
(assoc g :event-queue [])
(cond-> g
(rl/key-pressed? rl/key-space)
(update :editor-mode not)
(rl/key-pressed? rl/key-r)
(assoc :grid (object-array (* rows cols)))
;; (rl/key-pressed? rl/key-r)
;; (assoc :layers (object-array (* rows cols)))
(rl/mouse-button-pressed? rl/mouse-button-left)
(assoc :drag-mode :draw)
@ -196,46 +206,56 @@
(or (rl/mouse-button-released? rl/mouse-button-left)
(rl/mouse-button-released? rl/mouse-button-right))
(dissoc :drag-mode))
game (reduce (fn [g i]
(if (rl/key-pressed? (get rl/num-keys i))
(reduced (assoc game :active-texture-idx i))
game))
game
(range 1 (inc (count (:tilemaps game)))))]
(when (rl/mouse-button-pressed? rl/mouse-button-middle)
(do-grid [r 10 c 20]
(auto-tile! game r c)))
game))
(auto-tile! g r c)))
(reduce (fn [g i]
(cond
(and (rl/key-pressed? (get rl/num-keys i))
(rl/key-down? rl/key-left-shift))
(reduced (assoc g :current-tilemap (dec i)))
(rl/key-pressed? (get rl/num-keys i))
(reduced (assoc g :current-layer (dec i)))
:else
g))
g
(range 1 (inc num-layers)))))
(defn update-game [config game]
(update-as-> [g game]
(when-let [mode (:drag-mode game)]
(let [{mx :x my :y} (rl/get-mouse-position)
row (quot my (* cell-size scale))
col (quot mx (* cell-size scale))
existing (tile-at game row col)]
existing (tile-at game (:current-layer game) row col)]
(when (and existing (= mode :erase))
(delete-tile! game row col))
(when (and (not existing) (= mode :draw))
(auto-tile! game row col))))
game)
(delete-tile! game (:current-layer game) row col))
(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 row-idx col-idx x y scale]
(defn draw-tile! [game tilemap row-idx col-idx x y scale]
(let [src-rect (rl/rect-seg (* col-idx cell-size) (* row-idx 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))]
(rl/draw-texture-pro!* (:seg (get (vec (vals (:tilemaps game)))
(dec (or (:active-texture-idx game) 1))))
src-rect dst-rect (rl/vec2-seg 0 0) (float 0.0) rl/white)))
(rl/draw-texture-pro!* (:seg tilemap) src-rect dst-rect (rl/vec2-seg 0 0) (float 0.0) rl/white)))
(defn draw-game [config game]
(rl/clear-background!* color-ground)
(dotimes [layer num-layers]
(do-grid [row rows col cols]
(when-let [[tx ty] (tile-at game row col)]
(draw-tile! game tx ty (* col cell-size scale) (* row cell-size scale) scale)))
;; TODO: tile-at needs to return layer + row + col, so that's the data structure we need to save
(when-let [[tilemap [tx ty]] (tile-at game layer row col)]
(draw-tile! game tilemap tx ty (* col cell-size scale) (* row cell-size scale) scale))))
(when (not (contains? game :draw-drag))
(let [{mx :x my :y :as mouse-pos} (rl/get-mouse-position)]
(draw-tile! game 3 3 mx my scale)))
(draw-tile! game (get (:tilemaps game) :grass-hill) 3 3 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))
@ -251,7 +271,7 @@
(rl/draw-text!* "EDIT MODE" (- screen-width 100) 10 16 rl/green)))
(defn watch-game [config game]
{:active-texture-idx (:active-texture-idx game)})
{})
(defn unload-game [game]
(doseq [[_ tex] (:tilemaps game)]
@ -276,5 +296,5 @@
(reset! @#'engine/game-state (init-game {}))
(swap! @#'engine/game-state :assoc {})
(set-tile! @@#'engine/game-state 1 1 [2 2])
#_(set-tile! @@#'engine/game-state 1 1 [2 2])
:-)

2
src/rl.clj
View File

@ -191,6 +191,8 @@
(defcfn get-fps "GetFPS" [] ::mem/int)
(defcfn key-pressed? "IsKeyPressed" [::mem/int] ::bool)
(defcfn key-down? "IsKeyDown" [::mem/int] ::bool)
(defcfn key-released? "IsKeyPressed" [::mem/int] ::bool)
(defcfn mouse-button-down? "IsMouseButtonDown" [::mem/int] ::bool)
(defcfn mouse-button-pressed? "IsMouseButtonPressed" [::mem/int] ::bool)
(defcfn mouse-button-released? "IsMouseButtonReleased" [::mem/int] ::bool)

8
src/util.clj
View File

@ -4,3 +4,11 @@
`(dotimes [~r ~rows]
(dotimes [~c ~cols]
~@body)))
(defmacro update-as->
{:style/indent 1}
[[sym init] & body]
(let [g (gensym "game")]
`(let [~g ~init
~@(mapcat (fn [form] [g `(let [~sym ~g] (or ~form ~g))]) body)]
~g)))