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:
83
src/components/box-tests.lisp
Normal file
83
src/components/box-tests.lisp
Normal 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
50
src/components/box.lisp
Normal 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))))))
|
||||
9
src/components/package.lisp
Normal file
9
src/components/package.lisp
Normal 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)
|
||||
Reference in New Issue
Block a user