diff --git a/org/box-renderable.org b/org/box-renderable.org index 57e1b5d..310154a 100644 --- a/org/box-renderable.org +++ b/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 diff --git a/src/components/text.lisp b/src/components/text.lisp index 34d3d77..2df941d 100644 --- a/src/components/text.lisp +++ b/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))