;; This program makes files with random plaid
;; patterns.
;; You need the slope interpreter to run it.
;; https://git.rawtext.club/slope-lang/slope
;; There are lots of absolute paths inside this
;; program. Don't go thinking you can just run
;; this as is and expect it to work for you.
;; It creates a plaid by coming up with two lists
;; called "bibs" for some reason. Each bib is a
;; list of 1 to 3 "bands", where a band has a
;; random color and width. A bib is like
;; green-10, blue-8, yellow-2. It will arrange
;; those bands in a climb-up-climb-down pattern
;; like 1 2 3 2 1. That's the sequence of stripes
;; for one direction. And it makes another random
;; bib like that for the other direction.
;; Once you've got all the random widths and color
;; sequences for each direction like that, it goes
;; and converts that to a bunch of SVG boxes.
;; It's sort of tricky how all that works, and I
;; ought to write more about it here eventually.
;; For now, I'll say it starts at the "middle"
;; band of the bib - that is, the last one in that
;; sequence of 1-3 - and draws pairs of bands
;; going out from that. If your bib is a b c, it
;; will draw the c, then the b's - b c b - then
;; the a's - a b c b a. Then do the other
;; direction.
;;
;; In the end, once it's done drawing out the bibs
;; one time, it uses svg patterns to tile the
;; whole thing a bunch of times.
(define nil '())
(define random-16x
(lambda ()
(number->string (round (rand 15) 0) 16)))
(define random-color
(lambda ()
(define loop
(lambda (i s)
(if (equal? i 6)
s
(loop
(+ i 1)
(string-append s (random-16x))))))
(loop 0 "#")))
(define random-color-list
(lambda (n)
(define loop
(lambda (i l)
(if (equal? i n)
l
(loop (+ i 1)
(cons (random-color) l)))))
(loop 0 nil)))
(define random-bib
(lambda ()
(map
(lambda (x)
(cons (round (rand 5 20) 0) x))
(random-color-list
(+ 1 (round (rand 2) 0))))))
(define svg-start
(lambda (size)
(string-format "\n\n")
(define svg-box
(lambda (x y width height color opacity)
(string-format
"\n\n"
x y width height color opacity)))
(define make-svg
(lambda (file plaid)
(define background-color
(assoc plaid 'background))
(define size (assoc plaid 'size))
(file-append-to file (svg-start (* size 4)))
(file-append-to file
"")
(file-append-to file
(svg-box "0" "0" "100%" "100%"
background-color "100%"))
(file-append-to file (make-bands plaid 'vertical 100))
(file-append-to file (make-bands plaid 'horizontal 100))
(file-append-to file "\n\n")
(file-append-to file "")
(file-append-to file svg-end)))
(define div
(lambda (a b)
(floor (/ a b))))
(define make-bands
(lambda (plaid direction size)
(define out "")
(define band-widths
(map (lambda (b) (car b))
(assoc plaid direction)))
(define band-colors
(map (lambda (b) (car (cdr b)))
(assoc plaid direction)))
(define S (assoc plaid 'spacing))
(define W size)
(define M (- (length band-colors) 1))
(define loop
(lambda (i xl xr)
(if
(> i M)
out
(begin
(define W_Mmi
(list-ref band-widths (- M i)))
(if (equal? i 0)
(begin
(set! xl (- (div W 2) (div W_Mmi 2)))
(set! xr (- (div W 2) (div W_Mmi 2))))
(begin
(define W_Mmip1
(list-ref band-widths
(+ 1 (- M i))))
(set! xl (- xl S W_Mmi))
(set! xr (+ xr S W_Mmip1))))
(define color (list-ref band-colors (- M i)))
(set! out
(add-pair-of-bands
out
(equal? i 0)
direction
xl xr
0 W_Mmi "100%" color "50%"))
(loop (+ i 1) xl xr)))))
(loop 0 0 0)))
(define add-pair-of-bands
(lambda (s center? direction
xl xr y w h c)
(cond ((equal? direction 'vertical)
(string-append
s
(svg-box xl y w h c "50%")
(svg-box xr y w h c "50%")))
((equal? direction 'horizontal)
(string-append
s
(svg-box y xl h w c "50%")
(svg-box y xr h w c "50%"))))))
(define test
(lambda ()
(define loop
(lambda (i)
(if (equal? i 100)
nil
(begin
(subprocess
(list "rm"
(string-format "/home/joneworlds/html/plaid-%v.svg" i)))
(subprocess
(list "rm"
(string-format "/home/joneworlds/html/plaid-%v.html" i)))
(define plaid
(list
(cons 'background (random-color))
(cons 'size 100)
(cons 'spacing (round (rand 10 0)))
(cons 'vertical (list (random-bib)))
(cons 'horizontal (list (random-bib)))))
(make-svg
(string-format
"/home/joneworlds/html/plaid-%v.svg" i)
plaid)
(file-append-to
"/home/joneworlds/html/plaid.html"
(string-format
"%v -- \n" i i))
(file-append-to
(string-format "/home/joneworlds/html/plaid-%v.html" i)
(string-format
"%v ... top list " i (+ i 1) i))
(loop (+ i 1))))))
(subprocess
(list "rm"
(string-format "/home/joneworlds/html/plaid.html")))
(file-append-to "/home/joneworlds/html/plaid.html"
"