(define out-port (current-output-port)) (define (stream x) (display (if x x " ") out-port)) (define (stream-table) (stream "\n")) (define (stream-end-table) (stream "
\n")) (define (stream-thead) (stream "\n")) (define (stream-end-thead) (stream "\n")) (define (stream-tbody) (stream "\n")) (define (stream-end-tbody) (stream "\n")) (define (stream-tr y) (stream (if (even? y) "\n" "\n"))) (define (stream-end-tr) (stream "\n")) (define (stream-th c) (stream "") (stream c) (stream "")) (define (stream-th-row c s) (if s (begin (stream "") (stream c) (stream "")))) (define (stream-th-col c s) (if s (begin (stream "") (stream c) (stream "")))) (define (stream-th-corner r c y row-headers) (cond ((and (zero? y) (> r 1) (positive? c)) (stream "\n")) ((= y (- r 1)) (for-each stream-th row-headers)))) (define (stream-td c) (stream "") (stream c) (stream "")) (define (reset-span a sr i w) (if (< i w) (begin (vector-set! sr i (vector-ref a i)) (vector-set! a i 0) (reset-span a sr (+ i 1) w)))) (define (set-span a c p sr i w) (if (< i w) (if (string=? (vector-ref c i) (vector-ref p i)) (set-span a c p sr (+ i 1) w) (reset-span a sr i w)))) (define (vector-incr a s e) (if (< s e) (begin (vector-set! a s (+ (vector-ref a s) 1)) (vector-incr a (+ s 1) e)))) (define (vector-set-span p a h i sp w) (vector-incr a 0 w) (if (zero? i) (vector-set! sp 0 a) (let ((c (vector-ref h (- i 1))) (sr (make-vector w))) (set-span a c p sr 0 w) (vector-set! sp i sr) (vector-set-span c a h (- i 1) sp w)))) (define (make-span h w e) (let ((sp (make-vector e))) (if (positive? e) (vector-set-span (vector-ref h (- e 1)) (make-vector w 0) h (- e 1) sp w)) sp)) (define (stream-row-headers v sr s e) (if (< s e) (begin (stream-th-row (vector-ref v s) (vector-ref sr s)) (stream-row-headers v sr (+ s 1) e)))) (define (stream-row v s e) (if (< s e) (begin (stream-td (vector-ref v s)) (stream-row v (+ s 1) e)))) (define (pivot->stream-rows p sp y) (if (< y (height p)) (begin (stream-tr y) (stream-row-headers (vector-ref (row-headers p) y) (vector-ref sp y) 0 (row-heads-width p)) (stream-row (vector-ref (cells p) y) 0 (width p)) (stream-end-tr) (pivot->stream-rows p sp (+ y 1))))) (define (stream-col-headers v sp y s e) (if (< s e) (begin (stream-th-col (vector-ref (vector-ref v s) y) (vector-ref (vector-ref sp s) y)) (stream-col-headers v sp y (+ s 1) e)))) (define (pivot->stream-col-headers p sp y row-headers) (if (< y (col-heads-height p)) (begin (stream-tr y) (stream-th-corner (col-heads-height p) (row-heads-width p) y row-headers) (stream-col-headers (col-headers p) sp y 0 (width p)) (stream-end-tr) (pivot->stream-col-headers p sp (+ y 1) row-headers)))) (define (make-col-span p) (make-span (col-headers p) (col-heads-height p) (width p))) (define (make-row-span p) (make-span (row-headers p) (row-heads-width p) (height p))) (define (pivot->stream p row-headers) (stream-table) (stream-thead) (pivot->stream-col-headers p (make-col-span p) 0 row-headers) (stream-end-thead) (stream-tbody) (pivot->stream-rows p (make-row-span p) 0) (stream-end-tbody) (stream-end-table) #t)