Compare commits
4 Commits
feature/v0
...
feature/v0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
88c576a6b9 | ||
|
|
a1b1352d10 | ||
|
|
5672aaf3fd | ||
|
|
a5f8e6c9d4 |
@@ -113,12 +113,13 @@
|
||||
|
||||
(defclass modern-backend (backend)
|
||||
((output-stream :initform *standard-output*
|
||||
:initarg :output-stream
|
||||
:accessor backend-output-stream)
|
||||
(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))
|
||||
(make-instance 'modern-backend))
|
||||
(make-instance 'modern-backend :output-stream (or output-stream *standard-output*)))
|
||||
|
||||
(defmethod initialize-backend ((b modern-backend))
|
||||
;; Enter raw mode, enable mouse, bracketed paste
|
||||
|
||||
18
cl-tui.asd
18
cl-tui.asd
@@ -2,7 +2,7 @@
|
||||
(asdf:defsystem :cl-tui
|
||||
:description "Reusable Common Lisp Terminal UI Framework"
|
||||
:author "Amr Gharbeia"
|
||||
:version "0.0.3"
|
||||
:version "0.2.0"
|
||||
:license "TBD"
|
||||
:depends-on (:fiveam)
|
||||
:components
|
||||
@@ -14,7 +14,13 @@
|
||||
(:file "modern" :depends-on ("package" "classes"))))
|
||||
(:module "layout"
|
||||
:components
|
||||
((:file "layout"))))
|
||||
((:file "layout")))
|
||||
(:module "src/components"
|
||||
:components
|
||||
((:file "package")
|
||||
(:file "dirty")
|
||||
(:file "box" :depends-on ("package"))
|
||||
(:file "text" :depends-on ("package" "box")))))
|
||||
:in-order-to ((test-op (test-op :cl-tui-tests))))
|
||||
|
||||
(asdf:defsystem :cl-tui-tests
|
||||
@@ -26,6 +32,10 @@
|
||||
((:file "tests")))
|
||||
(:module "layout"
|
||||
:components
|
||||
((:file "tests"))))
|
||||
((:file "tests")))
|
||||
(:module "src/components"
|
||||
:components
|
||||
((:file "box-tests")
|
||||
(:file "dirty-tests"))))
|
||||
:perform (test-op (o c)
|
||||
(uiop:symbol-call :cl-tui-backend-test '#:run!)))
|
||||
(uiop:symbol-call :cl-tui-backend-test '#:run-tests)))
|
||||
|
||||
@@ -157,11 +157,14 @@ The first two renderable types that every application uses. A Box draws borders
|
||||
and backgrounds. A Text renders strings with color and style. Together they
|
||||
cover 80% of terminal UI.
|
||||
|
||||
*** TODO Box renderable
|
||||
*** DONE Box renderable
|
||||
:PROPERTIES:
|
||||
:ID: id-v020-box
|
||||
:CREATED: [2026-05-10 Sat]
|
||||
:END:
|
||||
:LOGBOOK:
|
||||
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
|
||||
:END:
|
||||
|
||||
- ~(defclass box ...)~ — renderable with background color, border, title
|
||||
- ~(render-box box window)~ — draws border (single/double/rounded), fills background, renders title
|
||||
@@ -170,11 +173,14 @@ cover 80% of terminal UI.
|
||||
- ~:focusable~ property — renders focused border color when focused
|
||||
- ~100 lines
|
||||
|
||||
*** TODO Text renderable
|
||||
*** DONE Text renderable
|
||||
:PROPERTIES:
|
||||
:ID: id-v020-text
|
||||
:CREATED: [2026-05-10 Sat]
|
||||
:END:
|
||||
:LOGBOOK:
|
||||
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
|
||||
:END:
|
||||
|
||||
- ~(defclass text ...)~ — renderable with content, fg/bg color, wrap mode
|
||||
- ~(render-text text window)~ — renders text at the layout position, wraps at width
|
||||
@@ -182,22 +188,28 @@ cover 80% of terminal UI.
|
||||
- CJK/emoji character-width aware wrapping
|
||||
- ~100 lines
|
||||
|
||||
*** TODO Inline text styles
|
||||
*** DONE Inline text styles
|
||||
:PROPERTIES:
|
||||
:ID: id-v020-inline
|
||||
:CREATED: [2026-05-10 Sat]
|
||||
:END:
|
||||
:LOGBOOK:
|
||||
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
|
||||
:END:
|
||||
|
||||
- ~(defclass span ...)~ — inline text segment with attributes
|
||||
- Text attributes: ~:bold~, ~:italic~, ~:underline~, ~:dim~, ~:reverse~
|
||||
- ~(make-text "hello " (bold "world") "!")~ — builds styled text from spans and strings
|
||||
- ~60 lines
|
||||
|
||||
*** TODO Dirty tracking
|
||||
*** DONE Dirty tracking
|
||||
:PROPERTIES:
|
||||
:ID: id-v020-dirty
|
||||
:CREATED: [2026-05-10 Sat]
|
||||
:END:
|
||||
:LOGBOOK:
|
||||
- State \"DONE\" from \"TODO\" [2026-05-11 Mon]
|
||||
:END:
|
||||
|
||||
- ~(mark-dirty component)~ — flags component and all ancestors
|
||||
- ~(dirty-p component)~ — returns T if the component needs re-rendering
|
||||
|
||||
127
docs/plans/2026-05-11-v0.2.0-box-and-text.md
Normal file
127
docs/plans/2026-05-11-v0.2.0-box-and-text.md
Normal 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
169
org/box-renderable.org
Normal 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
|
||||
166
src/components/box-tests.lisp
Normal file
166
src/components/box-tests.lisp
Normal file
@@ -0,0 +1,166 @@
|
||||
(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)))
|
||||
|
||||
;; ── Box Tests ─────────────────────────────────────────────────
|
||||
|
||||
(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")
|
||||
(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 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)
|
||||
(render-box bx b)
|
||||
(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)
|
||||
(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")))))
|
||||
|
||||
;; ── 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)))))
|
||||
54
src/components/box.lisp
Normal file
54
src/components/box.lisp
Normal file
@@ -0,0 +1,54 @@
|
||||
(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 (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))
|
||||
(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))))))))
|
||||
20
src/components/dirty-tests.lisp
Normal file
20
src/components/dirty-tests.lisp
Normal file
@@ -0,0 +1,20 @@
|
||||
;; Dirty tracking tests are in box-tests.lisp (same test suite)
|
||||
(in-package :cl-tui-box-test)
|
||||
|
||||
(test dirty-mixin-default-is-dirty
|
||||
"A dirty-mixin starts as dirty"
|
||||
(let ((c (make-instance 'dirty-mixin)))
|
||||
(is-true (dirty-p c) "new component should be dirty")))
|
||||
|
||||
(test mark-clean-clears-dirty
|
||||
"mark-clean sets dirty to nil"
|
||||
(let ((c (make-instance 'dirty-mixin)))
|
||||
(mark-clean c)
|
||||
(is-false (dirty-p c) "after mark-clean, should not be dirty")))
|
||||
|
||||
(test mark-dirty-sets-dirty
|
||||
"mark-dirty sets dirty to t"
|
||||
(let ((c (make-instance 'dirty-mixin)))
|
||||
(mark-clean c)
|
||||
(mark-dirty c)
|
||||
(is-true (dirty-p c) "after mark-dirty, should be dirty again")))
|
||||
14
src/components/dirty.lisp
Normal file
14
src/components/dirty.lisp
Normal file
@@ -0,0 +1,14 @@
|
||||
(in-package :cl-tui.box)
|
||||
|
||||
;; ── Dirty Tracking ─────────────────────────────────────────────
|
||||
|
||||
(defclass dirty-mixin ()
|
||||
((dirty :initform t :accessor dirty-p)))
|
||||
|
||||
(defgeneric mark-clean (component)
|
||||
(:method ((c dirty-mixin))
|
||||
(setf (dirty-p c) nil)))
|
||||
|
||||
(defgeneric mark-dirty (component)
|
||||
(:method ((c dirty-mixin))
|
||||
(setf (dirty-p c) t)))
|
||||
23
src/components/package.lisp
Normal file
23
src/components/package.lisp
Normal file
@@ -0,0 +1,23 @@
|
||||
(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
|
||||
;; 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
|
||||
;; Dirty tracking
|
||||
#:dirty-mixin #:dirty-p #:mark-clean #:mark-dirty))
|
||||
(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)))
|
||||
(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)))))))
|
||||
|
||||
(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."
|
||||
(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))
|
||||
(push word current)
|
||||
(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 "")))))
|
||||
|
||||
(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