cl-tty/org/scrollbox-tabbar.org

cl-tty v0.6.0 — ScrollBox + TabBar

• ScrollBox and TabBar
  • Contract
  • Tests
• Implementation
  • Package
  • ScrollBox class
  • ScrollBox: component protocol
  • ScrollBox: scroll-by
  • ScrollBox: content size estimation
  • ScrollBox: rendering with viewport culling
  • ScrollBox: sticky scroll
  • ScrollBox: scrollbar rendering
  • TabBar class
  • TabBar: component protocol
  • TabBar: navigation
  • TabBar: keyboard handler
  • TabBar: rendering
  • Bug Fixes (v1.0.0): scroll offset and scrollbar position
  • Combined tangle blocks

ScrollBox and TabBar

Container components. ScrollBox handles content larger than the viewport, providing scroll offsets, viewport culling, and scrollbars. TabBar handles horizontal tab navigation with keyboard support.

Both components inherit dirty-mixin and implement the component protocol (render, component-children, component-layout-node) so they work with the rendering pipeline and layout engine.

Contract

ScrollBox:

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

TabBar:

(tab-bar &key tabs active-tab) → tab-bar TABS is a list of (id title) plists.

(tab-bar-active sb) / (setf tab-bar-active) — currently active tab id. (tab-bar-tabs tb) — list of tab plists. (tab-bar-add tb id title) — add a tab. Returns the tab id.

(render ((tb tab-bar) backend)) — renders tab row, active tab highlighted, inactive tabs dimmed.

Tests

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

Implementation

Package

(defpackage :cl-tty.container
  (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
  (:export
   ;; ScrollBox
   #:scroll-box #:make-scroll-box
   #:scroll-box-scroll-y #:scroll-box-scroll-x
   #:scroll-box-children
   #:scroll-by #:sticky-scroll-p
   ;; TabBar
   #:tab-bar #:make-tab-bar
   #:tab-bar-active #:tab-bar-tabs
   #:tab-bar-add
   ;; Rendering
   #:render))

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 vy))
                   (> (+ cy (- sy) ch) vy))
          ;; 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) (- orig-x sx)
                    (layout-node-y cln) (- orig-y 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)))
    ;; 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 (1- viewport-w) 0 1 viewport-h :bg :scrollbar-bg)
        (draw-text backend (1- viewport-w) 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 0 (1- viewport-h) viewport-w 1 :bg :scrollbar-bg)
        (draw-text backend thumb-pos (1- viewport-h) "█" nil nil)))))

TabBar class

tab-bar stores a list of tab plists ((:id :tab1 :title \"One\") ...) and the currently active tab id. tab-bar-add creates a new tab with the given id and title, returns the id.

(in-package #:cl-tty.container)

(defclass tab-bar (dirty-mixin)
  ((tabs :initform nil :initarg :tabs
         :accessor tab-bar-tabs :type list)
   (active :initform nil :initarg :active
           :accessor tab-bar-active)
   (layout-node :initform (make-layout-node) :accessor tab-bar-layout-node)
   (focusable :initform t :accessor tab-bar-focusable)))

(defun make-tab-bar (&key tabs active)
  (make-instance 'tab-bar :tabs (or tabs nil) :active active))

(defun tab-bar-add (tb id title)
  "Add a tab with ID and TITLE. Sets as active if first tab."
  (setf (tab-bar-tabs tb)
        (nconc (tab-bar-tabs tb) (list (list :id id :title title))))
  (unless (tab-bar-active tb)
    (setf (tab-bar-active tb) id))
  id)

TabBar: component protocol

(defmethod component-layout-node ((tb tab-bar))
  (tab-bar-layout-node tb))

TabBar: navigation

tab-bar-next and tab-bar-prev cycle through tabs. tab-bar-select activates a tab by id. tab-bar-handle-key dispatches key events (Left/Right to navigate, optional Enter to select).

(defun tab-bar-next (tb)
  "Move to next tab."
  (let* ((tabs (tab-bar-tabs tb))
         (current (tab-bar-active tb))
         (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
         (pos (position current ids)))
    (when pos
      (let ((next (nth (mod (1+ pos) (length ids)) ids)))
        (setf (tab-bar-active tb) next)
        (mark-dirty tb)))))

(defun tab-bar-prev (tb)
  "Move to previous tab."
  (let* ((tabs (tab-bar-tabs tb))
         (current (tab-bar-active tb))
         (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
         (pos (position current ids)))
    (when pos
      (let ((prev (nth (mod (1- pos) (length ids)) ids)))
        (setf (tab-bar-active tb) prev)
        (mark-dirty tb)))))

(defun tab-bar-select (tb id)
  "Select a tab by ID."
  (setf (tab-bar-active tb) id)
  (mark-dirty tb))

TabBar: keyboard handler

tab-bar-handle-key dispatches Left → previous tab, Right → next tab. Returns T if the key was handled, NIL otherwise (for composability with the keybinding system).

(defun tab-bar-handle-key (tb event)
  "Handle a key-event on a TabBar. Returns T if handled."
  (case (key-event-key event)
    (:left (tab-bar-prev tb) t)
    (:right (tab-bar-next tb) t)
    (t nil)))

TabBar: rendering

render iterates tabs, drawing each as [ Title ] with the active tab highlighted (bold, accent color) and inactive tabs dimmed. Tabs are separated by two spaces.

The available width comes from the layout node. If tabs overflow, they are truncated with an ellipsis.

(defmethod render ((tb tab-bar) backend)
  (let* ((ln (tab-bar-layout-node tb))
         (x (if ln (layout-node-x ln) 0))
         (y (if ln (layout-node-y ln) 0))
         (w (if ln (layout-node-width ln) 80))
         (active-id (tab-bar-active tb))
         (tabs (tab-bar-tabs tb))
         (x-pos x))
    (dolist (tab tabs)
      (let* ((id (getf tab :id))
             (title (getf tab :title))
             (label (format nil " ~A " title))
             (label-len (length label))
             (is-active (eql id active-id))
             (fg (if is-active :accent :text-muted))
             (bg (if is-active :background-element nil)))
        ;; Check if tab fits
        (when (>= (+ x-pos label-len 2) (+ x w))
          (draw-text backend x-pos y "…" :text-muted nil)
          (return))
        ;; Draw tab
        (draw-text backend x-pos y label fg bg)
        (incf x-pos (+ label-len 2))))
    (values)))

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.

Combined tangle blocks

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

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

(defun clamp-scroll (sb)
  (let* ((ln (scroll-box-layout-node sb))
         (viewport-h (if ln (layout-node-height ln) 0))
         (viewport-w  (if ln (layout-node-width ln) 0))
         (content-h (scroll-box-content-height sb))
         (content-w  (scroll-box-content-width sb)))
    (setf (scroll-box-scroll-y sb) (max 0 (min (scroll-box-scroll-y sb) (- content-h viewport-h))))
    (setf (scroll-box-scroll-x sb) (max 0 (min (scroll-box-scroll-x sb) (- content-w viewport-w))))))

(defun scroll-by (sb dy dx)
  (incf (scroll-box-scroll-y sb) dy) (incf (scroll-box-scroll-x sb) dx)
  (clamp-scroll sb) (mark-dirty sb))

(defun scroll-box-content-height (sb)
  (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)
  (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))

(defmethod render ((sb scroll-box) backend)
  "Render ScrollBox children within the viewport, offset by scroll position.
Children outside the viewport are skipped."
  (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)))

(defun scrollbar-thumb (scroll-pos viewport-size content-size)
  (if (> content-size viewport-size) (/ (float scroll-pos) (- content-size viewport-size)) 0.0))

(defun draw-scrollbars (sb backend viewport-w viewport-h)
  (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)))
    (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 :bright-black)
        (draw-text backend (+ ox (1- viewport-w)) (+ oy thumb-pos) "█" nil nil)))
    (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 :bright-black)
        (draw-text backend (+ ox thumb-pos) (+ oy (1- viewport-h)) "█" nil nil)))))

