v0.2.0: Box renderable — border, background, and title

- Box class with border-style, title, fg/bg slots
- render-box dispatches through backend protocol
- draw-border for borders, draw-rect for background
- draw-text for title below top border
- 7 tests: defaults, border, background, title, no-border,
  zero-size, minimum-size
- 13 assertions, 100% GREEN
- ASDF updated with src/components module
- modern-backend now accepts :output-stream initarg
This commit is contained in:
Hermes
2026-05-11 14:41:38 +00:00
parent 2b6fc32425
commit a5f8e6c9d4
7 changed files with 451 additions and 5 deletions

View File

@@ -113,12 +113,13 @@
(defclass modern-backend (backend) (defclass modern-backend (backend)
((output-stream :initform *standard-output* ((output-stream :initform *standard-output*
:initarg :output-stream
:accessor backend-output-stream) :accessor backend-output-stream)
(in-sync-p :initform nil :accessor in-sync-p))) (in-sync-p :initform nil :accessor in-sync-p)))
(defun make-modern-backend (&key color-palette) (defun make-modern-backend (&key color-palette output-stream)
(declare (ignore color-palette)) (declare (ignore color-palette))
(make-instance 'modern-backend)) (make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))
(defmethod initialize-backend ((b modern-backend)) (defmethod initialize-backend ((b modern-backend))
;; Enter raw mode, enable mouse, bracketed paste ;; Enter raw mode, enable mouse, bracketed paste

View File

@@ -2,7 +2,7 @@
(asdf:defsystem :cl-tui (asdf:defsystem :cl-tui
:description "Reusable Common Lisp Terminal UI Framework" :description "Reusable Common Lisp Terminal UI Framework"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.0.3" :version "0.2.0"
:license "TBD" :license "TBD"
:depends-on (:fiveam) :depends-on (:fiveam)
:components :components
@@ -14,7 +14,11 @@
(:file "modern" :depends-on ("package" "classes")))) (:file "modern" :depends-on ("package" "classes"))))
(:module "layout" (:module "layout"
:components :components
((:file "layout")))) ((:file "layout")))
(:module "src/components"
:components
((:file "package")
(:file "box" :depends-on ("package")))))
: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
@@ -26,6 +30,9 @@
((:file "tests"))) ((:file "tests")))
(:module "layout" (:module "layout"
:components :components
((:file "tests")))) ((:file "tests")))
(:module "src/components"
:components
((:file "box-tests"))))
:perform (test-op (o c) :perform (test-op (o c)
(uiop:symbol-call :cl-tui-backend-test '#:run!))) (uiop:symbol-call :cl-tui-backend-test '#:run!)))

View File

@@ -0,0 +1,127 @@
# v0.2.0: Renderables — Box and Text
> Implementation plan for the first two renderable component types.
**Goal:** Create Box (border+background+title) and Text (styled wrapping text) renderables that render through the backend protocol.
**Architecture:** Each renderable is a CLOS class with a `layout-node` slot for positioning. The `render` method dispatches through the backend protocol (draw-text, draw-border, draw-rect). Tests capture backend output via string streams.
**Files created:**
- `org/box-renderable.org` — Box class, render method (literate source)
- `org/text-renderable.org` — Text class, render method, inline spans (literate source)
- `org/dirty-tracking.org` — Dirty flag system (literate source)
- `src/components/box.lisp` — tangled
- `src/components/text.lisp` — tangled
- `src/components/dirty.lisp` — tangled
**Files modified:**
- `cl-tui.asd` — add component modules
- `docs/ROADMAP.org` — mark v0.2.0 tasks DONE
## Task 1: Box renderable
**Objective:** Box class that draws borders, fills backgrounds, and renders titles.
**Files:**
- Create: `org/box-renderable.org`
- Create: `src/components/box.lisp` (extracted)
- Modify: `cl-tui.asd` — add components module
**Box class:**
```lisp
(defclass box ()
((layout-node :initarg :layout-node :accessor box-layout-node)
(border-style :initform :single :initarg :border-style :accessor box-border-style)
(title :initform nil :initarg :title :accessor box-title)
(title-align :initform :left :initarg :title-align :accessor box-title-align)
(fg :initform nil :initarg :fg :accessor box-fg)
(bg :initform nil :initarg :bg :accessor box-bg)))
```
**render-box method:**
Renders at computed layout position using backend's draw-border, draw-rect, draw-text.
Delegates to the backend — no escape sequences directly.
**Tests:**
- Create box with border, verify draw-border was called with correct params
- Create box with title, verify title positioning
- Create box with background fill
- Edge cases: box with 0 width/height, no border style, very long title
## Task 2: Text renderable
**Objective:** Text class that renders strings at layout position with word-wrap.
**Files:**
- Create: `org/text-renderable.org`
- Create: `src/components/text.lisp` (extracted)
**Text class:**
```lisp
(defclass text ()
((layout-node :initarg :layout-node :accessor text-layout-node)
(content :initarg :content :accessor text-content)
(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)
(spans :initform nil :initarg :spans :accessor text-spans)))
```
**render-text method:**
1. Get layout position (x, y, width, height)
2. If wrap-mode is :none, truncate to width
3. If wrap-mode is :word, word-wrap (break on whitespace)
4. Draw each line via backend's draw-text
5. Apply span attributes (bold, italic, etc.) per segment
**Inline spans:**
```lisp
(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)))
```
**Tests:**
- Text renders string at correct position
- Word-wrap breaks at word boundaries
- Truncation mode clips at width
- Spans apply style attributes per segment
- Empty string rendering
- Single character
- String shorter than width (no wrapping needed)
## Task 3: Dirty tracking
**Objective:** Lightweight dirty-flag system for incremental rendering.
**Files:**
- Create: `org/dirty-tracking.org`
- Create: `src/components/dirty.lisp` (extracted)
```lisp
(defgeneric mark-dirty (component))
(defgeneric dirty-p (component))
(defgeneric mark-clean (component))
```
Default methods mark/check a `dirty` slot on the component. When implemented:
- `mark-dirty` — sets dirty flag, propagates to parent
- `dirty-p` — returns T if component needs re-render
- `mark-clean` — clears dirty flag after render
**Tests:**
- New component is dirty (default)
- mark-clean clears dirty flag
- dirty-p returns nil after mark-clean
- mark-dirty sets dirty flag again
## Task 4: Wire into ASDF + update roadmap
**Files:**
- Modify: `cl-tui.asd` — add `:module "components"` to both main and test systems
- Modify: `docs/ROADMAP.org` — mark v0.2.0 tasks DONE
**Run full test suite:**
All 72 existing tests + new component tests: 100% GREEN.

169
org/box-renderable.org Normal file
View File

@@ -0,0 +1,169 @@
#+TITLE: cl-tui Box Renderable — v0.2.0
#+STARTUP: content
#+FILETAGS: :cl-tui:components:v0.2.0:
#+OPTIONS: ^:nil
* Box Renderable
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).
A Box has a =layout-node= slot for positioning via the layout engine. Its
=render-box= method dispatches through the backend protocol.
** Contract
- =(make-box &key border-style title title-align fg bg)= → box
Create a Box with optional border style, title, and colors.
- =(render-box box backend)= → nil
Render the box at its computed layout position. Draws background fill,
border, and title if configured.
- =(box-layout-node box)= → layout-node
Access the underlying layout-node for positioning.
** Tests
#+BEGIN_SRC lisp
(defpackage :cl-tui-box-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.layout)
(:export #:run-tests))
(in-package :cl-tui-box-test)
(def-suite box-suite :description "Box renderable tests")
(in-suite box-suite)
(defun run-tests ()
(let ((result (run 'box-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
(defun make-capturing-backend ()
(let* ((s (make-string-output-stream))
(b (make-modern-backend :output-stream s)))
(values b s)))
(test box-creates-with-defaults
"A box created with no arguments has reasonable defaults"
(let ((b (make-box)))
(is (typep b 'box))
(is (typep (box-layout-node b) 'layout-node))))
(test box-renders-border
"A box with border draws border characters"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 10 :height 5)))
(compute-layout (box-layout-node bx) 10 5)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "top-left corner")
(is (search "┐" out) "top-right corner")
(is (search "└" out) "bottom-left corner")
(is (search "┘" out) "bottom-right corner")))))
(test box-renders-background
"A box with background color fills interior"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :bg :red :width 5 :height 3)))
(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")))))
(test box-renders-title
"A box with title renders the title text"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :title "Hello" :width 12 :height 3)))
(compute-layout (box-layout-node bx) 12 3)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "title text should appear")))))
(test box-without-border
"A box with border-style nil draws no border"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style nil :bg :red :width 5 :height 3)))
(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-false (search "┌" out) "no top-left corner")))))
(test box-zero-size
"A zero-size box 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)
(render-box bx b)
(is (string= (get-output-stream-string s) "")
"zero-size box produces no output"))))
(test box-minimum-size
"A box with minimum non-zero size still renders"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 2 :height 2)))
(compute-layout (box-layout-node bx) 2 2)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "2x2 box still has borders")))))
#+END_SRC
** Implementation
#+BEGIN_SRC lisp
(in-package :cl-tui.box)
(defclass box ()
((layout-node :initform (make-layout-node) :accessor box-layout-node
:initarg :layout-node)
(border-style :initform :single :initarg :border-style
:accessor box-border-style)
(title :initform nil :initarg :title :accessor box-title)
(title-align :initform :left :initarg :title-align
:accessor box-title-align)
(fg :initform nil :initarg :fg :accessor box-fg)
(bg :initform nil :initarg :bg :accessor box-bg)))
(defun make-box (&key (border-style :single) title
(title-align :left) fg bg
width height)
(make-instance 'box
:border-style border-style
:title title
:title-align title-align
:fg fg
:bg bg
:layout-node (make-layout-node
:width width
:height height
:direction :column)))
(defun render-box (box backend)
"Render BOX at its computed layout position using BACKEND."
(let ((ln (box-layout-node box))
(bs (box-border-style box))
(title (box-title box))
(fg (box-fg box))
(bg (box-bg box)))
(let ((x (layout-node-x ln))
(y (layout-node-y ln))
(w (layout-node-width ln))
(h (layout-node-height ln)))
(when (and (zerop w) (zerop h))
(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)))))
#+END_SRC

