File: text.lisp

package info (click to toggle)
cl-pdf 166-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 1,520 kB
  • ctags: 639
  • sloc: lisp: 6,902; makefile: 39
file content (71 lines) | stat: -rw-r--r-- 2,700 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
;;; cl-pdf copyright 2002-2003 Marc Battyani see license.txt for the details
;;; You can reach me at marc.battyani@fractalconcept.com or marc@battyani.net
;;; The homepage of cl-pdf is here: http://www.fractalconcept.com/asp/html/cl-pdf.html

(in-package #:pdf)

;;; Basic (and crude) text layout functions
;;; use cl-typesetting for nice text layout functions

(defconstant +section-char+ (code-char 167)
  "This character is not entered literally to avoid causing problems
with Lisps that read source files in UTF-8 encoding.")
(defvar *delimiter-chars* (list #\Space #\Tab #\Newline +section-char+))

(defun text-width (string font font-size)
  (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 draw-centered-text (x y string font font-size &optional max-width)
  (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 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)
  (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 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)
  (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))
	 do
	 (show-text str)
	 (when rest (move-text 0 dy)))))