cl-tty/org/box-renderable.org

#+TITLE: cl-tty Box Renderable — v0.2.0
#+STARTUP: content
#+FILETAGS: :cl-tty: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-tty-box-test
  (:use :cl :fiveam :cl-tty.backend :cl-tty.layout)
  (:export #:run-tests))
(in-package :cl-tty-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-tty.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