Text Titles.

; If program outputs lot of plain text, then it is useful to break
; the text in smaller parts clearly divided with underlined or
; boxed titles, like
;
;                       Main title
;                       ==========
; or
;
;                    +----------------+
;                    | Another title. |
;                    +----------------+
;
; Yesterday, I was bored by manual writing of such titles and
; decided to write some support for it. It turned there are many
; special cases, and code is longer than I expected.

(set 'number-of-columns 64)
(set 'max-title-width 24)

(set 'nth-cyclic
     (lambda(i l)(nth (mod i (length l)) l)))
     
(set 'find-last
     (lambda(d l)
       (let ((result (find (reverse d) (reverse l))))
            (if result (- (length l) result (length d))))))

(set 'break-title
  (lambda(title-string)
    (let ((title-string (trim title-string))
          (lts (length title-string)))
      (if (<= lts max-title-width)
          (list (trim title-string))
          (let ((s (or (find-last " " (slice title-string 0 max-title-width))
                       max-title-width)))
              (cons (trim (slice title-string 0 s))
                     (break-title (slice title-string
                                         s
                                         (- lts s)))))))))
                                         
(set 'clean-string
     (lambda(x)
        (dolist(i (list (list "  " " ")
                         (list (char 13) "")
                         (list (char 10) "")))
           (while (find (i 0) x)
               (replace (i 0) x (i 1))))
        x))

(set 'underline
 (lambda(title-text underline-string)
  (let ((cc 0))
    (dolist(i (break-title (clean-string title-text)))
      (let ((indent (dup " " (round (div (sub number-of-columns
                                              (length i)
                                              +0.1)
                                          2)))))
          (print indent i "\n" indent)
          (dotimes(j (length i))
             (inc cc)
             (print (nth-cyclic cc underline-string)))
          (println)))
     (println))))
              

      
(set 'box
     (lambda(title-text box-string)
       (println)
       (letn ((cc 0)
              (L (map trim (break-title (clean-string title-text))))
              (maxlength (apply max (map length L)))
              (indent (dup " " (/ (- number-of-columns maxlength 4)
                                   2))))
           (print indent)
           (for(i 1 (+ maxlength 4))
              (print (nth-cyclic cc box-string))
              (inc cc))
           (println)
                 
           (dolist(i L)
               (print indent (nth-cyclic cc box-string))
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) +0.1) 2)))))
               (inc cc)
               (print i)
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) -0.1) 2)))))
               (println (nth-cyclic cc box-string))
               (inc cc))
               
           (print indent)
           (for(i 1 (+ maxlength 4))
              (print (nth-cyclic cc box-string))
              (inc cc))
           (println)
             
           (println))))
           
         
(set 'box-standard
     (lambda(title-text box-string)
       (println)
       (letn ((cc 0)
              (L (break-title (clean-string title-text)))
              (maxlength (apply max (map length L)))
              (indent (dup " " (/ (- number-of-columns maxlength 4)
                                   2))))
           (print indent)
           (println "+" (dup "-" (+ maxlength 2)) "+")
                 
           (dolist(i L)
               (print indent "|")
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) +0.1) 2)))))
               (print i)
               (print (dup " " (+ 1 (round (div (sub maxlength (length i) -0.1) 2)))))
               (println "|"))
               
           (print indent)
           (println "+" (dup "-" (+ maxlength 2)) "+")
             
           (println))))
           
(underline "newLISP focuses on the core components of Lisp: lists,
      symbols, and lambda expressions. To these, newLISP adds
      arrays, implicit indexing on lists and arrays, and dynamic
      and lexical scoping. Lexical scoping is implemented using
      separate namespaces called contexts." "-*")
      
(box-standard "newLISP focuses on the core components of Lisp: lists,
      symbols, and lambda expressions. To these, newLISP adds
      arrays, implicit indexing on lists and arrays, and dynamic
      and lexical scoping. Lexical scoping is implemented using
      separate namespaces called contexts.")
      
(box "newLISP focuses on the core components of Lisp: lists,
      symbols, and lambda expressions. To these, newLISP adds
      arrays, implicit indexing on lists and arrays, and dynamic
      and lexical scoping. Lexical scoping is implemented using
      separate namespaces called contexts." "/\\")


;                      newLISP focuses on the
;                      *-*-*-*-*-*-*-*-*-*-*-
;                        core components of
;                        *-*-*-*-*-*-*-*-*-
;                      Lisp: lists,  symbols,
;                      *-*-*-*-*-*-*-*-*-*-*-
;                     and lambda expressions.
;                     *-*-*-*-*-*-*-*-*-*-*-*
;                      To these, newLISP adds
;                      -*-*-*-*-*-*-*-*-*-*-*
;                         arrays, implicit
;                         -*-*-*-*-*-*-*-*
;                      indexing on lists and
;                      -*-*-*-*-*-*-*-*-*-*-
;                       arrays, and dynamic
;                       *-*-*-*-*-*-*-*-*-*
;                       and lexical scoping.
;                       -*-*-*-*-*-*-*-*-*-*
;                        Lexical scoping is
;                        -*-*-*-*-*-*-*-*-*
;                        implemented using
;                        -*-*-*-*-*-*-*-*-
;                       separate namespaces
;                       *-*-*-*-*-*-*-*-*-*
;                         called contexts.
;                         -*-*-*-*-*-*-*-*
;
;
;                   +-------------------------+
;                   | newLISP focuses on the  |
;                   |   core components of    |
;                   | Lisp: lists,  symbols,  |
;                   | and lambda expressions. |
;                   | To these, newLISP adds  |
;                   |    arrays, implicit     |
;                   |  indexing on lists and  |
;                   |   arrays, and dynamic   |
;                   |  and lexical scoping.   |
;                   |   Lexical scoping is    |
;                   |    implemented using    |
;                   |   separate namespaces   |
;                   |    called contexts.     |
;                   +-------------------------+
;
;
;                   /\/\/\/\/\/\/\/\/\/\/\/\/\/
;                   \ newLISP focuses on the  /
;                   \   core components of    /
;                   \ Lisp: lists,  symbols,  /
;                   \ and lambda expressions. /
;                   \ To these, newLISP adds  /
;                   \    arrays, implicit     /
;                   \  indexing on lists and  /
;                   \   arrays, and dynamic   /
;                   \  and lexical scoping.   /
;                   \   Lexical scoping is    /
;                   \    implemented using    /
;                   \   separate namespaces   /
;                   \    called contexts.     /
;                   \/\/\/\/\/\/\/\/\/\/\/\/\/\
;

Example of actual use.