amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: draw-border renders titles in modern and simple backends (title, title-align respected)

Browse Source
This commit is contained in:
Hermes Agent
2026-05-12 13:46:42 +00:00
parent b21daa99b8
commit bb1717a43d
3 changed files with 64 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
backend/simple.lisp
View File

@@ -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)