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
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]]
(let [skip (or skip 1)]
(doseq [row (take-nth skip my-map)]
(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 [639 479] (constantly 1))))
(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)]
[^long (dec x) y] [^long (inc x) y]
[^long (dec x) ^long (inc y)] [x ^long (inc y)] [^long (inc x) ^long (inc y)]]
(let [x (long x)
y (long 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))
width (count my-map)]
(remove #(= 0 (get-in my-map %))
(filter (fn [[x y]] (and (< -1 x width)
(< -1 y height))) candidates))))
(filter (fn [[^long x ^long y]] (and (< -1 x width)
(< -1 y height))) candidates))))
(defn resolve-path [came-from play-loc target-loc]
(let [came-from (into {} came-from)]
(if (nil? (came-from target-loc))
nil
(loop [path []
current-node (vec target-loc)]
(if (or (= current-node play-loc)
(nil? current-node))
(reverse (conj path current-node))
(reverse (conj path (from-scale current-node)))
(recur
(conj path current-node)
(conj path (from-scale current-node))
(came-from (vec current-node))))))))
(def d2 ^double (- (Math/sqrt 2) 1))
(defn heuristic [^long goal-x ^long goal-y ^long current-x ^long current-y]
(let [dist-x ^long (if (< goal-x current-x)
^long (- current-x goal-x)
^long (- goal-x current-x ))
dist-y ^long (if (< goal-y current-y)
^long (- current-y goal-y)
^long (- goal-y current-y))]
^long (+ dist-x dist-y (* ^double d2
^long (min dist-x dist-y)))))
(def d2 ^double (- (Math/sqrt 2) 2))
(defn heuristic ^long [^long goal-x ^long goal-y ^long current-x ^long current-y]
(let [dist-x (if (< goal-x current-x)
(unchecked-subtract current-x goal-x)
(unchecked-subtract goal-x current-x ))
dist-y (if (< goal-y current-y)
(unchecked-subtract current-y goal-y)
(unchecked-subtract goal-y current-y))
min-dist ^double (double (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]
(reset! my-count 0)
(let [play-loc (vec play-loc)
target-log (vec target-loc)]
(let [play-loc (vec (to-scale play-loc))
target-loc (vec (to-scale target-loc))]
(if (= 0 (get-in my-map target-loc))
nil
(let [cost-so-far ^java.util.HashMap (java.util.HashMap. {play-loc 0})
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})
(loop [current-loc (.poll fronteir)]
(if (or (nil? current-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)]
(let [cost-for-neighbor (.get cost-so-far neighbor)
new-cost (+ (.get cost-so-far (:loc current-loc)) (get-in my-map neighbor))]
@@ -106,17 +119,17 @@
(let [my-map (random-map)
path (visit-all my-map [1 1] [639 479 ])]
(println "Test")
#_(print-resolved path my-map)
(print-resolved path my-map)
(println path)))
(defn map-from-resource [filename]
(let [pm (pixmap filename)
black (color 0 0 0 255)
painful (color 255 0 0 255)]
(vec (for [x (range (pixmap! pm :get-width))]
(vec (for [y (reverse (range (pixmap! pm :get-height)))
:let [current-color (color (pixmap! pm :get-pixel x y))]]
(cond
(color! current-color :equals black) 0
(color! current-color :equals painful) 1
:else 1)))))))
(vec (take-nth scale (for [x (range (pixmap! pm :get-width))]
(vec (take-nth scale (for [y (reverse (range (pixmap! pm :get-height)))
:let [current-color (color (pixmap! pm :get-pixel x y))]]
(cond
(color! current-color :equals black) 0
(color! current-color :equals painful) 2
:else 1)))))))))

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

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