amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
- 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
Download Patch File Download Diff File Expand all files Collapse all files

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