;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                          Console Wrapper                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define *return-chars* (string #\return #\linefeed))

(define *wrap-column* 72)
(define *wrap-space*  '(#\space #\tab))
(define *wrap-prefix* '(#\> #\space #\tab))

(define (wrap-port out)
  (define (process-line s)
    (let ((len (string-length s)))
      (if (zero? len)
        (begin (display *return-chars* out) (flush-output out))
        (let ((n 0) (n1 #f) (prefix #f) (max-len #f))
          (while (and (< n len) (memq (string-ref s n) *wrap-prefix*))
            (inc! n))
          (set! prefix
                (substring s 0 (min n (quotient *wrap-column* 2))))
          (set! max-len (- *wrap-column* (string-length prefix)))
          (while (< n len)
            (while (and (< n len) (memq (string-ref s n) *wrap-space*))
              (inc! n))
            (set! n1 (min len (+ n max-len)))
            (when (and (< n1 len)
                       (not (memq (string-ref s n1) *wrap-space*)))
              (while (and (< n n1) (not (memq (string-ref s (sub1 n1))
                                              *wrap-space*)))
                (dec! n1)))
            (when (= n1 n)
              (set! n1 (min len (+ n max-len))))
            (display prefix out)
            (display (substring s n n1) out)
            (display *return-chars* out)
            (flush-output out)
            (set! n n1))))))
  (define process-by-newlines
    (let ((r (format "([^~%]*)~%(.*)")))
      (lambda (s)
        (cond ((regexp-match r s) =>
               (lambda (x)
                 (process-line (cadr x))
                 (process-by-newlines (caddr x))))
              (else s)))))
  (define process-input
    (let ((buffer ""))
      (lambda (s)
        (set! buffer (process-by-newlines (string-append buffer s))))))
  (define buffer "")
  (make-output-port process-input
                    (lambda () (close-output-port out))))

;;;(parameterize ((current-output-port
;;;                (wrap-port (current-output-port))))
;;;  (define (rref v) (vector-ref v (random (vector-length v))))
;;;  (let nloop ((n (random 80)))
;;;    (unless (zero? n)
;;;      (display (rref #("" "> " "    ")))
;;;      (let mloop ((m (random 120)))
;;;        (unless (zero? m)
;;;          (display (rref #("a" "me" "Eli" "Maze" "Life!")))
;;;          (display " ")
;;;          (mloop (sub1 m))))
;;;      (newline)
;;;      (nloop (sub1 n))))
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh~%")
;;;  (printf "  ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh ")
;;;  (printf "kjh kjh kjh kjh kjh kjh kjh kjh~%")
;;;  (printf "12345678901234567890123456789012 ")
;;;  (printf "kjh kjh kjh kjh kjh kjh~%")
;;;  (printf "~%")
;;;  (printf "~%")
;;;  (printf "~%")
;;;  (printf "12345678901234567890123456789012 ")
;;;  (printf "kjh kjh kjh kjh kjh kjh~%")
;;;  )
;;;(exit)