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")))))
|
||||
Reference in New Issue
Block a user