# HG changeset patch # User Steve Losh # Date 1517686552 18000 # Node ID 839094aa1657cba17157fa9770c6a4e4177dbd17 # Parent 55c0df99bd7affc82728e5d4d4fa714fc0c6d45d Cleanup diff -r 55c0df99bd7a -r 839094aa1657 src/looms/001-triangles.lisp --- 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))