cl-tty/org/scrollbox.org

#+TITLE: ScrollBox
#+STARTUP: content
#+FILETAGS: :cl-tty:container:

* Overview

ScrollBox is a container component that handles content larger than the
viewport. It provides scroll offsets, viewport culling (only renders
visible children), scrollbar rendering, and sticky-scroll (auto-scroll
to bottom when new content arrives).

~scroll-box~ inherits ~dirty-mixin~ and implements the component protocol
(~render~, ~component-children~, ~component-layout-node~) so it works
with the rendering pipeline and layout engine.

** Contract

~(scroll-box &key scroll-y scroll-x width height children)~ → scroll-box
  Create a ScrollBox container. CHILDREN is a list of components.
  ~scroll-y~ and ~scroll-x~ are the scroll offsets in lines.

~(scroll-box-children sb)~ → list of child components
~(scroll-box-scroll-y sb)~ / ~(setf scroll-box-scroll-y)~
~(scroll-box-scroll-x sb)~ / ~(setf scroll-box-scroll-x)~

~(render ((sb scroll-box) backend))~ — renders visible children with
  scroll offset applied, then draws scrollbars if content overflows.

~(scroll-by sb dy dx)~ — adjust scroll offset by DY rows, DX columns.
  Clamps to valid range (0 to content-size minus viewport-size).

~(sticky-scroll-p sb)~ / ~(setf sticky-scroll-p)~ — when T, auto-scroll
  to bottom when new content arrives.

* Implementation

** ScrollBox class

~scroll-box~ inherits from ~dirty-mixin~ for dirty tracking. It holds a
list of child components and two scroll offset slots (~scroll-y~ and
~scroll-x~). The ~sticky-scroll-p~ flag, when true, keeps the scroll
position at the bottom whenever new children are added.

Defining this as a class (rather than a struct) lets us integrate with
the CLOS-based component protocol — ~render~ dispatches on the class,
and dirty-mixin provides the marking machinery used by the refresh loop.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(in-package #:cl-tty.container)

(defclass scroll-box (dirty-mixin)
  ((children :initform nil :initarg :children
             :accessor scroll-box-children :type list)
   (scroll-y :initform 0 :initarg :scroll-y
             :accessor scroll-box-scroll-y :type fixnum)
   (scroll-x :initform 0 :initarg :scroll-x
             :accessor scroll-box-scroll-x :type fixnum)
   (sticky-scroll-p :initform t :initarg :sticky-scroll-p
                    :accessor sticky-scroll-p :type boolean)
   (layout-node :initform (make-layout-node) :accessor scroll-box-layout-node)))
#+END_SRC

** make-scroll-box constructor

A dedicated constructor function provides keyword argument defaults and
ensures ~sticky-scroll-p~ defaults to T even when the caller omits it
(the :initform on the slot handles default-initialization, but a nil
value explicitly passed as ~:sticky-scroll-p nil~ needs to be
preserved). Using a function instead of making the user call
~make-instance~ directly keeps the API ergonomic and hides CLOS plumbing.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun make-scroll-box (&key (children nil) (scroll-y 0) (scroll-x 0)
                          sticky-scroll-p)
  (make-instance 'scroll-box
    :children children
    :scroll-y scroll-y
    :scroll-x scroll-x
    :sticky-scroll-p (if (null sticky-scroll-p) t sticky-scroll-p)))
#+END_SRC

** component-children method

~component-children~ is part of the component protocol. The rendering
pipeline calls this to discover the tree of children to render. By
delegating to the ~scroll-box-children~ accessor, we keep the protocol
implementation thin — just an indirection that makes ~scroll-box~
participate polymorphically alongside other container types.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defmethod component-children ((sb scroll-box))
  (scroll-box-children sb))
#+END_SRC

** component-layout-node method

~component-layout-node~ returns the layout node that the layout engine
uses to position the ScrollBox itself within its parent. Each ScrollBox
creates its own layout node at construction time via ~make-layout-node~,
so this method simply returns that stored node.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defmethod component-layout-node ((sb scroll-box))
  (scroll-box-layout-node sb))
#+END_SRC

** clamp-scroll helper

