668966380e
Distribute the literate prose from the old combined scrollbox-tabbar.org into three individual module org files: - scrollbox.org: ScrollBox class, render, scrollbars, bug fixes, plus the combined test suite (tangles scrollbox-tabbar-tests.lisp) - tabbar.org: TabBar class, navigation, keyboard handler, render - container-package.org: Package definition and exports The old scrollbox-tabbar.org is retained as a documentation archive with all code blocks set to :tangle no and a redirecting note. Fixes the draw-scrollbars code block to use the post-bugfix version (with layout-node origin offset ox/oy), matching the working code. All 13 test suites pass at 100%.
402 lines
15 KiB
Org Mode
402 lines
15 KiB
Org Mode
#+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.
|
|
|
|
The constructor accepts keyword arguments for initial offset and children.
|
|
~children~ defaults to an empty list.
|
|
|
|
#+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)))
|
|
|
|
(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
|
|
|
|
** 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.
|
|
|
|
#+BEGIN_SRC lisp :tangle ../src/components/scrollbox.lisp
|
|
(defmethod component-children ((sb scroll-box))
|
|
(scroll-box-children sb))
|
|
|
|
(defmethod component-layout-node ((sb scroll-box))
|
|
(scroll-box-layout-node sb))
|
|
#+END_SRC
|
|
|
|
** 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.
|
|
|
|
#+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))))))
|
|
|
|
(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
|
|
|
|
** 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).
|
|
|
|
#+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))
|
|
|
|
(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
|
|
|
|
** 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.
|
|
|
|
#+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
|
|
|
|
** 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.
|
|
|
|
#+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
|
|
|
|
** 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.
|
|
|
|
#+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))
|
|
|
|
(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.
|
|
|
|
#+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)))
|
|
|
|
;; ── 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)")))
|
|
#+END_SRC
|