Can *probably* convert MicroWorld to STL
Code is written. It isn't tested.
This commit is contained in:
parent
a0b2b93f6b
commit
4187b52c66
2
.gitignore
vendored
2
.gitignore
vendored
|
|
@ -10,6 +10,8 @@ pom.xml.asc
|
|||
*.svg
|
||||
/.lein-*
|
||||
/.nrepl-port
|
||||
.clj-kondo
|
||||
.lsp
|
||||
.hgignore
|
||||
.hg/
|
||||
|
||||
|
|
|
|||
|
|
@ -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]]
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
50
src/cc/journeyman/walkmap/mw_stl.clj
Normal file
50
src/cc/journeyman/walkmap/mw_stl.clj
Normal file
|
|
@ -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))))
|
||||
|
|
@ -4,9 +4,9 @@
|
|||
[cc.journeyman.walkmap.edge :as e]
|
||||
[cc.journeyman.walkmap.tag :as t]
|
||||
[cc.journeyman.walkmap.utils :refer [check-kind-type
|
||||
check-kind-type-seq
|
||||
kind-type
|
||||
not-yet-implemented]]
|
||||
check-kind-type-seq
|
||||
kind-type
|
||||
not-yet-implemented]]
|
||||
[cc.journeyman.walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]]))
|
||||
|
||||
(defn polygon?
|
||||
|
|
@ -15,13 +15,13 @@
|
|||
of vertices."
|
||||
[o]
|
||||
(let
|
||||
[v (:vertices o)]
|
||||
[v (:vertices o)]
|
||||
(and
|
||||
(coll? v)
|
||||
(> (count v) 2)
|
||||
(every? vertex? v)
|
||||
(:walkmap.id/id o)
|
||||
(or (nil? (:kind o)) (= (:kind o) :polygon)))))
|
||||
(coll? v)
|
||||
(> (count v) 2)
|
||||
(every? vertex? v)
|
||||
(:walkmap.id/id o)
|
||||
(or (nil? (:kind o)) (= (:kind o) :polygon)))))
|
||||
|
||||
(defmacro check-polygon
|
||||
"If `o` is not a polygon, throw an `IllegalArgumentException` with an
|
||||
|
|
@ -42,8 +42,8 @@
|
|||
polygon with exactly three vertices."
|
||||
[o]
|
||||
(and
|
||||
(coll? o)
|
||||
(= (count (:vertices o)) 3)))
|
||||
(coll? o)
|
||||
(= (count (:vertices o)) 3)))
|
||||
|
||||
(defmacro check-triangle
|
||||
"If `o` is not a triangle, throw an `IllegalArgumentException` with an
|
||||
|
|
@ -52,16 +52,38 @@
|
|||
[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]
|
||||
(if
|
||||
(> (count vertices) 2)
|
||||
(> (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."))))
|
||||
"A polygon must have at least 3 vertices."))))
|
||||
|
||||
(defn rectangle
|
||||
"Return a rectangle, with edges aligned east-west and north-south, whose
|
||||
|
|
@ -78,15 +100,15 @@
|
|||
(/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))
|
||||
height-order (sort-by :z [vsw vne])]
|
||||
(t/tag
|
||||
(assoc
|
||||
(polygon vsw vnw vne vse)
|
||||
:gradient
|
||||
(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))
|
||||
(:z vse)))
|
||||
:rectangle)))
|
||||
(assoc
|
||||
(polygon vsw vnw vne vse)
|
||||
:gradient
|
||||
(e/unit-vector (e/edge (first height-order) (last height-order)))
|
||||
:centre
|
||||
(vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2))
|
||||
(+ (:y vsw) (/ (- (:y vne) (:y vsw)) 2))
|
||||
(:z vse)))
|
||||
:rectangle)))
|
||||
|
||||
;; (rectangle (vertex 1 2 3) (vertex 7 9 4))
|
||||
|
||||
|
|
@ -98,7 +120,7 @@
|
|||
(:vertices (check-triangle triangle)))
|
||||
highest (first order)
|
||||
lowest (last order)]
|
||||
(assoc triangle :gradient (e/unit-vector (e/edge lowest highest)))))
|
||||
(assoc triangle :gradient (e/unit-vector (e/edge lowest highest)))))
|
||||
|
||||
(defn triangle-centre
|
||||
"Return a canonicalised `facet` (i.e. a triangular polygon) with an added
|
||||
|
|
@ -111,13 +133,13 @@
|
|||
v1 (first vs)
|
||||
opposite (e/edge (nth vs 1) (nth vs 2))
|
||||
oc (e/centre opposite)]
|
||||
(assoc
|
||||
facet
|
||||
:centre
|
||||
(vertex
|
||||
(+ (:x v1) (* (- (:x oc) (:x v1)) 2/3))
|
||||
(+ (:y v1) (* (- (:y oc) (:y v1)) 2/3))
|
||||
(+ (:z v1) (* (- (:z oc) (:z v1)) 2/3))))))
|
||||
(assoc
|
||||
facet
|
||||
:centre
|
||||
(vertex
|
||||
(+ (:x v1) (* (- (:x oc) (:x v1)) 2/3))
|
||||
(+ (:y v1) (* (- (:y oc) (:y v1)) 2/3))
|
||||
(+ (:z v1) (* (- (:z oc) (:z v1)) 2/3))))))
|
||||
|
||||
(defn centre
|
||||
[poly]
|
||||
|
|
@ -125,8 +147,8 @@
|
|||
3 (triangle-centre poly)
|
||||
;; else
|
||||
(throw
|
||||
(UnsupportedOperationException.
|
||||
"The general case of centre for polygons is not yet implemented."))))
|
||||
(UnsupportedOperationException.
|
||||
"The general case of centre for polygons is not yet implemented."))))
|
||||
|
||||
(defmacro on2dtriangle?
|
||||
"Is the projection of this `vertex` on the x, y plane within the
|
||||
|
|
@ -141,15 +163,15 @@
|
|||
(let [xo (sort-by :x (:vertices rectangle))
|
||||
yo (sort-by :y (:vertices rectangle))]
|
||||
(and
|
||||
(< (:x (first xo)) (:x vertex) (:x (last xo)))
|
||||
(< (:y (first yo)) (:y vertex) (:y (last yo))))))
|
||||
(< (:x (first xo)) (:x vertex) (:x (last xo)))
|
||||
(< (:y (first yo)) (:y vertex) (:y (last yo))))))
|
||||
|
||||
(defmacro on2d?
|
||||
"Is the projection of this `vertex` on the x, y plane within the
|
||||
projection of this polygon `poly` on that plane?"
|
||||
[vertex poly]
|
||||
`(cond
|
||||
(rectangle? ~poly) (on2drectangle? ~vertex ~poly)
|
||||
(triangle? ~poly) (on2dtriangle? ~vertex ~poly)
|
||||
:else
|
||||
(not-yet-implemented "general case of on2d? for polygons.")))
|
||||
(rectangle? ~poly) (on2drectangle? ~vertex ~poly)
|
||||
(triangle? ~poly) (on2dtriangle? ~vertex ~poly)
|
||||
:else
|
||||
(not-yet-implemented "general case of on2d? for polygons.")))
|
||||
|
|
|
|||
|
|
@ -1,19 +1,23 @@
|
|||
(ns cc.journeyman.walkmap.stl
|
||||
"Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
|
||||
(:require
|
||||
[cc.journeyman.walkmap.ocean :refer [ocean?]]
|
||||
[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.vertex :as v]
|
||||
[clojure.lang.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]])
|
||||
(:require [cc.journeyman.walkmap.ocean :refer [ocean?]]
|
||||
[cc.journeyman.walkmap.polygon :refer [centre gradient triangle?]]
|
||||
[cc.journeyman.walkmap.superstructure :refer [store]]
|
||||
[cc.journeyman.walkmap.tag :refer [tag]]
|
||||
[cc.journeyman.walkmap.utils :refer [kind-type truncate]]
|
||||
[cc.journeyman.walkmap.vertex :as v :refer [vertex]]
|
||||
[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
|
||||
|
|
@ -26,27 +30,27 @@
|
|||
(stl? o false))
|
||||
([o verify-count?]
|
||||
(and
|
||||
(map? o)
|
||||
(:facets o)
|
||||
(every? polygon? (:facets o))
|
||||
(if (:header o) (string? (:header o)) true)
|
||||
(if (:count o) (integer? (:count o)) true)
|
||||
(or (nil? (:kind o)) (= (:kind o) :stl))
|
||||
(if verify-count? (= (:count o) (count (:facets o))) true))))
|
||||
(map? o)
|
||||
(: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))
|
||||
(if verify-count? (= (:count o) (count (:facets o))) true))))
|
||||
|
||||
(def vect
|
||||
"A codec for vectors within a binary STL file."
|
||||
(b/ordered-map
|
||||
:x :float-le
|
||||
:y :float-le
|
||||
:z :float-le))
|
||||
:x :float-le
|
||||
:y :float-le
|
||||
:z :float-le))
|
||||
|
||||
(def facet
|
||||
"A codec for a facet (triangle) within a binary STL file."
|
||||
(b/ordered-map
|
||||
:normal vect
|
||||
:vertices [vect vect vect]
|
||||
:abc :ushort-le))
|
||||
:normal vect
|
||||
:vertices [vect vect vect]
|
||||
:abc :ushort-le))
|
||||
|
||||
(def binary-stl
|
||||
"A codec for binary STL files"
|
||||
|
|
@ -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;
|
||||
|
|
@ -67,30 +115,34 @@
|
|||
(canonicalise o map-kind (v/vertex 1 1 1)))
|
||||
([o ^Keyword map-kind scale-vertex]
|
||||
(when-not
|
||||
(keyword? map-kind)
|
||||
(keyword? map-kind)
|
||||
(throw (IllegalArgumentException.
|
||||
(truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
|
||||
(truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
|
||||
(cond
|
||||
(and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
|
||||
;; 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")))
|
||||
:facets (canonicalise (:facets o) map-kind))
|
||||
:kind :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
|
||||
(centre
|
||||
(tag
|
||||
(assoc o
|
||||
:walkmap.id/id (or
|
||||
(:walkmap.id/id o)
|
||||
(keyword (gensym "poly")))
|
||||
:kind :polygon
|
||||
:vertices (canonicalise
|
||||
(:vertices o)
|
||||
map-kind))
|
||||
:facet map-kind)))]
|
||||
(centre
|
||||
(tag
|
||||
(assoc o
|
||||
:walkmap.id/id (or
|
||||
(:walkmap.id/id o)
|
||||
(keyword (gensym "poly")))
|
||||
:kind :polygon
|
||||
:vertices (canonicalise
|
||||
(:vertices o)
|
||||
map-kind))
|
||||
:facet map-kind)))]
|
||||
(if (ocean? f)
|
||||
(tag f :ocean :no-traversal)
|
||||
f))
|
||||
|
|
@ -131,7 +183,7 @@
|
|||
(let [in (input-stream filename)
|
||||
stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)]
|
||||
(if
|
||||
(map? superstructure)
|
||||
(map? superstructure)
|
||||
(store stl superstructure)
|
||||
stl))))
|
||||
|
||||
|
|
@ -140,13 +192,13 @@
|
|||
|
||||
(defn- facet2str [tri]
|
||||
(str
|
||||
(vect->str "facet normal" (:normal tri))
|
||||
"outer loop\n"
|
||||
(s/join
|
||||
(map
|
||||
#(vect->str "vertex" %)
|
||||
(:vertices tri)))
|
||||
"endloop\nendfacet\n"))
|
||||
(vect->str "facet normal" (:normal tri))
|
||||
"outer loop\n"
|
||||
(s/join
|
||||
(map
|
||||
#(vect->str "vertex" %)
|
||||
(:vertices tri)))
|
||||
"endloop\nendfacet\n"))
|
||||
|
||||
(defn stl->ascii
|
||||
"Return as a string an ASCII rendering of the `stl` structure."
|
||||
|
|
@ -154,17 +206,17 @@
|
|||
(stl->ascii stl "unknown"))
|
||||
([stl solidname]
|
||||
(str
|
||||
"solid "
|
||||
solidname
|
||||
(s/trim (:header stl))
|
||||
"\n"
|
||||
(s/join
|
||||
(map
|
||||
facet2str
|
||||
(:facets stl)))
|
||||
"endsolid "
|
||||
solidname
|
||||
"\n")))
|
||||
"solid "
|
||||
solidname
|
||||
(s/trim (:header stl))
|
||||
"\n"
|
||||
(s/join
|
||||
(map
|
||||
facet2str
|
||||
(:facets stl)))
|
||||
"endsolid "
|
||||
solidname
|
||||
"\n")))
|
||||
|
||||
(defn write-ascii-stl
|
||||
"Write an `stl` structure as read by `decode-binary-stl` to this
|
||||
|
|
@ -172,13 +224,13 @@
|
|||
([filename stl]
|
||||
(let [b (base-name filename true)]
|
||||
(write-ascii-stl
|
||||
filename stl
|
||||
(subs b 0 (or (s/index-of b ".") (count b))))))
|
||||
filename stl
|
||||
(subs b 0 (or (s/index-of b ".") (count b))))))
|
||||
([filename stl solidname]
|
||||
(debug "Solid name is " solidname)
|
||||
(spit
|
||||
filename
|
||||
(stl->ascii stl solidname))))
|
||||
filename
|
||||
(stl->ascii stl solidname))))
|
||||
|
||||
(defn binary-stl-to-ascii
|
||||
"Convert the binary STL file indicated by `in-filename`, and write it to
|
||||
|
|
@ -187,15 +239,15 @@
|
|||
([in-filename]
|
||||
(let [[_ ext] (split-ext in-filename)]
|
||||
(binary-stl-to-ascii
|
||||
in-filename
|
||||
(str
|
||||
(subs
|
||||
in-filename
|
||||
0
|
||||
(or
|
||||
(s/last-index-of in-filename ".")
|
||||
(count in-filename)))
|
||||
".ascii"
|
||||
ext))))
|
||||
in-filename
|
||||
(str
|
||||
(subs
|
||||
in-filename
|
||||
0
|
||||
(or
|
||||
(s/last-index-of in-filename ".")
|
||||
(count in-filename)))
|
||||
".ascii"
|
||||
ext))))
|
||||
([in-filename out-filename]
|
||||
(write-ascii-stl out-filename (decode-binary-stl in-filename))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue