(define-module text.format
  (use srfi-13)
  (export best-column-widths format-columns text-wrap))
(select-module text.format)

(define (best-column-widths widths . args)
  (let ((output-width (get-optional args 80))
        (max-num-cols 0))

    ;; find max num-cols
    (let loop ((w widths) (i 0))
      (if (and (pair? w) (< i output-width))
        (loop (cdr w) (+ i (car w)))
        (set! max-num-cols i)))

    ;; loop over possible num-cols
    (let loop ((num-cols max-num-cols))
      (if (< num-cols 2)
        #f
        (let ((cols (make-vector num-cols 0)))
          (let loop2 ((w widths)
                      (i 0)
                      (total 0))
            (cond
              ((> total output-width)
               (loop (- num-cols 1)))
              ((null? w)
               cols)
              (else
               (let ((old (vector-ref cols i))
                     (cur (car w)))
                 (cond
                   ((> cur old)
                    (vector-set! cols i cur)
                    (loop2 (cdr w) (modulo (+ i 1) num-cols) (+ total (- cur old))))
                   (else
                    (loop2 (cdr w) (modulo (+ i 1) num-cols) total) )))))))))))

(define (format-columns ls . args)
  (let-optionals* args
      ((port (current-output-port))
       (output-width 80))
    (let* ((widths (best-column-widths
                    (map (lambda (x) (+ 2 (string-length x))) ls)
                    output-width))
           (num-cols (and widths (vector-length widths))))
      (if widths
        (let loop ((l ls)
                   (i 0))
          (cond
            ((pair? l)
             (display (string-pad-right (car l) (vector-ref widths i)) port)
             (if (= i (- num-cols 1))
               (newline port))
             (loop (cdr l) (modulo (+ i 1) num-cols)))
            (else
             (newline port))))
        (with-output-to-port port
          (lambda () (for-each (cut print <>) ls)))))))

(define (text-wrap str . args)
  (let* ((words (string-tokenize str))
         (all '())
         (first (car words))
         (col (string-length first))
         (line (list first))
         (max-col (get-optional args 80)))
    (for-each
     (lambda (x)
       (let* ((len (string-length x))
              (new-col (+ col len 1)))
         (cond ((> new-col max-col)
                (set! all (cons (string-join (reverse! line) " ") all))
                (set! line (list x))
                (set! col len))
               (else
                (set! line (cons x line))
                (set! col new-col)))))
     (cdr words))
    (set! all (cons (string-join (reverse! line) " ") all))
    (string-join (reverse! all) "\n")))

(provide "text/format")