Lisp HUG Maillist Archive

Undocumented gp:draw-x-y-adjusted-string y-adjusts improperly

Hello,

When I tried the gp:draw-x-y-adjusted-string function on LWW 4.2, I
found it behavior slightly odd in "y-adjust" aspect. Later, its
definition was discovered in the scroll-test.lisp sample file:

;;; This should be in GP...
(defun draw-x-y-adjusted-string (port string x y &rest options &key
(x-adjust :left) (y-adjust :bottom) &allow-other-keys)
  (multiple-value-bind (left top right bottom)
      (gp:get-string-extent port string)

    (let ((width (- right left))
          (height (- bottom top)))
      (without-properties (draw-options options :x-adjust :y-adjust)
        (apply 'gp:draw-string
               port
        string
        (- x (ecase x-adjust
        (:left 0)
        ((:centre :center) (floor width 2))
        (:right width)))
        (+ y (ecase y-adjust
                      (:top height)
                      ((:centre :center) (floor height 2))
                      (:bottom 0)))
        draw-options)))))

To perform more intuitively, the above definition could be rewritten
like this:

(defun draw-x-y-adjusted-string (port string x y &rest options
                                                 &key (x-adjust :left)
(y-adjust :bottom)
                                                 &allow-other-keys)
  (multiple-value-bind (left top right bottom)
      (gp:get-string-extent port string)
    (let ((width (- right left))
          (height (- bottom top)))
      (without-properties (graphics-args options :x-adjust :y-adjust)
        (apply 'gp:draw-string
               port
        string
        (- x (ecase x-adjust
        (:left 0)
        ((:centre :center) (floor width 2))
        (:right width)))
        (+ y (ecase y-adjust
                      (:top (gp:get-font-ascent port))
                      ((:centre :center) (- (floor height 2)
                                            (gp:get-font-descent port)))
                      (:bottom (- (gp:get-font-descent port)))))
        graphics-args)))))
---
Sincerely,
Dmitri Ivanov
www.aha.ru/~divanov


Updated at: 2020-12-10 09:01 UTC