words->lines

gistfile1.scm

#!/usr/local/bin/guile -s
!#

; Scheme(guile) implementation for http://weibo.com/1822142792/Abqbesr1n?mod=weibotime

; include guile pattern matching module
(use-modules (ice-9 match))
; transform a list of words to list of lines, with length of line not exceeding line-len
(define (words->lines words line-len)
  (cond ((null? words) '())
        (else
          (match (get-one-line words line-len)
                 [(line rest-words)
                  (cons line (words->lines rest-words line-len))]
                 ))))

; extract a list of words. length of line formated by the words is at least line-len.
(define (extract-enough-words words line-len)
  (cond ((<= line-len 0) (list '() words))
        ((null? words) '(() ()))
        ((>= (string-length (car words))
             line-len)
         (list (list (car words))
               (cdr words)))
        (else
          (match (extract-enough-words (cdr words)
                                       (- line-len
                                          (+ (string-length (car words)) 1)))
                 [(cur-line-rest-words rest-words)
                  (list (cons (car words)
                              cur-line-rest-words)
                        rest-words)]
                 ))))

; extract one line from the words
(define (get-one-line words line-len)
  (match (extract-enough-words words line-len)
         [(cur-line-words rest-words)
          (cond ((null? (cdr cur-line-words)) ; only one word return
                 (let ((word (car cur-line-words)))
                   (cond ((> (string-length word)  ; the word is very long, let's segment it into two parts
                             line-len)
                          (list (string-take word line-len)
                                (cons (string-drop word line-len)
                                      rest-words))
                          )
                         (else  ; only one word returned.
                           (list word rest-words)))))
                (else
                  (let ((line (words->line cur-line-words)))
                    (cond ((> (string-length line) line-len)  ; line is too long, we need to get rid of the tail
                           (match cur-line-words
                                  [(heads ... tail)
                                   (list (words->line heads)
                                         (cons tail rest-words))]))
                          (else
                            (list line rest-words))))))]
         ))

(define (words->line words)
  (string-join words " "))

; test case
(define (print-lines lines)
  (if (not (null? lines))
    (begin
      (display (car lines))(display "----")(display (string-length (car lines)))(newline)
      (print-lines (cdr lines)))))

(define words '("Common"
                "Lisp"
                "is"
                "a"
                "successor"
                "to"
                "MacLisp."
                "The"
                "primary"
                "influences"
                "were"
                "Lisp"
                "Machine"
                "Lisp,"
                "MacLisp,"
                "NIL,"
                "S-1"
                "Lisp,"
                "Spice"
                "Lisp,"
                "and"
                "Scheme.[28]"
                "It"
                "has"
                "many"
                "of"
                "the"
                "features"
                "of"
                "Lisp"
                "Machine"
                "Lisp"
                "(a"
                "large"
                "Lisp"
                "dialect"
                "used"
                "to"
                "program"
                "Lisp"
                "Machines),"
                "but"
                "was"
                "designed"
                "to"
                "be"
                "efficiently"
                "implementable"
                "on"
                "any"
                "personal"
                "computer"
                "or"
                "workstation."
                "Common"
                "Lisp"
                "has"
                "a"
                "large"
                "language"
                "standard"
                "including"
                "many"
                "built-in"
                "data"
                "types,"
                "functions,"
                "macros"
                "and"
                "other"
                "language"
                "elements,"
                "as"
                "well"
                "as"
                "an"
                "object"
                "system"
                "(Common"
                "Lisp"
                "Object"
                "System"
                "or"
                "shorter"
                "CLOS)."
                "Common"
                "Lisp"
                "also"
                "borrowed"
                "certain"
                "features"
                "from"
                "Scheme"
                "such"
                "as"
                "lexical"
                "scoping"
                "and"
                "lexical"
                "closures."))

(print-lines (words->lines words 30))