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