~clamp-scroll~ recalculates valid scroll bounds after content or viewport
changes — called automatically when children change or the layout node
resizes. It reads the viewport dimensions from the layout node and the
content dimensions from the content-size helpers, then clamps both
scroll offsets with ~max~/~min~ to ensure they never go below 0 or
beyond the scrollable range.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun clamp-scroll (sb)
  "Clamp scroll offsets to valid range."
  (let* ((ln (scroll-box-layout-node sb))
         (viewport-height (if ln (layout-node-height ln) 0))
         (viewport-width  (if ln (layout-node-width ln) 0))
         (content-height (scroll-box-content-height sb))
         (content-width  (scroll-box-content-width sb)))
    (setf (scroll-box-scroll-y sb)
          (max 0 (min (scroll-box-scroll-y sb)
                      (- content-height viewport-height))))
    (setf (scroll-box-scroll-x sb)
          (max 0 (min (scroll-box-scroll-x sb)
                      (- content-width viewport-width))))))
#+END_SRC

** scroll-by method

~scroll-by~ adjusts the scroll offset by delta rows and columns. It
increments the current offset, clamps via ~clamp-scroll~, then marks
the component dirty so the render loop picks up the change. This is
the primary API entry point for programmatic scrolling (from keyboard
input or mouse wheel events).

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scroll-by (sb dy dx)
  "Scroll by DY rows and DX columns. Clamps to valid range."
  (incf (scroll-box-scroll-y sb) dy)
  (incf (scroll-box-scroll-x sb) dx)
  (clamp-scroll sb)
  (mark-dirty sb))
#+END_SRC

** scroll-box-content-height

~scroll-box-content-height~ calculates the total content height by
summing all child heights. Each child reports its height through its
layout node, with a minimum of 1 row (even zero-height children get a
floor so they don't collapse the layout). This is used by
~clamp-scroll~, scrollbar rendering, and sticky-scroll logic.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scroll-box-content-height (sb)
  "Total height of all children."
  (reduce #'+ (scroll-box-children sb)
          :key (lambda (c)
                 (let ((ln (component-layout-node c)))
                   (if ln (max 1 (layout-node-height ln)) 1)))
          :initial-value 0))
#+END_SRC

** scroll-box-content-width

~scroll-box-content-width~ calculates the maximum width among children,
since horizontal scrolling follows the widest child rather than summing
widths. Like the height counterpart, it floors child widths at 1 so
empty children don't zero out the measurement.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scroll-box-content-width (sb)
  "Maximum width among children."
  (reduce #'max (scroll-box-children sb)
          :key (lambda (c)
                 (let ((ln (component-layout-node c)))
                   (if ln (max 1 (layout-node-width ln)) 1)))
          :initial-value 0))
#+END_SRC

** Render method with viewport culling

~render~ iterates children, computes each child's position within
the viewport (adjusted for scroll offset), and only renders children
whose visible area intersects the viewport. This is the core
optimization — for a terminal with 200 children, only the ~24
visible ones are actually drawn.

The method temporarily offsets each child's layout node by the scroll
amount during rendering, then restores the original position via
~unwind-protect~. This avoids mutating the permanent layout state while
still making each child's ~render~ method draw at the correct scrolled
position.

After child rendering, it delegates to ~draw-scrollbars~ for the
scrollbar overlay.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defmethod render ((sb scroll-box) backend)
  "Render visible children with scroll offset applied.
Delegates to each child's `render` method, temporarily offsetting
its layout-node position for the scroll offset. Children outside
the viewport are clipped out."
  (let* ((ln (scroll-box-layout-node sb))
         (vx 0) (vy 0)
         (vw (if ln (layout-node-width ln) 80))
         (vh (if ln (layout-node-height ln) 24))
         (sy (scroll-box-scroll-y sb))
         (sx (scroll-box-scroll-x sb)))
    (dolist (child (scroll-box-children sb))
      (let* ((cln (component-layout-node child))
             (ch (if cln (layout-node-height cln) 1))
             (cy vy))
        ;; Only render children that are visible in the viewport
        (when (and (< (- cy sy) vh)
                   (> (+ (- cy sy) ch) 0))
          ;; Temporarily offset child's layout-node position for rendering
          (let ((orig-x (if cln (layout-node-x cln) 0))
                (orig-y (if cln (layout-node-y cln) 0)))
            (when cln
              (setf (layout-node-x cln) (- vx sx)
                    (layout-node-y cln) (- vy sy)))
            (unwind-protect
                 (render child backend)
              (when cln
                (setf (layout-node-x cln) orig-x
                      (layout-node-y cln) orig-y)))))
        (incf vy ch)))
    (draw-scrollbars sb backend vw vh)))
