# HG changeset patch # User Steve Losh # Date 1521082378 14400 # Node ID cb69666ad32fec3a8273f6f885c7466f57dee27f # Parent abd8097693a4f0866fc58fb10a30274ea369bb64 Update triangulation and a bit more diff -r abd8097693a4 -r cb69666ad32f src/looms/001-triangles.lisp --- 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)) diff -r abd8097693a4 -r cb69666ad32f src/looms/004-turtle-curves.lisp --- 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))) diff -r abd8097693a4 -r cb69666ad32f src/looms/005-simple-triangulations.lisp --- 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))