; XEmacs: This file contains -*- Scheme -*- source code.

;;; formatter: a rudimentary text formatter

;;; John David Stone
;;; Department of Mathematics and Computer Science
;;; Grinnell College
;;; stone@cs.grinnell.edu

(define null '())
(define page-body-length 54)
(define top-margin 6)
(define bottom-margin 6)
(define page-header-length 3)
(define page-label "page ")
(define page-body-width 65)
(define left-margin 10)

(define (formatter source-file-name target-file-name page-header)
  (let ((source (open-input-file source-file-name))
        (target (open-output-file target-file-name)))
    (print-blank-lines top-margin target)
    (let loop ((page-number 1)
               (lines-on-current-page 0)
               (current-line (read-line source)))
      (if (eof-object? current-line)
          (begin
            (close-input-port source)
            (close-output-port target))
          (if (= lines-on-current-page page-body-length)
              (begin
                (print-blank-lines bottom-margin target)
                (print-blank-lines top-margin target)
                (print-header page-header (+ page-number 1) target)
                (print-line current-line target)
                (loop (+ page-number 1)
                      (+ page-header-length 1)
                      (read-line source)))
              (begin
                (print-line current-line target)
                (loop page-number
                      (+ lines-on-current-page 1)
                      (read-line source))))))))

(define (read-line source)
  (let loop ((char-list null)
             (next-character (read-char source)))
    (if (eof-object? next-character)
        next-character
        (if (char=? next-character #\newline)
            (list->string (reverse char-list))
            (loop (cons next-character char-list)
                  (read-char source))))))

(define (print-blank-lines number target)
  (display (make-string number #\newline) target))

(define (print-header page-header page-number target)
  (let ((page-numeral (number->string page-number)))
    (let ((fill (make-string (- page-body-width
                                (string-length page-header)
                                (string-length page-label)
                                (string-length page-numeral))
                             #\space)))
      (display (make-string left-margin #\space) target)
      (display page-header target)
      (display fill target)
      (display page-label target)
      (display page-number target)
      (display (make-string page-header-length #\newline) target))))

(define (print-line line target)
  (display (make-string left-margin #\space) target)
  (display line target)
  (newline target))