cb69666ad32f

--- a/src/looms/001-triangles.lisp	Tue Mar 06 22:40:37 2018 -0500
+++ b/src/looms/001-triangles.lisp	Wed Mar 14 22:52:58 2018 -0400
@@ -101,4 +101,4 @@
     (flax.drawing:render canvas (convert (generate-universe-balancing depth seed)))))
 
 
-;; (time (loom 1964055800 17 "out" :png 1000 1000))
+;; (time (loom (pr (random (expt 2 31))) 12 "out" :svg 1000 1000))

--- a/src/looms/004-turtle-curves.lisp	Tue Mar 06 22:40:37 2018 -0500
+++ b/src/looms/004-turtle-curves.lisp	Wed Mar 14 22:52:58 2018 -0400
@@ -21,49 +21,52 @@
 (define-modify-macro rotf (amount) rot)
 
 
-(defgeneric perform-command (turtle command))
+(defgeneric perform-command (turtle command n))
 
-(defmethod perform-command (turtle (command (eql 'f)))
+(defmethod perform-command (turtle (command (eql 'f)) n)
   (with-turtle (turtle)
     (list (flax.drawing:path
             (list (coord x y)
-                  (progn (perform-command turtle 's)
+                  (progn (perform-command turtle 's n)
                          (coord x y)))
             :color *color*))))
 
-(defmethod perform-command (turtle (command (eql 'fl)))
-  (perform-command turtle 'f))
+(defmethod perform-command (turtle (command (eql 'fl)) n)
+  (perform-command turtle 'f n))
+
+(defmethod perform-command (turtle (command (eql 'fr)) n)
+  (perform-command turtle 'f n))
 
-(defmethod perform-command (turtle (command (eql 'fr)))
-  (perform-command turtle 'f))
-
-(defmethod perform-command (turtle (command (eql 's)))
-  (with-turtle (turtle)
-    (incf x (* *step* (cos angle)))
-    (incf y (* *step* (sin angle))))
+(defmethod perform-command (turtle (command (eql 's)) n)
+  (do-repeat n
+    (with-turtle (turtle)
+      (incf x (* *step* (cos angle)))
+      (incf y (* *step* (sin angle)))))
   nil)
 
-(defmethod perform-command (turtle (command (eql 'x)))
+(defmethod perform-command (turtle (command (eql 'x)) n)
   nil)
 
-(defmethod perform-command (turtle (command (eql '-)))
-  (rotf (turtle-angle turtle) *angle*)
+(defmethod perform-command (turtle (command (eql '-)) n)
+  (rotf (turtle-angle turtle) (* n *angle*))
   nil)
 
-(defmethod perform-command (turtle (command (eql '+)))
-  (rotf (turtle-angle turtle) (- *angle*))
+(defmethod perform-command (turtle (command (eql '+)) n)
+  (rotf (turtle-angle turtle) (* n (- *angle*)))
   nil)
 
-(defmethod perform-command (turtle (command (eql '<)))
-  (with-turtle (turtle)
-    (push (list x y angle) state))
+(defmethod perform-command (turtle (command (eql '<)) n)
+  (do-repeat n
+    (with-turtle (turtle)
+      (push (list x y angle) state)))
   nil)
 
-(defmethod perform-command (turtle (command (eql '>)))
-  (with-turtle (turtle)
-    (when-let ((prev (pop state)))
-      (destructuring-bind (ox oy oa) prev
-          (setf x ox y oy angle oa))))
+(defmethod perform-command (turtle (command (eql '>)) n)
+  (do-repeat n
+    (with-turtle (turtle)
+      (when-let ((prev (pop state)))
+        (destructuring-bind (ox oy oa) prev
+          (setf x ox y oy angle oa)))))
   nil)
 
 
@@ -96,8 +99,20 @@
       (x p2) (map-range min-x max-x x-padding (- 1.0 x-padding) %)
       (y p2) (map-range min-y max-y y-padding (- 1.0 y-padding) %))))
 
+
+(defun encode (commands)
+  (iterate
+    (with n = 1)
+    (for (command . next) :on commands)
+    (if (eq command (car next))
+      (incf n)
+      (progn (collect (cons command n))
+             (setf n 1)))))
+
 (defun turtle-draw (commands)
-  (let ((paths (mapcan (curry #'perform-command (make-turtle)) commands)))
+  (let ((paths (iterate (with turtle = (make-turtle))
+                        (for (command . n) :in (encode commands))
+                        (appending (perform-command turtle command n)))))
     (scale paths)
     paths))
 
@@ -293,4 +308,5 @@
                  (if should-mutate mutation-seed nil)))))
 
 
-;; (time (loom (pr (random (expt 2 31))) "out" :svg 1000 1000))
+;; (time (loom 201354591 "out" :svg 1000 1000
+;;             *tree-f* 6 (- 1/4tau)))

--- a/src/looms/005-simple-triangulations.lisp	Tue Mar 06 22:40:37 2018 -0500
+++ b/src/looms/005-simple-triangulations.lisp	Wed Mar 14 22:52:58 2018 -0400
@@ -2,19 +2,22 @@
 
 ;; https://mattdesl.svbtle.com/pen-plotter-1
 
-(defparameter *point-size* 0.004)
+(defparameter *point-size* 0.006)
 
 (defun convert-point (point)
-  (flax.drawing:circle point *point-size*))
+  (flax.drawing:circle point (random-gaussian *point-size*
+                                              (* 0.15 *point-size*)
+                                              #'rand)))
 
-(defun convert-triangle (tri)
-  (destructuring-bind (a b c) tri
-    (flax.drawing:triangle a b c)))
+(defun convert-triangle (ratio tri)
+  (when (randomp ratio #'rand)
+    (destructuring-bind (a b c) tri
+      (list (flax.drawing:triangle a b c)))))
 
-(defun convert (points)
+(defun convert (points ratio)
   (append
-    ;; (map 'list #'convert-point points)
-    (map 'list #'convert-triangle (triangulate points))))
+    (map 'list #'convert-point points)
+    (mapcan (curry #'convert-triangle ratio) (triangulate points))))
 
 (defun triangulate (points)
   (mapcar (lambda (indexes)
@@ -41,19 +44,26 @@
            (collect (funcall generator) 
                     :result-type 'vector)))
 
-(defun loom (seed points filename filetype width height)
+(defun loom (seed points filename filetype width height &key ratio)
   (losh::clear-gaussian-spare)
-  (with-seed seed
+  (nest
+    (with-seed seed)
     (flax.drawing:with-rendering (canvas filetype filename width height
-                                         :background (hsv 0.09 0.05 0.975))
-      (destructuring-bind (generator generator-name)
-          (random-elt '((generate-point-uniform "Uniform")
-                        (generate-point-gaussian "Gaussian")
-                        (generate-point-gaussian-vertical "Vertical Gaussian")
-                        (generate-point-gaussian-horizontal "Horizontal Gaussian"))
-                      #'rand)
-        (flax.drawing:render canvas (convert (generate generator points)))
-        generator-name))))
+                                         :background (hsv 0.09 0.05 0.975)))
+    (destructuring-bind (generator generator-name)
+        (random-elt '((generate-point-uniform "Uniform")
+                      (generate-point-gaussian "Gaussian")
+                      (generate-point-gaussian-vertical "Vertical Gaussian")
+                      (generate-point-gaussian-horizontal "Horizontal Gaussian"))
+                    #'rand))
+    (let* ((triangulation-ratio (if (randomp 0.5 #'rand)
+                                  1
+                                  (random-range 0.1 0.3 #'rand)))
+           (triangulation-ratio (or ratio triangulation-ratio))))
+    (progn
+      (flax.drawing:render canvas (convert (generate generator points)
+                                           triangulation-ratio))
+      (list generator-name triangulation-ratio))))
 
 
-;; (time (loom nil (* 10 (random 100)) "out" :png 800 800))
+;; (time (loom 5 400 "out" :svg 800 800 :ratio nil))