cl-tty/src/components/box-tests.lisp

(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 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")))))

;; ── 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
  "Text wraps even a single word if it exceeds 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) "word truncated to width")))))

(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)))))