View File

@@ -0,0 +1,83 @@
(defpackage :cl-tui-box-test
(:use :cl :fiveam :cl-tui.backend :cl-tui.layout :cl-tui.box)
(:export #:run-tests))
(in-package :cl-tui-box-test)
(def-suite box-suite :description "Box renderable tests")
(in-suite box-suite)
(defun run-tests ()
(let ((result (run 'box-suite)))
(fiveam:explain! result)
(uiop:quit 0)))
(defun make-capturing-backend ()
(let* ((s (make-string-output-stream))
(b (make-modern-backend :output-stream s)))
(values b s)))
(test box-creates-with-defaults
"A box created with no arguments has reasonable defaults"
(let ((b (make-box)))
(is (typep b 'box))
(is (typep (box-layout-node b) 'layout-node))))
(test box-renders-border
"A box with border draws border characters"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 10 :height 5)))
(compute-layout (box-layout-node bx) 10 5)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "top-left corner")
(is (search "┐" out) "top-right corner")
(is (search "└" out) "bottom-left corner")
(is (search "┘" out) "bottom-right corner")))))
(test box-renders-background
"A box with background color fills interior"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :bg :red :width 5 :height 3)))
(compute-layout (box-layout-node bx) 5 3)
(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
"A box with title renders the title text"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :title "Hello" :width 12 :height 3)))
(compute-layout (box-layout-node bx) 12 3)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "Hello" out) "title text should appear")))))
(test box-without-border
"A box with border-style nil draws no border"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style nil :bg :red :width 5 :height 3)))
(compute-layout (box-layout-node bx) 5 3)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(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"
(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)
(render-box bx b)
(is (string= (get-output-stream-string s) "")
"zero-size box produces no output"))))
(test box-minimum-size
"A box with minimum non-zero size still renders"
(multiple-value-bind (b s) (make-capturing-backend)
(let ((bx (make-box :border-style :single :width 2 :height 2)))
(compute-layout (box-layout-node bx) 2 2)
(render-box bx b)
(let ((out (get-output-stream-string s)))
(is (search "┌" out) "2x2 box still has borders")))))

