Namespace: thi.ng.morphogen.core

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.

Geometry nodes

BoxNode

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:

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

BoxNode implementation

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

End of implementation

Node constructor

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

Operators

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.

Operator node structure & evaluation

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.

Branch termination & leaf nodes

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 {}]}

insert image

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)

insert image

Operator multimethod

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)

Regular subdivision

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

Inset subdivision

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

Extrusion

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

Reflection

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

Replication

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

Scale edge

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

Skew

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

Split & displace

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

Operator constructors

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

Higher order operators

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

Tree walking & node processing

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

Caching operator results

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 {}) [])))

Operator tree walking

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

Operator tree flattening

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

Helper functions

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

Mesh functions

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

Complete namespace

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

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!