#+END_SRC

** update-sticky-scroll

~update-sticky-scroll~ checks whether the view is at the bottom and, if
the ~sticky-scroll-p~ flag is set, auto-scrolls to keep the bottommost
content visible. The comparison uses a 1-row tolerance (~(- content-h
viewport-h 1)~) so minor content changes don't cause jitter. The sticky
flag is reset to nil when the user manually scrolls up (handled by
callers of ~scroll-by~).

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun update-sticky-scroll (sb)
  "If sticky-scroll-p is active and at bottom, keep at bottom."
  (when (sticky-scroll-p sb)
    (let* ((content-h (scroll-box-content-height sb))
           (ln (scroll-box-layout-node sb))
           (viewport-h (if ln (layout-node-height ln) 24)))
      (when (>= (scroll-box-scroll-y sb) (- content-h viewport-h 1))
        (setf (scroll-box-scroll-y sb)
              (max 0 (- content-h viewport-h)))))))
#+END_SRC

** scrollbar-thumb helper

~scrollbar-thumb~ converts a raw scroll position (in lines) into a
normalized 0.0-to-1.0 ratio representing where the thumb should appear
on the scrollbar track. When content fits entirely within the viewport,
it returns 0.0 (no scrolling possible). This normalized value is used
by ~draw-scrollbars~ to compute the pixel/character position of the
thumb.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun scrollbar-thumb (scroll-pos viewport-size content-size)
  "Return the thumb position for a scrollbar (0.0 to 1.0)."
  (if (> content-size viewport-size)
      (/ (float scroll-pos) (- content-size viewport-size))
      0.0))
#+END_SRC

** draw-scrollbars

~draw-scrollbars~ renders vertical and horizontal scrollbars as
single-character-wide bars on the right and bottom edges of the
viewport. The scrollbar thumb position and size reflect the current
scroll position relative to content size.

