# Diff of /tutorial/example.lisp

revision 19 by tpapp, Thu Dec 20 13:05:07 2007 UTC revision 20 by tpapp, Wed May 28 01:34:00 2008 UTC
# Line 39  Line 39
39                 (- y (* height y-align) y-bearing))                 (- y (* height y-align) y-bearing))
40        (show-text text))))        (show-text text))))
41
42    ;;;; very simple text example
43    (setf *context* (create-ps-context "simpletext.ps" 100 100))
44    (move-to 0 100)
45    (set-font-size 50)
46    (show-text "foo")
47    (destroy *context*)
48
49
50    ;;;;
51    ;;;;  text placement example
52    ;;;;
53    ;;;;  This example demonstrates the use of text-extents, by placing
54    ;;;;  text aligned relative to a red marker.
55
56    (defun mark-at (x y d red green blue)
57      "Make a rectangle of size 2d around x y with the given colors,
58      50% alpha.  Used for marking points."
59      (rectangle (- x d) (- y d) (* 2 d) (* 2 d))
60      (set-source-rgba red green blue 0.5)
61      (fill-path))
62
63    (defun show-text-with-marker (text x y x-align y-align)
64      "Show text aligned relative to a red market at (x,y)."
65      (mark-at x y 2 1 0 0)
66      (set-source-rgba 0 0 0 0.6)
67      (show-text-aligned text x y x-align y-align))
68
69    (defparameter width 500)
70    (defparameter height 500)
71    (defparameter text "Fog")               ; contains g, which goes below baseline
72    (defparameter size 50)
73    (defparameter x 20d0)
74    (defparameter y 50d0)
75    (setf *context* (create-ps-context "text.ps" width height))
76    ;;(setf *context* (create-svg-context "text.svg" width height))
77    ;;(setf *context* (create-pdf-context "text.pdf" width height))
78    ;; white background
79    (set-source-rgb 1 1 1)
80    (paint)
81    ;; setup font
82    (select-font-face "Arial" 'font-slant-normal 'font-weight-normal)
83    (set-font-size size)
84    ;; starting point
85    (mark-at x y 2 1 0 0)                   ; red
86    ;; first text in a box
87    (multiple-value-bind (x-bearing y-bearing text-width text-height)
88        (text-extents text)
89      (let ((rect-x (+ x x-bearing))
90            (rect-y (+ y y-bearing)))
91        (rectangle rect-x rect-y text-width text-height)
92        (set-source-rgba 0 0 1 0.3)         ; blue
93        (set-line-width 1)
94        (set-dash 0 '(5 5))
95        (stroke)))
96    (set-source-rgba 0 0 0 0.6)
97    (move-to x y)
98    (show-text text)
99    ;; text automatically aligned
100    ;; (dolist (x-align '(0 0.5 1))
101    ;;   (dolist (y-align '(0 0.5 1))
102    ;;     (show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)
103    ;;                         x-align y-align)))
104    (dolist (x-align '(0))
105      (dolist (y-align '(0))
106        (show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)
107                               x-align y-align)))
108
109    (show-text-with-marker text x (+ y 100d0) 0d0 0d0)
110    ;; done
111    (destroy *context*)
112
113
114
115  ;;;;  ;;;;
116  ;;;;  text placement example  ;;;;  text placement example
117  ;;;;  ;;;;
# Line 64  Line 137
137  (defparameter size 50)  (defparameter size 50)
138  (defparameter x 20)  (defparameter x 20)
139  (defparameter y 50)  (defparameter y 50)
140  (setf *context* (create-ps-context "text.ps" width height))  (setf *context* (create-ps-context "text2.ps" width height))
141    ;;(setf *context* (create-svg-context "text.svg" width height))
142    ;;(setf *context* (create-pdf-context "text.pdf" width height))
143  ;; white background  ;; white background
144  (set-source-rgb 1 1 1)  (set-source-rgb 1 1 1)
145  (paint)  (paint)
# Line 91  Line 166
166    (dolist (y-align '(0 0.5 1))    (dolist (y-align '(0 0.5 1))
167      (show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)      (show-text-with-marker text (+ x (* x-align 300)) (+ y (* y-align 300) 100)
168                             x-align y-align)))                             x-align y-align)))
169
170    (show-text-with-marker text (+ x 0d0) (+ y 0d0 0d0) 0d0 0d0)
171
172  ;; done  ;; done
173  (destroy *context*)  (destroy *context*)
174

Legend:
 Removed from v.19 changed lines Added in v.20