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:
106
src/components/text.lisp
Normal file
106
src/components/text.lisp
Normal 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))))
|
||||
Reference in New Issue
Block a user