Can *probably* convert MicroWorld to STL

Code is written. It isn't tested.

.gitignore

@@ -10,6 +10,8 @@ pom.xml.asc
 *.svg
 /.lein-*
 /.nrepl-port
+.clj-kondo
+.lsp
 .hgignore
 .hg/
 

project.clj

@@ -15,6 +15,9 @@
                  [hiccup "1.0.5"]
                  [macroz/search "0.3.0"]
                  [me.raynes/fs "1.4.6"]
+                 [mw-engine "0.3.0-SNAPSHOT"]
+                 [net.mikera/core.matrix "0.63.0"]
+                 [net.mikera/vectorz-clj "0.48.0"]
                  [smee/binary "0.5.5"]]
   :deploy-repositories [["releases" :clojars]
                         ["snapshots" :clojars]]

src/cc/journeyman/walkmap/mw_stl.clj

@@ -0,0 +1,50 @@
+(ns cc.journeyman.walkmap.mw-stl
+  "Convert from Microworld to STL format"
+  (:require [cc.journeyman.walkmap.ocean :refer [cull-ocean-facets]]
+            [cc.journeyman.walkmap.polygon :refer [polygon]]
+            [cc.journeyman.walkmap.vertex :refer [vertex]]
+            [mw-engine.utils :refer [get-cell map-world]]))
+
+(defn mean-altitude
+  [cells]
+  (let [c (remove nil? cells)]
+    (if (= (count c) 1)
+      (:altitude (first c))
+      (/ (reduce + (map :altitude c)) (count c)))))
+
+(defn cell->facets
+  "Convert a cell into facets.
+   
+   All facets in an STL file must be triangles, so each MicroWorld cell needs 
+   to be split into two. I am not at present seeing a rational rule for
+   splitting cells, so at this stage I'm going to do it randomly to prevent
+   parallel ridge artifacts appearing in the output.
+   
+   This function is designed to be used with `mw-engint.utils/map-world`, q.v."
+  [world cell]
+  (let [;; bounds
+        n (:y cell)
+        e (:x cell)
+        s (inc n)
+        w (inc e)
+        ;; corner altitudes
+        nea (mean-altitude [cell (get-cell world (dec n) (dec e))])
+        nwa (mean-altitude [cell (get-cell world (dec n) (inc e))])
+        swa (mean-altitude [cell (get-cell world (inc n) (inc e))])
+        sea (mean-altitude [cell (get-cell world (inc n) (dec e))])]
+    (if (rand-nth [true false])
+      [(polygon (vertex n e nea) (vertex n w nwa) (vertex s e sea))
+       (polygon (vertex n w nwa) (vertex s e sea) (vertex s w swa))]
+      [(polygon (vertex n e nea) (vertex n w nwa) (vertex s w sea))
+       (polygon (vertex n e nwa) (vertex s e sea) (vertex s w swa))])))
+
+(defn mw->stl
+  "Return an STL structure representing the topology of this MicroWorld world 
+   `mw`. If `title` is supplied use that as the title of the STL structure."
+  ([mw]
+   (mw->stl mw nil))
+  ([mw title]
+   (let [facets (cull-ocean-facets (flatten (map-world mw cell->facets)))
+         stl {:facets facets
+              :count (count facets)}]
+     (if title (assoc stl :title title) stl))))

src/cc/journeyman/walkmap/polygon.clj

