daydreamer/daydreamer.scm

(use-modules (basket)
             (filigree)
             (ice-9 r5rs)
             (ice-9 pretty-print)
             (srfi srfi-1)
             (srfi srfi-26))

(define (random:range x y)
  (+ x (* (- y x) (random:uniform))))

;; main grammar. used to generate inputs to the mutf- grammars, which can
;; generate many slight variants on the same function
(define grammar
  `((c:randint ,(lambda (rng x y) (+ x (random (- y x) rng))))
    (c:randf ,(lambda (rng x y) (+ x (* (random:uniform rng) (- y x)))))
    (c:n () 3 5 7)
    (c:n2 () 2 4 6 8)
    (c:fn () sin cos)
    (c:t (c:x) (+ (c:mutf (c:randf 0 ,tau) 0.25) (c:x)))
    (c:size () 1 -1 1 -1 1 -1 ((c:fn) (c:t (* (c:n) t))))
    (c:pos () (+ (* 1/2 (c:size) ((c:fn) (c:t (* (c:n) t))))
                 (* 1/2 (c:size) ((c:fn) (c:t (* (c:n 2) t))))))
    (c:expr () (make-vec (c:pos) (c:pos)))
    (c:origin () (lambda (t) (c:expr)))))

;; mutate into identity
(define mutf-ident
  '((c:mutf (c:x c:y) (c:x))))

;; mutate randomly
(define mutf-mut
  `((c:mutf ,(lambda (rng x range) (+ x (- range) (* (random:uniform) 2 range))))))

(define (render-fn fn precision)
  (let ((fn (eval fn (interaction-environment))))
    (map (lambda (t)
           (vec-add (vec-div (fn t) 2) '(1/2 . 1/2)))
         (iota precision 0 (/ tau (- precision 1))))))

;; separate ribbon into a bunch of rectangles so fill rules don't break the
;; shape. doesn't look good with antialiasing enabled
(define (render-ribbon x y)
  (map (lambda (. x) `(fill ,x)) x (cdr x) (cdr y) y))

(define (create-image rect rng)
  (let* ((fn (grammar-flatten grammar '(c:origin) rng))
         (fn1 (grammar-flatten mutf-ident fn rng))
         (fn2 (grammar-flatten mutf-mut fn rng))
         (precision 1024))
    (render-ribbon
      (map (curry rect-lerp rect) (render-fn fn1 precision))
      (map (curry rect-lerp rect) (render-fn fn2 precision)))))

(define (image)
  `(set (antialias none)
        ,(create-image (poly-scale '((0 . 0) (1 . 1)) 15/16) *random-state*)))

(set! *random-state* (seed->random-state (caddr (program-arguments))))

(render-cairo-png (image) '(1024 . 1024) (cadr (program-arguments)))