12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061 ``````(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))) ``````