[cl-typesetting-devel] CLISP support

[Klaus Weidner]

On Sat, Apr 24, 2004 at 11:18:52PM -0500, Klaus Weidner wrote:
> The appended patch has workarounds, but IMHO the code should really be
> rewritten to be less loopy. Apparently having more than a single exit
> clause in a loop is asking for trouble, and the implementations can't
> even agree on the simple case of what an "for X on LIST" should return.

Some more notes on the patch...

CLISP died at (max ... max-height) due to max-height being NIL in the
loop. Replacing it with (or max-height 0) fixed that:

> -          finally (setf height (+ (max (or (height row) 0) max-height) +epsilon+)))
> +          finally (setf height (+ (max (or (height row) 0) (or max-height 0)) +epsilon+)))


The following single change is not needed after all, it's left over from
my experiments:

> -          while (<= y max-height)
> +          while (and rows (<= y max-height))

All the others *are* needed to make it work. I've appended a fixed full
patch including the older floating point handling patch.

-Klaus
-------------- next part --------------
diff -urN -x *.fas -x *.lib orig/cl-typesetting/cl-typesetting.asd cl-typesetting/cl-typesetting.asd
--- orig/cl-typesetting/cl-typesetting.asd	Thu Apr 22 05:23:18 2004
+++ cl-typesetting/cl-typesetting.asd	Sat Apr 24 18:32:45 2004
@@ -6,7 +6,6 @@
 
 (in-package asdf)
 
-#+(or allegro lispworks cmu sbcl openmcl mcl scl)
 (defsystem :cl-typesetting
     :name "cl-typesetting"
     :author "Marc Battyani <marc.battyani at fractalconcept.com>"
diff -urN -x *.fas -x *.lib orig/cl-typesetting/specials.lisp cl-typesetting/specials.lisp
--- orig/cl-typesetting/specials.lisp	Thu Apr 22 05:23:18 2004
+++ cl-typesetting/specials.lisp	Sat Apr 24 18:44:12 2004
@@ -4,6 +4,11 @@
 
 (in-package typeset)
 
+#+clisp
+(setq custom:*floating-point-contagion-ansi* t
+      custom:*warn-on-floating-point-contagion* nil
+      custom:*default-file-encoding* (ext:encoding-charset "iso-8859-1"))
+
 (defconstant +huge-number+ (truncate most-positive-fixnum 10))
 (defconstant +epsilon+ 0.0001)
 
diff -urN -x *.fas -x *.lib orig/cl-typesetting/tables.lisp cl-typesetting/tables.lisp
--- orig/cl-typesetting/tables.lisp	Tue Apr 20 17:16:58 2004
+++ cl-typesetting/tables.lisp	Sat Apr 24 23:34:58 2004
@@ -92,9 +92,9 @@
           do (setf (splittable-p row) nil)
         do
         (loop for j = 0 then (+ j (col-span c))
-              and tail on (cells row)
+              for tail = (cells row) then (cdr tail)
               for c = (first tail)		; j is the column number of c
-              while (< j col-number)
+              while (and tail (< j col-number))
               collect (first tail) into head
               finally				; insert cell between head and tail
               (setf (cells row) (nconc head (list cell) tail)))
@@ -131,7 +131,7 @@
                                 :end (1- (length row-span))
                                 :initial-value (* (1- (length row-span))
                                                   full-size-offset)))  into max-height
-          finally (setf height (+ (max (or (height row) 0) max-height) +epsilon+)))
+          finally (setf height (+ (max (or (height row) 0) (or max-height 0)) +epsilon+)))
     (setf (height row) height)
     (loop for cell in (cells row)
           for row-span = (row-span cell)
@@ -188,11 +188,18 @@
           ;do (setf (dy row) (+ (height row) full-size-offset))
           do (push row boxes)
           finally
+	  ;; screwed by loop semantic differences :-(
+	  ;; (loop for r in '(42) finally (return r))
+	  ;;    all   => 42
+	  ;; (loop for r on '(42) finally (return r))
+	  ;;    sbcl  => nil
+	  ;;    clisp => (42)
+	  #+clisp (unless (> y max-height) (pop rows))
           (when (and boxes
                      ;; Trim unsplitalbe rows and reverse the list of accumulated boxes
-                     (setf boxes (loop for tail on boxes
+                     (setf boxes (loop for tail = boxes then (cdr tail)
                                        for row = (first tail)
-                                       until (splittable-p row)
+                                       until (or (not row) (splittable-p row))
                                        do (decf prev-y (+ (height row) full-size-offset))
                                        finally (return (nreverse tail)))))
             (setq boxes (append header boxes footer))
diff -urN -x *.fas -x *.lib orig/cl-typesetting/test.lisp cl-typesetting/test.lisp
--- orig/cl-typesetting/test.lisp	Tue Apr 20 17:16:58 2004
+++ cl-typesetting/test.lisp	Sat Apr 24 23:36:59 2004
@@ -128,7 +128,7 @@
       (pdf:set-color-stroke (color box))
       (pdf:move-to (- dx/2) 0)
       (loop for x from (- dx/2) by 0.2
-	    for y = (* dy/2 (cos (* x 0.8)) (exp (* x x -0.006)))
+	    for y = (* dy/2 (cos (* x 0.8)) (exp (* x x -0.006d0)))
 	    while (< x dx/2)
 	    do (pdf:line-to x y))
       (pdf:stroke))))