;;; PROBLEM 5.  Paragraph filling


;;; Some auxiliary string-manipulation procedures that will be useful:
;;; ------------------------------------------------------------------

(define STRING-NULL
   (lambda [string]
      (= string "")))

(define STRING-FIRST
   (lambda [string]
      (nth-char 1 string)))

(define STRING-REST
   (lambda [string]
      (substring 2 (string-length string) string)))


;;; Some test:

(string-null "abc")                           ; normalizes to $FALSE
(string-null "")                              ; normalizes to $TRUE
(string-first "abc")                          ; normalizes to #a
(string-rest "abc")                           ; normalizes to "bc"


;;; Routines to read in text from the terminal:
;;; -------------------------------------------

;;; READLINE reads a line of text from the terminal and returns a
;;; -------- stringer designating the string of characters typed in.
;;;          A line is a series of characters delimited by a carriage
;;; return.  The carriage return character is not included in the
;;; returned string.

(define read-line 
   (lambda []
      (string-in ps cr)))


;;; READ-PARAGRAPH reads a paragraph of text from the terminal, where
;;; -------------- a paragraph is a series of lines delimited by the
;;;                empty line.

(define read-paragraph
   (lambda []
       (let [[line (read-line)]]
           (if (string-null line) 
               line
               (string-append line " "  
                              (read-paragraph))))))

;;; Note that READ-PARAGRAPH returns a string with no carriage returns
;;; in it.  The carriage returns are not part of the line returned by
;;; READ-LINE and the inter-line character used by READ-PARAGRAPH is a
;;; normal space.  However, if we wanted to be able to get rid of
;;; carriage returns in strings, we could do so with the following
;;; procedure.

;;; REMOVE-CRS removes all carriage returns from a string.
;;; ----------

(define REMOVE-CRS
   (lambda [string]
      (cond [(string-null string)  string]
            [(= (string-first string) cr) 
             (string-cons #  (remove-crs (string-rest string)))]
            [$true (string-cons (string-first string)
                                (remove-crs (string-rest string)))])))


;;; Some tests:

(remove-crs "abc
def ghi
jkl
mno pqr stu

vwx yz")             ; normalizes to "abc def ghi jkl mno pqr stu  vwx yz"

(remove-crs "")      ; normalizes to ""


;;; PROBLEM 5-b and 5-c

;;; Paragraph-filling procedures.
;;; -----------------------------

;;; We are going to break a string into lines (i.e. strings delimited
;;; by carriage returns) such that no line is longer than some
;;; parameter FILL-COLUMN and as many words are packed into a line as
;;; possible.  We decompose the problem recursively as follows.  First,
;;; find the first line, then recursively break the remaining text into
;;; pieces.  The base case occurs when no breaking needs to be done,
;;; that is, when the string is shorter than the fill-column requires.

;;; First, a routine to find the index of a good place to break off
;;; the first line.

;;; BREAK-LINE returns the index in a string of the appropriate place
;;; ---------- to break off the first line of a text.  It does this
;;;            by finding the last space in the first FILL-COLUMN
;;; characters of the text.  It assumes that the text is longer than
;;; fill-column.

(define BREAK-LINE
   (lambda [text fill-column]
      (letseq [[first-few-chars (substring 1 fill-column text)]
               [last-space (reverse-string-search " "
                                                  first-few-chars)]]
         last-space)))


;;; REVERSE-STRING-SEARCH returns the index of the last occurrence
;;; --------------------- of a string KEY in another string TEXT.

(define REVERSE-STRING-SEARCH
   (lambda [key text]
       (let [[reverse-location (string-search (string-reverse key)
                                              (string-reverse text))]]
          (- (- (1+ (string-length text))
                reverse-location)
             (1- (string-length key))))))

;;; STRING-REVERSE reverses a string.
;;; --------------

(define string-reverse
   (lambda [string]
      (if (string-null string) 
          string
          (string-append (string-reverse (string-rest string))
                         (string-cons (string-first string))))))


;;; Some tests:

(string-reverse "")                           ; normalizes to ""
(string-reverse "abc")                        ; normalizes to "cba"
(reverse-string-search "abc" "xyz abc xyz")   ; normalizes to 5
(reverse-string-search "aba" "ababababa")     ; normalizes to 7
(reverse-string-search "abc" "defghijkl")     ; normalizes to



;;; FILL-PARAGRAPH takes a string TEXT and a column FILL-COLUMN and 
;;; -------------- returns a string with carriage returns inserted so 
;;;                that the text is filled relative to the
;;; fill-column.

(define FILL-PARAGRAPH
    (lambda [text fill-column]
        (if (< (string-length text)
               fill-column)                   ; text is short enough
            text                              ; so return it
            (let [[break (break-line text fill-column)]]
                (string-append                ; else put together
                    (substring 1 break text)  ; the first line
                    (string-cons cr "")       ; a carriage return
                    (fill-paragraph           ; and a filled paragraph
                       (substring (1+ break)  ; based on the rest of
                                              ; the text
                                  (string-length text)
                                  text)
                       fill-column))))))


;;; Some tests.  See attached window image for the results.

(set test (remove-crs 

"She told me you had been to her
and mentioned me to him.
He gave me a good character
but said I could not swim."
))


(fill-paragraph test 30)
(fill-paragraph test 20)
(fill-paragraph test 10)
(fill-paragraph test 7)


;;; Note the behavior if a word is longer than the fill-column.
;;; It breaks the word in half at the fill-column.  Perhaps a
;;; better solution would be to break the line after the long
;;; word, even if it spills over the fill-column.  Thus:

(define BREAK-LINE
   (lambda [text fill-column]
      (letseq [[first-few-chars (substring 1 fill-column text)]
               [last-space (reverse-string-search " "
                                                  first-few-chars)]]
         (if (> last-space fill-column)
             (string-search " " text)
             last-space))))

;;; Now testing the new version:

(fill-paragraph test 7)

;;; Of course, one could imagine a BREAK-LINE that tried to hyphenate
;;; words at reasonable places, and so forth.  We won't attempt to
;;; give examples of this.  See the TeXbook by Donald Knuth for
;;; information about hyphenation algorithms (and algorithms for
;;; many other text formatting tasks, like line and page breaking).

;;; Finally, a routine to act as an interactive paragraph filler,
;;; allowing a user to enter a paragraph from the terminal, and
;;; printing the filled-paragraph to the terminal.

(define TEST
   (lambda [fill-column]
      (string-out ps
                  (fill-paragraph (read-paragraph) fill-column))))