├── .gitignore ├── LICENSE ├── README.md ├── assets └── img │ ├── morphogen-ex01.jpg │ ├── morphogen-ex02.jpg │ ├── morphogen-ex03-flat.jpg │ ├── morphogen-ex03.jpg │ ├── morphogen-ex05.jpg │ └── morphogen-virus.jpg ├── babel └── out │ └── .empty ├── src ├── core.org ├── examples.org ├── index.org ├── libraryofbabel.org └── setup.org ├── tangle.sh └── test └── core.org /.gitignore: -------------------------------------------------------------------------------- 1 | babel 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # thi.ng/morphogen 2 | 3 | ![Morphogen Hex Virus](assets/img/morphogen-virus.jpg) 4 | 5 | Declarative 3D form evolution through tree-based transformations. The [video version](https://www.youtube.com/watch?v=vXlOB4NfAE0) of the above structure demonstrates the overall process quite succinctly... 6 | 7 | > **Morphogenesis** 8 | > 9 | > The biological process that causes an organism to develop its shape. 10 | > It is one of three fundamental aspects of developmental biology along 11 | > with the control of cell growth and cellular differentiation. 12 | > ([Wikipedia](http://en.wikipedia.org/wiki/Morphogenesis)) 13 | 14 | ## Description & usage 15 | 16 | - [Overview & project details](src/index.org) 17 | - [Detailed implementation description](src/core.org) 18 | - [Examples & rendered results](src/examples.org) 19 | 20 | ## Leiningen coordinates 21 | 22 | ```clj 23 | [thi.ng/morphogen "0.1.1"] 24 | ``` 25 | 26 | ## License 27 | 28 | Copyright © 2014 Karsten Schmidt 29 | 30 | Distributed under the [Apache Software License 2.0](http://www.apache.org/licenses/LICENSE-2.0). 31 | -------------------------------------------------------------------------------- /assets/img/morphogen-ex01.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/assets/img/morphogen-ex01.jpg -------------------------------------------------------------------------------- /assets/img/morphogen-ex02.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/assets/img/morphogen-ex02.jpg -------------------------------------------------------------------------------- /assets/img/morphogen-ex03-flat.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/assets/img/morphogen-ex03-flat.jpg -------------------------------------------------------------------------------- /assets/img/morphogen-ex03.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/assets/img/morphogen-ex03.jpg -------------------------------------------------------------------------------- /assets/img/morphogen-ex05.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/assets/img/morphogen-ex05.jpg -------------------------------------------------------------------------------- /assets/img/morphogen-virus.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/assets/img/morphogen-virus.jpg -------------------------------------------------------------------------------- /babel/out/.empty: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thi-ng/morphogen/8107a4bdb5c119597c45dd7c00359afba2995877/babel/out/.empty -------------------------------------------------------------------------------- /src/core.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: "setup.org" 2 | 3 | * Namespace: thi.ng.morphogen.core 4 | 5 | This namespace provides all core entities and operators to evolve 3d 6 | meshes from a single seed form as described superficially in 7 | [[file:index.org][index.org]]. The architecture defined here is easily extensible to 8 | support custom tree nodes & operators acting on them. 9 | 10 | In order to apply nested transformation to a given seed form, we need 11 | to define a tree structure. For our approach we will actually use two 12 | of them: one to define the nesting of operators and another one to 13 | define temporary tree nodes representing the actual transformed 14 | geometries. The latter is merely an internal implementation detail and 15 | users of the library will only have to mainly deal with the operator 16 | tree. On the other hand, this dichotomy allows users to easily add 17 | their own operators & geometry node types and mix them with the 18 | defaults provided here. 19 | 20 | ** Geometry nodes 21 | 22 | *** BoxNode 23 | 24 | The default *morphogen* tree node is represented spatially as a freeform 25 | box with the following properties: 26 | 27 | : e +----+ h 28 | : |\ :\ 29 | : |f+----+ g 30 | : | | : | 31 | : a +-|--+d| 32 | : \| \| 33 | : b +----+ c 34 | 35 | - 8 points 36 | - 6 faces (quads) 37 | - parent node 38 | - tree depth 39 | 40 | The quads are only an implied property and can be computed on demand 41 | via the =faces= method of the =INode= protocol: 42 | 43 | **** INode protocol 44 | 45 | The =INode= protocol is part of the abstraction mechanism to allow for 46 | future extensions of *morphogen* functionality and ensures the overall 47 | functionality is not bound to the default box-shaped entities defined 48 | here. The protocol is purely used to define basic operations for 49 | navigating the tree (e.g. some operators might want access to parent 50 | nodes in order to achieve constraints etc.). Node types also must 51 | provide (partial) implementations of the =IVertexAccess= & 52 | =IFaceAccess= protocols defined in the =thi.ng.geom.core= namespace to 53 | extract points & facets for final mesh assembly: 54 | 55 | #+BEGIN_SRC clojure :noweb-ref proto 56 | (defprotocol INode 57 | (parent [_] "Returns the node's parent or `nil` if node is the root") 58 | (tree-depth [_] "Returns the node's tree depth") 59 | (operator-node [_] "Returns related node from operator tree") 60 | (with-operator-node [_ op] "Returns same node with new operator node attached") 61 | (face-vertices [_ face] "Returns vertices for given face ID") 62 | (face-topology [_] "Returns number of vertices used for each face in the node")) 63 | #+END_SRC 64 | 65 | The =face-topology= method isn't used at current, but will be useful 66 | in the future to restrict operator use to only compatible node types 67 | (e.g. some operators cannot be used with triangular bases). 68 | 69 | The table below shows the relationship between face IDs and box 70 | vertices (see above diagram for reference): 71 | 72 | | **Description** | **Face ID** | **Vertices** | 73 | |-----------------+-------------+--------------| 74 | | East | =:e= | =[c d h g]= | 75 | | West | =:w= | =[a b f e]= | 76 | | North | =:n= | =[e f g h]= | 77 | | South | =:s= | =[a d c b]= | 78 | | Front | =:f= | =[b c g f]= | 79 | | Back | =:b= | =[d a e h]= | 80 | 81 | We also define a map for looking up the opposite face ID for each 82 | side. This will become useful for some operators (e.g. extrusion). 83 | 84 | #+BEGIN_SRC clojure :noweb-ref helpers 85 | (def face-opposite {:e :w, :w :e, :n :s, :s :n, :f :b, :b :f}) 86 | #+END_SRC 87 | 88 | **** BoxNode implementation 89 | 90 | According to the above information, the default tree node 91 | implementation is defining nodes as =defrecord='s, with its =:points= 92 | field being a vector of the 8 box vertices (in this order: a, b, c .. h). 93 | 94 | #+BEGIN_SRC clojure :noweb-ref node 95 | (defrecord BoxNode [points parent op-node depth] 96 | #+END_SRC 97 | 98 | Of course, the node type must implement the above mentioned protocols 99 | in order to participate in the tree transformation process and 100 | generate resulting geometries. The =faces= implementation returns a 101 | vector of 6 quads arranged as shown in the diagram above. 102 | 103 | *IMPORTANT:* The vertex ordering of each face must be counterclockwise 104 | in order to produce outward facing face normals. 105 | 106 | #+BEGIN_SRC clojure :noweb-ref node 107 | INode 108 | (parent [_] parent) 109 | (tree-depth [_] depth) 110 | (operator-node [_] op-node) 111 | (with-operator-node [_ op] (assoc _ :op-node op)) 112 | (face-vertices 113 | [{[a b c d e f g h] :points} side] 114 | (case side 115 | :e [c d h g] 116 | :w [a b f e] 117 | :n [e f g h] 118 | :s [a d c b] 119 | :f [b c g f] 120 | :b [d a e h])) 121 | (face-topology [_] 4) 122 | 123 | g/IBounds 124 | (bounds [_] (gu/bounding-box (:points _))) 125 | (width [_] (gu/axis-range 0 (:points _))) 126 | (height [_] (gu/axis-range 1 (:points _))) 127 | (depth [_] (gu/axis-range 2 (:points _))) 128 | 129 | g/IVertexAccess 130 | (vertices [_] points) 131 | 132 | g/IFaceAccess 133 | (faces 134 | [{[a b c d e f g h] :points}] 135 | [[[b c g f]] ;; front 136 | [[d a e h]] ;; back 137 | [[a b f e]] ;; west 138 | [[c d h g]] ;; east 139 | [[e f g h]] ;; north 140 | [[a d c b]]] ;; south 141 | ) 142 | #+END_SRC 143 | 144 | Additionally, this node type also implements the =ISubdivide= protocol 145 | defined in the [[http://thi.ng/geom][thi.ng/geom]] library. 146 | 147 | #+BEGIN_SRC clojure :noweb-ref node 148 | g/ISubdivide 149 | (subdivide 150 | [_ {:keys [cols rows slices] :or {cols 1 rows 1 slices 1}}] 151 | (let [ru (d/successive-nth 2 (m/norm-range cols)) 152 | rv (d/successive-nth 2 (m/norm-range rows)) 153 | rw (d/successive-nth 2 (m/norm-range slices)) 154 | map-p (fn [p] (->> p (gu/map-trilinear points) (map #(m/roundto % *eps*)) vec3))] 155 | (for [[w1 w2] rw, [v1 v2] rv, [u1 u2] ru] 156 | (mapv map-p [[u1 v1 w1] [u1 v1 w2] [u2 v1 w2] [u2 v1 w1] 157 | [u1 v2 w1] [u1 v2 w2] [u2 v2 w2] [u2 v2 w1]])))) 158 | #+END_SRC 159 | 160 | ***** End of implementation :noexport: 161 | #+BEGIN_SRC clojure :noweb-ref node 162 | ) 163 | #+END_SRC 164 | 165 | **** Node constructor 166 | 167 | Since the seed form needs to be a valid =BoxNode= instance (or at 168 | least implement the =INode= protocol) in order to be transformed, the 169 | following constructor function can create a =BoxNode= in different 170 | ways: 171 | 172 | #+BEGIN_SRC clojure :noweb-ref node 173 | (defn seed-box 174 | [x] 175 | (let [points (cond 176 | (number? x) (g/vertices (a/aabb x)) 177 | (sequential? x) (mapv vec3 x) 178 | (satisfies? g/IVertexAccess x) (g/vertices x))] 179 | (BoxNode. points nil nil 0))) 180 | #+END_SRC 181 | 182 | ** Operators 183 | 184 | 185 | Node operators are responsible for transforming a geometry node to 186 | manipulate its points and/or produce a number of child nodes. Through 187 | their nested application they can produce a large number of resulting 188 | forms. The operators defined here are only applicable to the =BoxNode= 189 | type, but as we will see they're technically trivial and can be used 190 | as guidance to provide similar operators for custom nodes. 191 | 192 | The following operators are currently implemented: 193 | 194 | | *Operator* | *ID* | *Description* | 195 | |-------------------+---------------+----------------------------------------------------------------------------| 196 | | Subdivision | =:sd= | Regular subdivision resulting in self-similar children | 197 | | Inset subdivision | =:sd-inset= | Subdivision through insetting along an axis | 198 | | Reflection | =:reflect= | Reflection of entire node on one of its sides | 199 | | Replication | =:replicate= | Replication of entire node on one of its sides | 200 | | Extrusion | =:extrude= | Extrusion of the node along the normal of one of its sides | 201 | | Scale edge(s) | =:scale-edge= | Scale an edge and set its symmetric opposite (in X, Y or Z) to same length | 202 | 203 | The *ID* column states the IDs used to match operators to their 204 | implementation using the =operator= multimethod, described below. 205 | 206 | *** Operator node structure & evaluation 207 | 208 | Unlike the route taken for geometry nodes (using protocols & 209 | defrecords), operator nodes (the entire tree, really) are simple Clojure 210 | maps with this basic structure: 211 | 212 | #+BEGIN_SRC clojure 213 | {:op :operator-id ;; multimethod operator id 214 | :args {:foo 23 :bar 42 ...} ;; map of arbitrary transformation arguments 215 | :out [{:op ...} nil {} ...] ;; vector of nested child operators 216 | } 217 | #+END_SRC 218 | 219 | The =:out= vector deserves some more attention and discussion how 220 | tree evaluation work in our case: At the first iteration the root node 221 | operator is applied to the given seed form. Different operators 222 | (and their given arguments) will produce different numbers 223 | of geometry child nodes. For example, whereas the [[Reflection]] operator 224 | will always return two nodes (the original and reflected version), the 225 | [[Regular subdivision]] operator can produce any number of children. Based 226 | on that, the =:out= vector of an operator node should have the same 227 | number of elements as is produced by the operator. The next stage of 228 | tree evaluation is then matching operator elements from the =:out= 229 | vector to child nodes produced by the operator and is descending 230 | further into the tree. 231 | 232 | **** Branch termination & leaf nodes 233 | 234 | An interesting aspect of this approach is that we can terminate 235 | branches by explicitly setting elements of this =:out= vector to 236 | =nil=. If that is the case, no further descent is possible and no mesh 237 | will be collected from the related geometry node. Therefore, this 238 | mechanism can be used to create holes/concavities in the resulting 239 | mesh structure. Alternatively, we use an empty map ={}= (without any 240 | =:op= key) to specify a leaf node of the tree. *Final mesh information 241 | is collected /only/ from leaf nodes.* Another example illustrates this 242 | better: 243 | 244 | #+BEGIN_SRC clojure 245 | {:op :sd 246 | :args {:cols 3} 247 | :out [{} nil {}]} 248 | #+END_SRC 249 | 250 | ***** TODO insert image 251 | 252 | This operator node defines a 3x1 subdivision of the node's box into 3 253 | columns along its A->D edge (see point layout above) and is therefore 254 | resulting in 3 child nodes. However, the middle element of the =:out= 255 | vector is =nil= and is therefore removing the 2nd column entirely. The 256 | other two elements in =:out= are marked as leaf nodes and therefore 257 | will result in a mesh of two isolated columns. In contrast, the 258 | following example uses the same initial setup, but subdivides the 1st 259 | child node further: 260 | 261 | #+BEGIN_SRC clojure 262 | {:op :sd 263 | :args {:cols 3} ;; split root in 3 cols 264 | :out [{:op :sd 265 | :args {:cols 2 :rows 2} ;; split 1st child into 2x2 266 | :out [nil nil nil {}]} ;; only keep top-right child 267 | nil ;; ignore 2nd child of root 268 | {}]} ;; mark last child as leaf (no-op) 269 | #+END_SRC 270 | 271 | ***** TODO insert image 272 | 273 | *** Operator multimethod 274 | 275 | As stated previously, the operators are implemented as Clojure 276 | multimethod in order to allow for easy addition of custom operators 277 | without requiring any other changes. The multimethod is using both the 278 | geometry node type and operator ID to dispatch to the actual 279 | implementations: 280 | 281 | #+BEGIN_SRC clojure :noweb-ref operators 282 | (defmulti operator 283 | (fn [g-node op-node] 284 | (if (:op op-node) [(type g-node) (:op op-node)]))) 285 | 286 | ;; leaf node operator (no-op) 287 | (defmethod operator nil [_ _] nil) 288 | 289 | #+END_SRC 290 | 291 | *** Regular subdivision 292 | 293 | | *Argument* | *Value description* | *Default* | 294 | |------------+---------------------------------+-----------| 295 | | =:cols= | number of splits along AD edge | 1 | 296 | |------------+---------------------------------+-----------| 297 | | =:rows= | number of splits along AE edge | 1 | 298 | |------------+---------------------------------+-----------| 299 | | =:slices= | number of splits along AB edges | 1 | 300 | 301 | #+BEGIN_SRC clojure :noweb-ref operators 302 | (defmethod operator [BoxNode :sd] 303 | [^BoxNode node {:keys [args] :as op}] 304 | (let [depth (inc (tree-depth node))] 305 | (->> (g/subdivide node args) 306 | (mapv #(BoxNode. % node op depth))))) 307 | 308 | #+END_SRC 309 | 310 | *** Inset subdivision 311 | 312 | The inset subdivision operator is splitting a node along one of its 313 | local major axes (X, Y or Z) in the following formation, resulting in 314 | five child nodes in the specified order: 315 | 316 | : +---------+ 317 | : |\ 2 /| 318 | : | +-----+ | 319 | : |3| 5 |4| 320 | : | +-----+ | 321 | : |/ 1 \| 322 | : +---------+ 323 | 324 | | *Argument* | *Value description* | *Default* | 325 | |------------+--------------------------------------------------------------------------+-----------| 326 | | =:dir= | =:x= split from right side (as viewed so that face =[c d h g]= is front) | :y | 327 | | | =:y= from top (as viewed so that face =[e f g h]= is front) | | 328 | | | =:z= from front (as viewed so that face =[b c g f]= is front) | | 329 | |------------+--------------------------------------------------------------------------+-----------| 330 | | =:inset= | percentage to inset corner points (0.0 ... < 0.5) | 0.25 | 331 | 332 | #+BEGIN_SRC clojure :noweb-ref operators 333 | (defn subdivide-inset___ 334 | [[a b c d e f g h :as points] {i :inset dir :dir :or {i 0.1 dir :y}}] 335 | (let [ii (- 1.0 i) 336 | map-points (fn [base uv] 337 | (mapcat 338 | (fn [[u v]] 339 | [(gu/map-trilinear points (assoc (vec3) uv [u v])) 340 | (gu/map-trilinear points (assoc base uv [u v]))]) 341 | [[i i] [i ii] [ii ii] [ii i]]))] 342 | (condp = dir 343 | :x (let [[a1 a2 b1 b2 c1 c2 d1 d2] (map-points v/V3X :yz)] 344 | [[b c d a b1 b2 a2 a1] 345 | [c1 c2 d2 d1 f g h e] 346 | [b c b2 b1 f g c2 c1] 347 | [a1 a2 d a d1 d2 h e] 348 | [b1 b2 a2 a1 c1 c2 d2 d1]]) 349 | :y (let [[a1 a2 b1 b2 c1 c2 d1 d2] (map-points v/V3Y :xz)] 350 | [[b1 b c c1 b2 f g c2] 351 | [a a1 d1 d e a2 d2 h] 352 | [a b b1 a1 e f b2 a2] 353 | [d1 c1 c d d2 c2 g h] 354 | [a1 b1 c1 d1 a2 b2 c2 d2]]) 355 | :z (let [[a1 a2 b1 b2 c1 c2 d1 d2] (map-points v/V3Z :xy)] 356 | [[a b c d a1 a2 d2 d1] 357 | [b1 b2 c2 c1 e f g h] 358 | [a b a2 a1 e f b2 b1] 359 | [d1 d2 c d c1 c2 g h] 360 | [a1 a2 d2 d1 b1 b2 c2 c1]])))) 361 | 362 | (defn subdivide-inset 363 | [[a b c d e f g h :as points] {i :inset dir :dir :or {i 0.1 dir :y}}] 364 | (case dir 365 | :x (let [[a2 b2 f2 e2] (q/inset-quad [a b f e] i) 366 | [c2 d2 h2 g2] (q/inset-quad [c d h g] i)] 367 | [[b c d a b2 c2 d2 a2] 368 | [f2 g2 h2 e2 f g h e] 369 | [b c c2 b2 f g g2 f2] 370 | [a2 d2 d a e2 h2 h e] 371 | [b2 c2 d2 a2 f2 g2 h2 e2]]) 372 | :y (let [[a2 b2 c2 d2] (q/inset-quad [a b c d] i) 373 | [e2 f2 g2 h2] (q/inset-quad [e f g h] i)] 374 | [[b2 b c c2 f2 f g g2] 375 | [a a2 d2 d e e2 h2 h] 376 | [a b b2 a2 e f f2 e2] 377 | [d2 c2 c d h2 g2 g h] 378 | [a2 b2 c2 d2 e2 f2 g2 h2]]) 379 | :z (let [[a2 d2 h2 e2] (q/inset-quad [a d h e] i) 380 | [b2 c2 g2 f2] (q/inset-quad [b c g f] i) 381 | p' [a2 b2 c2 d2 e2 f2 g2 h2]] 382 | (if (some nil? p') 383 | (do 384 | ;;(prn points) 385 | ;;(prn p') 386 | ;;(prn "----") 387 | [points]) 388 | [[a b c d a2 b2 c2 d2] 389 | [e2 f2 g2 h2 e f g h] 390 | [a b b2 a2 e f f2 e2] 391 | [d2 c2 c d h2 g2 g h] 392 | [a2 b2 c2 d2 e2 f2 g2 h2]])))) 393 | 394 | (defmethod operator [BoxNode :sd-inset] 395 | [^BoxNode node {:keys [args] :as op}] 396 | (let [depth (inc (tree-depth node))] 397 | (->> (subdivide-inset (:points node) args) 398 | (mapv #(BoxNode. % node op depth))))) 399 | 400 | #+END_SRC 401 | 402 | *** Extrusion 403 | 404 | | *Argument* | *Value description* | *Default* | 405 | |------------+---------------------------------------+-----------| 406 | | =:dir= | =:e= reflect on right plane [c d h g] | :n | 407 | | | =:w= left plane [a b f e] | | 408 | | | =:n= top plane [e f g h] | | 409 | | | =:s= bottom plane [a b c d] | | 410 | | | =:f= front plane [b c g f] | | 411 | | | =:b= back plane [a d h e] | | 412 | |------------+---------------------------------------+-----------| 413 | | =:len= | Extrusion length | 1.0 | 414 | 415 | #+BEGIN_SRC clojure :noweb-ref operators 416 | (defn- offset 417 | [^thi.ng.geom.vector.Vec3 a b len] 418 | (let [^thi.ng.geom.vector.Vec3 d (m/- a b) 419 | m (/ len (m/mag d)) 420 | ^doubles ba (.-buf a) 421 | ^doubles bd (.-buf d) 422 | ^doubles dest #?(:clj (double-array 3) :cljs (js/Float32Array. 3))] 423 | (aset dest 0 (double (mm/madd (aget bd 0) m (aget ba 0)))) 424 | (aset dest 1 (double (mm/madd (aget bd 1) m (aget ba 1)))) 425 | (aset dest 2 (double (mm/madd (aget bd 2) m (aget ba 2)))) 426 | (thi.ng.geom.vector.Vec3. dest nil nil))) 427 | 428 | (defmethod operator [BoxNode :extrude] 429 | [^BoxNode node {{:keys [dir len] :or {dir :n len 1.0}} :args :as op}] 430 | (let [c1 (gu/centroid (face-vertices node dir)) 431 | c2 (gu/centroid (face-vertices node (face-opposite dir))) 432 | n (m/normalize (m/- c1 c2) len)] 433 | [(BoxNode. 434 | (offset-face-points (:points node) dir n) 435 | node op (inc (tree-depth node)))])) 436 | 437 | (defmethod operator [BoxNode :ext-prop] 438 | [{[a b c d e f g h] :points :as node} 439 | {{:keys [dir len] :or {dir :n len 1.0}} :args :as op}] 440 | [(BoxNode. 441 | (case dir 442 | :e [a b (offset c b len) (offset d a len) 443 | e f (offset g f len) (offset h e len)] 444 | :w [(offset a d len) (offset b c len) c d 445 | (offset e h len) (offset f g len) g h] 446 | :f [a (offset b a len) (offset c d len) d 447 | e (offset f e len) (offset g h len) h] 448 | :b [(offset a b len) b c (offset d c len) 449 | (offset e f len) f g (offset h g len)] 450 | :n [a b c d (offset e a len) (offset f b len) 451 | (offset g c len) (offset h d len)] 452 | :s [(offset a e len) (offset b f len) 453 | (offset c g len) (offset d h len) 454 | e f g h]) 455 | node op (inc (tree-depth node)))]) 456 | #+END_SRC 457 | 458 | *** Reflection 459 | 460 | The reflection operator simply mirrors a given node on one of its 461 | sides and returns the original node and the mirrored version. 462 | 463 | | *Argument* | *Value description* | *Default* | 464 | |------------+---------------------------------------+-----------| 465 | | =:dir= | =:e= reflect on right plane [c d h g] | :n | 466 | | | =:w= left plane [a b f e] | | 467 | | | =:n= top plane [e f g h] | | 468 | | | =:s= bottom plane [a b c d] | | 469 | | | =:f= front plane [b c g f] | | 470 | | | =:b= back plane [a d h e] | | 471 | 472 | #+BEGIN_SRC clojure :noweb-ref operators 473 | (defn reflect-on-plane 474 | "Reflects point p on plane defined by point q & normal n. 475 | Normal vector must be normalized." 476 | [p ^thi.ng.geom.vector.Vec3 q ^thi.ng.geom.vector.Vec3 n] 477 | (let [^thi.ng.geom.vector.Vec3 r (m/- q p) 478 | d (* (m/dot r n) 2.0) 479 | ^doubles bn (.-buf n) 480 | ^doubles br (.-buf r) 481 | ^doubles bq (.-buf q) 482 | ^doubles dest #?(:clj (double-array 3) :cljs (js/Float32Array. 3))] 483 | (aset dest 0 (double (+ (mm/msub (aget bn 0) d (aget br 0)) (aget bq 0)))) 484 | (aset dest 1 (double (+ (mm/msub (aget bn 1) d (aget br 1)) (aget bq 1)))) 485 | (aset dest 2 (double (+ (mm/msub (aget bn 2) d (aget br 2)) (aget bq 2)))) 486 | (thi.ng.geom.vector.Vec3. dest nil nil))) 487 | 488 | (defmethod operator [BoxNode :reflect] 489 | [{[a b c d e f g h] :points :as node} 490 | {{:keys [dir] :or {dir :n}} :args :as op}] 491 | [node 492 | (BoxNode. 493 | (case dir 494 | :e (let [n (gu/ortho-normal c d g)] 495 | [d c (reflect-on-plane b c n) (reflect-on-plane a d n) 496 | h g (reflect-on-plane f g n) (reflect-on-plane e h n)]) 497 | :w (let [n (gu/ortho-normal a b f)] 498 | [(reflect-on-plane d a n) (reflect-on-plane c b n) b a 499 | (reflect-on-plane h e n) (reflect-on-plane g f n) f e]) 500 | :s (let [n (gu/ortho-normal a c b)] 501 | [(reflect-on-plane e a n) (reflect-on-plane f b n) 502 | (reflect-on-plane g c n) (reflect-on-plane h d n) 503 | a b c d]) 504 | :n (let [n (gu/ortho-normal e f g)] 505 | [e f g h 506 | (reflect-on-plane a e n) (reflect-on-plane b f n) 507 | (reflect-on-plane c g n) (reflect-on-plane d h n)]) 508 | :f (let [n (gu/ortho-normal b c g)] 509 | [b (reflect-on-plane a b n) (reflect-on-plane d c n) c 510 | f (reflect-on-plane e f n) (reflect-on-plane h g n) g]) 511 | :b (let [n (gu/ortho-normal a e h)] 512 | [(reflect-on-plane b a n) a d (reflect-on-plane c d n) 513 | (reflect-on-plane f e n) e h (reflect-on-plane g h n)])) 514 | node op (inc (tree-depth node)))]) 515 | #+END_SRC 516 | 517 | *** Replication 518 | 519 | #+BEGIN_SRC clojure :noweb-ref operators 520 | (defmethod operator [BoxNode :replicate] 521 | [{[a b c d e f g h] :points :as node} {{:keys [dir] :or {dir :n}} :args :as op}] 522 | [node 523 | (BoxNode. 524 | (case dir 525 | :f (let [ba (m/- b a) 526 | cd (m/- c d) 527 | fe (m/- f e) 528 | gh (m/- g h)] 529 | [(m/+ a ba) (m/+ b ba) (m/+ c cd) (m/+ d cd) 530 | (m/+ e fe) (m/+ f fe) (m/+ g gh) (m/+ h gh)]) 531 | :b (let [ab (m/- a b) 532 | dc (m/- d c) 533 | ef (m/- e f) 534 | hg (m/- h g)] 535 | [(m/+ a ab) (m/+ b ab) (m/+ c dc) (m/+ d dc) 536 | (m/+ e ef) (m/+ f ef) (m/+ g hg) (m/+ h hg)]) 537 | :n (let [ea (m/- e a) 538 | fb (m/- f b) 539 | gc (m/- g c) 540 | hd (m/- h d)] 541 | [(m/+ a ea) (m/+ b fb) (m/+ c gc) (m/+ d hd) 542 | (m/+ e ea) (m/+ f fb) (m/+ g gc) (m/+ h hd)]) 543 | :s (let [ae (m/- a e) 544 | bf (m/- b f) 545 | cg (m/- c g) 546 | dh (m/- d h)] 547 | [(m/+ a ae) (m/+ b bf) (m/+ c cg) (m/+ d dh) 548 | (m/+ e ae) (m/+ f bf) (m/+ g cg) (m/+ h dh)]) 549 | :e (let [da (m/- d a) 550 | cb (m/- c b) 551 | he (m/- h e) 552 | gf (m/- g f)] 553 | [(m/+ a da) (m/+ b cb) (m/+ c cb) (m/+ d da) 554 | (m/+ e he) (m/+ f gf) (m/+ g gf) (m/+ h he)]) 555 | :w (let [ad (m/- a d) 556 | bc (m/- b c) 557 | eh (m/- e h) 558 | fg (m/- f g)] 559 | [(m/+ a ad) (m/+ b bc) (m/+ c bc) (m/+ d ad) 560 | (m/+ e eh) (m/+ f fg) (m/+ g fg) (m/+ h eh)])) 561 | node op (inc (tree-depth node)))]) 562 | #+END_SRC 563 | 564 | *** Scale edge 565 | 566 | | *Argument* | *Value description* | *Default* | 567 | |------------+----------------------------------------------------------+-------------| 568 | | =:edge= | =:ab=, =:bc=, =:cd=, =:ad= (bottom face edges) | =nil= | 569 | | | =:ef=, =:fg=, =:gh=, =:eh= (top face edges) | (mandatory) | 570 | | | =:ae=, =:bf=, =:cg=, =:dh= (sides) | | 571 | |------------+----------------------------------------------------------+-------------| 572 | | =:sym= | =:x= also scale edge on opposite side (along =:ad= edge) | =nil= | 573 | | | =:y= (along =:ae= edge) | (mandatory) | 574 | | | =:z= (along =:ab= edge) | | 575 | |------------+----------------------------------------------------------+-------------| 576 | | =:scale= | scale factor | 0.5 | 577 | 578 | #+BEGIN_SRC clojure :noweb-ref operators 579 | (defmethod operator [BoxNode :scale-edge] 580 | [{[a b c d e f g h] :points :as node} 581 | {{:keys [edge sym scale len] :or {scale 0.5}} :args :as op}] 582 | (let [scale-if (fn [sid p q s] 583 | (if (= sid sym) 584 | (let [c (m/mix p q)] 585 | [(m/madd (m/- p c) s c) (m/madd (m/- q c) s c)]) 586 | [p q])) 587 | scale (fn [p q s1 i j s2 k l] 588 | (let [ll (g/dist p q) 589 | dpq (or len (* ll scale)) 590 | s (/ dpq ll) 591 | c (m/mix p q) 592 | p' (m/madd (m/- p c) s c) 593 | q' (m/madd (m/- q c) s c) 594 | [i j] (scale-if s1 i j (/ dpq (g/dist i j))) 595 | [k l] (scale-if s2 k l (/ dpq (g/dist k l)))] 596 | [p' q' i j k l]))] 597 | [(BoxNode. 598 | (case edge 599 | ;; bottom 600 | :ab (let [[a b c d e f] (scale a b :x c d :y e f)] 601 | [a b c d e f g h]) 602 | :bc (let [[b c a d f g] (scale b c :z a d :y f g)] 603 | [a b c d e f g h]) 604 | :cd (let [[c d a b g h] (scale c d :x a b :y g h)] 605 | [a b c d e f g h]) 606 | :ad (let [[a d b c e h] (scale a d :z b c :y e h)] 607 | [a b c d e f g h]) 608 | ;; top 609 | :ef (let [[e f g h a b] (scale e f :x g h :y a b)] 610 | [a b c d e f g h]) 611 | :fg (let [[f g e h b c] (scale f g :z e h :y b c)] 612 | [a b c d e f g h]) 613 | :gh (let [[g h e f c d] (scale g h :x e f :y c d)] 614 | [a b c d e f g h]) 615 | :eh (let [[e h f g a d] (scale e h :z f g :y a d)] 616 | [a b c d e f g h]) 617 | ;; left 618 | :ae (let [[a e d h b f] (scale a e :x d h :z b f)] 619 | [a b c d e f g h]) 620 | :bf (let [[b f c g a e] (scale b f :x c g :z a e)] 621 | [a b c d e f g h]) 622 | ;; right 623 | :cg (let [[c g b f d h] (scale c g :x b f :z d h)] 624 | [a b c d e f g h]) 625 | :dh (let [[d h a e c g] (scale d h :x a e :z c g)] 626 | [a b c d e f g h])) 627 | node op (inc (tree-depth node)))])) 628 | 629 | (defn make-planar 630 | [a b c d] 631 | (let [pabc (pl/plane-from-points a b c) 632 | pabd (pl/plane-from-points a b d) 633 | pacd (pl/plane-from-points a c d) 634 | pbcd (pl/plane-from-points b c d)] 635 | (mapv #(g/dist % %2) [pbcd pacd pabd pabc] [a b c d]))) 636 | 637 | (defmethod operator [BoxNode :scale-side] 638 | [{[a b c d e f g h] :points :as node} 639 | {{:keys [side scale] :or {scale 0.5}} :args :as op}] 640 | (let [s (* (- 1.0 scale) 0.5) 641 | [fa fb fc fd] (face-vertices node side) 642 | [fa fb fc fd] (mapv (fn [[p q]] (m/mix p q s)) [[fa fc] [fb fd] [fc fa] [fd fb]])] 643 | [(BoxNode. 644 | (case side 645 | :e [a b fa fb e f fd fc] 646 | :w [fa fb c d fd fc g h] 647 | :n [a b c d fa fb fc fd] 648 | :s [fa fd fc fb e f g h] 649 | :f [a fa fb d e fd fc h] 650 | :b [fb b c fa fc f g fd]) 651 | node op (inc (tree-depth node)))])) 652 | #+END_SRC 653 | 654 | *** Skew 655 | 656 | #+BEGIN_SRC clojure :noweb-ref operators 657 | (defmethod operator [BoxNode :skew] 658 | [{[a b c d e f g h] :points :as node} 659 | {{:keys [side ref offset] :or {offset 0.5}} :args :as op}] 660 | (let [n (if (v/vec3? offset) 661 | offset 662 | (m/* (quad-normal (face-vertices node ref)) offset))] 663 | ;;(prn side ref n) 664 | [(BoxNode. 665 | (case side 666 | :e [a b (m/+ c n) (m/+ d n) e f (m/+ g n) (m/+ h n)] 667 | :w [(m/+ a n) (m/+ b n) c d (m/+ e n) (m/+ f n) g h] 668 | :n [a b c d (m/+ e n) (m/+ f n) (m/+ g n) (m/+ h n)] 669 | :s [(m/+ a n) (m/+ b n) (m/+ c n) (m/+ d n) e f g h] 670 | :f [a (m/+ b n) (m/+ c n) d e (m/+ f n) (m/+ g n) h] 671 | :b [(m/+ a n) b c (m/+ d n) (m/+ e n) f g (m/+ h n)]) 672 | node op (inc (tree-depth node)))])) 673 | 674 | (defmethod operator [BoxNode :skew2] 675 | [{[a b c d e f g h] :points :as node} 676 | {{:keys [side dir offset] :or {offset 0.5}} :args :as op}] 677 | (let [[fa fb fc fd] (face-vertices node side) 678 | skew-vec (if (v/vec3? offset) 679 | (constantly offset) 680 | (fn [a b c d] 681 | (m/normalize (m/- (m/mix a b) (m/mix c d)) offset)))] 682 | [(BoxNode. 683 | (case side 684 | :e (let [n (case dir 685 | :z (skew-vec fa fd fb fc) 686 | :y (skew-vec fc fd fb fa))] 687 | [a b (m/+ c n) (m/+ d n) e f (m/+ g n) (m/+ h n)]) 688 | :w (let [n (case dir 689 | :z (skew-vec fb fc fa fd) 690 | :y (skew-vec fc fd fb fa))] 691 | [(m/+ a n) (m/+ b n) c d (m/+ e n) (m/+ f n) g h]) 692 | :n (let [n (case dir 693 | :z (skew-vec fb fc fa fd) 694 | :x (skew-vec fc fd fa fb))] 695 | [a b c d (m/+ e n) (m/+ f n) (m/+ g n) (m/+ h n)]) 696 | :s (let [n (case dir 697 | :z (skew-vec fc fd fa fb) 698 | :x (skew-vec fb fc fa fd))] 699 | [(m/+ a n) (m/+ b n) (m/+ c n) (m/+ d n) e f g h]) 700 | :f (let [n (case dir 701 | :y (skew-vec fd fc fa fb) 702 | :x (skew-vec fb fc fa fd))] 703 | [a (m/+ b n) (m/+ c n) d e (m/+ f n) (m/+ g n) h]) 704 | :b (let [n (case dir 705 | :x (skew-vec fd fc fa fb) 706 | :y (skew-vec fb fc fa fd))] 707 | [(m/+ a n) b c (m/+ d n) (m/+ e n) f g (m/+ h n)])) 708 | node op (inc (tree-depth node)))])) 709 | #+END_SRC 710 | 711 | *** Split & displace 712 | 713 | #+BEGIN_SRC clojure :noweb-ref operators 714 | (defmethod operator [BoxNode :split-displace] 715 | [{[a b c d e f g h] :points :as node} 716 | {{:keys [dir ref offset] :or {offset 0.5}} :args :as op}] 717 | (let [sd-dir ({:x :cols :y :rows :z :slices} dir) 718 | children (operator node {:op :sd :args {sd-dir 2}})] 719 | (mapcat 720 | (fn [c side] 721 | (operator c {:op :skew2 722 | :args {:side side :dir ref :offset offset} 723 | :attribs (:attribs op)})) 724 | children 725 | (case dir 726 | :x [:e :w] 727 | :y [:n :s] 728 | :z [:f :b])))) 729 | 730 | (defmethod operator [BoxNode :split-displace2] 731 | [{[a b c d e f g h] :points :as node} 732 | {{:keys [dir ref offset] :or {offset 0.5}} :args :as op}] 733 | (let [sd-dir ({:x :cols :y :rows :z :slices} dir) 734 | children (operator node {:op :sd :args {sd-dir 2}}) 735 | offset (m/* (quad-normal (face-vertices node ({:x :e :y :n :z :f} ref))) offset)] 736 | (mapcat 737 | (fn [c side] 738 | (operator c {:op :skew2 739 | :args {:side side :dir ref :offset offset} 740 | :attribs (:attribs op)})) 741 | children 742 | (case dir 743 | :x [:e :w] 744 | :y [:n :s] 745 | :z [:f :b])))) 746 | #+END_SRC 747 | 748 | ** Operator constructors 749 | 750 | #+BEGIN_SRC clojure :noweb-ref op-ctors 751 | (defn operator-output 752 | [n out empty?] 753 | (let [default (vec (repeat n (if empty? nil {})))] 754 | (cond 755 | (map? out) (reduce-kv assoc default out) 756 | (sequential? out) (vec out) 757 | :default default))) 758 | 759 | (defn subdiv 760 | [& {:keys [cols rows slices num out empty?] :or {cols 1 rows 1 slices 1}}] 761 | (let [[cols rows slices] (if num [num num num] [cols rows slices])] 762 | {:op :sd 763 | :args {:cols cols :rows rows :slices slices} 764 | :out (operator-output (* cols rows slices) out empty?)})) 765 | 766 | (defn subdiv-inset 767 | [& {:keys [dir inset out empty?] :or {dir :y inset 0.25}}] 768 | {:op :sd-inset 769 | :args {:dir dir :inset inset} 770 | :out (operator-output 5 out empty?)}) 771 | 772 | (defn reflect 773 | [dir & {:keys [out empty?] :or {dir :n}}] 774 | {:op :reflect 775 | :args {:dir dir} 776 | :out (operator-output 2 out empty?)}) 777 | 778 | (defn replicate 779 | [dir & {:keys [out empty?]}] 780 | {:op :replicate 781 | :args {:dir dir} 782 | :out (operator-output 2 out empty?)}) 783 | 784 | (defn extrude 785 | [& {:keys [dir len out empty?] :or {dir :n len 1.0}}] 786 | {:op :extrude 787 | :args {:dir dir :len len} 788 | :out (operator-output 1 out empty?)}) 789 | 790 | (defn extrude-prop 791 | [& {:keys [dir len out empty?] :or {dir :n len 1.0}}] 792 | {:op :ext-prop 793 | :args {:dir dir :len len} 794 | :out (operator-output 1 out empty?)}) 795 | 796 | (defn scale-edge 797 | [edge sym & {:keys [scale len out] :or {scale 0.5}}] 798 | {:op :scale-edge 799 | :args {:edge edge :sym sym :scale scale :len len} 800 | :out (operator-output 1 out false)}) 801 | 802 | (defn skew 803 | [side ref & {:keys [offset out] :or {offset 0.25}}] 804 | {:op :skew 805 | :args {:side side :ref ref :offset offset} 806 | :out (operator-output 1 out false)}) 807 | 808 | (defn split-displace 809 | [dir ref & {:keys [offset out] :or {offset 0.25}}] 810 | {:op :split-displace2 811 | :args {:dir dir :ref ref :offset offset} 812 | :out (operator-output 2 out false)}) 813 | #+END_SRC 814 | 815 | ** Higher order operators 816 | 817 | #+BEGIN_SRC clojure :noweb-ref op-ctors 818 | (defn reflect-seq 819 | "Takes a seq of direction keys and optional `leaf` tree. Builds a 820 | tree encoding a nested reflection sequence in the order given. If 821 | `leaf` is specified, injects it at the end of the nested 822 | reflection." 823 | [dirs & [leaf]] 824 | (reduce 825 | (fn [t dir] (reflect dir :out [{} t])) (or leaf {}) 826 | (reverse dirs))) 827 | #+END_SRC 828 | 829 | ** Tree walking & node processing 830 | 831 | The following little functions are truly at the heart of this library 832 | and responsible for walking the operator tree, applying all 833 | transformations and collecting mesh geometries from any leaf nodes. 834 | 835 | In order to help with debugging complex trees, but also to allow for 836 | only partial descents into the tree, a maximum tree depth can be 837 | specified to stop further descending and consider nodes at this depth 838 | as leaves. This way it's also easy to create an animation of the tree 839 | transformation. 840 | 841 | #+BEGIN_SRC clojure :noweb-ref tree-walk 842 | (defn execute-op-tree 843 | [leaf-fn acc node tree max-depth] 844 | ;;(prn :d (tree-depth node) (:points node) tree) 845 | (if (< (tree-depth node) max-depth) 846 | (let [children (operator node tree)] 847 | (if children 848 | (loop [acc acc, children children, out (get tree :out)] 849 | (if (and out children) 850 | (let [ctree (first out)] 851 | (recur 852 | (if ctree (execute-op-tree leaf-fn acc (first children) ctree max-depth) acc) 853 | (next children) (next out))) 854 | acc)) 855 | (leaf-fn acc node))) 856 | (leaf-fn acc node))) 857 | #+END_SRC 858 | 859 | *** Caching operator results 860 | 861 | Some use cases require access to the complete computed state of the 862 | operator tree. E.g. In an interactive editor built around *morphogen*, 863 | a user might want to manipulate the resulting object only at deeper 864 | levels of the hierarchy. In this case it might be prohibitive from a 865 | performance POV to recompute the entire operator tree, if actually 866 | only the nodes below (and including) the edit point are impacted. The 867 | =compute-tree-map= function addresses this and is meant as an 868 | initialization step. It walks the tree in a similar manner as the 869 | =walk-with= function above. However, instead of returning a seq of face 870 | lists of the resulting meshes of all leaf nodes, this function 871 | produces a map of *all* computed geometry nodes, each with its path 872 | (cursor) into the operator tree as key. 873 | 874 | For example using this operator tree: 875 | 876 | #+BEGIN_SRC clojure 877 | {:op :sd, 878 | :args {:cols 2}, 879 | :out [{:op :reflect, :args {:dir :n}, :out [nil {}]} {}]} 880 | #+END_SRC 881 | 882 | ...produces a map like this (node =:parent= keys elided for simplicity): 883 | 884 | #+BEGIN_SRC clojure 885 | {[] {:points [...] :depth 0} 886 | [0] {:points [...] :depth 1} 887 | [0 0] {:points [...] :depth 2} 888 | [0 1] {:points [...] :depth 2} 889 | [1] {:points [...] :depth 1}} 890 | #+END_SRC 891 | 892 | *Note, that the map retains geometry nodes also for deleted children.* 893 | In the example tree, the first child of the =:reflect= operator should 894 | be removed, however its geometry node is kept in the map for cases 895 | when a user wants to replace the delete op with another operator later 896 | on. This would not be easily possible if such nodes would be excluded 897 | from this map. Because of this, and in order to find out if a node in 898 | this map should produce geometry in the final result mesh, it is 899 | necessary to consult the operator tree at the cursor position for each 900 | mapped node. This can be easily done via a checks using the following 901 | helper function, which given an operator tree, classifies node cursors 902 | as =:operator=, =:leaf= or =nil= (the latter for deleted nodes so that 903 | the fn can be used as predicate). 904 | 905 | #+BEGIN_SRC clojure :noweb-ref helpers 906 | (defn classify-node-at 907 | [op-tree cursor] 908 | (let [n (get-in op-tree (child-path cursor))] 909 | (cond 910 | (:op n) :operator 911 | n :leaf 912 | :else nil))) 913 | #+END_SRC 914 | 915 | Next up, the actual implementation of =compute-tree-map=: 916 | 917 | #+BEGIN_SRC clojure :noweb-ref tree-walk 918 | (defn compute-tree-map* 919 | [node tree acc path] 920 | (let [children (operator node tree)] 921 | (if children 922 | (loop [acc (assoc! acc path node), children children, out (get tree :out), i 0] 923 | (if (and out children) 924 | (let [c (first children) 925 | ctree (first out) 926 | cpath (conj path i)] 927 | (recur 928 | (if ctree 929 | (compute-tree-map* c ctree acc cpath) 930 | (assoc! acc cpath c)) 931 | (next children) (next out) (inc i))) 932 | acc)) 933 | (assoc! acc path node)))) 934 | 935 | (defn compute-tree-map 936 | [seed tree] 937 | (persistent! (compute-tree-map* seed tree (transient {}) []))) 938 | #+END_SRC 939 | 940 | *** Operator tree walking 941 | 942 | #+BEGIN_SRC clojure :noweb-ref tree-walk 943 | (defn walk-op-tree 944 | [f acc node depth] 945 | (let [d (inc depth)] 946 | (if-let [children (:out node)] 947 | (reduce #(walk-op-tree f % %2 d) acc children) 948 | (f acc node depth)))) 949 | 950 | (defn op-tree-depth 951 | [tree] (walk-op-tree (fn [acc _ d] (max acc d)) 0 tree 0)) 952 | #+END_SRC 953 | 954 | *** Operator tree flattening 955 | 956 | For UI or visualization purposes it is useful to obtain a flattened 957 | version of the operator tree. E.g. For the [[http://devartcodefactory.com][Co(de)Factory]] project we 958 | use color coding to produce a barcode-like overview of the operator 959 | tree of each created object. The functions =operator-seq= and 960 | =operator-seq-no-leaves= walk the tree in depth-first, pre-order and 961 | produce a seq of all operator IDs. Empty (deleted, =nil= nodes) and 962 | leaf nodes (without any operator) will be mapped to =:delete= & 963 | =:leaf= respectively. =operator-seq-no-leaves= *only* includes nodes 964 | with actual operators, but no deletions or leaves. 965 | 966 | #+BEGIN_SRC clojure :noweb-ref tree-walk 967 | (defn- operator-seq* 968 | [f] 969 | (fn opseq* 970 | [acc node] 971 | (reduce opseq* (f acc node) (:out node)))) 972 | 973 | (defn operator-seq 974 | [node] 975 | (->> node 976 | ((operator-seq* 977 | (fn [acc node] 978 | (conj! acc 979 | (cond 980 | (:op node) (:op node) 981 | (nil? node) :delete 982 | :else :leaf)))) 983 | (transient [])) 984 | (persistent!))) 985 | 986 | (defn operator-seq-no-leaves 987 | [node] 988 | (->> node 989 | ((operator-seq* 990 | (fn [acc node] 991 | (if-let [op (:op node)] (conj! acc op) acc))) 992 | (transient [])) 993 | (persistent!))) 994 | #+END_SRC 995 | 996 | ** Helper functions 997 | 998 | #+BEGIN_SRC clojure :noweb-ref helpers 999 | (defn quad-normal 1000 | "Takes 4 points (or a seq of 4 points), returns vector perdendicular 1001 | to the 2 diagonals of the quad" 1002 | ([[a b c d]] (quad-normal a b c d)) 1003 | ([a b c d] (gu/ortho-normal (m/- c a) (m/- d b)))) 1004 | 1005 | (defn offset-face-points 1006 | [[a b c d e f g h] side n] 1007 | (case side 1008 | :e [a b (m/+ c n) (m/+ d n) e f (m/+ g n) (m/+ h n)] 1009 | :w [(m/+ a n) (m/+ b n) c d (m/+ e n) (m/+ f n) g h] 1010 | :n [a b c d (m/+ e n) (m/+ f n) (m/+ g n) (m/+ h n)] 1011 | :s [(m/+ a n) (m/+ b n) (m/+ c n) (m/+ d n) e f g h] 1012 | :f [a (m/+ b n) (m/+ c n) d e (m/+ f n) (m/+ g n) h] 1013 | :b [(m/+ a n) b c (m/+ d n) (m/+ e n) f g (m/+ h n)])) 1014 | 1015 | (defn child-path 1016 | "Takes a seq of child indices and constructs a lookup path/vector 1017 | for them by interleaving `:out` in the seq: 1018 | (child-path [1 0 2]) => [:out 1 :out 0 :out 2]" 1019 | [path] (vec (interleave (repeat :out) path))) 1020 | 1021 | (defn inject 1022 | "Almost like assoc-in, but transforms lookup path with `child-path`." 1023 | [t path t'] 1024 | (assoc-in t (child-path path) t')) 1025 | 1026 | (defn apply-recursively 1027 | "Recursively injects tree into itself `n` times, starting at given 1028 | child path. At each subsequent level, the original tree given is 1029 | injected at index `id` of the `:out` child node vector. The initial 1030 | path is simply given as a seq of indices and will be translated into 1031 | an actual lookup path using the `child-path` fn." 1032 | [tree n path id] 1033 | (loop [t' tree, path (child-path path), n (dec n)] 1034 | (if (pos? n) 1035 | (recur (assoc-in t' path tree) (into path [:out id]) (dec n)) 1036 | t'))) 1037 | 1038 | (defn map-leaves 1039 | "Takes a fn and operator tree, applies f to all leaf nodes. The fn 1040 | must accept 3 args: the leaf's parent node, the child index of the 1041 | leaf in the parent and the tree depth. The leaf will be replaced 1042 | with the fn's return value." 1043 | ([f tree] (map-leaves f tree 0)) 1044 | ([f tree depth] 1045 | (->> (:out tree) 1046 | (interleave (range)) 1047 | (partition 2) 1048 | (reduce 1049 | (fn [acc [i c]] 1050 | (cond 1051 | (seq (:out c)) (assoc-in acc [:out i] (map-leaves f c (inc depth))) 1052 | (map? c) (assoc-in acc [:out i] (f acc i depth)) 1053 | :default acc)) 1054 | tree)))) 1055 | #+END_SRC 1056 | 1057 | ** Mesh functions 1058 | 1059 | #+BEGIN_SRC clojure :noweb-ref meshing 1060 | (defn circle-lattice-seg 1061 | [n h wall] 1062 | (let [theta (/ m/PI n) 1063 | off (vec3 0 0 h) 1064 | points (g/vertices (g/rotate (g/as-polygon (c/circle) n) (- (- HALF_PI) theta))) 1065 | [b c] (map vec3 points) 1066 | [a d] (map vec3 (p/inset-polygon points (- wall))) 1067 | [f g] (map #(m/+ off %) [b c]) 1068 | [e h] (map #(m/+ off %) [a d])] 1069 | [b f g c a e h d])) 1070 | 1071 | (defn sphere-lattice-seg 1072 | [n h inset wall] 1073 | (let [theta (/ m/PI n) 1074 | off (vec3 0 0 h) 1075 | points (g/vertices (g/rotate (g/as-polygon (c/circle) n) (- (- HALF_PI) theta))) 1076 | [b c] (map vec3 points) 1077 | [a d] (map vec3 (p/inset-polygon points (- wall))) 1078 | [f g] (map #(m/+ off %) (p/inset-polygon points (- inset))) 1079 | [e h] (map #(m/+ off %) (p/inset-polygon points (- (- inset) wall)))] 1080 | [b f g c a e h d])) 1081 | 1082 | (defn sphere-lat 1083 | [resu resv wall] 1084 | (let [r1 (- 1.0 wall) 1085 | lat2 (/ PI resv) 1086 | lat1 (- lat2) 1087 | lon2 (/ PI resu) 1088 | lon1 (- lon2)] 1089 | (->> [(vec3 r1 lat1 lon1) 1090 | (vec3 1 lat1 lon1) 1091 | (vec3 1 lat1 lon2) 1092 | (vec3 r1 lat1 lon2) 1093 | (vec3 r1 lat2 lon1) 1094 | (vec3 1 lat2 lon1) 1095 | (vec3 1 lat2 lon2) 1096 | (vec3 r1 lat2 lon2)] 1097 | (mapv g/as-cartesian)))) 1098 | 1099 | ;; TODO temporarily disabled result mesh cleaning 1100 | ;; due to outstanding issues in thi.ng/geom mesh.ops namespace 1101 | (defn union-mesh 1102 | ([meshes] 1103 | (union-mesh (bm/basic-mesh) 1e-3 meshes)) 1104 | ([target eps meshes] 1105 | (-> (reduce g/into target meshes) 1106 | #_(ops/canonicalize-vertices eps) 1107 | #_(first) 1108 | #_(ops/remove-internal)))) 1109 | 1110 | (defn generate-mesh 1111 | ([seed tree] 1112 | (generate-mesh seed tree 1e6)) 1113 | ([seed tree max-depth] 1114 | (union-mesh 1115 | (persistent! 1116 | (execute-op-tree 1117 | (fn [acc node] (conj! acc (g/faces node))) 1118 | (transient []) 1119 | (with-operator-node seed tree) 1120 | tree max-depth))))) 1121 | 1122 | #?(:clj 1123 | (defn save-obj-mesh 1124 | ([seed tree] (save-obj-mesh seed tree "out.obj" 1e6)) 1125 | ([seed tree path] (save-obj-mesh seed tree path 1e6)) 1126 | ([seed tree path max-depth] 1127 | (with-open [o (io/output-stream path)] 1128 | (->> (generate-mesh seed tree max-depth) 1129 | (mio/write-obj (mio/wrapped-output-stream o))))))) 1130 | 1131 | #?(:clj 1132 | (defn save-stl-mesh 1133 | ([seed tree] (save-stl-mesh seed tree "out.stl" 1e6)) 1134 | ([seed tree path] (save-stl-mesh seed tree path 1e6)) 1135 | ([seed tree path max-depth] 1136 | (with-open [o (io/output-stream path)] 1137 | (->> (generate-mesh seed tree max-depth) 1138 | (g/tessellate) 1139 | (mio/write-stl (mio/wrapped-output-stream o))))))) 1140 | 1141 | #?(:clj 1142 | (defn save-ply-mesh 1143 | ([seed tree] (save-ply-mesh seed tree "out.ply" 1e6)) 1144 | ([seed tree path] (save-ply-mesh seed tree path 1e6)) 1145 | ([seed tree path max-depth] 1146 | (with-open [o (io/output-stream path)] 1147 | (->> (generate-mesh seed tree max-depth) 1148 | (g/tessellate) 1149 | (mio/write-ply (mio/wrapped-output-stream o))))))) 1150 | #+END_SRC 1151 | 1152 | ** Complete namespace :noexport: 1153 | 1154 | With all elements in place now, we only need to bundle them all up 1155 | into a proper Clojure namespace... 1156 | 1157 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/morphogen/core.cljc :noweb yes :mkdirp yes :padline no 1158 | (ns thi.ng.morphogen.core 1159 | (:refer-clojure :exclude [replicate]) 1160 | #?(:cljs 1161 | (:require-macros 1162 | [thi.ng.math.macros :as mm])) 1163 | (:require 1164 | [thi.ng.geom.core :as g] 1165 | [thi.ng.geom.vector :as v :refer [vec3]] 1166 | [thi.ng.geom.utils :as gu] 1167 | [thi.ng.geom.circle :as c] 1168 | [thi.ng.geom.polygon :as p] 1169 | [thi.ng.geom.quad :as q] 1170 | [thi.ng.geom.plane :as pl] 1171 | [thi.ng.geom.aabb :as a] 1172 | [thi.ng.geom.cuboid :as cu] 1173 | [thi.ng.geom.basicmesh :as bm] 1174 | ;[thi.ng.geom.mesh.ops :as ops] 1175 | [thi.ng.dstruct.core :as d] 1176 | [thi.ng.math.core :as m :refer [*eps* TWO_PI PI HALF_PI]] 1177 | #?@(:clj 1178 | [[thi.ng.math.macros :as mm] 1179 | [thi.ng.geom.mesh.io :as mio] 1180 | [clojure.java.io :as io] 1181 | [clojure.pprint :refer [pprint]]]))) 1182 | 1183 | (declare operator child-path) 1184 | 1185 | <> 1186 | 1187 | <> 1188 | 1189 | <> 1190 | 1191 | <> 1192 | 1193 | <> 1194 | 1195 | <> 1196 | 1197 | <> 1198 | #+END_SRC 1199 | -------------------------------------------------------------------------------- /src/examples.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: "setup.org" 2 | 3 | * Examples & test trees 4 | 5 | All examples defined below will be tangled into the =/babel/examples/= 6 | subfolder of this project and can be directly loaded into a running 7 | REPL, e.g. via =(load-file "examples/ex03.clj")=. Loading the first 8 | example will take a few seconds, since the thi.ng/geom library is 9 | quite large, however subsequent calls will take < 1 sec... 10 | 11 | #+BEGIN_SRC clojure 12 | ;; run all examples 13 | (doseq [i (range 1 6)] (load-file (str "examples/ex0" i ".clj"))) 14 | #+END_SRC 15 | 16 | (See [[file:index.org][index.org]] for further information how to tangle & build this project) 17 | 18 | Each example generates one or more 3D models in binary STL format, 19 | which are saved in the [[../babel/out/][/out]] directory and can then be imported into 20 | other 3d applications. If you need a simple mesh viewer, we recommend 21 | [[http://meshlab.sf.net][Meshlab]]. 22 | 23 | ** Template for namespace setup 24 | #+BEGIN_SRC clojure :noweb-ref require-mg 25 | (:require 26 | [thi.ng.morphogen.core :as mg] 27 | [thi.ng.geom.core :as g] 28 | [thi.ng.geom.vector :as v :refer [vec3]] 29 | [thi.ng.geom.aabb :as a]) 30 | (:import 31 | [thi.ng.morphogen.core BoxNode]) 32 | #+END_SRC 33 | 34 | ** Reusable helpers 35 | 36 | At some point these will be refactored and moved into core ns... 37 | 38 | #+BEGIN_SRC clojure :noweb-ref stripes 39 | (defn make-stripes 40 | "Returns a tree which subdivides form into `n` columns and only 41 | keeps those for whose index the given predicate returns a truthy 42 | value. If no predicate is given, `even?` is used by default." 43 | ([n] (make-stripes even? n)) 44 | ([pred n] 45 | (mg/subdiv :cols n :out (mapv #(if (pred %) {}) (range n))))) 46 | #+END_SRC 47 | 48 | ** Extruded aluminium style module 49 | 50 | [[../assets/img/morphogen-ex01.jpg]] 51 | 52 | #+BEGIN_SRC clojure :tangle ../babel/examples/ex01.clj :noweb yes :mkdirp yes :padline no 53 | (ns ex01 54 | <>) 55 | 56 | (def tree 57 | (let [branch (fn [[dir lpos]] 58 | (mg/subdiv-inset 59 | :dir :y :inset 0.05 60 | :out {lpos (mg/subdiv dir 3 :out {1 nil}) 4 nil})) 61 | module (mg/subdiv-inset 62 | :dir :y :inset 0.4 63 | :out (mapv branch [[:cols 0] [:cols 1] [:slices 2] [:slices 3]]))] 64 | (mg/subdiv 65 | :rows 3 66 | :out [module 67 | (mg/subdiv 68 | :rows 3 :out {1 (mg/subdiv :cols 3 :out [nil {} nil])}) 69 | module]))) 70 | 71 | (mg/save-stl-mesh (mg/seed-box (a/aabb 1 0.5 1)) tree "out/ex01.stl") 72 | #+END_SRC 73 | 74 | ** Stripy module (heatsink?) 75 | 76 | [[../assets/img/morphogen-ex02.jpg]] 77 | 78 | #+BEGIN_SRC clojure :tangle ../babel/examples/ex02.clj :noweb yes :mkdirp yes :padline no 79 | (ns ex02 80 | <>) 81 | 82 | <> 83 | 84 | (defn stripes* 85 | "Similar to `make-stripes`, but replaces the killed off columns with 86 | connector elements by splitting each in 3x3 rows/slices and only 87 | keeping the center one. Returns tree of columns as created by 88 | `make-stripes` and connectors between them." 89 | [pred n] 90 | (loop [acc (make-stripes pred n) i (if (= pred even?) 1 0)] 91 | (if (< i n) 92 | (recur 93 | (assoc-in 94 | acc [:out i] 95 | (mg/subdiv 96 | :rows 3 :slices 3 :out {4 {}} :empty? true)) 97 | (+ i 2)) 98 | acc))) 99 | 100 | (def tree 101 | "Main tree. Splits seed form into 3x3 cols/slices, removes center 102 | and replaces others with striped versions." 103 | (let [se (stripes* even? 9) 104 | so (mg/subdiv :rows 2 :out [(stripes* odd? 9)])] 105 | (mg/subdiv :cols 3 :slices 3 :out [se so se se nil se se so se]))) 106 | 107 | (mg/save-stl-mesh (mg/seed-box (a/aabb 1 0.2 1)) tree "out/ex02.stl") 108 | #+END_SRC 109 | 110 | ** Hexagon hemisphere 111 | 112 | [[../assets/img/morphogen-ex03.jpg]] 113 | 114 | The following short code is all what's needed to generate the mesh 115 | shown in the image above: A sphere segment (generated with 116 | =sphere-lattice-seg=) is used as seed shape to create a number of hexagons, 117 | which due to the side angles of the seed shape automatically arrange 118 | themselves in a spherical constellation. The entire structure is only 119 | using the =reflection= operator. Since the operator tree is context 120 | free & distinct from any actual geometry node hierarchy, we can encode 121 | various repetitive sub-transformations using simple functions. 122 | 123 | #+BEGIN_SRC clojure :tangle ../babel/examples/ex03.clj :noweb yes :mkdirp yes :padline no 124 | (ns ex03 125 | <>) 126 | 127 | (def t 128 | "Arrangement of 10 hexagons as sequence of nested reflections." 129 | (let [hex (mg/apply-recursively (mg/reflect :e) 5 [1] 1) 130 | reflected-hex (mg/reflect :n :out [{} hex]) 131 | inject #(-> hex 132 | (assoc-in (mg/child-path [1 1 0]) %) 133 | (assoc-in (mg/child-path [1 1 1 1 0]) %)) 134 | seed-clone (mg/reflect :s :out [{} (inject reflected-hex)])] 135 | (mg/reflect :s :out [(inject seed-clone) (inject reflected-hex)]))) 136 | 137 | ;; apply to sphere lattice segment to form hemisphere 138 | (mg/save-stl-mesh (mg/seed-box (mg/sphere-lattice-seg 6 0.25 0.0955 0.2)) t "out/ex03.stl") 139 | 140 | ;; apply to circle lattice segment to form flat structure 141 | (mg/save-stl-mesh (mg/seed-box (mg/circle-lattice-seg 6 0.25 0.2)) t "out/ex03-alt.stl") 142 | #+END_SRC 143 | 144 | The example also includes a variation of the same tree applied to a 145 | circle lattice segment forming a flat, planar structure instead of a 146 | hemisphere. Just uncomment the last line to see its result. 147 | 148 | [[../assets/img/morphogen-ex03-flat.jpg]] 149 | 150 | ** Hex virus 151 | 152 | [[../assets/img/morphogen-virus.jpg]] 153 | 154 | This structure very nicely demonstrates the potential of the whole 155 | morphogenic approach and uses the same hexagonal base elements as the 156 | previous example, but with the tree having much deeper nesting to 157 | create the additional antenna structures & hollowed skeleton cells, 158 | all of which are unfolded & extruded from the 60 individual hexagon 159 | line segments. The resulting structure has 51840 faces, 8460 times 160 | that the initial seed form/box! 161 | 162 | #+BEGIN_SRC clojure :tangle ../babel/examples/ex04.clj :noweb yes :mkdirp yes :padline no 163 | (ns ex04 164 | (:require 165 | [thi.ng.morphogen.core :as mg] 166 | [thi.ng.geom.core :as g] 167 | [thi.ng.geom.aabb :as a]) 168 | (:import 169 | [thi.ng.morphogen.core BoxNode])) 170 | 171 | (defn hollow-out 172 | "Returns a tree which applies the `subdiv-inset` operator to a form 173 | in the given direction and removes the center child or optionally 174 | injects given :out vector/map of children. If `empty?` is true, all 175 | children are removed by default (only makes sense if other children 176 | are given, else it should be false)." 177 | ([dir inset] 178 | (hollow-out dir inset false {4 nil})) 179 | ([dir inset empty? out] 180 | (mg/subdiv-inset :dir dir :inset inset :out out :empty? empty?))) 181 | 182 | (defn antenna-ring 183 | "Returns tree which extrudes form in given direction (east/west), 184 | splits it into 3 columns, scales side edges of last to half length 185 | and then forms ring using last column by recursively reflecting it 186 | `n` times." 187 | [dir edge1 edge2 ring-child-id n] 188 | (let [ring (mg/apply-recursively (mg/reflect :n) n [1] 1)] 189 | (mg/extrude 190 | :dir dir :len 0.1 191 | :out 192 | [(mg/scale-edge 193 | edge1 :y 194 | :out 195 | [(mg/subdiv 196 | :cols 3 197 | :out 198 | {ring-child-id (mg/scale-edge edge2 :z :out [ring])})])]))) 199 | 200 | (def antenna-rings 201 | "The two east/west facing ring modules attached to the tip of the antenna." 202 | [(antenna-ring :w :ab :bf 0 13) 203 | (antenna-ring :e :cd :cg 2 13)]) 204 | 205 | (def antenna-tip 206 | "The last (thinnest) two antenna segments with rings attached to the lower one." 207 | (mg/subdiv 208 | :cols 3 209 | :out [nil 210 | (mg/extrude 211 | :dir :b :len 0.5 212 | :out [(mg/subdiv 213 | :slices 8 214 | :out {0 (hollow-out :z 0.01 false {4 (mg/extrude :dir :b :len 1)}) 215 | 1 (mg/subdiv :cols 2 :out antenna-rings)})]) 216 | nil])) 217 | 218 | (def antenna-main 219 | "Main antenna parts without base ." 220 | (hollow-out 221 | :z 0.025 true 222 | {4 (mg/extrude 223 | :dir :b :len 0.25 224 | :out [(hollow-out :z 0.025 false {4 antenna-tip})])})) 225 | 226 | (defn antenna-module 227 | "Complete antenna module with configurable base." 228 | [inset] 229 | (mg/extrude 230 | :dir :b :len 0.2 231 | :out [(hollow-out 232 | :z inset false 233 | {4 (mg/subdiv :slices 2 :out {0 antenna-main})})])) 234 | 235 | (def tree 236 | "Main tree. First forms arrangement of 10 hexagons using seed form & 237 | sequence of nested reflections. Then applies skeletonization and 238 | attaches antennas to all 60 segments. These are injected using the 239 | `map-leaves` function which replaces all leaf nodes in the tree with 240 | a new subtree." 241 | (let [hex (mg/apply-recursively (mg/reflect :e) 5 [1] 1) 242 | refl-hex (mg/reflect :n :out [{} hex]) 243 | inject #(-> hex 244 | (assoc-in (mg/child-path [1 1 0]) %) 245 | (assoc-in (mg/child-path [1 1 1 1 0]) %)) 246 | seed-clone (mg/reflect :s :out {1 (inject refl-hex)}) 247 | inset 0.03 248 | skeleton (hollow-out 249 | :y inset false 250 | [(hollow-out :z inset) 251 | (mg/subdiv 252 | :cols 3 253 | :out [(hollow-out :z inset) 254 | (antenna-module inset) 255 | (hollow-out :z inset)]) 256 | (hollow-out :x inset) 257 | (hollow-out :x inset)])] 258 | (->> (mg/reflect :s :out [(inject seed-clone) (inject refl-hex)]) 259 | (mg/map-leaves (constantly skeleton))))) 260 | 261 | ;; apply to sphere lattice segment to form hemisphere 262 | (mg/save-stl-mesh (mg/seed-box (mg/sphere-lattice-seg 6 0.25 0.0955 0.2)) tree "out/ex04.stl") 263 | #+END_SRC 264 | 265 | ** MIT Selfassembly module 266 | 267 | [[../assets/img/morphogen-ex05.jpg]] 268 | 269 | #+BEGIN_SRC clojure :tangle ../babel/examples/ex05.clj :noweb yes :mkdirp yes :padline no 270 | (ns ex05 271 | <>) 272 | 273 | <> 274 | 275 | (defn stripes* 276 | "Similar to `make-stripes`, but replaces the killed off columns with 277 | connector elements by splitting each with the 278 | keeping the center one. Returns tree of columns as created by 279 | `make-stripes` and connectors between them." 280 | [pred gap-opts n] 281 | (loop [acc (make-stripes pred n) i (if (= pred even?) 1 0)] 282 | (if (< i n) 283 | (recur 284 | (assoc-in acc [:out i] (apply mg/subdiv gap-opts)) 285 | (+ i 2)) 286 | acc))) 287 | 288 | (def tree 289 | (mg/subdiv 290 | :cols 3 291 | :out [(mg/subdiv 292 | :cols 2 :out [(mg/subdiv-inset :dir :x :inset 0.005 :out {4 nil}) {}]) 293 | (stripes* odd? [:rows 3 :out [nil {} nil]] 19) 294 | (mg/subdiv 295 | :cols 2 :out [{} (mg/subdiv-inset :dir :x :inset 0.0055 :out {4 {}} :empty? true)])])) 296 | 297 | (mg/save-stl-mesh (mg/seed-box (a/aabb 1 0.2 0.2)) tree "out/ex05.stl") 298 | #+END_SRC 299 | -------------------------------------------------------------------------------- /src/index.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: "setup.org" 2 | #+TITLE: thi.ng/morphogen 3 | 4 | * About the project 5 | 6 | ** Overview 7 | 8 | Declarative 3D form evolution through tree-based transformations. 9 | 10 | [[../assets/img/morphogen-virus.jpg]] 11 | 12 | This project is part of the [[https://github.com/thi-ng/][thi.ng]] collection of Clojure & 13 | Clojurescript libraries and is written in a literate programming 14 | style. Building on top of its companion, the [[https://github.com/thi-ng/geom][thi.ng/geom]] library, 15 | *morphogen* provides a set of extensible building blocks to generate 16 | complex 3d structures in a completely data driven, declarative style. 17 | 18 | [[http://en.wikipedia.org/wiki/Morphogenesis][Morphogensis]], as one of the fundamental processes in developmental 19 | biology, is used as the guiding metaphor for the design approach and 20 | the tools defined in this library: A purposely small number of spatial 21 | transformers (currently only: subdivision, reflection, extrusion) can 22 | be encoded as a (potentially) deeply nested tree, which is then 23 | recursively applied to a single, basic 3d seed form (e.g. a cube) to 24 | evolve it. This tree of operators fulfills a similar role as DNA does 25 | in nature, but can also be understood as the [[https://en.wikipedia.org/wiki/Abstract_syntax_tree][AST]] of a program. The 26 | operators themselves are [[https://en.wikipedia.org/wiki/Context-free_grammar][context free]], i.e. they have no direct 27 | relationship to the geometric elements they operate on, nor do they 28 | need to be aware of their position in the tree. In fact, the tree of 29 | operators is entirely distinct from any geometries. When the tree is 30 | walked & applied to the seed form, a second tree of mesh elements is 31 | being constructed reflecting the transformation results. Technically, 32 | the operators are pure functions, simply producing a sequence of new 33 | geometry nodes. This combination enables the declarative approach to 34 | tree building and the independent formulation, extraction and 35 | injection of sub-trees and therefore the definition of a re-usable 36 | vocabulary of higher order operators. The intention is to include some 37 | of them in the core library as development progresses. 38 | 39 | A more detailed description of all elements and their implementation 40 | can be found in the [[file:core.org][core namespace]] of this library. 41 | 42 | ** Status 43 | 44 | ALPHA quality, work in progress. This project is actively being worked 45 | on and is likely to receive daily updates over the next couple of months. 46 | 47 | ** Example usage 48 | 49 | Again, since operators are only depending on the basic topology (but 50 | *not* the position, size or orientation) of the seed form, even this 51 | small number of operators can already produce a vast number of 52 | outcomes. The repo contains a [[file:examples.org][file with documented examples]] which can 53 | be run from the REPL and export meshes in Stanford PLY format. 54 | 55 | * Namespaces 56 | 57 | - [[./core.org][thi.ng.morphogen.core]] 58 | - [[./examples.org][examples]] 59 | 60 | * Tests 61 | 62 | * Project definition 63 | 64 | ** Injected properties :noexport: 65 | #+BEGIN_SRC clojure :noweb-ref version 66 | 0.2.0-SNAPSHOT 67 | #+END_SRC 68 | #+BEGIN_SRC clojure :exports none :noweb-ref project-url 69 | https://github.com/thi-ng/morphogen 70 | #+END_SRC 71 | #+BEGIN_SRC clojure :exports none :noweb-ref gen-source-path 72 | target/classes 73 | #+END_SRC 74 | #+BEGIN_SRC clojure :exports none :noweb-ref gen-test-path 75 | target/test-classes 76 | #+END_SRC 77 | #+BEGIN_SRC clojure :exports none :noweb yes :noweb-ref cljs-artefact-path 78 | target/morphogen-<>.js 79 | #+END_SRC 80 | 81 | ** Dependencies 82 | *** Runtime 83 | **** [[https://github.com/clojure/clojure][Clojure]] 84 | #+BEGIN_SRC clojure :noweb-ref dep-clj 85 | [org.clojure/clojure "1.9.0"] 86 | #+END_SRC 87 | **** [[https://github.com/clojure/clojurescript][ClojureScript]] 88 | #+BEGIN_SRC clojure :noweb-ref dep-cljs 89 | [org.clojure/clojurescript "1.10.238"] 90 | #+END_SRC 91 | **** [[https://github.com/thi-ng/geom][thi.ng/geom]] 92 | #+BEGIN_SRC clojure :noweb-ref dep-geom 93 | [thi.ng/geom "1.0.0-RC3"] 94 | #+END_SRC 95 | *** Development 96 | **** [[https://github.com/thi-ng/luxor][thi.ng/luxor]] 97 | #+BEGIN_SRC clojure :noweb-ref dep-luxor 98 | [thi.ng/luxor "0.3.0" :exclusions [thi.ng/common thi.ng/geom]] 99 | #+END_SRC 100 | **** [[https://github.com/hugoduncan/criterium][Criterium]] 101 | #+BEGIN_SRC clojure :noweb-ref dep-criterium 102 | [criterium "0.4.3"] 103 | #+END_SRC 104 | **** [[https://github.com/cemerick/clojurescript.test][clojurescript.test]] 105 | #+BEGIN_SRC clojure :noweb-ref dep-cljs-test 106 | [com.cemerick/clojurescript.test "0.3.3"] 107 | #+END_SRC 108 | **** [[https://github.com/emezeske/lein-cljsbuild][Cljsbuild]] 109 | #+BEGIN_SRC clojure :noweb-ref dep-cljsbuild 110 | [lein-cljsbuild "1.1.7"] 111 | #+END_SRC 112 | 113 | ** Leiningen coordinates 114 | #+BEGIN_SRC clojure :noweb yes :noweb-ref lein-coords 115 | [thi.ng/morphogen "0.2.0-SNAPSHOT"] 116 | #+END_SRC 117 | 118 | ** Building this project 119 | 120 | This project is written in a literate programming format and requires 121 | [[https://www.gnu.org/software/emacs/][Emacs]] & [[http://orgmode.org][Org-mode]] to generate usable source code. Assuming both tools 122 | are installed, the easiest way to generate a working project is via 123 | command line (make sure =emacs= is on your path or else edit its path 124 | in =tangle.sh=): 125 | 126 | #+BEGIN_SRC bash 127 | git clone https://github.com/thi-ng/morphogen.git 128 | cd morphogen 129 | ./tangle.sh src/*.org test/*.org 130 | #+END_SRC 131 | 132 | Tangling is the process of extracting & combining source blocks from 133 | =.org= files into an actual working project/source tree. Once tangling 134 | is complete, you can =cd= into the generated project directory 135 | (=babel=) and then use =lein repl= as usual. 136 | 137 | *** Testing 138 | 139 | The =project.clj= file defines an alias to trigger a complete build & 140 | tests for both CLJ & CLJS versions. 141 | 142 | #+BEGIN_SRC bash 143 | cd babel 144 | lein cleantest 145 | #+END_SRC 146 | 147 | To build the Clojurescript version simply run =lein cljsbuild test= 148 | from the same directory. A small HTML harness for the resulting JS 149 | file is also located in that folder (=babel/index.html=), allowing for 150 | further experimentation in the browser. 151 | 152 | *** Working with the REPL 153 | 154 | Editing code blocks or files in Org-mode, then re-loading & testing 155 | changes is quite trivial. Simply launch a REPL (via =lein= or Emacs) 156 | as usual. Everytime you've made changes to an =.org= file, re-tangle 157 | it from Emacs (=C-c C-v t=) or =tangle.sh=, then reload the namespace 158 | in the REPL via =(require 'thi.ng.morphogen... :reload)= or similar. 159 | 160 | ** Leiningen project file :noexport: 161 | #+BEGIN_SRC clojure :tangle ../babel/project.clj :noweb yes :mkdirp yes :padline no 162 | (defproject thi.ng/morphogen "<>" 163 | :description "3d form evolution through tree-based transformations" 164 | :url "<>" 165 | :license {:name "Apache Software License 2.0" 166 | :url "http://www.apache.org/licenses/LICENSE-2.0" 167 | :distribution :repo} 168 | :scm {:name "git" 169 | :url "git@github.com:thi-ng/morphogen.git"} 170 | 171 | :min-lein-vesion "2.4.0" 172 | 173 | :dependencies [<> 174 | <>] 175 | 176 | :profiles {:dev {:dependencies [<> 177 | <> 178 | <>] 179 | :plugins [<> 180 | <>] 181 | :global-vars {*warn-on-reflection* true} 182 | :jvm-opts ^:replace [] 183 | :aliases {"cleantest" ["do" "clean" "test" "cljsbuild" "test"]}}} 184 | 185 | :cljsbuild {:builds [{:source-paths ["src" "test"] 186 | :id "simple" 187 | :compiler {:output-to "<>" 188 | :optimizations :whitespace 189 | :pretty-print true}}] 190 | :test-commands {"unit-tests" ["phantomjs" :runner "<>"]}} 191 | 192 | :pom-addition [:developers [:developer 193 | [:name "Karsten Schmidt"] 194 | [:url "http://postspectacular.com"] 195 | [:timezone "0"]]]) 196 | #+END_SRC 197 | 198 | ** ClojureScript HTML harness :noexport: 199 | #+BEGIN_SRC html :tangle ../babel/index.html :noweb yes :mkdirp yes :padline no 200 | 201 | 202 | 203 | <<lein-coords>> test 204 | 205 | 206 | 207 | 208 | 209 | #+END_SRC 210 | 211 | ** Accessing library version during runtime 212 | 213 | The autogenerated namespace =thi.ng.morphogen.version= contains a single 214 | symbol =version= holding the version string defined above: 215 | 216 | #+BEGIN_SRC clojure :noweb yes 217 | (use '[thi.ng.morphogen.version]) 218 | 219 | (prn version) 220 | ; "<>" 221 | #+END_SRC 222 | 223 | *** Version namespace :noexport: 224 | 225 | #+BEGIN_SRC clojure :tangle ../babel/src/thi/ng/morphogen/version.cljc :noweb yes :mkdirp yes :padline no :exports none 226 | (ns thi.ng.morphogen.version) 227 | 228 | (def version "<>") 229 | #+END_SRC 230 | 231 | ** Release history 232 | 233 | | *Version* | *Released* | *Description* | *Lein coordinates* | *Tagged Github URL* | 234 | |-----------+------------+---------------------+------------------------------+---------------------| 235 | | 0.1.1 | 2015-02-27 | bugfix dependencies | =[thi.ng/morphogen "0.1.1"]= | [[https://github.com/thi-ng/morphogen/tree/0.1.1][0.1.1]] | 236 | | 0.1.0 | 2015-02-25 | 1st public release | =[thi.ng/morphogen "0.1.0"]= | [[https://github.com/thi-ng/morphogen/tree/0.1.0][0.1.0]] | 237 | 238 | ** Contributors 239 | 240 | | *Name* | *Role* | *Website* | 241 | |-----------------+---------------------------------+----------------------------| 242 | | [[k@thi.ng][Karsten Schmidt]] | initiator & principal developer | http://postspectacular.com | 243 | | | | http://thi.ng | 244 | 245 | ** License 246 | 247 | This project is open source and licensed under the [[http://www.apache.org/licenses/LICENSE-2.0][Apache Software License 2.0]]. 248 | -------------------------------------------------------------------------------- /src/libraryofbabel.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: setup.org 2 | 3 | * The morphogen Library of Babel 4 | 5 | This file contains shared and configurable code templates for various 6 | parts of this project. Templates using variables are wrapped in a 7 | simple Elisp form, but you can also define verbatim templates if vars 8 | aren't needed... 9 | 10 | ** Example template with variables 11 | #+NAME: lob-morphogen-greetings 12 | #+BEGIN_SRC emacs-lisp :var msg="" 13 | (replace-regexp-in-string 14 | "~~msg~~" msg 15 | "(defn show-greetings 16 | [] (println \"~~msg~~\"))") 17 | #+END_SRC 18 | 19 | ** Example verbatim template 20 | #+NAME: lob-morphogen-verbatim 21 | #+BEGIN_SRC clojure 22 | (* 12345679 7.2) 23 | #+END_SRC 24 | -------------------------------------------------------------------------------- /src/setup.org: -------------------------------------------------------------------------------- 1 | #+SEQ_TODO: TODO(t) INPROGRESS(i) WAITING(w@) | DONE(d) CANCELED(c@) 2 | #+TAGS: write(w) fix(f) verify(v) noexport(n) template(t) usetemplate(u) 3 | #+EXPORT_EXCLUDE_TAGS: noexport 4 | #+AUTHOR: Karsten Schmidt 5 | #+EMAIL: k@thi.ng 6 | #+LANGUAGE: en 7 | #+OPTIONS: toc:3 h:4 html-postamble:auto html-preamble:t tex:t 8 | #+HTML_CONTAINER: div 9 | #+HTML_DOCTYPE: 10 | #+HTML_HEAD: 11 | #+HTML_HEAD: 12 | -------------------------------------------------------------------------------- /tangle.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | DIR=`pwd` 4 | FILES="" 5 | 6 | # wrap each argument in the code required to call tangle on it 7 | for i in $@; do 8 | FILES="$FILES \"$i\"" 9 | done 10 | 11 | emacs -Q --batch \ 12 | --eval \ 13 | "(progn 14 | (require 'org)(require 'ob)(require 'ob-tangle)(require 'ob-lob) 15 | (org-babel-lob-ingest \"src/libraryofbabel.org\") 16 | (setq org-confirm-babel-evaluate nil) 17 | (mapc (lambda (file) 18 | (find-file (expand-file-name file \"$DIR\")) 19 | (org-babel-tangle) 20 | (kill-buffer)) '($FILES)))" \ 21 | #2>&1 | grep Tangled 22 | -------------------------------------------------------------------------------- /test/core.org: -------------------------------------------------------------------------------- 1 | #+SETUPFILE: "../src/setup.org" 2 | 3 | * thi.ng.morphogen.test.core 4 | 5 | ** Namespace declaration 6 | 7 | #+BEGIN_SRC clojure :tangle ../babel/test/thi/ng/morphogen/test/core.cljc :mkdirp yes :padline no 8 | (ns thi.ng.morphogen.test.core 9 | #?(:cljs 10 | (:require-macros 11 | [cemerick.cljs.test :refer (is deftest with-test testing)]) 12 | :clj 13 | (:require 14 | [clojure.test :refer :all]))) 15 | #+END_SRC 16 | ** TODO Test constants 17 | 18 | #+BEGIN_SRC clojure :tangle ../babel/test/thi/ng/morphogen/test/core.cljc 19 | (def meaning 42) 20 | #+END_SRC 21 | 22 | ** TODO Main tests 23 | 24 | #+BEGIN_SRC clojure :tangle ../babel/test/thi/ng/morphogen/test/core.cljc 25 | (deftest epic-fail 26 | (is (= 3 (+ 1 1)) "FIXME")) 27 | #+END_SRC 28 | --------------------------------------------------------------------------------