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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
;;; cl-typesetting copyright 2003-2004 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-typesetting is here: http://www.fractalconcept.com/asp/html/cl-typesetting.html
(in-package typeset)
#+(and clisp win32)
(setq custom:*floating-point-contagion-ansi* t
custom:*warn-on-floating-point-contagion* nil
custom:*default-file-encoding* (ext:encoding-charset charset:iso-8859-1))
#+(and clisp (not win32))
(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)
(defvar *leading-ratio* 1.2)
;;
;; FLAG -- collect all these in *default-text-style* and *current-text-style* ;; djc
;; Note: Don't let any of these variables become NIL, otherwise
;; that style won't be restored after a change. cf. typo.lisp
;;
(defvar *default-font* (pdf:get-font))
(defvar *default-font-size* 12.0)
(defvar *default-text-x-scale* 1)
(defvar *default-color* '(0 0 0))
(defvar *default-background-color* '(1.0 1.0 1.0))
(defvar *default-h-align* :left)
(defvar *default-v-align* :top)
(defvar *default-left-margin* 0)
(defvar *default-right-margin* 0)
(defvar *default-pre-decoration* :none)
(defvar *default-post-decoration* :none)
(defvar *font* *default-font*)
(defvar *font-size* *default-font-size*)
(defvar *text-x-scale* *default-text-x-scale*)
(defvar *color* *default-color*)
(defvar *background-color* *default-background-color*)
(defvar *pre-decoration* *default-pre-decoration*)
(defvar *post-decoration* *default-post-decoration*)
(defvar *h-align* *default-h-align*)
(defvar *v-align* *default-v-align*)
(defvar *left-margin* *default-left-margin*)
(defvar *right-margin* *default-right-margin*)
(defvar *offset* 0)
(defvar *leading* (* *font-size* *leading-ratio*))
(defvar *use-exact-char-boxes* nil)
(defvar *content* nil)
(defvar *white-chars* (coerce '(#\Space #\Tab #\Newline #\Return) 'string))
(defvar *punctuation-marks* ".;:!?,")
(defvar *punctuation-marks-extra-spacing-ratios*
'((#\. 1.5 15.0 3.0 0.7 2.0)
(#\; 1.5 15.0 3.0 0.7 2.0)
(#\: 1.5 15.0 3.0 0.7 2.0)
(#\! 1.5 15.0 3.0 0.7 2.0)
(#\? 1.5 15.0 3.0 0.7 2.0)
(#\, 1.2 12.0 3.0 0.7 2.0)))
(defvar *current-pass* nil)
(defvar *max-number-of-passes* 2)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro with-gensyms ((&rest names) &body body)
`(let (,@(mapcar (lambda (sym) `(,sym (gensym ,(symbol-name sym)))) names))
,@body)))
;;; Quad is construction for specifying values for margins, borders, paddings etc.
;;; It is represented as
;;; - either four-element vector #(left top right bottom),
;;; - or four-or-less-element list with defaulting rightmost elements,
;;; - or number supplying the same value for all the four components.
;;; Roughly equivalent to
;;; (destructuring-bind (left &optional (top left) (right left) (bottom top)) quad
;;; NB: CSS2 assumes different sequence of values: (top right bottom left) !
(defmacro with-quad ((left &optional top right bottom) quad &body body)
(with-gensyms (q)
`(let* ((,q ,quad)
(,left (cond ((vectorp ,q) (aref ,q 0))
((consp ,q) (first ,q))
((prog1 (or ,q 0) (setq ,q nil)))))
,@(when top `((,top (if (vectorp ,q) (aref ,q 1) (or (second ,q) ,left)))))
,@(when right `((,right (if (vectorp ,q) (aref ,q 2) (or (third ,q) ,left)))))
,@(when bottom `((,bottom (if (vectorp ,q) (aref ,q 3) (or (fourth ,q) ,top))))) )
,@body)))
(define-condition end-of-page (condition)
((box :initarg :box :reader box :initform nil))
(:report (lambda (c stream)
(format stream "Unexpected end-of-page during layout or stroking~@[ ~s~]."
(box c)))))
(define-condition cannot-fit-on-page (condition)
((box :initarg :box :reader box :initform nil))
(:report (lambda (c stream)
(format stream "Unable to fit object~@[ ~s~] even on a new page."
(box c)))))
(defmacro defconstant* (name value &optional doc)
`(defconstant ,name
(if (boundp ',name) (symbol-value ',name) ,value)
,@(when doc (list doc))))
;;; The string type to use for unicode characters
(define-symbol-macro unicode-string-type
#+lispworks 'lispworks:simple-text-string
#+sbcl 'simple-string
#+(or allegro clisp) 'simple-base-string
#-(or lispworks sbcl clisp allegro) 'string)
|
