245 lines
6.8 KiB
Clojure
245 lines
6.8 KiB
Clojure
(ns game
|
|
(:gen-class)
|
|
(:require
|
|
[engine]
|
|
[watch :as w]
|
|
[rl :as rl]))
|
|
|
|
(def ^:const screen-width 1280)
|
|
(def ^:const screen-height 630)
|
|
;; (def ^:const screen-width 970)
|
|
;; (def ^:const screen-height 530)
|
|
(def ^:const cell-size 16)
|
|
(def ^:const rows (quot screen-height cell-size))
|
|
(def ^:const cols (quot screen-width cell-size))
|
|
(def ^:const grid-len (* rows cols))
|
|
|
|
(def scale 4.0)
|
|
|
|
(set! *warn-on-reflection* true)
|
|
;; (set! *unchecked-math* :warn-on-boxed)
|
|
|
|
;; Colors
|
|
(def color-ground (rl/color-seg 0xE8CFA6))
|
|
(def color-tint-gray (rl/color-seg 0 0 0 100))
|
|
|
|
(defonce texture-cache (atom {}))
|
|
|
|
(defn load-texture-once [path]
|
|
(or (@texture-cache path)
|
|
(let [t (rl/load-texture path)]
|
|
(swap! texture-cache assoc path t)
|
|
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 init-game [config]
|
|
{: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")})
|
|
|
|
(def edge-set
|
|
{0 [3 3],
|
|
70 [0 0],
|
|
7 [4 4],
|
|
59 [2 1],
|
|
175 [4 5],
|
|
27 [3 6],
|
|
1 [2 3],
|
|
206 [0 1],
|
|
239 [2 5],
|
|
4 [0 3],
|
|
95 [4 6],
|
|
141 [2 7],
|
|
15 [4 8],
|
|
159 [1 9],
|
|
31 [3 9],
|
|
223 [2 6],
|
|
13 [4 7],
|
|
191 [1 5],
|
|
143 [2 10],
|
|
41 [2 2],
|
|
43 [3 5],
|
|
6 [0 4],
|
|
111 [0 9],
|
|
3 [3 4],
|
|
12 [0 7],
|
|
2 [3 0],
|
|
142 [0 5],
|
|
23 [1 4],
|
|
47 [3 10],
|
|
127 [1 6],
|
|
19 [2 0],
|
|
11 [3 8],
|
|
255 {[1 1] 10.0
|
|
[5 0] 0.5
|
|
[5 1] 0.5
|
|
[5 2] 0.5
|
|
[5 3] 0.05
|
|
[5 4] 0.05
|
|
[5 5] 0.1
|
|
[6 0] 0.2
|
|
[6 1] 0.2
|
|
[6 2] 0.2
|
|
[6 3] 0.05
|
|
[6 4] 0.05
|
|
[6 5] 0.1},
|
|
9 [3 7],
|
|
5 [1 3],
|
|
14 [0 8],
|
|
45 [1 7],
|
|
78 [0 6],
|
|
140 [0 2],
|
|
79 [2 9],
|
|
173 [1 2],
|
|
87 [1 0],
|
|
207 [2 8],
|
|
10 [3 1],
|
|
71 [2 4],
|
|
63 [1 8],
|
|
8 [3 2]})
|
|
|
|
(def directions
|
|
[[:N [-1 0]]
|
|
[:E [0 1]]
|
|
[:S [1 0]]
|
|
[:W [0 -1]]
|
|
[:NE [-1 1]]
|
|
[:NW [-1 -1]]
|
|
[:SE [1 1]]
|
|
[:SW [1 -1]]])
|
|
|
|
(defn normalize-mask [m]
|
|
(cond-> m
|
|
(not (and (bit-test m 0) (bit-test m 1))) (bit-clear 4)
|
|
(not (and (bit-test m 0) (bit-test m 3))) (bit-clear 5)
|
|
(not (and (bit-test m 2) (bit-test m 1))) (bit-clear 6)
|
|
(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]
|
|
(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))
|
|
(bit-set acc i)
|
|
acc)))
|
|
0
|
|
directions)))
|
|
|
|
(defn do-neighbors! [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))))
|
|
|
|
;; rows ;; => 80
|
|
;; cols ;; => 39
|
|
;; grid-len ;; => 3120
|
|
|
|
(defn set-random-tile! [game row col]
|
|
(let [tile (edge-set (surrounding-tiles game row col))]
|
|
(if (vector? tile)
|
|
(set-tile! game row col tile)
|
|
;; It's a map, should have the ratios
|
|
(set-tile! game row col
|
|
(reduce (fn [acc [tile weight]]
|
|
(if (< acc weight) (reduced 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)
|
|
(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
|
|
(rl/key-pressed? rl/key-space)
|
|
(update :editor-mode not)
|
|
|
|
(rl/mouse-button-pressed? rl/mouse-button-left)
|
|
(assoc :draw-drag true)
|
|
|
|
(rl/mouse-button-released? rl/mouse-button-left)
|
|
(dissoc :draw-drag))))
|
|
|
|
(defn update-game [config game]
|
|
(when (:draw-drag 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)
|
|
(auto-tile! game row col))))
|
|
game)
|
|
|
|
(defn draw-tile! [game 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 (:texture game)) 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)]
|
|
(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)))
|
|
(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-text!* "EDIT MODE" (- screen-width 100) 10 16 rl/green)))
|
|
|
|
(defn watch-game [config game]
|
|
{})
|
|
|
|
(defn unload-game [game]
|
|
(rl/unload-texture! (:texture game))
|
|
(reset! texture-cache {}))
|
|
|
|
(defn -main [& _args]
|
|
(engine/run-game!
|
|
{:title "Siam Farmer"
|
|
:width screen-width
|
|
:height screen-height
|
|
:config-path "game-config.edn"
|
|
:init #'init-game
|
|
:input #'handle-game-input
|
|
:update #'update-game
|
|
:draw #'draw-game
|
|
:watch-fn #'watch-game
|
|
:unload #'unload-game}))
|
|
|
|
(comment
|
|
(future (-main))
|
|
(reset! @#'engine/game-state (init-game {}))
|
|
(swap! @#'engine/game-state :assoc {})
|
|
(set-tile! @@#'engine/game-state 1 1 [2 2])
|
|
:-)
|