(defun update-sticky-scroll (sb)
  (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)))))))

(in-package #:cl-tty.container)

(defclass tab-bar (dirty-mixin)
  ((tabs :initform nil :initarg :tabs :accessor tab-bar-tabs :type list)
   (active :initform nil :initarg :active :accessor tab-bar-active)
   (layout-node :initform (make-layout-node) :accessor tab-bar-layout-node)
   (focusable :initform t :accessor tab-bar-focusable)))

(defun make-tab-bar (&key tabs active)
  (make-instance 'tab-bar :tabs (or tabs nil) :active active))

(defun tab-bar-add (tb id title)
  (setf (tab-bar-tabs tb) (nconc (tab-bar-tabs tb) (list (list :id id :title title))))
  (unless (tab-bar-active tb) (setf (tab-bar-active tb) id)) id)

(defmethod component-layout-node ((tb tab-bar)) (tab-bar-layout-node tb))

(defun tab-bar-next (tb)
  (let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
         (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
         (pos (position current ids)))
    (when pos (let ((next (nth (mod (1+ pos) (length ids)) ids)))
                (setf (tab-bar-active tb) next) (mark-dirty tb)))))

(defun tab-bar-prev (tb)
  (let* ((tabs (tab-bar-tabs tb)) (current (tab-bar-active tb))
         (ids (mapcar (lambda (tab) (getf tab :id)) tabs))
         (pos (position current ids)))
    (when pos (let ((prev (nth (mod (1- pos) (length ids)) ids)))
                (setf (tab-bar-active tb) prev) (mark-dirty tb)))))

(defun tab-bar-select (tb id) (setf (tab-bar-active tb) id) (mark-dirty tb))

(defun tab-bar-handle-key (tb event)
  (case (key-event-key event) (:left (tab-bar-prev tb) t) (:right (tab-bar-next tb) t) (t nil)))

(defmethod render ((tb tab-bar) backend)
  (let* ((ln (tab-bar-layout-node tb))
         (x (if ln (layout-node-x ln) 0))
         (y (if ln (layout-node-y ln) 0))
         (w (if ln (layout-node-width ln) 80))
         (active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos x))
    (dolist (tab tabs)
      (let* ((id (getf tab :id)) (title (getf tab :title))
             (label (format nil " ~A " title)) (label-len (length label))
             (is-active (eql id active-id))
             (fg (if is-active :accent :text-muted))
             (bg (if is-active :background-element nil)))
        (when (>= (+ x-pos label-len 2) w)
          (draw-text backend x-pos y "..." :text-muted nil) (return))
        (draw-text backend x-pos y label fg bg)
        (incf x-pos (+ label-len 2)))))
  (values))

(defpackage :cl-tty.container
  (:use :cl :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
  (:export
   #:scroll-box #:make-scroll-box
   #:scroll-box-scroll-y #:scroll-box-scroll-x
   #:scroll-box-children #:scroll-by
   #:sticky-scroll-p
   #:clamp-scroll
   #:tab-bar #:make-tab-bar
   #:tab-bar-active #:tab-bar-tabs
   #:tab-bar-add #:tab-bar-next #:tab-bar-prev
   #:tab-bar-select #:tab-bar-handle-key))