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

fix: word-wrap never incremented current-len (all text treated as single line); scrollbox wrong offset origin; integration test fixes

Browse Source
This commit is contained in:
Hermes Agent
2026-05-12 14:41:16 +00:00
parent 00db3c61a5
commit d5a767350f
3 changed files with 13 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/components/scrollbox.lisp
View File

@@ -47,20 +47,19 @@ Children outside the viewport are skipped."
(vh (if ln (layout-node-height ln) 24))
(sy (scroll-box-scroll-y sb))
(sx (scroll-box-scroll-x sb)))
(declare (ignore vx))
(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))
(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) (- orig-x sx)
(layout-node-y cln) (- orig-y sy)))
(setf (layout-node-x cln) (- vx sx)
(layout-node-y cln) (- vy sy)))
(unwind-protect
(render child backend)
(when cln

2
src/components/text.lisp
View File

@@ -70,7 +70,9 @@ Breaks at word boundaries. Words exceeding MAX-WIDTH are hard-broken."
(let ((wl (length word)))
(cond ((<= wl max-width)
(if (and current (<= (+ current-len 1 wl) max-width))
(progn
(push word current)
(incf current-len (1+ wl)))
(progn
(when current
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))

12
tests/integration-tests.lisp
View File

@@ -56,7 +56,7 @@
(is-true (fb-contains fb "+") "top-left corner appears")
(is-true (fb-contains fb "-") "horizontal border appears")
;; Check the title at row 0, col 2
(is (equal "My Box" (fb-string fb 2 0 6)) "title at correct position")))
(is (equal "My Box" (fb-string fb 2 1 6)) "title at correct position")))
;; ─── Test: Text component with word-wrap ──────────────────────────
@@ -76,17 +76,17 @@
(test textinput-value-on-fb
"TextInput renders its value and cursor on framebuffer."
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
(ti (make-text-input :value "hello world" :cursor 5)))
(ti (make-text-input :value "hello world" :cursor 11)))
(setf (text-input-layout-node ti)
(make-layout-node :width 40 :height 1))
(compute-layout (text-input-layout-node ti) 40 1)
(render ti fb)
;; Verify value via direct cell inspection
(is (equal "hello world" (fb-string fb 0 0 11)) "value appears at row 0")
;; Check cursor block at position 5
;; Check cursor block at position 11
(let* ((cells (fb-framebuffer fb))
(cursor-char (cell-char (aref cells 0 5))))
(is (eql #\█ cursor-char) "cursor block is drawn at position 5"))))
(cursor-char (cell-char (aref cells 0 11))))
(is (eql #\█ cursor-char) "cursor block is drawn at position 11"))))
;; ─── Test: TextInput empty shows placeholder ──────────────────────
@@ -228,7 +228,7 @@
;;
;; 3. TextInput
;;
(let ((ti (make-text-input :value "search query" :cursor 6)))
(let ((ti (make-text-input :value "search query" :cursor 12)))
(setf (text-input-layout-node ti) (make-layout-node))
(setf (layout-node-x (text-input-layout-node ti)) 2)
(setf (layout-node-y (text-input-layout-node ti)) 6)