From e5101032f7442c2def430141b0e2db1efc8d017d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Tue, 25 Nov 2008 00:02:15 +0100
Subject: justify, text-table: Fix width rounding issues.

* src/guile/skribilo/utils/justify.scm (make-justified-line): Make
  ONE-SPACES inexact.
  (make-centered-line): Round WIDTH to an exact integer.
  (make-justifier): Check the type and range of WIDTH.

* src/guile/skribilo/utils/text-table.scm (table->ascii): Check whether
  WIDTH is a number.  Round LCOLSWIDTH with `round-to-exact'.
  (table-row-format)[cell-width]: Round W with `round-to-exact'.
  (table-cell-vformat): Round NEW/2.
  (round-to-exact): New.
---
 src/guile/skribilo/utils/justify.scm    | 21 ++++++++++++++++++---
 src/guile/skribilo/utils/text-table.scm | 25 ++++++++++++++++---------
 2 files changed, 34 insertions(+), 12 deletions(-)

(limited to 'src')

diff --git a/src/guile/skribilo/utils/justify.scm b/src/guile/skribilo/utils/justify.scm
index 733f53f..c47b14f 100644
--- a/src/guile/skribilo/utils/justify.scm
+++ b/src/guile/skribilo/utils/justify.scm
@@ -21,6 +21,9 @@
 
 (define-module (skribilo utils justify)
   :use-module (srfi srfi-13)
+  :autoload   (srfi srfi-34)       (raise)
+  :use-module (srfi srfi-35)
+  :use-module (skribilo condition)
   :export (make-justifier output-flush
 
 	   *text-column-width*
@@ -219,7 +222,7 @@
                  (nb-chars   (apply + (map string-length
                                            tokens)))
                  (all-spaces (- width nb-chars))
-                 (one-spaces (/ all-spaces
+                 (one-spaces (/ all-spaces 1.0
                                 (- nb-tokens 1)))
                  (cursor     (string-length (car tokens))))
              (string-insert! result (car tokens) 0)
@@ -268,12 +271,15 @@
 ;*    make-centered-line ...                                           */
 ;*---------------------------------------------------------------------*/
 (define (make-centered-line tokens width)
+  (let ((width (if (inexact? width)
+                   (inexact->exact (round width))
+                   (round width))))
    (make-formated-line tokens
 		       width
 		       (quotient (- width
 				    (+ (apply + (map string-length tokens))
 				       (- (length tokens) 1)))
-				 2)))
+				 2))))
 
 ;*---------------------------------------------------------------------*/
 ;*    make-flushleft-line ...                                          */
@@ -337,6 +343,11 @@
 ;*    make-justifier ...                                               */
 ;*---------------------------------------------------------------------*/
 (define (make-justifier width policy)
+   (and (or (not (number? width)) (< width 0))
+        (raise (condition
+                (&invalid-argument-error (proc-name "make-justifier")
+                                         (argument  width)))))
+
    (let ((tokens '()))
       (if (eq? policy 'verbatim)
 	  (lambda (cmd . vals)
@@ -393,7 +404,11 @@
 		       (if (pair? ntokens)
 			   (let ((toks (reverse! ntokens)))
 			      (set! tokens '())
-			      (tokens-justify justifier toks width))
+			      (tokens-justify justifier toks
+                                              (if (inexact? width)
+                                                  (round
+                                                   (inexact->exact width))
+                                                  (round width))))
 			   '())))
 		   ((width)
 		    width)
diff --git a/src/guile/skribilo/utils/text-table.scm b/src/guile/skribilo/utils/text-table.scm
index 2f6d2d2..b90517a 100644
--- a/src/guile/skribilo/utils/text-table.scm
+++ b/src/guile/skribilo/utils/text-table.scm
@@ -50,14 +50,14 @@
 	     (awidth (- (cond
 			     ((integer? width)
 			      width)
-			     ((inexact? width)
+			     ((and (number? width) (inexact? width))
 			      (inexact->exact (* width (justification-width))))
 			     (else
 			      (justification-width)))
 			  ;; remove one characters per columns separation
 			  (- nc 1)))
 	     (colswidth (rows-requested-sizes obj nc awidth))
-	     (lcolswidth (vector->list colswidth))
+	     (lcolswidth (map round-to-exact (vector->list colswidth)))
 	     (nb-def-cols (length (filter (lambda (s) (= s 0)) lcolswidth)))
 	     (defcolwidth (if (= nb-def-cols 0)
 			      0
@@ -81,7 +81,7 @@
 		       (loop (+ i 1) (+ sum defcolwidth)))
 		    (loop (+ i 1) (+ sum (vector-ref colswidth i))))))
 	 ;; at that point colswidth contains the width of each colums.
-	 (let ((lcolswidth (vector->list colswidth))
+	 (let ((lcolswidth (map round-to-exact (vector->list colswidth)))
 	       (hrows (map (lambda (r)
 			      (table-row-format r nc colswidth scribe->ascii))
 			   rows)))
@@ -111,9 +111,10 @@
 (define (table-row-format row nbcols colswidth scribe->ascii)
    (define (cell-width cnum cspan)
       (let ((v (do ((i cnum (+ i 1))
-		    (w 0 (+ w (vector-ref colswidth i))))
+		    (w 0 (+ w (round-to-exact (vector-ref colswidth i)))))
 		   ((= i (+ cnum cspan)) w))))
 	 (+ v (- cspan 1))))
+
    (let ((cells (markup-body row)))
       (let loop ((cells cells)
 		 (cnum 0)
@@ -192,7 +193,7 @@
       (if (= lfmt nblines)
 	  fmt
 	  (let* ((new (- nblines lfmt))
-		 (new/2 (inexact->exact (/ new 2))))
+		 (new/2 (inexact->exact (round (/ new 2)))))
 	     (case (markup-option cell :valign)
 		((top)
 		 (append fmt (make-filler-lines new)))
@@ -237,14 +238,20 @@
 				 (loop (cdr cells) (+ col cspan)))))))
 		(markup-body table))
       rsizes))
-				       
-;*---------------------------------------------------------------------*/
-;*    smallest-map ...                                                 */
-;*---------------------------------------------------------------------*/
+
+
+;;;
+;;; Convenience functions.
+;;;
+
 (define (smallest-map f l1 l2)
    (if (or (null? l1) (null? l2))
        '()
        (cons (f (car l1) (car l2)) (smallest-map f (cdr l1) (cdr l2)))))
 
+(define (round-to-exact w)
+  (if (inexact? w)
+      (inexact->exact (round w))
+      (round w)))
 
 ;;; text-table.scm ends here
-- 
cgit v1.2.3