diff options
| author | Daniel Kochmański <daniel@turtleware.eu> | 2024-06-26 11:01:15 +0200 |
|---|---|---|
| committer | Daniel Kochmański <daniel@turtleware.eu> | 2024-06-28 12:45:34 +0200 |
| commit | 482dbbbd76da4755ab196fa180746bd26bb12098 (patch) | |
| tree | 6ccca0a4e1861fd2b1f4f67020ef5336b4455b7e /Backends | |
| parent | c0a0baa31b7ac94b05a502620320c5a8efbd536d (diff) | |
multiline-medium-mixin: be more frugal with computations
Diffstat (limited to 'Backends')
| -rw-r--r-- | Backends/common/medium.lisp | 37 |
1 files changed, 21 insertions, 16 deletions
diff --git a/Backends/common/medium.lisp b/Backends/common/medium.lisp index 1fb94bad..159d8b0a 100644 --- a/Backends/common/medium.lisp +++ b/Backends/common/medium.lisp @@ -84,25 +84,30 @@ start end align-x align-y toward-x toward-y transform-glyphs) - (let* ((base-transf (medium-device-transformation medium)) - (text-transf (if transform-glyphs - (draw-text-rotation* x y toward-x toward-y) - (with-transformed-positions* (base-transf x y toward-x toward-y) - (compose-transformations - (draw-text-rotation* x y toward-x toward-y) - (invert-transformation base-transf)))))) - (flet ((advance-line (idx0 idx1) - (multiple-value-bind (w h dx dy baseline) - ;; IDX1 is a position of #\newline hence #'1+ - (text-size medium string :start idx0 :end (1+ idx1)) - (declare (ignore w h baseline)) - (with-transformed-distance (text-transf dx dy) - (incf x dx) (incf toward-x dx) - (incf y dy) (incf toward-y dy))))) + (let (dx dy) + (flet ((advance-line () + (unless dx + (let* ((base-transf (medium-device-transformation medium)) + (text-transf (if transform-glyphs + (draw-text-rotation* x y toward-x toward-y) + (with-transformed-positions* + (base-transf x y toward-x toward-y) + (compose-transformations + (draw-text-rotation* x y toward-x toward-y) + (invert-transformation base-transf)))))) + (multiple-value-bind (w h line-dx line-dy baseline) + (text-size medium #.(format nil " ~%")) + ;; ;; IDX1 is a position of #\newline hence #'1+ + #+ (or) (text-size medium string :start idx0 :end (1+ idx1)) + (declare (ignore w h baseline)) + (multiple-value-setq (dx dy) + (transform-distance text-transf line-dx line-dy))))) + (incf x dx) (incf toward-x dx) + (incf y dy) (incf toward-y dy))) (loop for idx0 = start then (1+ idx1) for idx1 = (position #\newline string :start idx0 :end end) do (call-next-method medium string x y idx0 (or idx1 end) align-x align-y toward-x toward-y transform-glyphs) while idx1 - do (advance-line idx0 idx1))))) + do (advance-line))))) |