src/looms/002-wobbly-lines.lisp @ d3a901ef3501

Loom 2
author Steve Losh <steve@stevelosh.com>
date Sun, 04 Feb 2018 00:02:49 -0500
parents (none)
children 2cb0d67b2cfa
(in-package :flax.looms.002-wobbly-lines)

;;;; Elements -----------------------------------------------------------------
(defstruct (line (:conc-name "")
                 (:constructor line (points)))
  (points (error "Required") :type vector))

(define-with-macro (line :conc-name "") points)

;;;; Element Conversion -------------------------------------------------------
(defun convert (line total-ticks)
  (list (flax.drawing::path (coerce (points line) 'list)
                            :opacity (/ 75.0 total-ticks))))


;;;; Generation ---------------------------------------------------------------
(defun initial (segments)
  (line
    (iterate
      (for x :from 0.0 :to (+ 1.0 least-positive-single-float) :by (/ 1.0 segments))
      (collect (coord x 0.5) :result-type 'vector))))

;;;; Tick ---------------------------------------------------------------------
(defun perturb-line (line)
  (map nil (lambda (c)
             (incf (y c) (random-range-inclusive -0.02 0.02 #'rand)))
       (points line)))

(defun smooth-line (line)
  (iterate
    (with points = (points line))
    (with final = (1- (length points)))
    (for c :in-vector points :with-index i)
    (for y = (y c))
    (for l = (or (unless (zerop i) (y (aref points (1- i)))) y))
    (for r = (or (unless (= final i) (y (aref points (1+ i)))) y))
    (zapf (y c) (/ (+ % % l r) 4.0))))

(defun tick (line)
  (perturb-line line)
  (smooth-line line))


;;;; Main ---------------------------------------------------------------------
(defun loom (seed ticks filename width height)
  (with-seed seed
    (flax.drawing:with-rendering (image filename width height :padding 0.0)
      (let ((line (initial 300)))
        (dotimes (tick ticks)
          (when (dividesp tick (/ (expt 10 (floor (log ticks 10))) 2))
            (print tick))
          (flax.drawing:render image (convert line ticks))
          (tick line))))))


;; (time (loom nil 1000 "out.pnm" 2000 500))