fork download
copy 
  1. ; greedy text justification
  2.  
  3. (define (sum xs) (apply + xs))
  4.  
  5. (define (string-split sep str)
  6.   (define (f cs xs) (cons (list->string (reverse cs)) xs))
  7.   (let loop ((ss (string->list str)) (cs '()) (xs '()))
  8.     (cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
  9.           ((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
  10.           (else (loop (cdr ss) (cons (car ss) cs) xs)))))
  11.  
  12. (define (justify str line-width)
  13.   (let loop ((words (string-split #\space str)) (line (list)) (curr-width 0))
  14.     (cond ((null? words)
  15.             (when (pair? line)
  16.                       (write-line line (+ (length line) -1
  17.                         (sum (map string-length line))))))
  18.           ((< line-width (+ curr-width (string-length (car words))))
  19.             (write-line line line-width)
  20.             (loop words (list) 0))
  21.           (else (loop (cdr words) (cons (car words) line)
  22.                       (+ curr-width (string-length (car words)) 1))))))
  23.  
  24. (define (write-line rev-words width)
  25.   (let* ((words (reverse rev-words))
  26.          (first-word (car words))
  27.          (width (- width (string-length first-word)))
  28.          (words (cdr words)))
  29.     (display first-word)
  30.     (if (null? words) (newline)
  31.       (let* ((nblanks (- width (sum (map string-length words))))
  32.              (sep (make-string (quotient nblanks (length words)) #\space))
  33.              (nextra (remainder nblanks (length words))))
  34.         (do ((n 0 (+ n 1)) (words words (cdr words)))
  35.             ((null? words) (newline))
  36.           (display sep)
  37.           (when (< n nextra) (display #\space))
  38.           (display (car words)))))))
  39.  
  40. (justify "This is an example of text justification." 16)
Success #stdin #stdout 0s 8044KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
This    is    an
example  of text
justification.
https://ideone.com/NFKI0N
language:
Scheme (chicken 4.13)
created:
3 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!