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:
@@ -18,7 +18,8 @@
|
|||||||
(:module "src/components"
|
(:module "src/components"
|
||||||
:components
|
:components
|
||||||
((:file "package")
|
((:file "package")
|
||||||
(:file "box" :depends-on ("package")))))
|
(:file "box" :depends-on ("package"))
|
||||||
|
(:file "text" :depends-on ("package" "box")))))
|
||||||
:in-order-to ((test-op (test-op :cl-tui-tests))))
|
:in-order-to ((test-op (test-op :cl-tui-tests))))
|
||||||
|
|
||||||
(asdf:defsystem :cl-tui-tests
|
(asdf:defsystem :cl-tui-tests
|
||||||
|
|||||||
@@ -16,6 +16,8 @@
|
|||||||
(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)))
|
||||||
@@ -42,7 +44,6 @@
|
|||||||
(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) "border with background")
|
(is (search "┌" out) "border with background")
|
||||||
;; :red is a named color → indexed SGR (41m, not 48;2;...)
|
|
||||||
(is (search "41m" out) "SGR background for red")))))
|
(is (search "41m" out) "SGR background for red")))))
|
||||||
|
|
||||||
(test box-renders-title
|
(test box-renders-title
|
||||||
@@ -81,3 +82,75 @@
|
|||||||
(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
|
||||||
|
"Text wraps even a single word if it exceeds 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) "word truncated to width")))))
|
||||||
|
|
||||||
|
(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)))))
|
||||||
|
|||||||
@@ -1,9 +1,21 @@
|
|||||||
(defpackage :cl-tui.box
|
(defpackage :cl-tui.box
|
||||||
(:use :cl :cl-tui.backend :cl-tui.layout)
|
(:use :cl :cl-tui.backend :cl-tui.layout)
|
||||||
(:export
|
(:export
|
||||||
|
;; Box
|
||||||
#:box #:make-box
|
#:box #:make-box
|
||||||
#:box-layout-node
|
#:box-layout-node
|
||||||
#:box-border-style #:box-title #:box-title-align
|
#:box-border-style #:box-title #:box-title-align
|
||||||
#:box-fg #:box-bg
|
#:box-fg #:box-bg
|
||||||
#:render-box))
|
#:render-box
|
||||||
|
;; Span
|
||||||
|
#:span
|
||||||
|
#:span-text #:span-bold #:span-italic #:span-underline
|
||||||
|
#:span-reverse #:span-dim #:span-fg #:span-bg
|
||||||
|
;; Text
|
||||||
|
#:text #:make-text
|
||||||
|
#:text-layout-node #:text-content #:text-spans
|
||||||
|
#:text-fg #:text-bg #:text-wrap-mode
|
||||||
|
#:render-text
|
||||||
|
;; Utilities (for tests)
|
||||||
|
#:word-wrap #:split-string))
|
||||||
(in-package :cl-tui.box)
|
(in-package :cl-tui.box)
|
||||||
|
|||||||
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