Initial slimed surface counting

1 files changed, 74 insertions, 4 deletions

diff --git a/map.fnl b/map.fnl
index b2c2772..efaf6bb 100644
--- a/map.fnl
+++ b/map.fnl
@@ -15,7 +15,7 @@
 ;;;; You should have received a copy of the GNU General Public License along
 ;;;; with slime-the-world. If not, see <http://www.gnu.org/licenses/>.
 
-(local tiles
+(local tile-sheet
        {:img (love.graphics.newImage "art/tiles.png")
         :width 32 :height 32
         :padding-x 8 :padding-y 8
@@ -31,6 +31,71 @@
         :padding-x 8 :padding-y 8
         :offsets {:top 0 :bottom 1 :left 2 :right 3}})
 
+(fn tile-at [tiles x y]
+  (if (and (>= x 0)
+           (< x (. tiles :width))
+           (>= y 0)
+           (< y (. tiles :height)))
+      (. tiles :tiles (+ 1 y) (+ 1 x))
+      nil))
+
+(fn find-first [tile-type tiles]
+  (var res nil)
+  (each [_ row (ipairs (. tiles :tiles))]
+    (each [_ tile (ipairs row)]
+      (when (= tile-type (. tile :type))
+        (set res tile))))
+  res)
+
+(fn tile-checked [tile checked]
+  (var res false)
+  (each [_ other (ipairs checked)]
+    (when (and (= (. tile :x-pos) (. other :x-pos))
+               (= (. tile :y-pos) (. other :y-pos)))
+      (set res true)))
+  res)
+
+(fn count-surfaces-recur [tiles tile checked]
+  (var surfaces 0)
+
+  (when (not (tile-checked tile checked))
+    (table.insert checked tile)
+
+    (let [x (/ (. tile :x-pos) (. tile-sheet :width))
+          y (/ (. tile :y-pos) (. tile-sheet :height))
+          width (. tiles :width)
+          height (. tiles :height)]
+      (when (>= x 0)
+        (let [tile (tile-at tiles (- x 1) y)]
+          (if (= :empty (. tile :type))
+              (set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
+              (set surfaces (+ 1 surfaces)))))
+
+      (when (< x width)
+        (let [tile (tile-at tiles (+ x 1) y)]
+          (if (= :empty (. tile :type))
+              (set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
+              (set surfaces (+ 1 surfaces)))))
+
+      (when (>= y 0)
+        (let [tile (tile-at tiles x (- y 1))]
+          (if (= :empty (. tile :type))
+              (set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
+              (set surfaces (+ 1 surfaces)))))
+
+      (when (< y height)
+        (let [tile (tile-at tiles x (+ y 1))]
+          (if (= :empty (. tile :type))
+              (set surfaces (+ surfaces (count-surfaces-recur tiles tile checked)))
+              (set surfaces (+ 1 surfaces)))))))
+
+  surfaces)
+
+(fn count-surfaces [tiles]
+  (let [seed (find-first :empty tiles)]
+    (when seed
+      (count-surfaces-recur tiles seed []))))
+
 ;; Creates a new tile object of the given `type-type' positioned at world
 ;; coordinates (`x', `y').
 (fn make-tile [tile-type x y]
@@ -44,7 +109,7 @@
 
 ;; Returns the tile object for a given pixel in `image'.
 (fn get-tile [image x y]
-  (var res (make-tile :empty (* x (. tiles :width)) (* y (. tiles :width))))
+  (var res (make-tile :empty (* x (. tile-sheet :width)) (* y (. tile-sheet :width))))
   (let [(r g b a) (: image :getPixel x y)]
     (each [tile-type colors (pairs tile-values)]
       (when (and (= (. colors 1) r)
@@ -77,12 +142,17 @@
 (fn load [name]
   (let [tiles-path (.. "maps/" name ".png")
         meta-path (.. "maps/" name ".fnl")]
-    (let [(tiles width height) (load-tiles (love.image.newImageData tiles-path))]
+    (let [(tiles width height) (load-tiles (love.image.newImageData tiles-path))
+          tiles-temp {:tiles tiles :width width :height height}]
       {:tiles tiles
        :width width
        :height height
+
+       :surfaces-slimed 0
+       :surfaces-total (count-surfaces tiles-temp)
+
        :meta (load-meta meta-path)})))
 
-{:tiles tiles
+{:tiles tile-sheet
  :slime slime
  :load load}