daydreamer.scm 2.1 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. (use-modules (basket)
  2. (filigree)
  3. (ice-9 r5rs)
  4. (ice-9 pretty-print)
  5. (srfi srfi-1)
  6. (srfi srfi-26))
  7. (define (random:range x y)
  8. (+ x (* (- y x) (random:uniform))))
  9. ;; main grammar. used to generate inputs to the mutf- grammars, which can
  10. ;; generate many slight variants on the same function
  11. (define grammar
  12. `((c:randint ,(lambda (rng x y) (+ x (random (- y x) rng))))
  13. (c:randf ,(lambda (rng x y) (+ x (* (random:uniform rng) (- y x)))))
  14. (c:n () 3 5 7)
  15. (c:n2 () 2 4 6 8)
  16. (c:fn () sin cos)
  17. (c:t (c:x) (+ (c:mutf (c:randf 0 ,tau) 0.25) (c:x)))
  18. (c:size () 1 -1 1 -1 1 -1 ((c:fn) (c:t (* (c:n) t))))
  19. (c:pos () (+ (* 1/2 (c:size) ((c:fn) (c:t (* (c:n) t))))
  20. (* 1/2 (c:size) ((c:fn) (c:t (* (c:n 2) t))))))
  21. (c:expr () (make-vec (c:pos) (c:pos)))
  22. (c:origin () (lambda (t) (c:expr)))))
  23. ;; mutate into identity
  24. (define mutf-ident
  25. '((c:mutf (c:x c:y) (c:x))))
  26. ;; mutate randomly
  27. (define mutf-mut
  28. `((c:mutf ,(lambda (rng x range) (+ x (- range) (* (random:uniform) 2 range))))))
  29. (define (render-fn fn precision)
  30. (let ((fn (eval fn (interaction-environment))))
  31. (map (lambda (t)
  32. (vec-add (vec-div (fn t) 2) '(1/2 . 1/2)))
  33. (iota precision 0 (/ tau (- precision 1))))))
  34. ;; separate ribbon into a bunch of rectangles so fill rules don't break the
  35. ;; shape. doesn't look good with antialiasing enabled
  36. (define (render-ribbon x y)
  37. (map (lambda (. x) `(fill ,x)) x (cdr x) (cdr y) y))
  38. (define (create-image rect rng)
  39. (let* ((fn (grammar-flatten grammar '(c:origin) rng))
  40. (fn1 (grammar-flatten mutf-ident fn rng))
  41. (fn2 (grammar-flatten mutf-mut fn rng))
  42. (precision 1024))
  43. (render-ribbon
  44. (map (curry rect-lerp rect) (render-fn fn1 precision))
  45. (map (curry rect-lerp rect) (render-fn fn2 precision)))))
  46. (define (image)
  47. `(set (antialias none)
  48. ,(create-image (poly-scale '((0 . 0) (1 . 1)) 15/16) *random-state*)))
  49. (set! *random-state* (seed->random-state (caddr (program-arguments))))
  50. (render-cairo-png (image) '(1024 . 1024) (cadr (program-arguments)))