The vertical scrollbar uses a filled block (█) for the thumb and a
background fill for the track. The horizontal scrollbar is drawn along
the bottom edge. Both account for the scrollbox's own position within
the layout tree (~ox~, ~oy~) so nested scrollboxes render scrollbars at
the correct screen coordinates.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/scrollbox.lisp
(defun draw-scrollbars (sb backend viewport-w viewport-h)
  "Draw scrollbars if content exceeds viewport."
  (let* ((content-h (scroll-box-content-height sb))
         (content-w (scroll-box-content-width sb))
         (sy (scroll-box-scroll-y sb))
         (sx (scroll-box-scroll-x sb))
         (ln (scroll-box-layout-node sb))
         (ox (if ln (layout-node-x ln) 0))
         (oy (if ln (layout-node-y ln) 0)))
    ;; Vertical scrollbar
    (when (> content-h viewport-h)
      (let* ((thumb (scrollbar-thumb sy viewport-h content-h))
             (thumb-pos (round (* thumb viewport-h))))
        (draw-rect backend (+ ox (1- viewport-w)) oy 1 viewport-h :bg :scrollbar-bg)
        (draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
    ;; Horizontal scrollbar
    (when (> content-w viewport-w)
      (let* ((thumb (scrollbar-thumb sx viewport-w content-w))
             (thumb-pos (round (* thumb viewport-w))))
        (draw-rect backend ox (+ oy (1- viewport-h)) viewport-w 1 :bg :scrollbar-bg)
        (draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))
#+END_SRC

** Bug Fixes (v1.0.0): scroll offset and scrollbar position

Two bugs were fixed in the ScrollBox render pipeline:

1. *Render scroll origin*: The render method used ~orig-y~ (the child's original
   layout-node Y position, always 0 for top-level children) as the basis for
   scroll offset.  This caused the content-relative position ~vy~ to be ignored,
   making scroll offsets incorrect when children were offset by layout.

   Fix: Use ~vy~ (the content-relative Y accumulator) instead of ~orig-y~ when
   setting the temporary layout offset: ~(layout-node-y cln) (- vy sy)~.

2. *Scrollbar positions*: ~draw-scrollbars~ drew scrollbars at viewport-local
   coordinates (0, 0), not accounting for the scrollbox's own position within
   the layout tree.  Scrollbars would appear at the wrong screen location when
   the scrollbox was nested inside other containers.

   Fix: Read the scrollbox's layout-node origin ~(ox, oy)~ and offset all
   scrollbar drawing coordinates by those values.

* Tests

Test suite for both ScrollBox and TabBar.

** Package and test infrastructure

The tests use FiveAM, the Common Lisp testing framework. The package
setup pulls in all the systems under test (~cl-tty.backend~,
~cl-tty.box~, ~cl-tty.layout~, ~cl-tty.input~, ~cl-tty.container~)
along with the base ~:cl~ language and ~:fiveam~ itself.

~run-tests~ is exported so the test runner script can call it
unconditionally; it runs the ~scrollbox-suite~ and prints results via
~fiveam:explain!~ before exiting.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(defpackage :cl-tty-scrollbox-test
  (:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input :cl-tty.container)
  (:export #:run-tests))
(in-package #:cl-tty-scrollbox-test)

(def-suite scrollbox-suite :description "ScrollBox + TabBar tests")
(in-suite scrollbox-suite)

(defun run-tests ()
  (let ((result (run 'scrollbox-suite)))
    (fiveam:explain! result)
    (uiop:quit 0)))
#+END_SRC

** ScrollBox constructor test

Confirms a bare ~make-scroll-box~ returns a ~scroll-box~ instance with
default scroll offsets of 0 and no children. This establishes that the
class definition and constructor are wired up correctly.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-creates
  "A ScrollBox can be created with defaults."
  (let ((sb (make-scroll-box)))
    (is (typep sb 'scroll-box))
    (is (= (scroll-box-scroll-y sb) 0))
    (is (= (scroll-box-scroll-x sb) 0))
    (is-false (scroll-box-children sb))))
#+END_SRC

** ScrollBox with children test

Verifies that the ~:children~ initarg is accepted and that
~scroll-box-children~ returns the list. A ScrollBox with one child
should report length 1.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-with-children
  "A ScrollBox can have children."
  (let ((sb (make-scroll-box :children (list (make-text "hello")))))
    (is (= (length (scroll-box-children sb)) 1))))
#+END_SRC

** ScrollBox scroll-by test

Exercises ~scroll-by~ with a positive DY offset and asserts the
scroll-y is non-negative after the operation. Combined with
~scrollbox-scroll-clamp~ below, this covers both the normal and
boundary behavior of the scroll mechanic.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-scroll-by
  "ScrollBy adjusts offset clamped to valid range."
  (let ((sb (make-scroll-box :scroll-y 0)))
    (scroll-by sb 5 0)
    (is (>= (scroll-box-scroll-y sb) 0))))
#+END_SRC

** ScrollBox component-children test

Confirms the component protocol method ~component-children~ returns the
same child list that ~scroll-box-children~ does. This ensures the
protocol indirection works and that the rendering pipeline will see the
correct children.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-component-children
  "Component protocol: children are accessible."
  (let* ((child (make-text "hello"))
         (sb (make-scroll-box :children (list child))))
    (is (eql (first (component-children sb)) child))))
#+END_SRC

** ScrollBox render no-op test

Renders a ScrollBox with no children to a string-output-stream backend.
The test passes if no errors are signaled — this guards against nil
layout nodes or unbound slots causing problems during the render
pipeline's initial traversal.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-render-noop
  "Rendering a ScrollBox with no children does not error."
  (let* ((stream (make-string-output-stream))
         (backend (make-simple-backend :output-stream stream))
         (sb (make-scroll-box)))
    (render sb backend)
    (is-true t)))
#+END_SRC

** TabBar constructor test

Confirms a bare ~make-tab-bar~ returns a ~tab-bar~ instance with no
active tab and no tabs. This validates the TabBar class definition and
constructor.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-creates
  "A TabBar can be created with defaults."
  (let ((tb (make-tab-bar)))
    (is (typep tb 'tab-bar))
    (is-false (tab-bar-active tb))
    (is-false (tab-bar-tabs tb))))
#+END_SRC

** TabBar add-tab test

Tests that ~tab-bar-add~ returns the supplied ID, adds a tab to the
internal list, and stores the title correctly. Each tab is stored as a
plist, so the test checks both list length and the ~:title~ property.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-add-tab
  "Adding a tab returns the id and updates tabs."
  (let ((tb (make-tab-bar)))
    (let ((id (tab-bar-add tb :tab1 "Tab One")))
      (is (eql id :tab1))
      (is (= (length (tab-bar-tabs tb)) 1))
      (is (string= (getf (first (tab-bar-tabs tb)) :title) "Tab One")))))
#+END_SRC

** TabBar active tab test

Verifies that ~(setf tab-bar-active)~ correctly selects a tab by ID and
that ~tab-bar-active~ returns that ID afterward.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-active-tab
  "Setting active tab works."
  (let ((tb (make-tab-bar)))
    (tab-bar-add tb :tab1 "One")
    (tab-bar-add tb :tab2 "Two")
    (setf (tab-bar-active tb) :tab2)
    (is (eql (tab-bar-active tb) :tab2))))
#+END_SRC

** TabBar render no-op test

Renders a fully configured TabBar (with tabs and an active selection) to
a string-output-stream backend to confirm the render method doesn't
error. A TabBar must draw its tab strip without crashing even when
disconnected from a real terminal.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-render-noop
  "Rendering a TabBar does not error."
  (let* ((stream (make-string-output-stream))
         (backend (make-simple-backend :output-stream stream))
         (tb (make-tab-bar)))
    (tab-bar-add tb :tab1 "One")
    (tab-bar-add tb :tab2 "Two")
    (setf (tab-bar-active tb) :tab1)
    (render tb backend)
    (is-true t)))
#+END_SRC

** TabBar next/prev navigation test

Exercises the full navigation cycle: ~tab-bar-next~ advances through
three tabs, wrapping around past the last; ~tab-bar-prev~ goes backward,
wrapping around past the first. This is the core keyboard interaction
for tabbed UIs and must handle edge cases (empty bar, single tab, etc.)
gracefully.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-next-prev
  "TabBar next/prev wraps around through tabs."
  (let ((tb (make-tab-bar)))
    (tab-bar-add tb :tab1 "One")
    (tab-bar-add tb :tab2 "Two")
    (tab-bar-add tb :tab3 "Three")
    (is (eql (tab-bar-active tb) :tab1))
    (tab-bar-next tb)
    (is (eql (tab-bar-active tb) :tab2))
    (tab-bar-next tb)
    (is (eql (tab-bar-active tb) :tab3))
    (tab-bar-next tb)
    (is (eql (tab-bar-active tb) :tab1) "wrap around past last")
    (tab-bar-prev tb)
    (is (eql (tab-bar-active tb) :tab3) "wrap around past first")))
#+END_SRC

** TabBar select test

~tab-bar-select~ activates a named tab directly (as opposed to relative
next/prev navigation). This test verifies that selecting ~:tab2~ from a
three-tab bar correctly sets the active tab.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-select
  "TabBar select activates the specified tab."
  (let ((tb (make-tab-bar)))
    (tab-bar-add tb :tab1 "One")
    (tab-bar-add tb :tab2 "Two")
    (tab-bar-select tb :tab2)
    (is (eql (tab-bar-active tb) :tab2))))
#+END_SRC

** TabBar key handling test

~tab-bar-handle-key~ maps keyboard events to navigation actions. A
~:right~ key event should advance; a ~:left~ key event should retreat.
This tests the bridge between the input event system and the TabBar
navigation API.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test tabbar-handle-key
  "TabBar handle-key dispatches left/right."
  (let ((tb (make-tab-bar)))
    (tab-bar-add tb :tab1 "One")
    (tab-bar-add tb :tab2 "Two")
    (setf (tab-bar-active tb) :tab1)
    (tab-bar-handle-key tb (make-key-event :key :right))
    (is (eql (tab-bar-active tb) :tab2))
    (tab-bar-handle-key tb (make-key-event :key :left))
    (is (eql (tab-bar-active tb) :tab1))))
#+END_SRC

** ScrollBox clamp boundary test

Directly tests ~clamp-scroll~ by setting scroll offsets to invalid
values (negative and extremely large) and confirming they get clamped
back to 0. With no children, content size is 0 so the max scroll is
also 0 — this exercises the degenerate case.

#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/tests/scrollbox-tabbar-tests.lisp
(test scrollbox-scroll-clamp
  "ScrollBox clamp prevents scrolling past bounds."
  (let ((sb (make-scroll-box :scroll-y 5 :scroll-x 3)))
    (setf (scroll-box-scroll-y sb) -1)
    (clamp-scroll sb)
    (is (= (scroll-box-scroll-y sb) 0) "clamps below 0")
    (setf (scroll-box-scroll-y sb) 1000000)
    (clamp-scroll sb)
    (is (= (scroll-box-scroll-y sb) 0) "clamps above max (no children = 0 content)")))
#+END_SRC