The current implementation does not handle non-default :align keywords properly except when an +identity-transformation+ is in effect. This can be fixed simply by moving the transform-position form up before the (unlesss (and (eq align-x... ) stuff as shown below.
(multiple-value-bind (x y) (transform-position merged-transform x y) (unless (and (eq align-x :left) (eq align-y :baseline)) (setq x (- x (ecase align-x (:left 0) (:center (round text-width 2)) ; worst case (:right text-width)))) ; worst case (setq y (ecase align-y (:top (+ y baseline)) ; OK (:baseline y) ; OK (:center (+ y baseline (- (floor text-height 2)))) ; change (:bottom (+ y baseline (- text-height)))))) ; change (xlib:draw-glyphs mi gc (truncate (+ x 0.5)) (truncate (+ y 0.5)) string :start start :end end :translate #'translate :size 16))))))
Hello Paul,
thank you for the report. Please note that the implementation using draw-glyphs is obsolete in favor of the ttf renderer. Currently works on improving the latter are pending, with additional features like the text directionality.
Best regards, Daniel
-- Daniel Kochmański ;; aka jackdaniel | Przemyśl, Poland TurtleWare - Daniel Kochmański | www.turtleware.eu
"Be the change that you wish to see in the world." - Mahatma Gandhi
On Wednesday, May 1st, 2024 at 3:38 PM, Paul Werkowski pw@snoopy.qozzy.com wrote:
The current implementation does not handle non-default :align keywords properly except when an +identity-transformation+ is in effect. This can be fixed simply by moving the transform-position form up before the (unlesss (and (eq align-x... ) stuff as shown below.
(multiple-value-bind (x y) (transform-position merged-transform x y) (unless (and (eq align-x :left) (eq align-y :baseline)) (setq x (- x (ecase align-x (:left 0) (:center (round text-width 2)) ; worst case (:right text-width)))) ; worst case (setq y (ecase align-y (:top (+ y baseline)) ; OK (:baseline y) ; OK (:center (+ y baseline (- (floor text-height 2)))) ; change (:bottom (+ y baseline (- text-height)))))) ; change (xlib:draw-glyphs mi gc (truncate (+ x 0.5)) (truncate (+ y 0.5)) string :start start :end end :translate #'translate :size 16))))))
Oops, that fix was almost correct. The translate #'translate at the end should be removed. clx-ttf almost works.
Here is a simple test program to demonstrate. Choose your favorite backend.
;;;;;;;;;;;;; (in-package :clim-user)
(define-application-frame draw-text-test () () (:panes (p1 :application :scroll-bars nil :display-function #'(lambda (frame pane) (declare (ignorable frame pane)) (with-first-quadrant-coordinates (pane 10 100) (draw-rectangle* pane 0 0 90 90 :filled nil) (draw-line* pane 20 20 80 20) (draw-line* pane 20 20 20 80) (draw-text* pane "AbCde" 50 20 :align-x :center :align-y :top) )))))
(find-application-frame 'draw-text-test :port (find-port :server-path '(:clx-ttf)) :height 120 :left 900 :top 200)
-
Daniel Kochmański -
Paul Werkowski