src/looms/005-simple-triangulations.lisp @ 5341efcdeefe
Update to latest cl-losh
author |
Steve Losh <steve@stevelosh.com> |
date |
Thu, 02 Dec 2021 12:35:37 -0500 |
parents |
ebe16cb914fb |
children |
(none) |
(in-package :flax.looms.005-simple-triangulations)
;; https://mattdesl.svbtle.com/pen-plotter-1
(defparameter *point-size* 0.003)
(defun convert-point (point)
(flax.drawing:circle point (random-gaussian *point-size*
(* 0.15 *point-size*)
#'rand)))
(defun convert-triangle (ratio tri)
(when (randomp ratio #'rand)
(list (apply #'flax.drawing:triangle tri))))
(defun convert (points ratio)
(append
(map 'list #'convert-point points)
(mapcan (curry #'convert-triangle ratio) (triangulate points))))
(defun triangulate (points)
(mapcar (lambda (indexes)
(map 'list (curry #'aref points) indexes))
(lofi.tri:triangulate (map 'vector (lambda (p)
(cons (vx p) (vy p)))
points))))
(defun gauss ()
(clamp 0.0 1.0 (random-gaussian 0.5 0.15 #'rand)))
(defun generate-point-uniform ()
(vec2 (rand 1.0) (rand 1.0)))
(defun generate-point-gaussian ()
(vec2 (gauss) (gauss)))
(defun generate-point-gaussian-vertical ()
(vec2 (rand 1.0) (gauss)))
(defun generate-point-gaussian-horizontal ()
(vec2 (gauss) (rand 1.0)))
(defun generate (generator n)
(iterate (repeat n)
(collect (funcall generator)
:result-type 'vector)))
(defun select-generator ()
(random-elt '((generate-point-uniform "Uniform")
(generate-point-gaussian "Gaussian")
(generate-point-gaussian-vertical "Vertical Gaussian")
(generate-point-gaussian-horizontal "Horizontal Gaussian"))
#'rand))
(defun loom (seed filename filetype width height &key ratio points)
(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) (select-generator))
(randomly-initialize
((ratio (if (randomp 0.5 #'rand)
1
(random-range 0.05 0.2 #'rand)))
(points (round-to (random-range-inclusive 100 1000 #'rand) 10))))
(progn
(_ (generate generator points)
(convert _ ratio)
(flax.drawing:render canvas _))
(values generator-name points ratio))))
;; (time (loom 55 "out" :svg 800 800 ))