v0.2.0: Text renderable with word-wrap and inline spans

- Text class with content, fg/bg, wrap-mode (:word or :none)
- Span class for inline styled segments (bold, italic, etc.)
- render-text dispatches through backend's draw-text
- word-wrap function splits text at word boundaries
- split-string utility for whitespace tokenization
- 9 new tests: creation, content, empty, truncation, word-wrap,
  single-word, span creation, span storage
- modern-backend now accepts :output-stream
- ASDF updated with text component
- 28 total component tests, 100% GREEN
This commit is contained in:
Hermes
2026-05-11 14:45:56 +00:00
parent a5f8e6c9d4
commit 5672aaf3fd
4 changed files with 195 additions and 3 deletions

106
src/components/text.lisp Normal file
View File

@@ -0,0 +1,106 @@
(in-package :cl-tui.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))
(defclass text ()
((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)))
(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)))
(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)
;; No wrap — truncate to width
(let ((display (subseq content 0 (min (length content) w))))
(draw-text backend x y display fg bg))
;; Word wrap
(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)))))))
(defun word-wrap (text max-width)
"Split TEXT into lines, each no longer than MAX-WIDTH characters.
Breaks at word boundaries when possible."
(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 ((word-len (length word)))
(if (and current (<= (+ current-len 1 word-len) max-width))
;; Add to current line
(progn
(push word current)
(incf current-len (1+ word-len)))
;; Start new line
(progn
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
(setf current (list word))
(setf current-len word-len)))))
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
(or (nreverse lines) (list "")))))
(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))))