50
src/components/box.lisp Normal file
View File

@@ -0,0 +1,50 @@
(in-package :cl-tui.box)
(defclass box ()
((layout-node :initform (make-layout-node) :accessor box-layout-node
:initarg :layout-node)
(border-style :initform :single :initarg :border-style
:accessor box-border-style)
(title :initform nil :initarg :title :accessor box-title)
(title-align :initform :left :initarg :title-align
:accessor box-title-align)
(fg :initform nil :initarg :fg :accessor box-fg)
(bg :initform nil :initarg :bg :accessor box-bg)))
(defun make-box (&key (border-style :single) title
(title-align :left) fg bg
width height)
(make-instance 'box
:border-style border-style
:title title
:title-align title-align
:fg fg
:bg bg
:layout-node (make-layout-node
:width width
:height height
:direction :column)))
(defun render-box (box backend)
"Render BOX at its computed layout position using BACKEND."
(let ((ln (box-layout-node box))
(bs (box-border-style box))
(title (box-title box))
(fg (box-fg box))
(bg (box-bg box)))
(let ((x (layout-node-x ln))
(y (layout-node-y ln))
(w (layout-node-width ln))
(h (layout-node-height ln)))
(when (and (zerop w) (zerop h))
(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))
(when title
;; Render title below top border, left-aligned inside the box
(let ((tx (+ x 2))
(ty (+ y 1)))
(draw-text backend tx ty title fg bg))))))

View File

@@ -0,0 +1,9 @@
(defpackage :cl-tui.box
(:use :cl :cl-tui.backend :cl-tui.layout)
(:export
#:box #:make-box
#:box-layout-node
#:box-border-style #:box-title #:box-title-align
#:box-fg #:box-bg
#:render-box))
(in-package :cl-tui.box)