@@ -52,6 +52,28 @@
   [o]
   `(check-kind-type ~o triangle? :triangle))
 
+(def recognised-polygon-types #{:triangle
+                                :quadrilateral
+                                :pentagon
+                                :hexagon
+                                :heptagon
+                                :octogon
+                                :polygon})
+
+(defn- poly-kind 
+  "Return a keyword representing the kind of polygon which has this many
+   `vertices`."
+  [vertices]
+  (case (count vertices)
+    3 :triangle
+    4 :quadrilateral
+    5 :pentagon
+    6 :hexagon
+    7 :heptagon
+    8 :octogon
+    ;;else
+    :polygon))
+
 (defn polygon
   "Return a polygon constructed from these `vertices`."
   [& vertices]
@@ -59,7 +81,7 @@
    (> (count vertices) 2)
     {:vertices (check-vertices vertices)
      :walkmap.id/id (keyword (gensym "poly"))
-     :kind :polygon}
+     :kind (poly-kind vertices)}
     (throw (IllegalArgumentException.
             "A polygon must have at least 3 vertices."))))
 
@@ -84,7 +106,7 @@
       (e/unit-vector (e/edge (first height-order) (last height-order)))
       :centre
       (vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2))
-                (+ (:x vsw) (/ (- (:y vne) (:y vsw)) 2))
+              (+ (:y vsw) (/ (- (:y vne) (:y vsw)) 2))
               (:z vse)))
      :rectangle)))
 

src/cc/journeyman/walkmap/stl.clj

@@ -1,19 +1,23 @@
 (ns cc.journeyman.walkmap.stl
   "Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
-  (:require
+  (:require [cc.journeyman.walkmap.ocean :refer [ocean?]]
-   [cc.journeyman.walkmap.ocean :refer [ocean?]]
+            [cc.journeyman.walkmap.polygon :refer [centre gradient triangle?]]
-   [cc.journeyman.walkmap.polygon :refer [centre gradient polygon?]]
             [cc.journeyman.walkmap.superstructure :refer [store]]
             [cc.journeyman.walkmap.tag :refer [tag]]
-   [cc.journeyman.walkmap.utils :refer [truncate]]
+            [cc.journeyman.walkmap.utils :refer [kind-type truncate]]
-   [cc.journeyman.walkmap.vertex :as v]
+            [cc.journeyman.walkmap.vertex :as v :refer [vertex]]
-   [clojure.lang.io :refer [input-stream]]
+            [clojure.core.matrix :refer [set-current-implementation sub]]
+            [clojure.java.io :refer [input-stream]]
             [clojure.string :as s]
             [me.raynes.fs :refer [base-name split-ext]]
             [org.clojars.smee.binary.core :as b]
             [taoensso.timbre :refer [debug]])
   (:import [clojure.lang Keyword]))
 
+;; We want to use the `[vectorz](https://github.com/mikera/vectorz-clj)` 
+;; implementation of core.matrix.
+(set-current-implementation :vectorz)
+
 (defn stl?
   "True if `o` is recogniseable as an STL structure. An STL structure must
   have a key `:facets`, whose value must be a sequence of polygons; and
@@ -28,7 +32,7 @@
    (and
     (map? o)
     (:facets o)
-     (every? polygon? (:facets o))
+    (every? triangle? (:facets o)) 
     (if (:header o) (string? (:header o)) true)
     (if (:count o) (integer? (:count o)) true)
     (or (nil? (:kind o)) (= (:kind o) :stl))
@@ -55,6 +59,50 @@
    :count :uint-le
    :facets (b/repeated facet)))
 
+(defn vertex->array
+  [v]
+  [(:x v) (:y v) (or (:z v) 0)])
+
+(defn surface-normal 
+  "From https://www.khronos.org/opengl/wiki/Calculating_a_Surface_Normal
+   ```
+   Begin Function CalculateSurfaceNormal (Input Triangle) Returns Vector
+  
+   Set Vector U to (Triangle.p2 minus Triangle.p1)
+   Set Vector V to (Triangle.p3 minus Triangle.p1)
+  
+   Set Normal.x to (multiply U.y by V.z) minus (multiply U.z by V.y)
+   Set Normal.y to (multiply U.z by V.x) minus (multiply U.x by V.z)
+   Set Normal.z to (multiply U.x by V.y) minus (multiply U.y by V.x)
+  
+   Returning Normal
+  
+   End Function
+   ```"
+  [triangle]
+  (if (triangle? triangle)
+    (let 
+     [vertices (:vertices triangle)
+      v1 (vertex->array (nth vertices 0))
+      u (sub (vertex->array (nth vertices 1)) v1)
+      v (sub (vertex->array (nth vertices 2)) v1)
+      x (- (* (nth u 1)(nth v 2)) (* (nth u 2) (nth v 1)))
+          y (- (* (nth u 2) (nth v 0)) (* (nth u 0) (nth v 2)))
+          z (- (* (nth u 0) (nth v 1)) (* (nth u 1 (nth v 0))))]
+      (debug (format "Calculating normal for triangle %s" triangle))
+      (vertex x y z))
+    (throw (IllegalArgumentException. 
+            (format "Expected :triangle, found %s" (kind-type triangle))))))
+
+(defn ensure-normal
+  "Ensure this `triangle` has a normal vector/"
+  [triangle]
+  (if (triangle? triangle)
+    (if (:normal triangle) triangle 
+        (assoc triangle :normal (surface-normal triangle)))
+    (throw (IllegalArgumentException. 
+            (format "Expected :triangle, found %s" (kind-type triangle))))))
+
 (defn canonicalise
   "Objects read in from STL won't have all the keys/values we need them to have.
   `o` may be a map (representing a facet or a vertex), or a sequence of such maps;
@@ -75,8 +123,12 @@
      ;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
      (:facets o) (assoc o
                         :kind :stl
-                   :walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "stl")))
+                        :walkmap.id/id (or (:walkmap.id/id o) 
+                                           (keyword (gensym "stl")))
                         :facets (canonicalise (:facets o) map-kind))
+     ;; if it's a triangle it's almost a facet. All it needs now is a normal 
+     ;; vector
+     (triangle? o) (ensure-normal o)
      ;; if it has :vertices it's a polygon, but it may not yet conform to
      ;; `polygon?`
      (:vertices o) (let [f (gradient