#+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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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 ../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