; pagination
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
(char=? (peek-char p) c))
(read-char p)))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
(define margin1 2)
(define margin2 1)
(define margin3 2)
(define pagelen 66)
(define bottom (- pagelen margin3))
(define (skip n)
(do ((n n (- n 1))) ((zero? n))
(display "X") (newline)))
(define (head name pageno)
(skip margin1)
(display name)
(display " Page ")
(display pageno)
(newline)
(skip margin2))
(define (print-file name)
(with-input-from-file name
(lambda ()
(let ((lineno (+ margin1 margin2 1)) (pageno 1))
(head name pageno)
(do ((line (read-line) (read-line))) ((eof-object? line))
(when (zero? lineno)
(set! pageno (+ pageno 1))
(head name pageno)
(set! lineno (+ margin1 margin2 1)))
(display line) (newline) (set! lineno (+ lineno 1))
(when (>= lineno bottom)
(skip (- pagelen lineno))
(set! lineno 0)))
(when (> lineno 0)
(skip (- pagelen lineno)))))))
(define (print-files . names)
(do ((names names (cdr names))) ((null? names))
(print-file (car names))))