From archimag at gmail.com Wed Apr 29 12:12:35 2009 From: archimag at gmail.com (Andrey Moskvitin) Date: Wed, 29 Apr 2009 16:12:35 +0400 Subject: [cl-pdf-devel] Simple patch for draw-...-text In-Reply-To: <49CFB58B.5050203@fractalconcept.com> References: <49CFB58B.5050203@fractalconcept.com> Message-ID: 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 > 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: From archimag at gmail.com Wed Apr 29 12:33:03 2009 From: archimag at gmail.com (Andrey Moskvitin) Date: Wed, 29 Apr 2009 16:33:03 +0400 Subject: [cl-pdf-devel] pdf-string don't work with unicode strings in sbcl Message-ID: Hi, In SBCL result of the expression (type-of (code-char 244)) is extended-char, so pdf-string can not handle unicode strings. See my patch. Moskvitin Andrey --- diff --git a/pdf.lisp b/pdf.lisp index 16d8f6f..b54b5a6 100644 --- a/pdf.lisp +++ b/pdf.lisp @@ -235,21 +235,20 @@ (setq unicode (notevery #+lispworks #'lw:base-char-p #-lispworks (lambda (char) (<= (char-code char) 255)) string))) - (with-output-to-string (stream nil :element-type 'base-char) - (write-char #\( stream) - (when unicode ; write the Unicode byte order marker U+FEFF - (write-char #.(code-char 254) stream) (write-char #.(code-char 255) stream)) + (with-output-to-string (stream nil :element-type 'base-char) + (if unicode + (write-string " code 255) do (write-char (code-char (ldb (byte 8 0) code)) stream) ; lo else do (case char ((#\( #\) #\\) (write-char #\\ stream))) (write-char char stream)) - (write-char #\) stream)))) + (write-char (if unicode #\> #\)) stream)))) (defmacro with-outline-level ((title ref-name) &body body) `(unwind-protect -------------- next part -------------- An HTML attachment was scrubbed... URL: