; greedy text justification

(define (sum xs) (apply + xs))

(define (string-split sep str)
  (define (f cs xs) (cons (list->string (reverse cs)) xs))
  (let loop ((ss (string->list str)) (cs '()) (xs '()))
    (cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
          ((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
          (else (loop (cdr ss) (cons (car ss) cs) xs)))))

(define (justify str line-width)
  (let loop ((words (string-split #\space str)) (line (list)) (curr-width 0))
    (cond ((null? words)
            (when (pair? line)
                      (write-line line (+ (length line) -1
                        (sum (map string-length line))))))
          ((< line-width (+ curr-width (string-length (car words))))
            (write-line line line-width)
            (loop words (list) 0))
          (else (loop (cdr words) (cons (car words) line)
                      (+ curr-width (string-length (car words)) 1))))))

(define (write-line rev-words width)
  (let* ((words (reverse rev-words))
         (first-word (car words))
         (width (- width (string-length first-word)))
         (words (cdr words)))
    (display first-word)
    (if (null? words) (newline)
      (let* ((nblanks (- width (sum (map string-length words))))
             (sep (make-string (quotient nblanks (length words)) #\space))
             (nextra (remainder nblanks (length words))))
        (do ((n 0 (+ n 1)) (words words (cdr words)))
            ((null? words) (newline))
          (display sep)
          (when (< n nextra) (display #\space))
          (display (car words)))))))

(justify "This is an example of text justification." 16)