839094aa1657

Cleanup
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 03 Feb 2018 14:35:52 -0500
parents 55c0df99bd7a
children b5df1c581eaf
branches/tags (none)
files src/looms/001-triangles.lisp

Changes

--- a/src/looms/001-triangles.lisp	Sat Feb 03 14:31:14 2018 -0500
+++ b/src/looms/001-triangles.lisp	Sat Feb 03 14:35:52 2018 -0500
@@ -1,6 +1,15 @@
 (in-package :flax.looms.001-triangles)
 
+;;;; Triangle Subdivision
+;;;
+;;; Based on http://www.tylerlhobbs.com/writings/triangle-subdivision
 
+;;;; Utils --------------------------------------------------------------------
+(defun round-to (number divisor)
+  (* divisor (round number divisor)))
+
+
+;;;; Elements -----------------------------------------------------------------
 (defstruct (triangle (:conc-name ""))
   (a (coord 0 0) :type coord)
   (b (coord 0 0) :type coord)
@@ -12,8 +21,21 @@
   (make-triangle :a a :b b :c c))
 
 
-(defun round-to (number divisor)
-  (* divisor (round number divisor)))
+;;;; Element Conversion -------------------------------------------------------
+(defun convert-to-drawing (triangle)
+  (with-triangle (triangle)
+    (flax.drawing:triangle a b c)))
+
+
+;;;; Generation ---------------------------------------------------------------
+(defun initial-triangles ()
+  (list (triangle (coord 0 1)
+                  (coord 1 1)
+                  (coord 0 0))
+        (triangle (coord 1 0)
+                  (coord 1 1)
+                  (coord 0 0))))
+
 
 (defun split-triangle-evenly (triangle)
   (with-triangle (triangle)
@@ -23,6 +45,12 @@
       (list (triangle p b a)
             (triangle p a c)))))
 
+(defun generate-universe-even (depth &aux (triangles (initial-triangles)))
+  (do-repeat depth
+    (zapf triangles (mappend #'split-triangle-evenly %)))
+  triangles)
+
+
 (defun find-longest-side (triangle)
   (with-triangle (triangle)
     (let* ((ab (distance a b))
@@ -35,7 +63,6 @@
         ((= longest ca) (list b c a))
         (t (error "what?"))))))
 
-
 (defun split-triangle-self-balancing (triangle)
   (destructuring-bind (a b c) (find-longest-side triangle)
     (let ((p (-<> (random-gaussian 0.5 0.1 #'rand)
@@ -45,23 +72,6 @@
       (list (triangle p b a)
             (triangle p a c)))))
 
-(defun convert-to-drawing (triangle)
-  (with-triangle (triangle)
-    (flax.drawing:triangle a b c)))
-
-(defun initial-triangles ()
-  (list (triangle (coord 0 1)
-                  (coord 1 1)
-                  (coord 0 0))
-        (triangle (coord 1 0)
-                  (coord 1 1)
-                  (coord 0 0))))
-
-(defun generate-universe-even (depth &aux (triangles (initial-triangles)))
-  (do-repeat depth
-    (zapf triangles (mappend #'split-triangle-evenly %)))
-  triangles)
-
 (defun generate-universe-balancing (depth seed)
   (losh::clear-gaussian-spare)
   (with-seed seed
@@ -80,14 +90,13 @@
                         (split-triangle-self-balancing triangle)))))
         (map nil #'recur (initial-triangles))))))
 
-(defun render (universe filename width height)
-  (flax.drawing:render (mapcar #'convert-to-drawing universe)
-                       filename width height))
+
+;;;; Main ---------------------------------------------------------------------
+(defun convert (universe)
+  (mapcar #'convert-to-drawing universe))
 
 (defun loom (seed depth filename width height)
-  (render (generate-universe-balancing depth seed)
-          filename width height))
+  (flax.drawing:render (convert (generate-universe-balancing depth seed))
+                       filename width height))
 
-
-
-(time (loom nil 19 "out.pnm" 4000 4000))
+;; (time (loom nil 19 "out.pnm" 4000 4000))