org/box-renderable.org

@@ -1,34 +1,45 @@
-#+TITLE: cl-tty Box Renderable — v0.2.0
+#+TITLE: Box and Text Renderables
 #+STARTUP: content
-#+FILETAGS: :cl-tty:components:v0.2.0:
-#+OPTIONS: ^:nil
+#+FILETAGS: :cl-tty:components:
 
-* Box Renderable
+* Overview
 
-The Box renderable draws a bordered rectangle with optional title and background
-fill. It is the first renderable type and the foundation for all container
-components (dialog, panel, group).
+Box and Text are the two fundamental renderable component types. Box
+provides a bordered container with optional background fill and title.
+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
-=render-box= method dispatches through the backend protocol.
+Both inherit from ~dirty-mixin~ for incremental rendering support and
+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
-  Create a Box with optional border style, title, and colors.
+** Box
 
-- =(render-box box backend)= → nil
-  Render the box at its computed layout position. Draws background fill,
-  border, and title if configured.
+- ~(make-box &key border-style title title-align fg bg width height)~ → box
+- ~(render-box box backend)~ — draw the box at its layout position
+- Border styles: ~:single~, ~:double~, ~:rounded~, ~nil~ (no border)
 
-- =(box-layout-node box)= → layout-node
-  Access the underlying layout-node for positioning.
+** Span
 
-** 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
-  (:use :cl :fiveam :cl-tty.backend :cl-tty.layout)
+  (:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
   (:export #:run-tests))
 (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)))
     (values b s)))
 
+;; ── Box Tests ─────────────────────────────────────────────────
+
 (test box-creates-with-defaults
   "A box created with no arguments has reasonable defaults"
   (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)
       (render-box bx b)
       (let ((out (get-output-stream-string s)))
-        ;; Should contain SGR background escape for red
-        (is (search "48;2;255;0;0" out) "SGR background should be red")
-        (is (search "┌" out) "border with background")))))
+        (is (search "┌" out) "border with background")
+        (is (search "41m" out) "SGR background for red")))))
 
 (test box-renders-title
   "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)
       (render-box bx b)
       (let ((out (get-output-stream-string s)))
-        (is (search "48;2;255;0;0" out) "background still renders")
-        ;; No border chars
+        (is (search "41m" out) "background still renders")
         (is-false (search "┌" out) "no top-left corner")))))
 
 (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)
     (let ((bx (make-box :border-style :single :width 0 :height 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) "")
           "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
   "A box with minimum non-zero size still renders"
   (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)
       (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
+  "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
 
-** 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)
 
-(defclass box ()
+(defclass box (dirty-mixin)
   ((layout-node :initform (make-layout-node) :accessor box-layout-node
      :initarg :layout-node)
    (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)
    (fg :initform nil :initarg :fg :accessor box-fg)
    (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
                   (title-align :left) fg bg
                   width height)
@@ -142,7 +246,13 @@ A Box has a =layout-node= slot for positioning via the layout engine. Its
                    :width width
                    :height height
                    :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)
   "Render BOX at its computed layout position using BACKEND."
   (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))
           (w (layout-node-width 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)))
       (when bg
         (draw-rect backend x y w h :bg bg))
       (when bs
-        (draw-border backend x y w h
-                     :style bs :fg fg :bg bg
-                     :title title
-                     :title-align (box-title-align box)))
-      (when (and title bs)
-        ;; Title is rendered by draw-border — nothing extra needed
-        (values)))))
+        (draw-border backend x y w h :style bs :fg fg :bg bg))
+      (when title
+        (let* ((content-w (- w 4))
+               (tx (+ x 2))
+               (ty (+ y (if bs 1 0)))
+               (ta (box-title-align box))
+               (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

src/components/text.lisp

@@ -61,8 +61,7 @@
                   do (draw-text backend x (+ y row) line fg bg)))))))
 
 (defun word-wrap (text max-width)
-  "Split TEXT into lines, each <= MAX-WIDTH chars.
-Breaks at word boundaries. Words exceeding MAX-WIDTH are hard-broken."
+  "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))