From bb1717a43d4922daf7c9b66a55b69f45b4bb9c07 Mon Sep 17 00:00:00 2001 From: Hermes Agent Date: Tue, 12 May 2026 13:46:42 +0000 Subject: [PATCH] fix: draw-border renders titles in modern and simple backends (title, title-align respected) --- backend/modern.lisp | 38 +++++++++++++++++++++++++++++++------- backend/simple.lisp | 45 +++++++++++++++++++++++++++++++-------------- backend/tests.lisp | 4 ++-- 3 files changed, 64 insertions(+), 23 deletions(-) diff --git a/backend/modern.lisp b/backend/modern.lisp index aabf5dd..23c620a 100644 --- a/backend/modern.lisp +++ b/backend/modern.lisp @@ -191,7 +191,6 @@ as a fallback when a keyword is not in *named-colors*.") (defmethod draw-border ((b modern-backend) x y width height &key style fg bg title title-align) - (declare (ignore title title-align)) (let* ((s (or style :single)) (tl (border-char s :top-left)) (tr (border-char s :top-right)) @@ -202,17 +201,42 @@ as a fallback when a keyword is not in *named-colors*.") (fg-esc (sgr-fg fg)) (bg-esc (sgr-bg bg)) (reset (sgr-attr :reset)) - (top (concatenate 'string - fg-esc bg-esc tl - (make-string (- width 2) :initial-element (char h 0)) - tr reset (string #\Newline))) + (inner-width (- width 2)) + (hc (char h 0)) + (top (if (and title (plusp (length title))) + (let* ((align (or title-align :left)) + (max-tlen (- inner-width 2)) + (tlen (min (length title) max-tlen)) + (trunc-title (subseq title 0 tlen))) + (ecase align + (:left + (let ((right-hyphens (- inner-width tlen 2))) + (concatenate 'string + fg-esc bg-esc tl (string #\Space) + trunc-title (string #\Space) + (make-string (max 0 right-hyphens) :initial-element hc) + tr reset (string #\Newline)))) + (:center + (let* ((total-pad (- inner-width tlen)) + (left-pad (floor total-pad 2)) + (right-pad (- total-pad left-pad))) + (concatenate 'string + fg-esc bg-esc tl + (make-string left-pad :initial-element hc) + trunc-title + (make-string right-pad :initial-element hc) + tr reset (string #\Newline)))))) + (concatenate 'string + fg-esc bg-esc tl + (make-string inner-width :initial-element hc) + tr reset (string #\Newline)))) (mid (concatenate 'string fg-esc bg-esc v - (make-string (- width 2) :initial-element #\Space) + (make-string inner-width :initial-element #\Space) v reset (string #\Newline))) (bot (concatenate 'string fg-esc bg-esc bl - (make-string (- width 2) :initial-element (char h 0)) + (make-string inner-width :initial-element hc) br reset))) (backend-write b top) (loop repeat (- height 2) do (backend-write b mid)) diff --git a/backend/simple.lisp b/backend/simple.lisp index 14d0a1c..b9b3a87 100644 --- a/backend/simple.lisp +++ b/backend/simple.lisp @@ -41,24 +41,39 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right, (defmethod draw-border ((b simple-backend) x y width height &key style fg bg title title-align) - (declare (ignore style fg bg title-align)) + (declare (ignore style fg bg)) (let ((h (%simple-border-char :horizontal)) - (v (%simple-border-char :vertical))) + (v (%simple-border-char :vertical)) + (tl (%simple-border-char :top-left)) + (tr (%simple-border-char :top-right)) + (bl (%simple-border-char :bottom-left)) + (br (%simple-border-char :bottom-right))) ;; Position cursor with newlines and spaces (no escape sequences) (dotimes (row y) (backend-write b (string #\Newline))) ;; Top edge with optional title (backend-write b (make-string x :initial-element #\space)) - (if title - (let* ((tlen (length title)) - (space-left (- width tlen 2)) - (left (max 0 (floor space-left 2))) - (right (max 0 (- space-left left)))) - (backend-write b (make-string left :initial-element h)) - (backend-write b (string #\space)) - (backend-write b title) - (backend-write b (string #\space)) - (backend-write b (make-string right :initial-element h))) - (backend-write b (make-string width :initial-element h))) + (backend-write b (string tl)) + (if (and title (plusp (length title))) + (let* ((align (or title-align :left)) + (inner-width (- width 2)) + (max-tlen (- inner-width 2)) + (tlen (min (length title) max-tlen)) + (trunc-title (subseq title 0 tlen))) + (ecase align + (:left + (backend-write b (string #\Space)) + (backend-write b trunc-title) + (backend-write b (string #\Space)) + (backend-write b (make-string (- inner-width tlen 2) :initial-element h))) + (:center + (let* ((total-pad (- inner-width tlen)) + (left-pad (floor total-pad 2)) + (right-pad (- total-pad left-pad))) + (backend-write b (make-string left-pad :initial-element h)) + (backend-write b trunc-title) + (backend-write b (make-string right-pad :initial-element h)))))) + (backend-write b (make-string (- width 2) :initial-element h))) + (backend-write b (string tr)) ;; Sides (loop for i from 1 below (1- height) do (backend-write b (string #\Newline)) @@ -69,7 +84,9 @@ POS is :top-left, :top-right, :bottom-left, :bottom-right, ;; Bottom edge (backend-write b (string #\Newline)) (backend-write b (make-string x :initial-element #\space)) - (backend-write b (make-string width :initial-element h)))) + (backend-write b (string bl)) + (backend-write b (make-string (- width 2) :initial-element h)) + (backend-write b (string br)))) (defmethod draw-rect ((b simple-backend) x y width height &key bg) diff --git a/backend/tests.lisp b/backend/tests.lisp index ea8f2fc..6c3a96e 100644 --- a/backend/tests.lisp +++ b/backend/tests.lisp @@ -46,7 +46,7 @@ (draw-border b 0 0 5 3 :style :single) (shutdown-backend b) (let ((out (get-output-stream-string s))) - (is (search "-----" out) "top edge should have 5 dashes") + (is (search "+---+" out) "top edge should have +---+") (is (search "| |" out) "middle row should have pipe sides")))) (test simple-backend-draw-rounded @@ -57,7 +57,7 @@ (shutdown-backend b) (let ((out (get-output-stream-string s))) ;; Rounded falls back to ASCII — identical output to single - (is (search "-----" out) "rounded style produces same dashes as single")))) + (is (search "+---+" out) "rounded style produces same dashes as single")))) (test simple-backend-draw-link "simple-backend renders link as plain text"