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
2026-05-11 14:45:56 +00:00
parent a5f8e6c9d4
commit 5672aaf3fd
4 changed files with 195 additions and 3 deletions
--- a/src/components/box-tests.lisp
+++ b/src/components/box-tests.lisp
@@ -16,6 +16,8 @@
         (b (make-modern-backend :output-stream s)))
    (values b s)))

+;; ── Box Tests ─────────────────────────────────────────────────
+
 (test box-creates-with-defaults
  "A box created with no arguments has reasonable defaults"
  (let ((b (make-box)))
@@ -42,7 +44,6 @@
      (render-box bx b)
      (let ((out (get-output-stream-string s)))
        (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")))))

 (test box-renders-title
@@ -81,3 +82,75 @@
      (render-box bx b)
      (let ((out (get-output-stream-string s)))
        (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)))))
--- a/src/components/package.lisp
+++ b/src/components/package.lisp
@@ -1,9 +1,21 @@
 (defpackage :cl-tui.box
  (:use :cl :cl-tui.backend :cl-tui.layout)
  (:export
+   ;; Box
   #:box #:make-box
   #:box-layout-node
   #:box-border-style #:box-title #:box-title-align
   #: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)
--- a/src/components/text.lisp
+++ b/src/components/text.lisp
@@ -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))))