[ prog / sol / mona ]
prog
frontpage - thread list - new thread - preferences - ?
- 256 2023-05-02 22:52
-
scheme@(guile-user)> (display ((lambda (rec xjoin extract windowtopleft expandspec derive expandsize cell index connector connectors cellspec cellrows cellcols expansions expandx expandy levels start chars band columnfactor n) ((lambda (xjoin expandspec connector lines columns cycle size) ((lambda (cellspec expansions sizex sizey) ((lambda (derive cell) ((lambda (derive) ((lambda (derivecell) ((lambda (window) ((lambda (patch) ((lambda (symbol) (xjoin lines (lambda (k) (string-append (xjoin columns (lambda (j) (symbol k j)) "") "\n")) "")) (lambda (k j) (extract chars (index patch band cycle columnfactor n k j) 1)))) (lambda (cycle x y dx dy band) (if (connector (window x y) dx dy) 1 0)))) (windowtopleft sizex sizey derivecell))) (lambda (y x) ((lambda (qx mx qy my) (cell (derive qx qy) mx my)) (quotient x cellcols) (modulo x cellcols) (quotient y cellrows) (modulo y cellrows))))) ((lambda (sizex sizey) (lambda (x y) (rec derive start x y sizex sizey))) (quotient sizex cellcols) (quotient sizey cellrows)))) (derive expansions expandx expandy) (cell cellspec cellcols))) (expandspec cellspec) (expandspec expansions) (car size) (cadr size))) (lambda (n fun sep) (rec xjoin n fun sep "")) (lambda (spec) (rec expandspec spec '())) (connector connectors band) (+ (* 2 n) 1) (+ (* 2 columnfactor n) 1) (string-length chars) (expandsize cellcols cellrows expandx expandy levels))) (lambda (f . args) (apply f (cons f args))) (lambda (self n fun sep acc) (if (<= n 0) "" (if (= n 1) (string-append (fun 0) acc) (self self (- n 1) fun sep (string-append sep (fun (- n 1)) acc))))) (lambda (str pos len) (substring str pos (+ pos len))) (lambda (width height fun) ((lambda (w2 h2) ((lambda (x1 x2 y1 y2) (lambda (x y) (if (and (<= x1 x x2) (<= y1 y y2)) (fun (- y y1) (- x x1)) 0))) (- w2) (- width w2 1) (- h2) (- height h2 1))) (quotient width 2) (quotient height 2))) ((lambda (onecorner) ((lambda (onecell) (lambda (self spec acc) (if (null? spec) (apply vector acc) (self self (cdr spec) (onecell onecell (car spec) acc 3))))) (lambda (self cell acc round) (if (< round 0) acc (self self cell (cons (onecorner onecorner cell '() round #t) acc) (- round 1)))))) (lambda (self corners acc bits fresh) (if (null? corners) (apply vector acc) (if (caar corners) (self self (cdr corners) (cons ((if (logbit? (if fresh 0 1) bits) caddar cadar) corners) acc) bits #f) (self self (cdr corners) (cons (cadar corners) acc) bits fresh)))))
- 267
-