cl-tty/org/scrollbox.org

ScrollBox

• Overview
  • Contract
• Implementation
  • ScrollBox class
  • ScrollBox: component protocol
  • ScrollBox: scroll-by
  • ScrollBox: content size estimation
  • ScrollBox: rendering with viewport culling
  • ScrollBox: sticky scroll
  • ScrollBox: scrollbar rendering
  • Bug Fixes (v1.0.0): scroll offset and scrollbar position
• Tests

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.

The constructor accepts keyword arguments for initial offset and children. children defaults to an empty list.

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

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

ScrollBox: component protocol

component-children returns the child list for the rendering pipeline to traverse. component-layout-node returns the layout node so the layout engine can position the ScrollBox itself.

(defmethod component-children ((sb scroll-box))
  (scroll-box-children sb))

(defmethod component-layout-node ((sb scroll-box))
  (scroll-box-layout-node sb))

ScrollBox: scroll-by

scroll-by adjusts the scroll offset by delta rows and columns. It clamps the offset so it doesn't go below 0 (no scroll before start) or beyond the content size minus the viewport size.

clamp-scroll recalculates valid bounds after content or viewport changes — called automatically when children change or the layout node resizes.

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

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

ScrollBox: content size estimation

scroll-box-content-height and scroll-box-content-width calculate the total content size by summing child layout node dimensions. This is used by clamp-scroll and scrollbar rendering.

For height: sum of all child heights (vertical layout). For width: max of all child widths (horizontal scroll).

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

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

ScrollBox: rendering 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.

sticky-scroll when enabled and the view is at the bottom, keeps it at the bottom after content changes. The flag resets to false when the user manually scrolls up.

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

ScrollBox: sticky scroll

sticky-scroll checks whether the view is at the bottom. If so, auto-scrolls to keep the bottommost content visible. The user calling scroll-by with a negative DY resets the sticky flag.

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

ScrollBox: scrollbar rendering

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.

Vertical scrollbar: blocks (#\\Full #\\Up #\\Mid #\\Down). Horizontal scrollbar: block characters along the bottom.

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

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

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.

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

;; ── ScrollBox Tests ─────────────────────────────────────────────

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

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

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

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

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

;; ── TabBar Tests ────────────────────────────────────────────────

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

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

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

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

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

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

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

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