amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

split: scrollbox-tabbar.org into scrollbox.org, tabbar.org, container-package.org

Browse Source 
- Create org/scrollbox.org (tangles scrollbox.lisp)
- Create org/tabbar.org (tangles tabbar.lisp)
- Create org/container-package.org (tangles container-package.lisp)
- Disable :tangle in old scrollbox-tabbar.org (kept for prose docs)
- Fix missing paren in render method (was depth=1 at EOF)
- All 483 tests pass, 14 suites, 100%
This commit is contained in:
Hermes Agent
2026-05-12 18:00:06 +00:00
parent d5caaf296d
commit a061d60898
6 changed files with 199 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
src/components/scrollbox.lisp
View File

@@ -39,8 +39,6 @@
: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))
@@ -48,23 +46,12 @@ Children outside the viewport are skipped."
(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)))))
(let* ((cln (component-layout-node child)) (ch (if cln (layout-node-height cln) 1)) (cy vy))
(when (and (< (- cy sy) vh) (> (+ (- cy sy) ch) 0))
(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)))
@@ -74,24 +61,19 @@ Children outside the viewport are skipped."
(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)))
(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))))
(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))))
(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)))
(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)))))))