diff --git a/desktop/resources/pathfind-test-big.png b/desktop/resources/pathfind-test-big.png new file mode 100644 index 00000000..38611a98 Binary files /dev/null and b/desktop/resources/pathfind-test-big.png differ diff --git a/desktop/resources/pathfind-test.png b/desktop/resources/pathfind-test.png new file mode 100644 index 00000000..f067079a Binary files /dev/null and b/desktop/resources/pathfind-test.png differ diff --git a/desktop/src-common/advent/core.clj b/desktop/src-common/advent/core.clj index 63e52f68..96d06c0e 100644 --- a/desktop/src-common/advent/core.clj +++ b/desktop/src-common/advent/core.clj @@ -3,7 +3,8 @@ [play-clj.ui :refer :all] [play-clj.utils :refer :all] [play-clj.g2d :refer :all] - [clojure.pprint]) + [clojure.pprint] + [advent.pathfind]) (:import [com.badlogic.gdx.graphics Pixmap Pixmap$Filter])) (def scale 4) @@ -32,7 +33,10 @@ (defn left-click [screen entities] (let [{:keys [x y]} (input->screen screen {:x (:input-x screen) :y (:input-y screen)})] - (assoc-in entities [:ego :target] {:x x :y y}))) + (assoc-in entities [:ego :target-path] (take-nth 10 (advent.pathfind/visit-all + (:collision (:background entities)) + [(int (:x (:ego entities))) (int (:y (:ego entities)))] + [(int x) (int y)]))))) (defn get-ego [screen] (let [player-sheet (texture! (texture "player.png") :split 18 36) @@ -42,27 +46,29 @@ (texture (aget player-sheet 1 i)))) :anim (animation 0.075 (for [i (range 8)] (texture (aget player-sheet 0 i)))) - :x 100 :y 75 :x-velocity 1 + :x 150 :y 95 :x-velocity 1 :id "ego"}] (merge (animation->texture screen (:anim ego)) ego))) (defn update-ego [screen entities ego] - (let [ego (merge ego (animation->texture screen (:anim ego))) - target (:target ego)] - (if target - (let [delta-x (- (:x target) (:x ego)) + target-path (:target-path ego) + [target-x target-y] (first target-path) + target {:x target-x :y target-y}] + (if (and target (seq target-path)) + (let [ + delta-x (- (:x target) (:x ego)) delta-y (- (:y target) (:y ego)) mag (Math/sqrt (+ (* delta-x delta-x) (* delta-y delta-y))) - vector-x (* 2 (/ delta-x mag)) - vector-y (* 2 (/ delta-y mag))] + vector-x (* 1.5 (/ delta-x mag)) + vector-y (* 1.5 (/ delta-y mag))] (if (< mag 1) - (dissoc ego :target) + (update-in ego [:target-path] rest) (-> ego (update-in [:x] #(+ % vector-x)) (update-in [:y] #(+ % vector-y))))) - ego))) + (dissoc ego :target-path)))) (defscreen main-screen :on-show (fn [screen entities] @@ -71,7 +77,7 @@ _ (input! :set-cursor-image (cursor "cursor.png" 0) 0 0) background (texture "bg5.png")] {:cursor {:id "cursor" :cursor-index 0} - :background (assoc background :origin-y 0 :origin-x 0 :id "background" :x 0 :y 0 :scale-x 1 :scale-y 1) + :background (assoc background :origin-y 0 :origin-x 0 :id "background" :x 0 :y 0 :scale-x 1 :scale-y 1 :collision (advent.pathfind/map-from-resource "pathfind-test-big.png")) :ego (get-ego screen)})) :on-render diff --git a/desktop/src-common/advent/pathfind.clj b/desktop/src-common/advent/pathfind.clj new file mode 100644 index 00000000..c58ae5e9 --- /dev/null +++ b/desktop/src-common/advent/pathfind.clj @@ -0,0 +1,80 @@ +(ns advent.pathfind + (:require [play-clj.core :refer :all] + [play-clj.ui :refer :all] + [play-clj.utils :refer :all] + [play-clj.g2d :refer :all] + [clojure.pprint]) + (:import [com.badlogic.gdx.files FileHandle] + [com.badlogic.gdx Files] + [com.badlogic.gdx.graphics Camera Color GL20 OrthographicCamera + PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture + VertexAttributes$Usage])) + +(defn printmap [my-map & [skip]] + (let [skip (or skip 1)] + (doseq [row (take-nth skip my-map)] + (println (take-nth skip (map {0 \space 1 "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 neighbors [x y my-map] + (let [candidates [[(dec x) (dec y)] [x (dec y)] [(inc x) (dec y)] + [(dec x) y] [(inc x) y] + [(dec x) (inc y)] [x (inc y)] [(inc x) (inc y)]]] + (remove #(= 1 (get-in my-map (reverse %))) + (filter (fn [[x y]] (and (< -1 x (count (first my-map))) + (< -1 y (count my-map)))) candidates)))) + + +(defn resolve [came-from play-loc target-loc] + (loop [path [] + current-node target-loc] + (if (or (= current-node play-loc) + (nil? current-node)) + (reverse (conj path current-node)) + (recur + (conj path current-node) + (came-from current-node))))) + +(defn visit-all [my-map play-loc target-loc ] + (if (= 1 (get-in my-map (reverse target-loc))) + nil + (loop [came-from {} + fronteir [play-loc]] + (let [[current-x current-y] (first fronteir)] + (if (or (empty? fronteir) + (= [current-x current-y] target-loc)) + (if (nil? (came-from target-loc)) + nil + (resolve came-from play-loc target-loc)) + (let [neighbors (neighbors current-x current-y my-map) + [came-from fronteir] (reduce (fn [[came-from fronteir] neighbor] + (if (came-from neighbor) + [came-from (vec fronteir)] + [(assoc came-from neighbor [current-x current-y]) + (vec (conj fronteir neighbor))])) + [came-from fronteir] + neighbors)] + (recur came-from (vec (rest fronteir))))))))) + + +(defn print-resolved [path my-map] + (doseq [row (reduce (fn [acc path] + (if path + (update-in acc (reverse path) (constantly "X")) + acc)) + my-map + path)] + + (println (map {0 \space 1 "W" "X" "X"} row))) + nil) + +(defn map-from-resource [filename] + (let [pm (pixmap filename)] + (vec (for [y (reverse (range (pixmap! pm :get-height)))] + (vec (for [x (range (pixmap! pm :get-width))] + (if (color! (color (pixmap! pm :get-pixel x y)) :equals (color 0 0 0 255)) + 1 0)))))))