pathfinding works.

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)]
+        target-path (:target-path ego)
-    (if target
+        [target-x target-y] (first target-path)
-      (let [delta-x (- (:x target) (:x ego))
+        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-x (* 1.5 (/ delta-x mag))
-            vector-y (* 2 (/ delta-y 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

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)))))))