notid/gitea-docker
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

pathfinding is reasonably fast.

Browse Source
This commit is contained in:
=
2014-09-12 15:56:32 -07:00
parent dfc534a8a9
commit b13aa6a26e
2 changed files with 50 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

85
desktop/src-common/advent/pathfind.clj
View File

@@ -12,73 +12,86 @@
PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture
VertexAttributes$Usage])) VertexAttributes$Usage]))
(def compare-count (atom 0))
(def scale 2)
(def cost-comparator (comparator (fn [{^long a :cost} {^long b :cost}] (< a b))))
(defn from-scale [[x y]]
[(int (* scale x)) (int (* scale y))])
(defn to-scale [[x y]]
[(int (/ x scale)) (int (/ y scale ))])
(defn printmap [my-map & [skip]] (defn printmap [my-map & [skip]]
(let [skip (or skip 1)] (let [skip (or skip 1)]
(doseq [row (take-nth skip my-map)] (doseq [row (take-nth skip my-map)]
(println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row)))))) (println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row))))))
(defn random-map [] (-> (vec (take 640 (repeatedly (fn [] (vec (take 480 (repeatedly (fn [] (rand-nth [1 1 1 5 5 0]))))))))) (defn random-map [] (-> (vec (take 640 (repeatedly (fn [] (vec (take 480 (repeatedly (fn [] (rand-nth [1 1 1 1 1 0])))))))))
(update-in [1 1] (constantly 1)) (update-in [1 1] (constantly 1))
(update-in [639 479] (constantly 1)))) (update-in [639 479] (constantly 1))))
(defn neighbors [[^long x ^long y] my-map] (defn neighbors [[^long x ^long y] my-map]
(let [candidates [[^long (dec x) ^long (dec y)] [x ^long (dec y)] [^long (inc x) ^long (dec y)] (let [x (long x)
[^long (dec x) y] [^long (inc x) y] y (long y)
[^long (dec x) ^long (inc y)] [x ^long (inc y)] [^long (inc x) ^long (inc y)]] left-x (unchecked-subtract x 1)
right-x (unchecked-add x 1)
top-y (unchecked-subtract y 1)
below-y (unchecked-add y 1)
candidates [[left-x top-y] [x top-y] [right-x top-y]
[left-x y] [right-x y]
[left-x below-y] [x below-y] [right-x below-y]]
height (count (first my-map)) height (count (first my-map))
width (count my-map)] width (count my-map)]
(remove #(= 0 (get-in my-map %)) (remove #(= 0 (get-in my-map %))
(filter (fn [[x y]] (and (< -1 x width) (filter (fn [[^long x ^long y]] (and (< -1 x width)
(< -1 y height))) candidates)))) (< -1 y height))) candidates))))
(defn resolve-path [came-from play-loc target-loc] (defn resolve-path [came-from play-loc target-loc]
(let [came-from (into {} came-from)] (let [came-from (into {} came-from)]
(if (nil? (came-from target-loc)) (if (nil? (came-from target-loc))
nil nil
(loop [path [] (loop [path []
current-node (vec target-loc)] current-node (vec target-loc)]
(if (or (= current-node play-loc) (if (or (= current-node play-loc)
(nil? current-node)) (nil? current-node))
(reverse (conj path current-node)) (reverse (conj path (from-scale current-node)))
(recur (recur
(conj path current-node) (conj path (from-scale current-node))
(came-from (vec current-node)))))))) (came-from (vec current-node))))))))
(def d2 ^double (- (Math/sqrt 2) 1)) (def d2 ^double (- (Math/sqrt 2) 2))
(defn heuristic [^long goal-x ^long goal-y ^long current-x ^long current-y] (defn heuristic ^long [^long goal-x ^long goal-y ^long current-x ^long current-y]
(let [dist-x ^long (if (< goal-x current-x) (let [dist-x (if (< goal-x current-x)
^long (- current-x goal-x) (unchecked-subtract current-x goal-x)
^long (- goal-x current-x )) (unchecked-subtract goal-x current-x ))
dist-y ^long (if (< goal-y current-y) dist-y (if (< goal-y current-y)
^long (- current-y goal-y) (unchecked-subtract current-y goal-y)
^long (- goal-y current-y))] (unchecked-subtract goal-y current-y))
^long (+ dist-x dist-y (* ^double d2 min-dist ^double (double (min dist-x dist-y))]
^long (min dist-x dist-y))))) (unchecked-add (unchecked-add dist-x dist-y )
(long (unchecked-multiply ^double d2 min-dist)))))
(def my-count (atom 0))
(def cost-comparator (comparator (fn [{^long a :cost} {^long b :cost}] (do (swap! my-count inc) (< a b)))))
(defn visit-all [my-map play-loc target-loc] (defn visit-all [my-map play-loc target-loc]
(reset! my-count 0) (let [play-loc (vec (to-scale play-loc))
(let [play-loc (vec play-loc) target-loc (vec (to-scale target-loc))]
target-log (vec target-loc)]
(if (= 0 (get-in my-map target-loc)) (if (= 0 (get-in my-map target-loc))
nil nil
(let [cost-so-far ^java.util.HashMap (java.util.HashMap. {play-loc 0}) (let [cost-so-far ^java.util.HashMap (java.util.HashMap. {play-loc 0})
came-from ^java.util.HashMap (java.util.HashMap.) came-from ^java.util.HashMap (java.util.HashMap.)
fronteir ^java.util.PriorityQueue (java.util.PriorityQueue. 100 cost-comparator)] fronteir ^java.util.PriorityQueue (java.util.PriorityQueue. (/ (* 320 240) scale) cost-comparator)]
(.offer fronteir {:cost 0 :loc play-loc}) (.offer fronteir {:cost 0 :loc play-loc})
(loop [current-loc (.poll fronteir)] (loop [current-loc (.poll fronteir)]
(if (or (nil? current-loc) (if (or (nil? current-loc)
(= (:loc current-loc) target-loc)) (= (:loc current-loc) target-loc))
(do (println @my-count) (resolve-path came-from play-loc target-loc)
(resolve-path came-from play-loc target-loc))
(do (doseq [neighbor (neighbors (:loc current-loc) my-map)] (do (doseq [neighbor (neighbors (:loc current-loc) my-map)]
(let [cost-for-neighbor (.get cost-so-far neighbor) (let [cost-for-neighbor (.get cost-so-far neighbor)
new-cost (+ (.get cost-so-far (:loc current-loc)) (get-in my-map neighbor))] new-cost (+ (.get cost-so-far (:loc current-loc)) (get-in my-map neighbor))]
@@ -106,17 +119,17 @@
(let [my-map (random-map) (let [my-map (random-map)
path (visit-all my-map [1 1] [639 479 ])] path (visit-all my-map [1 1] [639 479 ])]
(println "Test") (println "Test")
#_(print-resolved path my-map) (print-resolved path my-map)
(println path))) (println path)))
(defn map-from-resource [filename] (defn map-from-resource [filename]
(let [pm (pixmap filename) (let [pm (pixmap filename)
black (color 0 0 0 255) black (color 0 0 0 255)
painful (color 255 0 0 255)] painful (color 255 0 0 255)]
(vec (for [x (range (pixmap! pm :get-width))] (vec (take-nth scale (for [x (range (pixmap! pm :get-width))]
(vec (for [y (reverse (range (pixmap! pm :get-height))) (vec (take-nth scale (for [y (reverse (range (pixmap! pm :get-height)))
:let [current-color (color (pixmap! pm :get-pixel x y))]] :let [current-color (color (pixmap! pm :get-pixel x y))]]
(cond (cond
(color! current-color :equals black) 0 (color! current-color :equals black) 0
(color! current-color :equals painful) 1 (color! current-color :equals painful) 2
:else 1))))))) :else 1)))))))))

2
desktop/src-common/advent/screens/scene.clj
View File

@@ -123,7 +123,7 @@
house (texture "house.png") house (texture "house.png")
overdirt (texture "overdirt.png") overdirt (texture "overdirt.png")
music (sound "town-music.mp3") music (sound "town-music.mp3")
_ (sound! music :loop) ;;_ (sound! music :loop)
] ]
{ {
:cursor {:id "cursor" :current :walk } :cursor {:id "cursor" :current :walk }