[cl-pdf-devel] Simple patch for draw-...-text

[Andrey Moskvitin]

Hi,

I apologize for the long silence, was strongly engaged.

> Anyway, it's an interesting feature so could you rework its
implementation?
Well, I agree, this is a new version.

Andrey

---

diff --git a/text.lisp b/text.lisp
 index 8fbddf3..4c695d4 100644
--- a/text.lisp
+++ b/text.lisp
@@ -16,56 +16,71 @@ with Lisps that read source files in UTF-8 encoding.")
    (loop for c across string
     summing (get-char-width c font font-size)))

-(defun split-text (string font font-size max-width)
-  (if (> (* 2 (get-char-width #\M font font-size)) max-width)
-      (loop for c across string
 -        collect (make-string 1 :initial-element c))
-      (let ((width 0)
-        (start 0)
-        (result ()))
-    (loop for i from 0
-          for c across string
-          for d = (get-char-width c font font-size) do
 -          (if (or (char= c #\Newline)
-                      (char= c +section-char+)
-                      (> (+ width d) max-width))
-          (progn
-            (push (string-trim *delimiter-chars* (subseq string start i))
result)
 -            (setf start i width 0))
-          (incf width d))
-          finally (push (string-trim *delimiter-chars* (subseq string
start)) result))
-    (nreverse result))))
+(defun split-text (string font font-size max-width &optional max-height)
 +  (let ((max-line-number (if max-height
+                             (floor (+ max-height (* 0.2 font-size))
+                                    (* 1.2 font-size))))
+        (current-line-number 1))
+    (flet ((check-max-number-of-lines ()
 +             (and max-line-number
+                  (< max-line-number
+                     (prog1
+                         current-line-number
+                       (incf current-line-number))))))
 +      (if (> (* 2 (get-char-width #\M font font-size)) max-width)
+          (loop for c across string
+                until (check-max-number-of-lines)
+                collect (string c))
+          (let ((width 0)
 +                (start 0)
+                (result ()))
+            (loop with max-number-of-lines = (and max-line-number (<
max-line-number current-line-number))
+                  until max-number-of-lines
 +                  for i from 0
+                  for c across string
+                  for d = (get-char-width c font font-size) do
+                  (if (or (char= c #\Newline)
+                          (char= c +section-char+)
 +                          (> (+ width d) max-width))
+                      (progn
+                        (push (string-trim *delimiter-chars* (subseq string
start i)) result)
+                        (setf start i width 0)
 +                        (setf max-number-of-lines
(check-max-number-of-lines)))
+                      (incf width d))
+                  finally (unless max-number-of-lines
+                            (push (string-trim *delimiter-chars* (subseq
string start)) result)))
 +            (nreverse result))))))

-(defun draw-centered-text (x y string font font-size &optional max-width)
+(defun draw-centered-text (x y string font font-size &optional max-width
max-height)
   (pdf:in-text-mode
     (pdf:move-text x y)
    (pdf:set-font font font-size)
    (loop with dy = (* -1.2 font-size)
-     for (str . rest) on (if max-width (split-text string font font-size
max-width) (list string))
+     for (str . rest) on (if max-width (split-text string font font-size
max-width max-height) (list string))
       for last-x = 0 then offset
      for offset = (* -0.5 (text-width str font font-size)) do
      (move-text (- offset last-x) 0)
      (show-text str)
      (when rest (pdf:move-text 0 dy)))))

-(defun draw-left-text (x y string font font-size &optional max-width)
+(defun draw-left-text (x y string font font-size &optional max-width
max-height)
   (pdf:in-text-mode
    (pdf:move-text x y)
    (pdf:set-font font font-size)
    (loop with dy = (* -1.2 font-size)
-     for (str . rest) on (if max-width (split-text string font font-size
max-width) (list string))
 +     for (str . rest) on (if max-width (split-text string font font-size
max-width max-height) (list string))
      for last-x = 0 then offset
      for offset = (- (text-width str font font-size)) do
      (move-text (- offset last-x) 0)
       (show-text str)
      (when rest (pdf:move-text 0 dy)))))

-(defun draw-right-text (x y string font font-size &optional max-width)
+(defun draw-right-text (x y string font font-size &optional max-width
max-height)
   (pdf:in-text-mode
    (pdf:move-text x y)
    (pdf:set-font font font-size)
    (loop with dy = (* -1.2 font-size)
-     for (str . rest) on (if max-width (split-text string font font-size
max-width) (list string))
 +     for (str . rest) on (if max-width (split-text string font font-size
max-width max-height) (list string))
      do
      (show-text str)
      (when rest (move-text 0 dy)))))


2009/3/29 Marc Battyani <marc.battyani at fractalconcept.com>

>  Hi Andrey,
>
> This is a very good idea but I think it needs some polish. :)
>
> Having a while clause before for clauses is not compliant even if most loop
> implementations are OK with this.
>
> Using a line count and then multiplying by dy at each iteration is not very
> efficient, it would be better to have a current-height and add dy at each
> iteration or even simply to substract dy from max-height until it goes
> negative (with a default huge value for max-height)
>
> BTW as the draw-...-text functions all call split text, in fact it would be
> much more efficient to limit the number of lines directly in split-text.
> After all what is the point of splitting a text in n lines if we only want 2
> lines for instance.
>
> Anyway, it's an interesting feature so could you rework its implementation?
>
> Thanks,
>
> Marc
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cl-pdf-devel/attachments/20090429/6b754bc8/attachment.html>