fork(1) download
copy 
  1. ; line breaks
  2.  
  3. (define (make-matrix rows columns . value)
  4.   (do ((m (make-vector rows)) (i 0 (+ i 1)))
  5.       ((= i rows) m)
  6.     (if (null? value)
  7.         (vector-set! m i (make-vector columns))
  8.         (vector-set! m i (make-vector columns (car value))))))
  9.  
  10. (define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
  11.  
  12. (define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
  13.  
  14. (define-syntax for
  15.   (syntax-rules ()
  16.     ((for (var first past step) body ...)
  17.       (let ((ge? (if (< first past) >= <=)))
  18.         (do ((var first (+ var step)))
  19.             ((ge? var past))
  20.           body ...)))
  21.     ((for (var first past) body ...)
  22.       (let* ((f first) (p past) (s (if (< first past) 1 -1)))
  23.         (for (var f p s) body ...)))
  24.     ((for (var past) body ...)
  25.       (let* ((p past)) (for (var 0 p) body ...)))))
  26.  
  27. (define (string-split sep str)
  28.   (define (f cs xs) (cons (list->string (reverse cs)) xs))
  29.   (let loop ((ss (string->list str)) (cs '()) (xs '()))
  30.     (cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
  31.           ((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
  32.           (else (loop (cdr ss) (cons (car ss) cs) xs)))))
  33.  
  34. (define (string-join sep ss)
  35.   (define (f s ss)
  36.     (string-append s (string sep) ss))
  37.   (define (join ss)
  38.     (if (null? (cdr ss)) (car ss)
  39.       (f (car ss) (join (cdr ss)))))
  40.   (if (null? ss) "" (join ss)))
  41.  
  42. (define (line-break str width)
  43.   (define (not-null? str) (< 0 (string-length str)))
  44.   (define (min-non-neg-at m x c)
  45.     (let ((min #e1e15) (at (+ x 1)))
  46.       (for (r 0 x 1)
  47.         (when (and (< (matrix-ref m r c) min)
  48.                    (not (negative? (matrix-ref m r c))))
  49.           (set! min (matrix-ref m r c)) (set! at r)))
  50.       at))
  51.   (define (slice xs first past)
  52.     (let loop ((i first) (zs (list)))
  53.       (if (= i past) (string-join #\space (reverse zs))
  54.         (loop (+ i 1) (cons (vector-ref xs i) zs)))))
  55.   (let* ((words (filter not-null? (string-split #\space str)))
  56.          (lens (list->vector (map string-length words)))
  57.          (count (length words)) (words (list->vector words)))
  58.     (let ((spaces (make-matrix count count -1)))
  59.       (for (r 0 count 1)
  60.         (matrix-set! spaces r r
  61.             (- width (vector-ref lens r)))
  62.         (for (c (+ r 1) count 1)
  63.           (matrix-set! spaces r c
  64.               (- (matrix-ref spaces r (- c 1))
  65.                  (vector-ref lens c) 1))))
  66.       (let loop ((end count) (lines (list)))
  67.         (let ((start (min-non-neg-at spaces count (- end 1))))
  68.           (if (zero? start) (cons (slice words start end) lines)
  69.             (loop start (cons (slice words start end) lines))))))))
  70.  
  71. (display (line-break "aaa bb cc ddddd" 6)) (newline)
  72. (newline)
  73.  
  74. (for-each (lambda (line) (display line) (newline))
  75.   (line-break "It was the best of times, it was the worst of times." 15))
  76. (newline)
  77.  
  78. (for-each (lambda (line) (display line) (newline))
  79.   (line-break "It was the best of times, it was the worst of times." 20))
Success #stdin #stdout 0.02s 8800KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(aaa bb cc ddddd)

It was the
best of times,
it was the
worst of times.

It was the best
of times, it was
the worst of times.
https://ideone.com/QPEK3f
language:
Scheme (guile 2.2.4)
created:
7 years ago
visibility:
public

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!