(define (t-row . elts) (let ((elts (flatten-combos elts 'row))) (make-row (make-dims (* (reduce max 0 (map elt-width elts)) (length elts)) (reduce lcm 0 (map elt-height elts))) elts))) (define (t-column . elts) (let ((elts (flatten-combos elts 'col))) (make-col (make-dims (reduce lcm 0 (map elt-width elts)) (* (reduce max 0 (map elt-height elts)) (length elts))) elts))) (define (x-arrange elt) (cons 'table (x-arrange-1 (if (row? elt) elt (t-row elt))))) (define (x-arrange-1 row) (let ((w (elt-width row)) (h (elt-height row))) (let y-loop ((y 0)) (if (< y h) (cons (cons 'tr (let x-loop ((x 0)) (if (< x w) (append! (traverse-row row 0 0 w h (lambda (elt x* y* w h) (if (and (= x* x) (= y* y)) (list (list 'td w h elt)) '()))) (x-loop (+ x 1))) '()))) (y-loop (+ y 1))) '())))) (define (traverse-row row x y w h generate) (let* ((elts (combo-elts row)) (w (quotient w (length elts)))) (let loop ((elts elts) (x x)) (if (pair? elts) (append! (if (col? (car elts)) (traverse-col (car elts) x y w h generate) (generate (car elts) x y w h)) (loop (cdr elts) (+ x w))) '())))) (define (traverse-col col x y w h generate) (let* ((elts (combo-elts col)) (h (quotient h (length elts)))) (let loop ((elts elts) (y y)) (if (pair? elts) (append! (if (row? (car elts)) (traverse-row (car elts) x y w h generate) (generate (car elts) x y w h)) (loop (cdr elts) (+ y h))) '())))) (define (lcm a b) (quotient (* a b) (gcd a b))) (define (gcd a b) (if (= b 0) a (gcd b (remainder a b)))) (define (flatten-combos elts type) (append-map (lambda (elt) (if (cond ((row? elt) (eq? type 'row)) ((col? elt) (eq? type 'col)) (else #f)) (combo-elts elt) (list elt))) elts)) (define (elt-width elt) (if (string? elt) 1 (dims-width (combo-dims elt)))) (define (elt-height elt) (if (string? elt) 1 (dims-height (combo-dims elt)))) (define (make-row dims elts) (cons* 'row dims elts)) (define (row? elt) (and (pair? elt) (eq? (car elt) 'row))) (define (make-col dims elts) (cons* 'col dims elts)) (define (col? elt) (and (pair? elt) (eq? (car elt) 'col))) (define (combo-dims elt) (cadr elt)) (define (combo-elts elt) (cddr elt)) (define (make-dims width height) (cons width height)) (define (dims-width dims) (car dims)) (define (dims-height dims) (cdr dims))