Text display in graphics ports at arbitrary baseline angles?
Hi,I have a routine for printing the vertical axis labels of a 2-D graph sideways. That works fine on the screen, and in BMP images. But when attempting to print to a saved PDF file on Mac OS/X, the entire Lisp image bombs out with a raft of null ObjC pointers.
Obviously, my technique of drawing text along a horizontal baseline in a "compatible" graphics port, extracting the image bits, transposing them, and then planting the rotated image back into the output graphics port, does not work properly for PDF ports. And even if it did, the magnified PDF displays wouldn't show nice smooth text glyphs, but rather it would show chunky bitmap images.
Anyone have any ideas on how to make LW produce text along arbitrary baseline angles? Without resorting to this kludge of bitmap rotations?
Code below is included for anyone that might find it useful anyway... I certainly do for the screen presentation of my graphs, but it won't work for PDF output...
Cheers,
David McClain
Chief Technical Officer
Refined Audiometrics Laboratory
4391 N. Camino Ferreo
Tucson, AZ 85750
email: dbm@refined-audiometrics.com
phone: 1.520.390.3995
Skype: dbmcclain
(defun draw-vert-string-x-y (pane string x y
&key
(x-alignment :baseline)
(y-alignment :left)
font
prev-bounds
(margin 2)
(color :black)
(transparent t))
(multiple-value-bind (lf tp rt bt)
(gp:get-string-extent pane string font)
(let* ((wd (- rt lf -1))
(ht (- bt tp -1))
(dx (ecase x-alignment
(:top 0)
(:bottom (- ht))
(:baseline tp)
(:center (floor tp 2))
))
(dy (ecase y-alignment
(:right 0)
(:left (- wd))
(:center (- (floor wd 2)))
))
(new-bounds (list (+ y lf dy) (+ y rt dy))))
(if (and prev-bounds
(bounds-overlap-p (expand-bounds prev-bounds margin) new-bounds))
prev-bounds
(gp:with-pixmap-graphics-port (ph pane wd ht
:clear t)
(gp:with-graphics-state
(ph :foreground color)
(gp:draw-string ph string
0 (- tp)
:font font
:block (not transparent)))
(with-image (pane (v-image #+:COCOA (gp:make-image pane ht wd)
#+:WIN32 (gp:make-image pane ht wd :alpha nil)
))
(with-image (ph (h-image (gp:make-image-from-port ph)))
(with-image-access (ha (gp:make-image-access ph h-image))
(with-image-access (va (gp:make-image-access pane v-image))
(gp:image-access-transfer-from-image ha)
(loop for ix from 0 below wd do
(loop for iy from 0 below ht do
(setf (gp:image-access-pixel va iy (- wd ix 1))
(gp:image-access-pixel ha ix iy))
))
(gp:image-access-transfer-to-image va)
)))
(gp:draw-image pane v-image (+ x dx) (+ y dy)))
new-bounds
))
)))
------------------------------------------------------------------------------