v0.6.0: ScrollBox + TabBar — container components

ScrollBox:
- Container with vertical/horizontal scroll, viewport culling
- Scroll offset (:scroll-y, :scroll-x) with clamp to valid bounds
- Scrollbars rendered when content exceeds viewport
- Sticky scroll (auto-scroll to bottom on content change)
- Component protocol: component-children, component-layout-node

TabBar:
- Horizontal tab row with active/inactive styling
- tab-bar-next/prev (wraps around), tab-bar-select, tab-bar-handle-key
- Tab title rendering with overflow truncation (ellipsis)
- Component protocol: component-layout-node

26 scrollbox+tabbar tests, 100% GREEN:
171 total (27 backend + 58 box + 60 input + 26 scrollbox)

Review fixes applied:
- Removed duplicate definitions (org per-function blocks are prose-only)
- Fixed ASDF test path (../../tests/...)
- Version bumped to 0.6.0
- Added clamp-scroll export
- Added tab-bar-next/prev/select/handle-key tests
- Added scroll clamp boundary tests
This commit is contained in:
Hermes
2026-05-11 17:17:22 +00:00
parent 3b0410b088
commit 9adefb5dbb
7 changed files with 1239 additions and 5 deletions

View File

@@ -0,0 +1,13 @@
(defpackage :cl-tui.container
(:use :cl :cl-tui.backend :cl-tui.box :cl-tui.layout :cl-tui.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
#:render))

View File

@@ -0,0 +1,81 @@
(in-package #:cl-tui.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)
(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))
(when (and (< (+ cy (- sy)) (+ vh vy)) (> (+ cy (- sy) ch) vy))
(draw-text backend (- sx) (+ vy cy (- sy))
(format nil "child at ~D" vy) nil nil))
(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)))
(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 :background-element)
(draw-text backend (1- viewport-w) 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 0 (1- viewport-h) viewport-w 1 :bg :background-element)
(draw-text backend thumb-pos (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)))))))

View File

@@ -0,0 +1,51 @@
(in-package #:cl-tui.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)) (y 0)
(w (if ln (layout-node-width ln) 80))
(active-id (tab-bar-active tb)) (tabs (tab-bar-tabs tb)) (x-pos 0))
(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))