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

Add tile swapping with 1-9 keys, first macro

Browse Source
This commit is contained in:
Joseph Ferano 2026-08-27 10:45:35 +07:00
parent a7e8309546
commit 45ef9f3cda
4 changed files with 89 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/engine.clj
View File

@ -32,7 +32,7 @@
(if (rl/window-ready?)
(println "Warning: Existing raylib window open, ignoring!")
(do
(rl/set-trace-log-level! rl/log-warning)
(rl/set-trace-log-level! 0)
(rl/init-window! width height title)
(rl/set-target-fps! 30)
(let [config (if config-path

90
src/game.clj
View File

@ -1,5 +1,7 @@
(ns game
(:gen-class)
(:use
[util])
(:require
[engine]
[watch :as w]
@ -37,12 +39,17 @@
(defn set-tile! [game r c tile] (aset ^objects (:grid game) (idx r c) tile))
(defn init-game [config]
(let [tileset-path "./source-assets/Sprout Lands Premium/Tilesets/ground tiles/New tiles/"]
{:editor-mode false
: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))
:texture (load-texture-once "source-assets/Sprout Lands - Sprites - premium pack/Sprout Lands - Sprites - premium pack/Tilesets/ground tiles/New tiles/Grass_Hill_Tiles_v2.png")})
;; TODO: When we cannot find the image, no errors are being reported. Likely because raylib is failing silently
: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"))
#_#_:bush (load-texture-once "/home/joe/Downloads/Try1.png")}}))
(def edge-set
{0 [3 3],
@ -162,36 +169,53 @@
(do-neighbors! at-row at-col
(fn [r c]
(when (tile-at game 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 handle-game-input [config game]
(let [game (assoc game :event-queue [])]
(when (rl/key-pressed? rl/key-r))
(when (rl/mouse-button-pressed? rl/mouse-button-right)
(let [{mx :x my :y} (rl/get-mouse-position)
at-row (quot my (* scale cell-size))
at-col (quot mx (* scale cell-size))]
(auto-tile! game at-row at-col)
(set-tile! game at-row at-col nil)))
(when (rl/mouse-button-pressed? rl/mouse-button-middle)
(doseq [r (range 10) c (range 20)]
(auto-tile! game r c)))
(cond-> game
(let [game (assoc game :event-queue [])
game (cond-> game
(rl/key-pressed? rl/key-space)
(update :editor-mode not)
(rl/mouse-button-pressed? rl/mouse-button-left)
(assoc :draw-drag true)
(rl/key-pressed? rl/key-r)
(assoc :grid (object-array (* rows cols)))
(rl/mouse-button-released? rl/mouse-button-left)
(dissoc :draw-drag))))
(rl/mouse-button-pressed? rl/mouse-button-left)
(assoc :drag-mode :draw)
(rl/mouse-button-pressed? rl/mouse-button-right)
(assoc :drag-mode :erase)
(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))
(defn update-game [config game]
(when (:draw-drag 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))]
(when-not (tile-at game row col)
col (quot mx (* cell-size scale))
existing (tile-at 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)
@ -200,27 +224,38 @@
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 (:texture game)) src-rect dst-rect (rl/vec2-seg 0 0) (float 0.0) rl/white)))
(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)))
(defn draw-game [config game]
(rl/clear-background!* color-ground)
(doseq [row (range rows)
col (range cols)]
(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)))
(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)))
#_(rl/draw-texture-pro!* (:seg (:bush (:tilemaps game)))
(rl/rect-seg 0 0 54 35)
(rl/rect-seg 600 180 (* 54 2) (* 35 2))
(rl/vec2-seg 0 0) (float 0.0) rl/white)
(when (:editor-mode game)
(rl/draw-rectangle!* 0 0 screen-width screen-height color-tint-gray)
(rl/draw-rectangle!* (/ screen-width 2) (/ screen-height 2) 100 100 rl/white)
(rl/draw-rectangle-lines-ex!* (rl/rect-seg 0 0 screen-width screen-height) 5.0 rl/green)
(doseq [[idx [k {:keys [width height seg]}]] (map-indexed vector (:tilemaps game))
:let [padding 10]]
(rl/draw-texture-pro!* seg
(rl/rect-seg 0 0 width height)
(rl/rect-seg (+ (* idx width ) padding) (+ height padding) )
(rl/vec2-seg 0 0) (float 0.0) rl/white))
(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]
(rl/unload-texture! (:texture game))
(doseq [[_ tex] (:tilemaps game)]
(rl/unload-texture! tex))
(reset! texture-cache {}))
(defn -main [& _args]
@ -240,5 +275,6 @@
(future (-main))
(reset! @#'engine/game-state (init-game {}))
(swap! @#'engine/game-state :assoc {})
(set-tile! @@#'engine/game-state 1 1 [2 2])
:-)

10
src/rl.clj
View File

@ -172,6 +172,9 @@
(def ^:const pixelformat-r8g8b8a8 7)
(def ^:const texture-filter-point 0)
(def ^:const num-keys [key-zero key-one key-two key-three key-four
key-five key-six key-seven key-eight key-nine])
;;; ----------------------------------------------------------------- functions
(defcfn init-window! "InitWindow" [::mem/int ::mem/int ::mem/c-string] ::mem/void)
@ -216,6 +219,13 @@
[x y w h color]
(draw-rectangle-lines-raw!* (int x) (int y) (int w) (int h) color))
(def ^:private draw-rectangle-lines-ex-raw!*
(ffi/make-downcall "DrawRectangleLinesEx"
[::rectangle ::mem/float ::color] ::mem/void))
(defn draw-rectangle-lines-ex!* [rec line-thick color]
(draw-rectangle-lines-ex-raw!* rec (float line-thick) color))
(def update-texture!*
(ffi/make-downcall "UpdateTexture" [::texture ::mem/pointer] ::mem/void))

6
src/util.clj Normal file
View File

@ -0,0 +1,6 @@
(ns util)
(defmacro do-grid [[r rows c cols] & body]
`(dotimes [~r ~rows]
(dotimes [~c ~cols]
~@body)))