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

clj: fix palette selection and delete tile and better init-game

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-07 08:28:05 +07:00
parent 3e8ba200cd
commit 017fbebad4
2 changed files with 96 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
src/game.clj
View File

@ -46,12 +46,47 @@
(aset (+ i 1) (int tr))
(aset (+ i 2) (int tc)))))
(defn delete-tile! [game layer cr cc]
(let [i (idx cr cc)]
(doto ^ints (e/cells (get (:layers game) layer))
(aset i -1)
(aset (+ i 1) -1)
(aset (+ i 2) -1)))
#_(do-neighbors! layer at-row at-col
(fn [l r c]
(when-let [tile (tile-at game l r c)]
(when (contains? (:tags tile) :randomized)
(set-random-tile! game l r c))))))
(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 compute-tileset-rects [tiles]
(mapv (fn [[r c]]
(let [padding 10
curr-size (* cell-size scale)
pos-x (+ (* padding (inc c)) (* c curr-size))
pos-y (+ (* padding (inc r)) (* r curr-size))]
{:x pos-x :y pos-y :width curr-size :height curr-size}))
tiles))
(defn load-tileset [path]
(let [tileset (edn/read-string (slurp path))
;; TODO: We should include the WxH in the end file
texture (e/load-texture-once :level-props (:texture-path tileset))
tiles (:selected-cells tileset)]
{:id :level-props
:texture texture
;; TODO: This is going to change soon because it needs to be a rect for multi-tile sprites
:tiles tiles
:src-rects (mapv (fn [[r c]] {:x (* c cell-size) :y (* r cell-size) :width cell-size :height cell-size})
tiles)
;; TODO: Maybe we have a separate place for this?
:dst-rects (compute-tileset-rects tiles)}))
(defn init-game [config]
(let [tileset-path "./source-assets/Sprout Lands Premium/Tilesets/ground tiles/New tiles/"]
{:editor-mode false
@ -60,11 +95,10 @@
:current-layer 0
:current-tilemap 0
:selected-tile [-1 -1 -1]
:atlases
:hovered-tile nil
:tilesets
;; (edn/read-string (slurp "./assets/Mushrooms, Flowers, Stones.edn"))
(let [path "./assets/Mushrooms, Flowers, Stones.edn"
atlas (edn/read-string (slurp path))]
[[:level-props (e/load-texture-once :level-props (:texture-path atlas)) (:selected-cells atlas)]])
[(load-tileset "./assets/Mushrooms, Flowers, Stones.edn")]
;; 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
@ -192,16 +226,6 @@
(when (tile-at game l r c)
(set-random-tile! game l 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-let [tile (tile-at game l r c)]
(when (contains? (:tags tile) :randomized)
(set-random-tile! game l r c))))))
;; (when (contains? (:tags tile) :randomized)
(defn handle-game-input [config game]
(update-as-> [g game]
(assoc g :event-queue [])
@ -224,6 +248,10 @@
(when (rl/key-pressed? rl/key-space)
(update g :editor-mode not))
(when (rl/key-pressed? rl/key-e)
(doseq [i (conj (range 10) :asdf)]
(+ 1 i))
g)
#_(when (and (:editor-mode game)
(rl/mouse-button-pressed? rl/mouse-button-left))
(let [{mx :x my :y} (rl/get-mouse-position)]
@ -267,7 +295,23 @@
#_(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]))))))
(assoc game :last-filled-cell [row col]))))
;; Find a hovered or selected tile
(when (:editor-mode game)
(let [tileset (first (:tilesets game))
mouse-pos (rl/get-mouse-position)
{:keys [width height seg]} (:texture tileset)]
(reduce-kv (fn [g idx rect]
(if (not (rl/collision-point-rec? mouse-pos rect))
g
(if (rl/mouse-button-pressed? rl/mouse-button-left)
(let [src-rect (get (:src-rects tileset) idx)]
(reduced (-> g
(assoc :selected-tile [0 (quot (:y src-rect) cell-size) (quot (:x src-rect) cell-size)])
(dissoc :editor-mode :hovered-tile))))
(assoc g :hovered-tile rect))))
g
(:dst-rects (first (:tilesets game))))))))
(defn draw-tile! [game tilemap row col x y scale]
(let [src-rect (rl/rect-seg (* col cell-size) (* row cell-size) cell-size cell-size)
@ -282,15 +326,15 @@
(do-grid [cr rows cc cols]
(let [[aid tr tc] (tile-at game layer cr cc)]
(when (and (not= aid -1)
(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)
(get (:tilesets game) aid))
(draw-tile! game (:texture (get (:tilesets 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)
[aid tr tc] (:selected-tile game)]
;; TODO: Maybe better if we create a get-tilemap-by-name
(draw-tile! game (second (get (:atlases game) aid)) tr tc mx my scale)))
(draw-tile! game (:texture (get (:tilesets 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))
@ -298,29 +342,16 @@
(when (:editor-mode game)
(rl/draw-rectangle-lines-ex!* (rl/rect-seg 0 0 screen-width screen-height) 5.0 rl/green)
(rl/draw-rectangle!* 0 0 screen-width screen-height color-tint-gray)
(let [[_ texture cells] (first (:atlases game))
{:keys [width height seg]} texture]
(doseq [[r c] cells]
(let [padding 10
curr-size (* cell-size scale)
pos-x (+ (* padding (inc c)) (* c curr-size))
pos-y (+ (* padding (inc r)) (* r curr-size))
dst-rec (rl/rect-seg pos-x pos-y curr-size curr-size)
mouse-pos (rl/get-mouse-position)
{mx :x my :y} mouse-pos]
(rl/draw-texture-pro!* seg
(rl/rect-seg (* c cell-size) (* r cell-size) cell-size cell-size)
dst-rec
(rl/vec2-seg 0 0) (float 0.0)
(let [{:keys [src-rects dst-rects texture]} (first (:tilesets game))]
(dotimes [i (count src-rects)]
(rl/draw-texture-pro! texture
(get src-rects i)
(get dst-rects i)
{:x 0 :y 0} (float 0.0)
rl/white)
(rl/draw-rectangle-lines!* pos-x pos-y curr-size curr-size rl/white)
(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)
;; 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))))))
(rl/draw-rectangle-lines! (get dst-rects i) rl/white))
(when-let [tile (:hovered-tile game)]
(rl/draw-rectangle-lines! tile rl/green)))
#_(doseq [[idx [k {:keys [width height seg]}]] (into [] (map-indexed vector) (:tilemaps game))
:let [padding 10]]
(rl/draw-texture-pro!* seg
@ -331,8 +362,7 @@
(defn watch-game [config game]
{:mouse-pos (rl/get-mouse-position)
:current-layer (:current-layer game)
:current-tilemap (:current-tilemap game)})
:state (dissoc game :tilemaps :tilesets :layers)})
(defn unload-game [game])
@ -353,8 +383,9 @@
;; 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 :selected-tile [0 0 6])
e/game-state
(dissoc @e/game-state :tilemaps :tilesets)
(:tilemaps @e/game-state)
(reset! e/use-debugger? true)
:-)

18
src/rl.clj
View File

@ -221,6 +221,10 @@
[x y w h color]
(draw-rectangle-lines-raw!* (int x) (int y) (int w) (int h) color))
(defn draw-rectangle-lines!
[{:keys [x y width height]} color]
(draw-rectangle-lines-raw!* (int x) (int y) (int width) (int height) color))
(def ^:private draw-rectangle-lines-ex-raw!*
(ffi/make-downcall "DrawRectangleLinesEx"
[::rectangle ::mem/float ::color] ::mem/void))
@ -359,6 +363,20 @@
(defn vec2-seg [x y]
(mem/serialize {:x (float x) :y (float y)} ::vector-2 arena))
(defn- rect-floats [{:keys [x y width height]}]
{:x (float x) :y (float y) :width (float width) :height (float height)})
(def draw-texture-pro!
(let [src (mem/alloc-instance ::rectangle arena)
dst (mem/alloc-instance ::rectangle arena)
org (mem/alloc-instance ::vector-2 arena)]
(fn [texture src-rect dst-rect origin rotation color]
(mem/serialize-into (rect-floats src-rect) ::rectangle src arena)
(mem/serialize-into (rect-floats dst-rect) ::rectangle dst arena)
(mem/serialize-into {:x (float (:x origin)) :y (float (:y origin))}
::vector-2 org arena)
(draw-texture-pro!* (:seg texture) src dst org (float rotation) color))))
(defn image-seg [img]
(mem/serialize img ::image arena))