;; 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<svg version=\"1.1\" width=\"%v\" height=\"%v\" xmlns=\"http://www.w3.org/2000/svg\">\n" size size)))

(define svg-end
 "\n</svg>\n")


(define svg-box
 (lambda (x y width height color opacity)
    (string-format
     "\n<rect x=\"%v\" y=\"%v\" width=\"%v\" height=\"%v\" fill=\"%v\" fill-opacity=\"%v\"/>\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
                   "<pattern id=\"Pattern\" x=\"0\" y=\"0\" width=\"100\" height=\"100\" patternUnits=\"userSpaceOnUse\">")
   (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</pattern>\n")
   (file-append-to file "<rect fill=\"url(#Pattern)\" x=\"0\" y=\"0\" width=\"400\" height=\"400\"/>")
   (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
               "<a href=\"plaid-%v.svg\">%v -- </a>\n" i i))
             (file-append-to
              (string-format "/home/joneworlds/html/plaid-%v.html" i)
              (string-format
               "%v ... <a href=\"plaid.html\">top list</a><br><a href=\"plaid-%v.html\"><img src=\"plaid-%v.svg\" /></a>" 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"
                   "<h1>Many Plaids</h1><a href=\"plaid-0.html\">slideshow</a><br>")
   (loop 0)))


(test)

You are viewing proxied material from republic.circumlunar.space. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.