Removed scaling. Hopefully we will make this fast enough where it doesn't matter.

This commit is contained in:
=
2014-09-11 12:49:21 -07:00
parent 8cb523468a
commit dc40512eda
2 changed files with 49 additions and 49 deletions

View File

@@ -45,7 +45,7 @@
(defn from-path [screen entities target-id [x y]]
(let [entity (target-id entities)
path (vec (take-nth 2 (advent.pathfind/visit-all
path (vec (take-nth 4 (advent.pathfind/visit-all
(:collision (:background entities))
[(int (:x entity)) (int (:y entity))]
[(int x) (int y)])))

View File

@@ -16,9 +16,9 @@
(doseq [row (take-nth skip my-map)]
(println (take-nth skip (map {1 \space 0 "W" "X" "X" "." "."} row))))))
(defn random-map [] (-> (vec (take (/ 240 2) (repeatedly (fn [] (vec (take (/ 320 2) (repeatedly (fn [] (rand-nth [0 0 1 ])))))))))
(update-in [1 1] (constantly 0))
(update-in [50 50] (constantly 0))))
(defn random-map [] (-> (vec (take (/ 240 4) (repeatedly (fn [] (vec (take (/ 320 4) (repeatedly (fn [] (rand-nth [1 1 1 1 1 5 0])))))))))
(update-in [1 1] (constantly 1))
(update-in [50 50] (constantly 1))))
(defn neighbors [[x y] my-map]
@@ -31,16 +31,16 @@
(defn resolve-path [came-from play-loc target-loc]
(if (nil? (came-from target-loc))
nil
(loop [path []
current-node target-loc]
(if (or (= current-node play-loc)
(nil? current-node))
(reverse (map (fn [[x y]] [(* x 2) (* y 2)]) (conj path current-node)))
(recur
(conj path current-node)
(came-from current-node))))))
(doto (if (nil? (came-from target-loc))
nil
(loop [path []
current-node target-loc]
(if (or (= current-node play-loc)
(nil? current-node))
(reverse (map (fn [[x y]] [x y]) (conj path current-node)))
(recur
(conj path current-node)
(came-from current-node))))) println))
(defn heuristic [[goal-x goal-y] [current-x current-y]]
(let [dist-x (Math/abs (- goal-x current-x ))
@@ -49,34 +49,30 @@
(+ dist-x dist-y (* (- d2 1)
(min dist-x dist-y)))))
(defn ->scale [loc]
(vec (map (fn [x] (int (/ x 2))) loc)))
(defn visit-all [my-map play-loc target-loc]
(let [play-loc (->scale play-loc)
target-loc (->scale target-loc)]
(if (= 0 (get-in my-map (reverse target-loc)))
nil
(loop [cost-so-far {play-loc 0}
came-from {}
fronteir (priority-map play-loc 0)]
(let [current-loc (first (keys fronteir))]
(if (or (empty? fronteir)
(= current-loc target-loc))
(resolve-path came-from play-loc target-loc)
(let [neighbors (neighbors current-loc my-map)
[cost-so-far came-from fronteir] (reduce (fn [[cost-so-far came-from fronteir] neighbor]
(let [new-cost (+ (cost-so-far current-loc) (get-in my-map (reverse neighbor)))]
(if (or (nil? (cost-so-far neighbor))
(< new-cost (cost-so-far neighbor)))
[(assoc cost-so-far neighbor new-cost)
(assoc came-from neighbor current-loc)
(assoc fronteir neighbor (+ new-cost (heuristic target-loc neighbor)))]
[cost-so-far came-from fronteir]
)))
[cost-so-far came-from fronteir]
neighbors)]
(recur cost-so-far came-from (dissoc fronteir current-loc)))))))))
(if (= 0 (get-in my-map (reverse target-loc)))
nil
(loop [cost-so-far {play-loc 0}
came-from {}
fronteir (priority-map play-loc 0)]
(let [current-loc (first (keys fronteir))]
(if (or (empty? fronteir)
(= current-loc target-loc))
(resolve-path came-from play-loc target-loc)
(let [neighbors (neighbors current-loc my-map)
[cost-so-far came-from fronteir] (reduce (fn [[cost-so-far came-from fronteir] neighbor]
(let [new-cost (+ (cost-so-far current-loc) (get-in my-map (reverse neighbor)))]
(if (or (nil? (cost-so-far neighbor))
(< new-cost (cost-so-far neighbor)))
[(assoc cost-so-far neighbor new-cost)
(assoc came-from neighbor current-loc)
(assoc fronteir neighbor (+ new-cost (heuristic target-loc neighbor)))]
[cost-so-far came-from fronteir]
)))
[cost-so-far came-from fronteir]
neighbors)]
(recur cost-so-far came-from (dissoc fronteir current-loc))))))))
(defn print-resolved [path my-map]
@@ -87,17 +83,21 @@
my-map
path)]
(println (map {1 \space 2 "." 0 "W" "X" "X"} row)))
(println (map {1 \space 5 "." 0 "W" "X" "X"} row)))
nil)
(defn test-pathfind []
(let [my-map (random-map)]
(print-resolved (visit-all my-map [1 1] [50 50]) my-map)))
(defn map-from-resource [filename]
(let [pm (pixmap filename)
black (color 0 0 0 255)
painful (color 255 0 0 255)]
(vec (take-nth 2 (for [y (reverse (range (pixmap! pm :get-height)))]
(vec (take-nth 2 (for [x (range (pixmap! pm :get-width))
:let [current-color (color (pixmap! pm :get-pixel x y))]]
(cond
(color! current-color :equals black) 0
(color! current-color :equals painful) 10
:else 1)))))))))
(vec (for [y (reverse (range (pixmap! pm :get-height)))]
(vec (for [x (range (pixmap! pm :get-width))
:let [current-color (color (pixmap! pm :get-pixel x y))]]
(cond
(color! current-color :equals black) 0
(color! current-color :equals painful) 10
:else 1)))))))