literate: convert org/box-renderable.org from doc-only to tangle source

Now tangles to box.lisp + text.lisp + box-tests.lisp.
Deleted hand-written originals and regenerated — GREEN.
This commit is contained in:
Hermes Agent
2026-05-12 17:16:26 +00:00
parent c77c6b9d02
commit f50d0e61d1
2 changed files with 297 additions and 39 deletions

View File

@@ -1,34 +1,45 @@
#+TITLE: cl-tty Box Renderable — v0.2.0 #+TITLE: Box and Text Renderables
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :cl-tty:components:v0.2.0: #+FILETAGS: :cl-tty:components:
#+OPTIONS: ^:nil
* Box Renderable * Overview
The Box renderable draws a bordered rectangle with optional title and background Box and Text are the two fundamental renderable component types. Box
fill. It is the first renderable type and the foundation for all container provides a bordered container with optional background fill and title.
components (dialog, panel, group). Text renders strings with word-wrap, color, and inline style spans.
A Box has a =layout-node= slot for positioning via the layout engine. Its Both inherit from ~dirty-mixin~ for incremental rendering support and
=render-box= method dispatches through the backend protocol. carry a ~layout-node~ for position/size computed by the layout engine.
** Contract * Contract
- =(make-box &key border-style title title-align fg bg)= → box ** Box
Create a Box with optional border style, title, and colors.
- =(render-box box backend)=nil - ~(make-box &key border-style title title-align fg bg width height)~box
Render the box at its computed layout position. Draws background fill, - ~(render-box box backend)~ — draw the box at its layout position
border, and title if configured. - Border styles: ~:single~, ~:double~, ~:rounded~, ~nil~ (no border)
- =(box-layout-node box)= → layout-node ** Span
Access the underlying layout-node for positioning.
** Tests - ~(span text &key bold italic underline reverse dim fg bg)~ → span
- Inline text segment with per-run style attributes.
#+BEGIN_SRC lisp ** Text
- ~(make-text content &key fg bg wrap-mode width height spans)~ → text
- ~(render-text text-object backend)~ — render text at layout position
- Wrap modes: ~:word~ (break at word boundaries), ~:none~ (truncate)
** Utilities
- ~(word-wrap text max-width)~ → list of strings
- ~(split-string string)~ → list of words
* Tests
#+BEGIN_SRC lisp :tangle ../src/components/box-tests.lisp
(defpackage :cl-tty-box-test (defpackage :cl-tty-box-test
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout) (:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
(:export #:run-tests)) (:export #:run-tests))
(in-package :cl-tty-box-test) (in-package :cl-tty-box-test)
@@ -45,6 +56,8 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
(b (make-modern-backend :output-stream s))) (b (make-modern-backend :output-stream s)))
(values b s))) (values b s)))
;; ── Box Tests ─────────────────────────────────────────────────
(test box-creates-with-defaults (test box-creates-with-defaults
"A box created with no arguments has reasonable defaults" "A box created with no arguments has reasonable defaults"
(let ((b (make-box))) (let ((b (make-box)))
@@ -70,9 +83,8 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
(compute-layout (box-layout-node bx) 5 3) (compute-layout (box-layout-node bx) 5 3)
(render-box bx b) (render-box bx b)
(let ((out (get-output-stream-string s))) (let ((out (get-output-stream-string s)))
;; Should contain SGR background escape for red (is (search "┌" out) "border with background")
(is (search "48;2;255;0;0" out) "SGR background should be red") (is (search "41m" out) "SGR background for red")))))
(is (search "┌" out) "border with background")))))
(test box-renders-title (test box-renders-title
"A box with title renders the title text" "A box with title renders the title text"
@@ -90,12 +102,11 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
(compute-layout (box-layout-node bx) 5 3) (compute-layout (box-layout-node bx) 5 3)
(render-box bx b) (render-box bx b)
(let ((out (get-output-stream-string s))) (let ((out (get-output-stream-string s)))
(is (search "48;2;255;0;0" out) "background still renders") (is (search "41m" out) "background still renders")
;; No border chars
(is-false (search "┌" out) "no top-left corner"))))) (is-false (search "┌" out) "no top-left corner")))))
(test box-zero-size (test box-zero-size
"A zero-size box renders nothing" "A box with any zero dimension renders nothing"
(multiple-value-bind (b s) (make-capturing-backend) (multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 0 :height 0))) (let ((bx (make-box :border-style :single :width 0 :height 0)))
(compute-layout (box-layout-node bx) 0 0) (compute-layout (box-layout-node bx) 0 0)
@@ -103,6 +114,15 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
(is (string= (get-output-stream-string s) "") (is (string= (get-output-stream-string s) "")
"zero-size box produces no output")))) "zero-size box produces no output"))))
(test box-single-column
"A box with width 1 renders nothing (needs min 2 for border)"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 1 :height 5)))
(compute-layout (box-layout-node bx) 1 5)
(render-box bx b)
(is (string= (get-output-stream-string s) "")
"width=1 box renders nothing"))))
(test box-minimum-size (test box-minimum-size
"A box with minimum non-zero size still renders" "A box with minimum non-zero size still renders"
(multiple-value-bind (b s) (make-capturing-backend) (multiple-value-bind (b s) (make-capturing-backend)
@@ -111,14 +131,93 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
(render-box bx b) (render-box bx b)
(let ((out (get-output-stream-string s))) (let ((out (get-output-stream-string s)))
(is (search "┌" out) "2x2 box still has borders"))))) (is (search "┌" out) "2x2 box still has borders")))))
;; ── Text and Span Tests ───────────────────────────────────────
(test text-creates-with-defaults
"A text created with no arguments has reasonable defaults"
(let ((txt (make-text "")))
(is (typep txt 'text))
(is (typep (text-layout-node txt) 'layout-node))))
(test text-renders-content
"A text renders its content at position"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello" :width 10 :height 1)))
(compute-layout (text-layout-node tx) 10 1)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "content should appear")))))
(test text-empty-string
"Empty text produces no output"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "" :width 10 :height 1)))
(compute-layout (text-layout-node tx) 10 1)
(render-text tx b)
(is (string= (get-output-stream-string s) "")
"empty string produces no output"))))
(test text-truncates-when-no-wrap
"Text with wrap-mode :none truncates at width"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello World" :width 5 :height 1
:wrap-mode :none)))
(compute-layout (text-layout-node tx) 5 1)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "truncated to first 5 chars")))))
(test text-word-wraps
"Text with wrap-mode :word wraps at word boundaries"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello brave new world" :width 6 :height 3)))
(compute-layout (text-layout-node tx) 6 3)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "first line")
(is (search "brave" out) "second line")
(is (search "new" out) "third line")))))
(test text-word-wrap-single-word
"A word longer than width is hard-broken at max-width"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((tx (make-text "Hello" :width 3 :height 3)))
(compute-layout (text-layout-node tx) 3 3)
(render-text tx b)
(let ((out (get-output-stream-string s)))
(is (search "Hel" out) "first chunk is Hel")
(is (search "lo" out) "second chunk is lo")))))
(test span-creates-with-attributes
"A span has text and optional style attributes"
(let ((s (span "bold text" :bold t)))
(is (string= (span-text s) "bold text"))
(is-true (span-bold s))
(is-false (span-italic s))))
(test make-text-with-spans
"Text with spans stores span objects"
(let* ((sp (list (span "Hello" :bold t)
(span "World" :italic t)))
(tx (make-text "" :spans sp)))
(is (= (length (text-spans tx)) 2))
(is (string= (span-text (elt (text-spans tx) 0)) "Hello"))
(is-true (span-bold (elt (text-spans tx) 0)))))
#+END_SRC #+END_SRC
** Implementation * Implementation
#+BEGIN_SRC lisp ** Box class
~box~ inherits from ~dirty-mixin~ so changes (resize, title update,
color change) trigger incremental re-render. The ~layout-node~ slot
holds the computed position and size from the layout engine.
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
(in-package :cl-tty.box) (in-package :cl-tty.box)
(defclass box () (defclass box (dirty-mixin)
((layout-node :initform (make-layout-node) :accessor box-layout-node ((layout-node :initform (make-layout-node) :accessor box-layout-node
:initarg :layout-node) :initarg :layout-node)
(border-style :initform :single :initarg :border-style (border-style :initform :single :initarg :border-style
@@ -128,7 +227,12 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
:accessor box-title-align) :accessor box-title-align)
(fg :initform nil :initarg :fg :accessor box-fg) (fg :initform nil :initarg :fg :accessor box-fg)
(bg :initform nil :initarg :bg :accessor box-bg))) (bg :initform nil :initarg :bg :accessor box-bg)))
#+END_SRC
The constructor wraps ~make-instance~ and passes layout parameters
through to the layout node:
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
(defun make-box (&key (border-style :single) title (defun make-box (&key (border-style :single) title
(title-align :left) fg bg (title-align :left) fg bg
width height) width height)
@@ -142,7 +246,13 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
:width width :width width
:height height :height height
:direction :column))) :direction :column)))
#+END_SRC
~render-box~ draws the border at the component's layout position.
It handles zero-size (returns immediately) and optional background
fill.
#+BEGIN_SRC lisp :tangle ../src/components/box.lisp
(defun render-box (box backend) (defun render-box (box backend)
"Render BOX at its computed layout position using BACKEND." "Render BOX at its computed layout position using BACKEND."
(let ((ln (box-layout-node box)) (let ((ln (box-layout-node box))
@@ -154,16 +264,165 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
(y (layout-node-y ln)) (y (layout-node-y ln))
(w (layout-node-width ln)) (w (layout-node-width ln))
(h (layout-node-height ln))) (h (layout-node-height ln)))
(when (and (zerop w) (zerop h)) (when (or (zerop w) (zerop h) (< w 2) (< h 2))
(return-from render-box (values))) (return-from render-box (values)))
(when bg (when bg
(draw-rect backend x y w h :bg bg)) (draw-rect backend x y w h :bg bg))
(when bs (when bs
(draw-border backend x y w h (draw-border backend x y w h :style bs :fg fg :bg bg))
:style bs :fg fg :bg bg (when title
:title title (let* ((content-w (- w 4))
:title-align (box-title-align box))) (tx (+ x 2))
(when (and title bs) (ty (+ y (if bs 1 0)))
;; Title is rendered by draw-border — nothing extra needed (ta (box-title-align box))
(values))))) (display (subseq title 0 (min (length title) content-w))))
(case ta
(:center (draw-text backend (+ x (ceiling (- w (length display)) 2)) ty display fg bg))
(:right (draw-text backend (+ x (- w (length display) 2)) ty display fg bg))
(t (draw-text backend tx ty display fg bg))))))))
#+END_SRC
The early return for ~(< w 2)~ is important: ~draw-border~ requires
at least 2 columns of width to draw corner characters.
** Span class
~span~ represents an inline styled segment within a Text component.
Multiple spans let a single Text contain bold, colored, or italicized
runs.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
(in-package :cl-tty.box)
;; ── Text Renderable ────────────────────────────────────────────
(defclass span ()
((text :initarg :text :accessor span-text)
(bold :initform nil :initarg :bold :accessor span-bold)
(italic :initform nil :initarg :italic :accessor span-italic)
(underline :initform nil :initarg :underline :accessor span-underline)
(reverse :initform nil :initarg :reverse :accessor span-reverse)
(dim :initform nil :initarg :dim :accessor span-dim)
(fg :initform nil :initarg :fg :accessor span-fg)
(bg :initform nil :initarg :bg :accessor span-bg)))
(defun span (text &key bold italic underline reverse dim fg bg)
(make-instance 'span
:text text :bold bold :italic italic
:underline underline :reverse reverse :dim dim
:fg fg :bg bg))
#+END_SRC
** Text class
~text~ renders a string at a layout position with word-wrapping.
Spans are stored but not yet rendered with per-run styling in the
current implementation.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
(defclass text (dirty-mixin)
((layout-node :initform (make-layout-node) :accessor text-layout-node
:initarg :layout-node)
(content :initform "" :initarg :content :accessor text-content)
(spans :initform nil :initarg :spans :accessor text-spans)
(fg :initform nil :initarg :fg :accessor text-fg)
(bg :initform nil :initarg :bg :accessor text-bg)
(wrap-mode :initform :word :initarg :wrap-mode :accessor text-wrap-mode)))
(defun make-text (content &key fg bg wrap-mode width height spans)
(make-instance 'text
:content content
:fg fg :bg bg
:wrap-mode (or wrap-mode :word)
:spans spans
:layout-node (make-layout-node :direction :column
:width width :height height)))
#+END_SRC
~render-text~ handles both wrap modes. For ~:word~, it calls
~word-wrap~ to break the content into lines, then renders each line
at successive row positions.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
(defun render-text (text-object backend)
"Render TEXT-OBJECT at its computed layout position using BACKEND."
(let ((ln (text-layout-node text-object))
(content (text-content text-object))
(fg (text-fg text-object))
(bg (text-bg text-object))
(wrap (text-wrap-mode text-object))
(spans (text-spans text-object)))
(declare (ignore spans))
(let ((x (layout-node-x ln))
(y (layout-node-y ln))
(w (layout-node-width ln))
(h (layout-node-height ln)))
(when (or (zerop (length content)) (zerop w) (zerop h))
(return-from render-text (values)))
(if (eql wrap :none)
(let ((display (subseq content 0 (min (length content) w))))
(draw-text backend x y display fg bg))
(let ((lines (word-wrap content w))
(max-lines h))
(loop for line in lines
for row from 0 below max-lines
do (draw-text backend x (+ y row) line fg bg)))))))
#+END_SRC
** Word wrapping utility
~word-wrap~ implements the line-breaking algorithm. It splits the
input into words, then packs them into lines respecting ~max-width~.
Words that exceed ~max-width~ are hard-broken at character boundaries.
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
(defun word-wrap (text max-width)
"Split TEXT into lines, each <= MAX-WIDTH chars."
(if (or (zerop max-width) (zerop (length text)))
(list "")
(let ((words (split-string text)) (lines nil) (current nil) (current-len 0))
(dolist (word words)
(let ((wl (length word)))
(cond ((<= wl max-width)
(if (and current (<= (+ current-len 1 wl) max-width))
(progn
(push word current)
(incf current-len (1+ wl)))
(progn
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
(setf current (list word))
(setf current-len wl))))
(t
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines)
(setf current nil)
(setf current-len 0))
(loop for i from 0 below wl by max-width
do (push (subseq word i (min (+ i max-width) wl)) lines))))))
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
(or (nreverse lines) (list "")))))
#+END_SRC
~split-string~ tokenizes on whitespace (space, tab, newline):
#+BEGIN_SRC lisp :tangle ../src/components/text.lisp
(defun split-string (string)
"Split STRING into words separated by whitespace."
(loop with words = nil
with start = 0
with len = (length string)
while (< start len)
do (let ((ws-start (position-if (lambda (c) (find c '(#\Space #\Tab #\Newline)))
string :start start)))
(if ws-start
(progn
(when (> ws-start start)
(push (subseq string start ws-start) words))
(setf start (1+ ws-start)))
(progn
(push (subseq string start) words)
(setf start len))))
finally (return (nreverse words))))
#+END_SRC #+END_SRC

View File

@@ -61,8 +61,7 @@
do (draw-text backend x (+ y row) line fg bg))))))) do (draw-text backend x (+ y row) line fg bg)))))))
(defun word-wrap (text max-width) (defun word-wrap (text max-width)
"Split TEXT into lines, each <= MAX-WIDTH chars. "Split TEXT into lines, each <= MAX-WIDTH chars."
Breaks at word boundaries. Words exceeding MAX-WIDTH are hard-broken."
(if (or (zerop max-width) (zerop (length text))) (if (or (zerop max-width) (zerop (length text)))
(list "") (list "")
(let ((words (split-string text)) (lines nil) (current nil) (current-len 0)) (let ((words (split-string text)) (lines nil) (current nil) (current-len 0))