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

Update sprite atlas, add dragging and zooming to cursor pos

Browse Source
This commit is contained in:
Joseph Ferano 2026-08-29 06:05:42 +07:00
parent e65685aec8
commit 04318f0b85
1 changed files with 77 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
src/sprite_atlas.clj
View File

@ -1,48 +1,56 @@
(ns sprite-atlas (ns sprite-atlas
(:use
[util])
(:require (:require
[clojure.java.io :as io] [clojure.java.io :as io]
[engine] [engine :as e]
[rl :as rl])) [rl :as rl]
[watch :as w]))
(def screen-width 1250) (def ^:const screen-width 1280)
(def screen-height 780) (def ^:const screen-height 630)
(defonce state (atom {})) (defn sprite-atlas-path []
(let [asset-path "./source-assets/Sprout Lands Premium/"
;; (defn tile-source [game] level-deco "Objects/Mushrooms, Flowers, Stones.png"]
;; {:x (str asset-path level-deco)))
;; :y
;; :width
;; :height
;; :name })
(defn init-sprite-atlas [config] (defn init-sprite-atlas [config]
(let [path (:sprite-path @state)] {:zoom 1
(-> (if (.exists (io/file path)) :atlas (e/load-texture-once :main-atlas (sprite-atlas-path))
{:atlas (rl/load-texture path)} :atlas-pos [0 0]
{}) :drag-delta [0 0]})
(assoc :zoom 1))))
(defn- auto-tile [game cell-size cell-count] (defn- auto-tile [game cell-size cell-count]
(assoc game :auto-tile-info {:cell-size 16 :cell-count 11})) (assoc game :auto-tile-info {:cell-size 16 :cell-count 11}))
(defn handle-sprite-atlas-input [_ game] (defn handle-input [_ game]
(let [game (cond-> game (update-as-> [g game]
(rl/mouse-button-pressed? rl/mouse-button-left) (when (rl/key-pressed? rl/key-r)
(assoc :drag-start (rl/get-mouse-position)) (assoc g :atlas-pos [0 0]))
(rl/mouse-button-released? rl/mouse-button-left) (when (rl/mouse-button-pressed? rl/mouse-button-left)
(assoc :event-drag-ended true) (assoc g :drag-start-pos (rl/get-mouse-position) :drag-mode :zooming))
(when (rl/mouse-button-released? rl/mouse-button-left)
:always (-> g
(as-> g (cond-> g (assoc :selected-sprite (get-selection-rect (:drag-start-pos g) (:current-mouse-pos g)))
(contains? g :drag-start) (dissoc :drag-start-pos :current-mouse-pos :drag-mode)))
(assoc :current-mouse-pos (rl/get-mouse-position))))) (when (rl/mouse-button-pressed? rl/mouse-button-right)
move (rl/get-mouse-wheel-move) (assoc g :drag-start-pos (rl/get-mouse-position) :drag-mode :dragging :drag-delta [0 0]))
game (cond-> game (when (rl/mouse-button-released? rl/mouse-button-right)
(not (zero? move)) (-> g
(update :zoom #(+ % move)))] (assoc :atlas-pos (let [[dx dy] (:drag-delta g)
game)) [ax ay] (:atlas-pos g)]
[(+ ax dx) (+ ay dy)]))
(dissoc :drag-start-pos :current-mouse-pos :drag-mode :drag-delta)))
(let [move (rl/get-mouse-wheel-move)]
(when (not (zero? move))
(let [new-scale (max 1.0 ((if (pos? move) * /) (:zoom g) 1.2))
[ax ay] (:atlas-pos g)
{mx :x my :y} (rl/get-mouse-position)
k (/ new-scale (:zoom g))]
(assoc g :zoom new-scale :atlas-pos [(- mx (* k (- mx ax)))
(- my (* k (- my ay)))]))))))
(defn- get-selection-rect [{ax :x ay :y} {bx :x by :y}] (defn- get-selection-rect [{ax :x ay :y} {bx :x by :y}]
(let [start-x (min ax bx) (let [start-x (min ax bx)
@ -52,16 +60,26 @@
{:x start-x :y start-y :w (- end-x start-x) :h (- end-y start-y)})) {:x start-x :y start-y :w (- end-x start-x) :h (- end-y start-y)}))
(defn update-sprite-atlas [_ game] (defn update-sprite-atlas [_ game]
(cond-> game (update-as-> [g game]
(contains? game :event-drag-ended) (handle-input {} g)
(-> (assoc :selected-sprite (get-selection-rect (:drag-start game) (:current-mouse-pos game))) (when (contains? g :drag-start-pos)
(dissoc :event-drag-ended :drag-start :current-mouse-pos)))) (case (:drag-mode g)
:zooming (assoc g :current-mouse-pos (rl/get-mouse-position))
:dragging (assoc g :drag-delta (let [{mx :x my :y} (rl/get-mouse-position)
{:keys [x y]} (:drag-start-pos g)]
[(- mx x) (- my y)]))))))
(swap! e/game-state assoc :atlas-pos [0 0])
(defn draw-sprite-atlas [_ {:keys [atlas zoom drag-start current-mouse-pos selected-sprite auto-tile-info]}] (defn draw-sprite-atlas [_ {:keys [atlas atlas-pos drag-delta zoom drag-start current-mouse-pos selected-sprite auto-tile-info]}]
(rl/clear-background!* rl/black) (rl/clear-background!* rl/black)
(let [current-scale (* (/ screen-height (:height atlas)) (max 0.1 (* zoom 0.1)))] (let [current-scale (* (/ screen-height (:height atlas)) (max 0.1 (* zoom 0.1)))
[ax ay] atlas-pos
[dx dy] (or drag-delta [0 0])
ax (+ ax dx)
ay (+ ay dy)]
(when atlas (when atlas
(rl/draw-texture-ex!* (:seg atlas) (rl/vec2-seg 0 0) 0.0 current-scale rl/white) (let []
(rl/draw-texture-ex!* (:seg atlas) (rl/vec2-seg ax ay) 0.0 current-scale rl/white))
(when drag-start (when drag-start
(let [start-x (:x drag-start) (let [start-x (:x drag-start)
start-y (:y drag-start) start-y (:y drag-start)
@ -76,31 +94,42 @@
cols 12] cols 12]
(doseq [row (range rows) (doseq [row (range rows)
col (range cols)] col (range cols)]
(rl/draw-rectangle-lines!* (* col cell-size current-scale) (rl/draw-rectangle-lines!* (+ ax (* col cell-size current-scale))
(* row cell-size current-scale) (+ ay (* row cell-size current-scale))
(* cell-size current-scale) (* cell-size current-scale)
(* cell-size current-scale) (* cell-size current-scale)
rl/gray)))))) rl/gray)))))
(let [font-size 28
width (quot screen-width 2)
height 30
x width
y (- screen-height height)
{mx :x my :y} (rl/get-mouse-position)]
(rl/draw-rectangle!* x y width height rl/white)
(rl/draw-text!* (format " X: %d" (int mx)) x y font-size rl/black)
(rl/draw-text!* (format "Y: %d" (int my)) (+ x 150) y font-size rl/black)))
(defn watch-sprite-atlas [config game] (defn watch-sprite-atlas [config game]
{:zoom (:zoom game)}) {:zoom (:zoom game)
:atlas-pos (:atlas-pos game)
:drag-delta (:drag-delta game)})
(defn unload-sprite-atlas [game] (defn unload-sprite-atlas [game]
(rl/unload-texture! (:atlas game))) (rl/unload-texture! (:atlas game)))
(defn -main [& sprite-path] (defn -main [& _args]
(swap! state assoc :sprite-path (first sprite-path))
(engine/run-game! (engine/run-game!
{:title "Sprite Atlas" {:title "Sprite Atlas"
:width screen-width :width screen-width
:height screen-height :height screen-height
:init #'init-sprite-atlas :init #'init-sprite-atlas
:input #'handle-sprite-atlas-input
:update #'update-sprite-atlas :update #'update-sprite-atlas
:draw #'draw-sprite-atlas :draw #'draw-sprite-atlas
:unload #'unload-sprite-atlas :unload #'unload-sprite-atlas
:watch-fn #'watch-sprite-atlas})) :watch-fn #'watch-sprite-atlas}))
(comment (comment
(future (-main "source-assets/Sprout Lands - Sprites - premium pack/Sprout Lands - Sprites - premium pack/Tilesets/ground tiles/New tiles/Grass_tiles_v2.png")) (future (-main))
(reset! e/game-state (init-sprite-atlas {}))
(rl/set-clipboard-text!* "foo bar")
:-) :-)