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

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

2
desktop/src-common/advent/actions.clj
View File

@@ -45,7 +45,7 @@
(defn from-path [screen entities target-id [x y]] (defn from-path [screen entities target-id [x y]]
(let [entity (target-id entities) (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)) (:collision (:background entities))
[(int (:x entity)) (int (:y entity))] [(int (:x entity)) (int (:y entity))]
[(int x) (int y)]))) [(int x) (int y)])))

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

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