This namespace provides all core entities and operators to evolve 3d meshes from a single seed form as described superficially in index.org. The architecture defined here is easily extensible to support custom tree nodes & operators acting on them.
In order to apply nested transformation to a given seed form, we need to define a tree structure. For our approach we will actually use two of them: one to define the nesting of operators and another one to define temporary tree nodes representing the actual transformed geometries. The latter is merely an internal implementation detail and users of the library will only have to mainly deal with the operator tree. On the other hand, this dichotomy allows users to easily add their own operators & geometry node types and mix them with the defaults provided here.
The default morphogen tree node is represented spatially as a freeform box with the following properties:
e +----+ h |\ :\ |f+----+ g | | : | a +-|--+d| \| \| b +----+ c
- 8 points
- 6 faces (quads)
- parent node
- tree depth
The quads are only an implied property and can be computed on demand
via the faces method of the INode protocol:
The INode protocol is part of the abstraction mechanism to allow for
future extensions of morphogen functionality and ensures the overall
functionality is not bound to the default box-shaped entities defined
here. The protocol is purely used to define basic operations for
navigating the tree (e.g. some operators might want access to parent
nodes in order to achieve constraints etc.). Node types also must
provide (partial) implementations of the IVertexAccess &
IFaceAccess protocols defined in the thi.ng.geom.core namespace to
extract points & facets for final mesh assembly:
(defprotocol INode
(parent [_] "Returns the node's parent or `nil` if node is the root")
(tree-depth [_] "Returns the node's tree depth")
(operator-node [_] "Returns related node from operator tree")
(with-operator-node [_ op] "Returns same node with new operator node attached")
(face-vertices [_ face] "Returns vertices for given face ID")
(face-topology [_] "Returns number of vertices used for each face in the node"))The face-topology method isn’t used at current, but will be useful
in the future to restrict operator use to only compatible node types
(e.g. some operators cannot be used with triangular bases).
The table below shows the relationship between face IDs and box vertices (see above diagram for reference):
| **Description** | **Face ID** | **Vertices** |
|---|---|---|
| East | :e | [c d h g] |
| West | :w | [a b f e] |
| North | :n | [e f g h] |
| South | :s | [a d c b] |
| Front | :f | [b c g f] |
| Back | :b | [d a e h] |
We also define a map for looking up the opposite face ID for each side. This will become useful for some operators (e.g. extrusion).
(def face-opposite {:e :w, :w :e, :n :s, :s :n, :f :b, :b :f})According to the above information, the default tree node
implementation is defining nodes as defrecord’s, with its :points
field being a vector of the 8 box vertices (in this order: a, b, c .. h).
(defrecord BoxNode [points parent op-node depth]Of course, the node type must implement the above mentioned protocols
in order to participate in the tree transformation process and
generate resulting geometries. The faces implementation returns a
vector of 6 quads arranged as shown in the diagram above.
IMPORTANT: The vertex ordering of each face must be counterclockwise in order to produce outward facing face normals.
INode
(parent [_] parent)
(tree-depth [_] depth)
(operator-node [_] op-node)
(with-operator-node [_ op] (assoc _ :op-node op))
(face-vertices
[{[a b c d e f g h] :points} side]
(case side
:e [c d h g]
:w [a b f e]
:n [e f g h]
:s [a d c b]
:f [b c g f]
:b [d a e h]))
(face-topology [_] 4)
g/IBounds
(bounds [_] (gu/bounding-box (:points _)))
(width [_] (gu/axis-range 0 (:points _)))
(height [_] (gu/axis-range 1 (:points _)))
(depth [_] (gu/axis-range 2 (:points _)))
g/IVertexAccess
(vertices [_] points)
g/IFaceAccess
(faces
[{[a b c d e f g h] :points}]
[[[b c g f]] ;; front
[[d a e h]] ;; back
[[a b f e]] ;; west
[[c d h g]] ;; east
[[e f g h]] ;; north
[[a d c b]]] ;; south
)Additionally, this node type also implements the ISubdivide protocol
defined in the thi.ng/geom library.
g/ISubdivide
(subdivide
[_ {:keys [cols rows slices] :or {cols 1 rows 1 slices 1}}]
(let [ru (d/successive-nth 2 (m/norm-range cols))
rv (d/successive-nth 2 (m/norm-range rows))
rw (d/successive-nth 2 (m/norm-range slices))
map-p (fn [p] (->> p (gu/map-trilinear points) (map #(m/roundto % *eps*)) vec3))]
(for [[w1 w2] rw, [v1 v2] rv, [u1 u2] ru]
(mapv map-p [[u1 v1 w1] [u1 v1 w2] [u2 v1 w2] [u2 v1 w1]
[u1 v2 w1] [u1 v2 w2] [u2 v2 w2] [u2 v2 w1]])))))Since the seed form needs to be a valid BoxNode instance (or at
least implement the INode protocol) in order to be transformed, the
following constructor function can create a BoxNode in different
ways:
(defn seed-box
[x]
(let [points (cond
(number? x) (g/vertices (a/aabb x))
(sequential? x) (mapv vec3 x)
(satisfies? g/IVertexAccess x) (g/vertices x))]
(BoxNode. points nil nil 0)))Node operators are responsible for transforming a geometry node to
manipulate its points and/or produce a number of child nodes. Through
their nested application they can produce a large number of resulting
forms. The operators defined here are only applicable to the BoxNode
type, but as we will see they’re technically trivial and can be used
as guidance to provide similar operators for custom nodes.
The following operators are currently implemented:
| Operator | ID | Description |
|---|---|---|
| Subdivision | :sd | Regular subdivision resulting in self-similar children |
| Inset subdivision | :sd-inset | Subdivision through insetting along an axis |
| Reflection | :reflect | Reflection of entire node on one of its sides |
| Replication | :replicate | Replication of entire node on one of its sides |
| Extrusion | :extrude | Extrusion of the node along the normal of one of its sides |
| Scale edge(s) | :scale-edge | Scale an edge and set its symmetric opposite (in X, Y or Z) to same length |
The ID column states the IDs used to match operators to their
implementation using the operator multimethod, described below.
Unlike the route taken for geometry nodes (using protocols & defrecords), operator nodes (the entire tree, really) are simple Clojure maps with this basic structure:
{:op :operator-id ;; multimethod operator id
:args {:foo 23 :bar 42 ...} ;; map of arbitrary transformation arguments
:out [{:op ...} nil {} ...] ;; vector of nested child operators
}The :out vector deserves some more attention and discussion how
tree evaluation work in our case: At the first iteration the root node
operator is applied to the given seed form. Different operators
(and their given arguments) will produce different numbers
of geometry child nodes. For example, whereas the Reflection operator
will always return two nodes (the original and reflected version), the
Regular subdivision operator can produce any number of children. Based
on that, the :out vector of an operator node should have the same
number of elements as is produced by the operator. The next stage of
tree evaluation is then matching operator elements from the :out
vector to child nodes produced by the operator and is descending
further into the tree.
An interesting aspect of this approach is that we can terminate
branches by explicitly setting elements of this :out vector to
nil. If that is the case, no further descent is possible and no mesh
will be collected from the related geometry node. Therefore, this
mechanism can be used to create holes/concavities in the resulting
mesh structure. Alternatively, we use an empty map {} (without any
:op key) to specify a leaf node of the tree. Final mesh information
is collected /only/ from leaf nodes. Another example illustrates this
better:
{:op :sd
:args {:cols 3}
:out [{} nil {}]}This operator node defines a 3x1 subdivision of the node’s box into 3
columns along its A->D edge (see point layout above) and is therefore
resulting in 3 child nodes. However, the middle element of the :out
vector is nil and is therefore removing the 2nd column entirely. The
other two elements in :out are marked as leaf nodes and therefore
will result in a mesh of two isolated columns. In contrast, the
following example uses the same initial setup, but subdivides the 1st
child node further:
{:op :sd
:args {:cols 3} ;; split root in 3 cols
:out [{:op :sd
:args {:cols 2 :rows 2} ;; split 1st child into 2x2
:out [nil nil nil {}]} ;; only keep top-right child
nil ;; ignore 2nd child of root
{}]} ;; mark last child as leaf (no-op)As stated previously, the operators are implemented as Clojure multimethod in order to allow for easy addition of custom operators without requiring any other changes. The multimethod is using both the geometry node type and operator ID to dispatch to the actual implementations:
(defmulti operator
(fn [g-node op-node]
(if (:op op-node) [(type g-node) (:op op-node)])))
;; leaf node operator (no-op)
(defmethod operator nil [_ _] nil)
| Argument | Value description | Default |
|---|---|---|
:cols | number of splits along AD edge | 1 |
:rows | number of splits along AE edge | 1 |
:slices | number of splits along AB edges | 1 |
(defmethod operator [BoxNode :sd]
[^BoxNode node {:keys [args] :as op}]
(let [depth (inc (tree-depth node))]
(->> (g/subdivide node args)
(mapv #(BoxNode. % node op depth)))))
The inset subdivision operator is splitting a node along one of its local major axes (X, Y or Z) in the following formation, resulting in five child nodes in the specified order:
+---------+ |\ 2 /| | +-----+ | |3| 5 |4| | +-----+ | |/ 1 \| +---------+
| Argument | Value description | Default |
|---|---|---|
:dir | :x split from right side (as viewed so that face [c d h g] is front) | :y |
:y from top (as viewed so that face [e f g h] is front) | ||
:z from front (as viewed so that face [b c g f] is front) | ||
:inset | percentage to inset corner points (0.0 … < 0.5) | 0.25 |
(defn subdivide-inset___
[[a b c d e f g h :as points] {i :inset dir :dir :or {i 0.1 dir :y}}]
(let [ii (- 1.0 i)
map-points (fn [base uv]
(mapcat
(fn [[u v]]
[(gu/map-trilinear points (assoc (vec3) uv [u v]))
(gu/map-trilinear points (assoc base uv [u v]))])
[[i i] [i ii] [ii ii] [ii i]]))]
(condp = dir
:x (let [[a1 a2 b1 b2 c1 c2 d1 d2] (map-points v/V3X :yz)]
[[b c d a b1 b2 a2 a1]
[c1 c2 d2 d1 f g h e]
[b c b2 b1 f g c2 c1]
[a1 a2 d a d1 d2 h e]
[b1 b2 a2 a1 c1 c2 d2 d1]])
:y (let [[a1 a2 b1 b2 c1 c2 d1 d2] (map-points v/V3Y :xz)]
[[b1 b c c1 b2 f g c2]
[a a1 d1 d e a2 d2 h]
[a b b1 a1 e f b2 a2]
[d1 c1 c d d2 c2 g h]
[a1 b1 c1 d1 a2 b2 c2 d2]])
:z (let [[a1 a2 b1 b2 c1 c2 d1 d2] (map-points v/V3Z :xy)]
[[a b c d a1 a2 d2 d1]
[b1 b2 c2 c1 e f g h]
[a b a2 a1 e f b2 b1]
[d1 d2 c d c1 c2 g h]
[a1 a2 d2 d1 b1 b2 c2 c1]]))))
(defn subdivide-inset
[[a b c d e f g h :as points] {i :inset dir :dir :or {i 0.1 dir :y}}]
(case dir
:x (let [[a2 b2 f2 e2] (q/inset-quad [a b f e] i)
[c2 d2 h2 g2] (q/inset-quad [c d h g] i)]
[[b c d a b2 c2 d2 a2]
[f2 g2 h2 e2 f g h e]
[b c c2 b2 f g g2 f2]
[a2 d2 d a e2 h2 h e]
[b2 c2 d2 a2 f2 g2 h2 e2]])
:y (let [[a2 b2 c2 d2] (q/inset-quad [a b c d] i)
[e2 f2 g2 h2] (q/inset-quad [e f g h] i)]
[[b2 b c c2 f2 f g g2]
[a a2 d2 d e e2 h2 h]
[a b b2 a2 e f f2 e2]
[d2 c2 c d h2 g2 g h]
[a2 b2 c2 d2 e2 f2 g2 h2]])
:z (let [[a2 d2 h2 e2] (q/inset-quad [a d h e] i)
[b2 c2 g2 f2] (q/inset-quad [b c g f] i)
p' [a2 b2 c2 d2 e2 f2 g2 h2]]
(if (some nil? p')
(do
;;(prn points)
;;(prn p')
;;(prn "----")
[points])
[[a b c d a2 b2 c2 d2]
[e2 f2 g2 h2 e f g h]
[a b b2 a2 e f f2 e2]
[d2 c2 c d h2 g2 g h]
[a2 b2 c2 d2 e2 f2 g2 h2]]))))
(defmethod operator [BoxNode :sd-inset]
[^BoxNode node {:keys [args] :as op}]
(let [depth (inc (tree-depth node))]
(->> (subdivide-inset (:points node) args)
(mapv #(BoxNode. % node op depth)))))
| Argument | Value description | Default |
|---|---|---|
:dir | :e reflect on right plane [c d h g] | :n |
:w left plane [a b f e] | ||
:n top plane [e f g h] | ||
:s bottom plane [a b c d] | ||
:f front plane [b c g f] | ||
:b back plane [a d h e] | ||
:len | Extrusion length | 1.0 |
(defn- offset
[^thi.ng.geom.vector.Vec3 a b len]
(let [^thi.ng.geom.vector.Vec3 d (m/- a b)
m (/ len (m/mag d))
^doubles ba (.-buf a)
^doubles bd (.-buf d)
^doubles dest #?(:clj (double-array 3) :cljs (js/Float32Array. 3))]
(aset dest 0 (double (mm/madd (aget bd 0) m (aget ba 0))))
(aset dest 1 (double (mm/madd (aget bd 1) m (aget ba 1))))
(aset dest 2 (double (mm/madd (aget bd 2) m (aget ba 2))))
(thi.ng.geom.vector.Vec3. dest nil nil)))
(defmethod operator [BoxNode :extrude]
[^BoxNode node {{:keys [dir len] :or {dir :n len 1.0}} :args :as op}]
(let [c1 (gu/centroid (face-vertices node dir))
c2 (gu/centroid (face-vertices node (face-opposite dir)))
n (m/normalize (m/- c1 c2) len)]
[(BoxNode.
(offset-face-points (:points node) dir n)
node op (inc (tree-depth node)))]))
(defmethod operator [BoxNode :ext-prop]
[{[a b c d e f g h] :points :as node}
{{:keys [dir len] :or {dir :n len 1.0}} :args :as op}]
[(BoxNode.
(case dir
:e [a b (offset c b len) (offset d a len)
e f (offset g f len) (offset h e len)]
:w [(offset a d len) (offset b c len) c d
(offset e h len) (offset f g len) g h]
:f [a (offset b a len) (offset c d len) d
e (offset f e len) (offset g h len) h]
:b [(offset a b len) b c (offset d c len)
(offset e f len) f g (offset h g len)]
:n [a b c d (offset e a len) (offset f b len)
(offset g c len) (offset h d len)]
:s [(offset a e len) (offset b f len)
(offset c g len) (offset d h len)
e f g h])
node op (inc (tree-depth node)))])The reflection operator simply mirrors a given node on one of its sides and returns the original node and the mirrored version.
| Argument | Value description | Default |
|---|---|---|
:dir | :e reflect on right plane [c d h g] | :n |
:w left plane [a b f e] | ||
:n top plane [e f g h] | ||
:s bottom plane [a b c d] | ||
:f front plane [b c g f] | ||
:b back plane [a d h e] |
(defn reflect-on-plane
"Reflects point p on plane defined by point q & normal n.
Normal vector must be normalized."
[p ^thi.ng.geom.vector.Vec3 q ^thi.ng.geom.vector.Vec3 n]
(let [^thi.ng.geom.vector.Vec3 r (m/- q p)
d (* (m/dot r n) 2.0)
^doubles bn (.-buf n)
^doubles br (.-buf r)
^doubles bq (.-buf q)
^doubles dest #?(:clj (double-array 3) :cljs (js/Float32Array. 3))]
(aset dest 0 (double (+ (mm/msub (aget bn 0) d (aget br 0)) (aget bq 0))))
(aset dest 1 (double (+ (mm/msub (aget bn 1) d (aget br 1)) (aget bq 1))))
(aset dest 2 (double (+ (mm/msub (aget bn 2) d (aget br 2)) (aget bq 2))))
(thi.ng.geom.vector.Vec3. dest nil nil)))
(defmethod operator [BoxNode :reflect]
[{[a b c d e f g h] :points :as node}
{{:keys [dir] :or {dir :n}} :args :as op}]
[node
(BoxNode.
(case dir
:e (let [n (gu/ortho-normal c d g)]
[d c (reflect-on-plane b c n) (reflect-on-plane a d n)
h g (reflect-on-plane f g n) (reflect-on-plane e h n)])
:w (let [n (gu/ortho-normal a b f)]
[(reflect-on-plane d a n) (reflect-on-plane c b n) b a
(reflect-on-plane h e n) (reflect-on-plane g f n) f e])
:s (let [n (gu/ortho-normal a c b)]
[(reflect-on-plane e a n) (reflect-on-plane f b n)
(reflect-on-plane g c n) (reflect-on-plane h d n)
a b c d])
:n (let [n (gu/ortho-normal e f g)]
[e f g h
(reflect-on-plane a e n) (reflect-on-plane b f n)
(reflect-on-plane c g n) (reflect-on-plane d h n)])
:f (let [n (gu/ortho-normal b c g)]
[b (reflect-on-plane a b n) (reflect-on-plane d c n) c
f (reflect-on-plane e f n) (reflect-on-plane h g n) g])
:b (let [n (gu/ortho-normal a e h)]
[(reflect-on-plane b a n) a d (reflect-on-plane c d n)
(reflect-on-plane f e n) e h (reflect-on-plane g h n)]))
node op (inc (tree-depth node)))])(defmethod operator [BoxNode :replicate]
[{[a b c d e f g h] :points :as node} {{:keys [dir] :or {dir :n}} :args :as op}]
[node
(BoxNode.
(case dir
:f (let [ba (m/- b a)
cd (m/- c d)
fe (m/- f e)
gh (m/- g h)]
[(m/+ a ba) (m/+ b ba) (m/+ c cd) (m/+ d cd)
(m/+ e fe) (m/+ f fe) (m/+ g gh) (m/+ h gh)])
:b (let [ab (m/- a b)
dc (m/- d c)
ef (m/- e f)
hg (m/- h g)]
[(m/+ a ab) (m/+ b ab) (m/+ c dc) (m/+ d dc)
(m/+ e ef) (m/+ f ef) (m/+ g hg) (m/+ h hg)])
:n (let [ea (m/- e a)
fb (m/- f b)
gc (m/- g c)
hd (m/- h d)]
[(m/+ a ea) (m/+ b fb) (m/+ c gc) (m/+ d hd)
(m/+ e ea) (m/+ f fb) (m/+ g gc) (m/+ h hd)])
:s (let [ae (m/- a e)
bf (m/- b f)
cg (m/- c g)
dh (m/- d h)]
[(m/+ a ae) (m/+ b bf) (m/+ c cg) (m/+ d dh)
(m/+ e ae) (m/+ f bf) (m/+ g cg) (m/+ h dh)])
:e (let [da (m/- d a)
cb (m/- c b)
he (m/- h e)
gf (m/- g f)]
[(m/+ a da) (m/+ b cb) (m/+ c cb) (m/+ d da)
(m/+ e he) (m/+ f gf) (m/+ g gf) (m/+ h he)])
:w (let [ad (m/- a d)
bc (m/- b c)
eh (m/- e h)
fg (m/- f g)]
[(m/+ a ad) (m/+ b bc) (m/+ c bc) (m/+ d ad)
(m/+ e eh) (m/+ f fg) (m/+ g fg) (m/+ h eh)]))
node op (inc (tree-depth node)))])| Argument | Value description | Default |
|---|---|---|
:edge | :ab, :bc, :cd, :ad (bottom face edges) | nil |
:ef, :fg, :gh, :eh (top face edges) | (mandatory) | |
:ae, :bf, :cg, :dh (sides) | ||
:sym | :x also scale edge on opposite side (along :ad edge) | nil |
:y (along :ae edge) | (mandatory) | |
:z (along :ab edge) | ||
:scale | scale factor | 0.5 |
(defmethod operator [BoxNode :scale-edge]
[{[a b c d e f g h] :points :as node}
{{:keys [edge sym scale len] :or {scale 0.5}} :args :as op}]
(let [scale-if (fn [sid p q s]
(if (= sid sym)
(let [c (m/mix p q)]
[(m/madd (m/- p c) s c) (m/madd (m/- q c) s c)])
[p q]))
scale (fn [p q s1 i j s2 k l]
(let [ll (g/dist p q)
dpq (or len (* ll scale))
s (/ dpq ll)
c (m/mix p q)
p' (m/madd (m/- p c) s c)
q' (m/madd (m/- q c) s c)
[i j] (scale-if s1 i j (/ dpq (g/dist i j)))
[k l] (scale-if s2 k l (/ dpq (g/dist k l)))]
[p' q' i j k l]))]
[(BoxNode.
(case edge
;; bottom
:ab (let [[a b c d e f] (scale a b :x c d :y e f)]
[a b c d e f g h])
:bc (let [[b c a d f g] (scale b c :z a d :y f g)]
[a b c d e f g h])
:cd (let [[c d a b g h] (scale c d :x a b :y g h)]
[a b c d e f g h])
:ad (let [[a d b c e h] (scale a d :z b c :y e h)]
[a b c d e f g h])
;; top
:ef (let [[e f g h a b] (scale e f :x g h :y a b)]
[a b c d e f g h])
:fg (let [[f g e h b c] (scale f g :z e h :y b c)]
[a b c d e f g h])
:gh (let [[g h e f c d] (scale g h :x e f :y c d)]
[a b c d e f g h])
:eh (let [[e h f g a d] (scale e h :z f g :y a d)]
[a b c d e f g h])
;; left
:ae (let [[a e d h b f] (scale a e :x d h :z b f)]
[a b c d e f g h])
:bf (let [[b f c g a e] (scale b f :x c g :z a e)]
[a b c d e f g h])
;; right
:cg (let [[c g b f d h] (scale c g :x b f :z d h)]
[a b c d e f g h])
:dh (let [[d h a e c g] (scale d h :x a e :z c g)]
[a b c d e f g h]))
node op (inc (tree-depth node)))]))
(defn make-planar
[a b c d]
(let [pabc (pl/plane-from-points a b c)
pabd (pl/plane-from-points a b d)
pacd (pl/plane-from-points a c d)
pbcd (pl/plane-from-points b c d)]
(mapv #(g/dist % %2) [pbcd pacd pabd pabc] [a b c d])))
(defmethod operator [BoxNode :scale-side]
[{[a b c d e f g h] :points :as node}
{{:keys [side scale] :or {scale 0.5}} :args :as op}]
(let [s (* (- 1.0 scale) 0.5)
[fa fb fc fd] (face-vertices node side)
[fa fb fc fd] (mapv (fn [[p q]] (m/mix p q s)) [[fa fc] [fb fd] [fc fa] [fd fb]])]
[(BoxNode.
(case side
:e [a b fa fb e f fd fc]
:w [fa fb c d fd fc g h]
:n [a b c d fa fb fc fd]
:s [fa fd fc fb e f g h]
:f [a fa fb d e fd fc h]
:b [fb b c fa fc f g fd])
node op (inc (tree-depth node)))]))(defmethod operator [BoxNode :skew]
[{[a b c d e f g h] :points :as node}
{{:keys [side ref offset] :or {offset 0.5}} :args :as op}]
(let [n (if (v/vec3? offset)
offset
(m/* (quad-normal (face-vertices node ref)) offset))]
;;(prn side ref n)
[(BoxNode.
(case side
:e [a b (m/+ c n) (m/+ d n) e f (m/+ g n) (m/+ h n)]
:w [(m/+ a n) (m/+ b n) c d (m/+ e n) (m/+ f n) g h]
:n [a b c d (m/+ e n) (m/+ f n) (m/+ g n) (m/+ h n)]
:s [(m/+ a n) (m/+ b n) (m/+ c n) (m/+ d n) e f g h]
:f [a (m/+ b n) (m/+ c n) d e (m/+ f n) (m/+ g n) h]
:b [(m/+ a n) b c (m/+ d n) (m/+ e n) f g (m/+ h n)])
node op (inc (tree-depth node)))]))
(defmethod operator [BoxNode :skew2]
[{[a b c d e f g h] :points :as node}
{{:keys [side dir offset] :or {offset 0.5}} :args :as op}]
(let [[fa fb fc fd] (face-vertices node side)
skew-vec (if (v/vec3? offset)
(constantly offset)
(fn [a b c d]
(m/normalize (m/- (m/mix a b) (m/mix c d)) offset)))]
[(BoxNode.
(case side
:e (let [n (case dir
:z (skew-vec fa fd fb fc)
:y (skew-vec fc fd fb fa))]
[a b (m/+ c n) (m/+ d n) e f (m/+ g n) (m/+ h n)])
:w (let [n (case dir
:z (skew-vec fb fc fa fd)
:y (skew-vec fc fd fb fa))]
[(m/+ a n) (m/+ b n) c d (m/+ e n) (m/+ f n) g h])
:n (let [n (case dir
:z (skew-vec fb fc fa fd)
:x (skew-vec fc fd fa fb))]
[a b c d (m/+ e n) (m/+ f n) (m/+ g n) (m/+ h n)])
:s (let [n (case dir
:z (skew-vec fc fd fa fb)
:x (skew-vec fb fc fa fd))]
[(m/+ a n) (m/+ b n) (m/+ c n) (m/+ d n) e f g h])
:f (let [n (case dir
:y (skew-vec fd fc fa fb)
:x (skew-vec fb fc fa fd))]
[a (m/+ b n) (m/+ c n) d e (m/+ f n) (m/+ g n) h])
:b (let [n (case dir
:x (skew-vec fd fc fa fb)
:y (skew-vec fb fc fa fd))]
[(m/+ a n) b c (m/+ d n) (m/+ e n) f g (m/+ h n)]))
node op (inc (tree-depth node)))]))(defmethod operator [BoxNode :split-displace]
[{[a b c d e f g h] :points :as node}
{{:keys [dir ref offset] :or {offset 0.5}} :args :as op}]
(let [sd-dir ({:x :cols :y :rows :z :slices} dir)
children (operator node {:op :sd :args {sd-dir 2}})]
(mapcat
(fn [c side]
(operator c {:op :skew2
:args {:side side :dir ref :offset offset}
:attribs (:attribs op)}))
children
(case dir
:x [:e :w]
:y [:n :s]
:z [:f :b]))))
(defmethod operator [BoxNode :split-displace2]
[{[a b c d e f g h] :points :as node}
{{:keys [dir ref offset] :or {offset 0.5}} :args :as op}]
(let [sd-dir ({:x :cols :y :rows :z :slices} dir)
children (operator node {:op :sd :args {sd-dir 2}})
offset (m/* (quad-normal (face-vertices node ({:x :e :y :n :z :f} ref))) offset)]
(mapcat
(fn [c side]
(operator c {:op :skew2
:args {:side side :dir ref :offset offset}
:attribs (:attribs op)}))
children
(case dir
:x [:e :w]
:y [:n :s]
:z [:f :b]))))(defn operator-output
[n out empty?]
(let [default (vec (repeat n (if empty? nil {})))]
(cond
(map? out) (reduce-kv assoc default out)
(sequential? out) (vec out)
:default default)))
(defn subdiv
[& {:keys [cols rows slices num out empty?] :or {cols 1 rows 1 slices 1}}]
(let [[cols rows slices] (if num [num num num] [cols rows slices])]
{:op :sd
:args {:cols cols :rows rows :slices slices}
:out (operator-output (* cols rows slices) out empty?)}))
(defn subdiv-inset
[& {:keys [dir inset out empty?] :or {dir :y inset 0.25}}]
{:op :sd-inset
:args {:dir dir :inset inset}
:out (operator-output 5 out empty?)})
(defn reflect
[dir & {:keys [out empty?] :or {dir :n}}]
{:op :reflect
:args {:dir dir}
:out (operator-output 2 out empty?)})
(defn replicate
[dir & {:keys [out empty?]}]
{:op :replicate
:args {:dir dir}
:out (operator-output 2 out empty?)})
(defn extrude
[& {:keys [dir len out empty?] :or {dir :n len 1.0}}]
{:op :extrude
:args {:dir dir :len len}
:out (operator-output 1 out empty?)})
(defn extrude-prop
[& {:keys [dir len out empty?] :or {dir :n len 1.0}}]
{:op :ext-prop
:args {:dir dir :len len}
:out (operator-output 1 out empty?)})
(defn scale-edge
[edge sym & {:keys [scale len out] :or {scale 0.5}}]
{:op :scale-edge
:args {:edge edge :sym sym :scale scale :len len}
:out (operator-output 1 out false)})
(defn skew
[side ref & {:keys [offset out] :or {offset 0.25}}]
{:op :skew
:args {:side side :ref ref :offset offset}
:out (operator-output 1 out false)})
(defn split-displace
[dir ref & {:keys [offset out] :or {offset 0.25}}]
{:op :split-displace2
:args {:dir dir :ref ref :offset offset}
:out (operator-output 2 out false)})(defn reflect-seq
"Takes a seq of direction keys and optional `leaf` tree. Builds a
tree encoding a nested reflection sequence in the order given. If
`leaf` is specified, injects it at the end of the nested
reflection."
[dirs & [leaf]]
(reduce
(fn [t dir] (reflect dir :out [{} t])) (or leaf {})
(reverse dirs)))The following little functions are truly at the heart of this library and responsible for walking the operator tree, applying all transformations and collecting mesh geometries from any leaf nodes.
In order to help with debugging complex trees, but also to allow for only partial descents into the tree, a maximum tree depth can be specified to stop further descending and consider nodes at this depth as leaves. This way it’s also easy to create an animation of the tree transformation.
(defn execute-op-tree
[leaf-fn acc node tree max-depth]
;;(prn :d (tree-depth node) (:points node) tree)
(if (< (tree-depth node) max-depth)
(let [children (operator node tree)]
(if children
(loop [acc acc, children children, out (get tree :out)]
(if (and out children)
(let [ctree (first out)]
(recur
(if ctree (execute-op-tree leaf-fn acc (first children) ctree max-depth) acc)
(next children) (next out)))
acc))
(leaf-fn acc node)))
(leaf-fn acc node)))Some use cases require access to the complete computed state of the
operator tree. E.g. In an interactive editor built around morphogen,
a user might want to manipulate the resulting object only at deeper
levels of the hierarchy. In this case it might be prohibitive from a
performance POV to recompute the entire operator tree, if actually
only the nodes below (and including) the edit point are impacted. The
compute-tree-map function addresses this and is meant as an
initialization step. It walks the tree in a similar manner as the
walk-with function above. However, instead of returning a seq of face
lists of the resulting meshes of all leaf nodes, this function
produces a map of all computed geometry nodes, each with its path
(cursor) into the operator tree as key.
For example using this operator tree:
{:op :sd,
:args {:cols 2},
:out [{:op :reflect, :args {:dir :n}, :out [nil {}]} {}]}…produces a map like this (node :parent keys elided for simplicity):
{[] {:points [...] :depth 0}
[0] {:points [...] :depth 1}
[0 0] {:points [...] :depth 2}
[0 1] {:points [...] :depth 2}
[1] {:points [...] :depth 1}}Note, that the map retains geometry nodes also for deleted children.
In the example tree, the first child of the :reflect operator should
be removed, however its geometry node is kept in the map for cases
when a user wants to replace the delete op with another operator later
on. This would not be easily possible if such nodes would be excluded
from this map. Because of this, and in order to find out if a node in
this map should produce geometry in the final result mesh, it is
necessary to consult the operator tree at the cursor position for each
mapped node. This can be easily done via a checks using the following
helper function, which given an operator tree, classifies node cursors
as :operator, :leaf or nil (the latter for deleted nodes so that
the fn can be used as predicate).
(defn classify-node-at
[op-tree cursor]
(let [n (get-in op-tree (child-path cursor))]
(cond
(:op n) :operator
n :leaf
:else nil)))Next up, the actual implementation of compute-tree-map:
(defn compute-tree-map*
[node tree acc path]
(let [children (operator node tree)]
(if children
(loop [acc (assoc! acc path node), children children, out (get tree :out), i 0]
(if (and out children)
(let [c (first children)
ctree (first out)
cpath (conj path i)]
(recur
(if ctree
(compute-tree-map* c ctree acc cpath)
(assoc! acc cpath c))
(next children) (next out) (inc i)))
acc))
(assoc! acc path node))))
(defn compute-tree-map
[seed tree]
(persistent! (compute-tree-map* seed tree (transient {}) [])))(defn walk-op-tree
[f acc node depth]
(let [d (inc depth)]
(if-let [children (:out node)]
(reduce #(walk-op-tree f % %2 d) acc children)
(f acc node depth))))
(defn op-tree-depth
[tree] (walk-op-tree (fn [acc _ d] (max acc d)) 0 tree 0))For UI or visualization purposes it is useful to obtain a flattened
version of the operator tree. E.g. For the Co(de)Factory project we
use color coding to produce a barcode-like overview of the operator
tree of each created object. The functions operator-seq and
operator-seq-no-leaves walk the tree in depth-first, pre-order and
produce a seq of all operator IDs. Empty (deleted, nil nodes) and
leaf nodes (without any operator) will be mapped to :delete &
:leaf respectively. operator-seq-no-leaves only includes nodes
with actual operators, but no deletions or leaves.
(defn- operator-seq*
[f]
(fn opseq*
[acc node]
(reduce opseq* (f acc node) (:out node))))
(defn operator-seq
[node]
(->> node
((operator-seq*
(fn [acc node]
(conj! acc
(cond
(:op node) (:op node)
(nil? node) :delete
:else :leaf))))
(transient []))
(persistent!)))
(defn operator-seq-no-leaves
[node]
(->> node
((operator-seq*
(fn [acc node]
(if-let [op (:op node)] (conj! acc op) acc)))
(transient []))
(persistent!)))(defn quad-normal
"Takes 4 points (or a seq of 4 points), returns vector perdendicular
to the 2 diagonals of the quad"
([[a b c d]] (quad-normal a b c d))
([a b c d] (gu/ortho-normal (m/- c a) (m/- d b))))
(defn offset-face-points
[[a b c d e f g h] side n]
(case side
:e [a b (m/+ c n) (m/+ d n) e f (m/+ g n) (m/+ h n)]
:w [(m/+ a n) (m/+ b n) c d (m/+ e n) (m/+ f n) g h]
:n [a b c d (m/+ e n) (m/+ f n) (m/+ g n) (m/+ h n)]
:s [(m/+ a n) (m/+ b n) (m/+ c n) (m/+ d n) e f g h]
:f [a (m/+ b n) (m/+ c n) d e (m/+ f n) (m/+ g n) h]
:b [(m/+ a n) b c (m/+ d n) (m/+ e n) f g (m/+ h n)]))
(defn child-path
"Takes a seq of child indices and constructs a lookup path/vector
for them by interleaving `:out` in the seq:
(child-path [1 0 2]) => [:out 1 :out 0 :out 2]"
[path] (vec (interleave (repeat :out) path)))
(defn inject
"Almost like assoc-in, but transforms lookup path with `child-path`."
[t path t']
(assoc-in t (child-path path) t'))
(defn apply-recursively
"Recursively injects tree into itself `n` times, starting at given
child path. At each subsequent level, the original tree given is
injected at index `id` of the `:out` child node vector. The initial
path is simply given as a seq of indices and will be translated into
an actual lookup path using the `child-path` fn."
[tree n path id]
(loop [t' tree, path (child-path path), n (dec n)]
(if (pos? n)
(recur (assoc-in t' path tree) (into path [:out id]) (dec n))
t')))
(defn map-leaves
"Takes a fn and operator tree, applies f to all leaf nodes. The fn
must accept 3 args: the leaf's parent node, the child index of the
leaf in the parent and the tree depth. The leaf will be replaced
with the fn's return value."
([f tree] (map-leaves f tree 0))
([f tree depth]
(->> (:out tree)
(interleave (range))
(partition 2)
(reduce
(fn [acc [i c]]
(cond
(seq (:out c)) (assoc-in acc [:out i] (map-leaves f c (inc depth)))
(map? c) (assoc-in acc [:out i] (f acc i depth))
:default acc))
tree))))(defn circle-lattice-seg
[n h wall]
(let [theta (/ m/PI n)
off (vec3 0 0 h)
points (g/vertices (g/rotate (g/as-polygon (c/circle) n) (- (- HALF_PI) theta)))
[b c] (map vec3 points)
[a d] (map vec3 (p/inset-polygon points (- wall)))
[f g] (map #(m/+ off %) [b c])
[e h] (map #(m/+ off %) [a d])]
[b f g c a e h d]))
(defn sphere-lattice-seg
[n h inset wall]
(let [theta (/ m/PI n)
off (vec3 0 0 h)
points (g/vertices (g/rotate (g/as-polygon (c/circle) n) (- (- HALF_PI) theta)))
[b c] (map vec3 points)
[a d] (map vec3 (p/inset-polygon points (- wall)))
[f g] (map #(m/+ off %) (p/inset-polygon points (- inset)))
[e h] (map #(m/+ off %) (p/inset-polygon points (- (- inset) wall)))]
[b f g c a e h d]))
(defn sphere-lat
[resu resv wall]
(let [r1 (- 1.0 wall)
lat2 (/ PI resv)
lat1 (- lat2)
lon2 (/ PI resu)
lon1 (- lon2)]
(->> [(vec3 r1 lat1 lon1)
(vec3 1 lat1 lon1)
(vec3 1 lat1 lon2)
(vec3 r1 lat1 lon2)
(vec3 r1 lat2 lon1)
(vec3 1 lat2 lon1)
(vec3 1 lat2 lon2)
(vec3 r1 lat2 lon2)]
(mapv g/as-cartesian))))
;; TODO temporarily disabled result mesh cleaning
;; due to outstanding issues in thi.ng/geom mesh.ops namespace
(defn union-mesh
([meshes]
(union-mesh (bm/basic-mesh) 1e-3 meshes))
([target eps meshes]
(-> (reduce g/into target meshes)
#_(ops/canonicalize-vertices eps)
#_(first)
#_(ops/remove-internal))))
(defn generate-mesh
([seed tree]
(generate-mesh seed tree 1e6))
([seed tree max-depth]
(union-mesh
(persistent!
(execute-op-tree
(fn [acc node] (conj! acc (g/faces node)))
(transient [])
(with-operator-node seed tree)
tree max-depth)))))
#?(:clj
(defn save-obj-mesh
([seed tree] (save-obj-mesh seed tree "out.obj" 1e6))
([seed tree path] (save-obj-mesh seed tree path 1e6))
([seed tree path max-depth]
(with-open [o (io/output-stream path)]
(->> (generate-mesh seed tree max-depth)
(mio/write-obj (mio/wrapped-output-stream o)))))))
#?(:clj
(defn save-stl-mesh
([seed tree] (save-stl-mesh seed tree "out.stl" 1e6))
([seed tree path] (save-stl-mesh seed tree path 1e6))
([seed tree path max-depth]
(with-open [o (io/output-stream path)]
(->> (generate-mesh seed tree max-depth)
(g/tessellate)
(mio/write-stl (mio/wrapped-output-stream o)))))))
#?(:clj
(defn save-ply-mesh
([seed tree] (save-ply-mesh seed tree "out.ply" 1e6))
([seed tree path] (save-ply-mesh seed tree path 1e6))
([seed tree path max-depth]
(with-open [o (io/output-stream path)]
(->> (generate-mesh seed tree max-depth)
(g/tessellate)
(mio/write-ply (mio/wrapped-output-stream o)))))))With all elements in place now, we only need to bundle them all up into a proper Clojure namespace…
(ns thi.ng.morphogen.core
(:refer-clojure :exclude [replicate])
#?(:cljs
(:require-macros
[thi.ng.math.macros :as mm]))
(:require
[thi.ng.geom.core :as g]
[thi.ng.geom.vector :as v :refer [vec3]]
[thi.ng.geom.utils :as gu]
[thi.ng.geom.circle :as c]
[thi.ng.geom.polygon :as p]
[thi.ng.geom.quad :as q]
[thi.ng.geom.plane :as pl]
[thi.ng.geom.aabb :as a]
[thi.ng.geom.cuboid :as cu]
[thi.ng.geom.basicmesh :as bm]
;[thi.ng.geom.mesh.ops :as ops]
[thi.ng.dstruct.core :as d]
[thi.ng.math.core :as m :refer [*eps* TWO_PI PI HALF_PI]]
#?@(:clj
[[thi.ng.math.macros :as mm]
[thi.ng.geom.mesh.io :as mio]
[clojure.java.io :as io]
[clojure.pprint :refer [pprint]]])))
(declare operator child-path)
<<helpers>>
<<proto>>
<<node>>
<<operators>>
<<op-ctors>>
<<tree-walk>>
<<meshing>>