amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix: add word-wrap function, complete TUI migration

Browse Source 
- Add missing word-wrap function (was declared in contract but never defined)
- TUI now renders correctly: draw-text on framebuffer arrays works
- Daemon connection verified
- All three view functions (status, chat, input) call draw-text correctly
This commit is contained in:
Amr Gharbeia
2026-05-13 16:06:05 -04:00
parent 79896c5ffd
commit af4d81ec9f
5 changed files with 63 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
lisp/channel-tui-main.lisp
View File

@@ -1,18 +1,9 @@
(in-package :passepartout.channel-tui)
(defun on-key (&rest args)
;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for
;; backspace). Croatoan's code-key + key-name convert them to keywords
;; so the cond below can use eq.
(let* ((raw (car args))
(ch (if (and (integerp raw) (> raw 255))
(let* ((k (code-key raw))
(name (and k (key-name k))))
(or name raw))
raw)))
(cond
;; v0.7.1: Esc — interrupt streaming
((and (eql ch 27) (st :streaming-text))
(defun on-key (ch)
(cond
;; v0.7.1: Esc — interrupt streaming
((and (eq ch :escape) (st :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0)
(let ((idx (1- (length (st :messages)))))
@@ -535,17 +526,17 @@
(input-delete-char)
(setf (st :dirty) (list nil nil t)))
;; Left arrow
((or (eq ch :left) (eql ch 260))
((eq ch :left)
(when (> (or (st :cursor-pos) 0) 0)
(decf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Right arrow
((or (eq ch :right) (eql ch 261))
((eq ch :right)
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
(incf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Up arrow
((or (eq ch :up) (eql ch 259))
((eq ch :up)
(let* ((h (st :input-history)) (p (st :input-hpos)))
(when (and h (< p (1- (length h))))
(incf (st :input-hpos))
@@ -553,7 +544,7 @@
(reverse (coerce (nth (st :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; Down arrow
((or (eq ch :down) (eql ch 258))
((eq ch :down)
(when (> (st :input-hpos) 0)
(decf (st :input-hpos))
(let ((h (st :input-history)))
@@ -563,12 +554,12 @@
nil))
(setf (st :dirty) (list nil nil t)))))
;; PageUp — scroll back by page (10 lines)
((or (eq ch :ppage) (eql ch 339))
((eq ch :ppage)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil)))
;; PageDown — scroll forward by page
((or (eq ch :npage) (eql ch 338))
((eq ch :npage)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil)))
;; Printable
@@ -579,7 +570,7 @@
(t nil))))
(when (and chr (graphic-char-p chr))
(input-insert-char chr)
(setf (st :dirty) (list nil nil t))))))))
(setf (st :dirty) (list nil nil t)))))))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision)
@@ -801,7 +792,7 @@
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
(curr-fb (cl-tty.rendering:make-framebuffer w h)))
;; Initial render
(redraw be curr-fb w h)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb)
(loop while (st :running) do
@@ -850,7 +841,7 @@
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear curr-fb)
(redraw be curr-fb w h)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb))
(sleep 0.1))))

23
lisp/channel-tui-view.lisp
View File

@@ -1,11 +1,24 @@
(in-package :passepartout.channel-tui)
(defun word-wrap (text width)
"Wrap TEXT to at most WIDTH columns. Splits on word boundaries.
Returns a list of strings, one per line."
(let ((lines nil))
(loop while (> (length text) width)
do (let ((break (or (position #\Space text :end width :from-end t)
width)))
(push (subseq text 0 break) lines)
(setf text (string-left-trim '(#\Space)
(subseq text break)))))
(push text lines)
(nreverse lines)))
(defun view-status (fb w)
(let ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"

35
org/channel-tui-main.org
View File

@@ -34,19 +34,10 @@ Event handlers + daemon I/O + main loop.
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(in-package :passepartout.channel-tui)
(defun on-key (&rest args)
;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for
;; backspace). Croatoan's code-key + key-name convert them to keywords
;; so the cond below can use eq.
(let* ((raw (car args))
(ch (if (and (integerp raw) (> raw 255))
(let* ((k (code-key raw))
(name (and k (key-name k))))
(or name raw))
raw)))
(cond
;; v0.7.1: Esc — interrupt streaming
((and (eql ch 27) (st :streaming-text))
(defun on-key (ch)
(cond
;; v0.7.1: Esc — interrupt streaming
((and (eq ch :escape) (st :streaming-text))
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0)
(let ((idx (1- (length (st :messages)))))
@@ -569,17 +560,17 @@ Event handlers + daemon I/O + main loop.
(input-delete-char)
(setf (st :dirty) (list nil nil t)))
;; Left arrow
((or (eq ch :left) (eql ch 260))
((eq ch :left)
(when (> (or (st :cursor-pos) 0) 0)
(decf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Right arrow
((or (eq ch :right) (eql ch 261))
((eq ch :right)
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
(incf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Up arrow
((or (eq ch :up) (eql ch 259))
((eq ch :up)
(let* ((h (st :input-history)) (p (st :input-hpos)))
(when (and h (< p (1- (length h))))
(incf (st :input-hpos))
@@ -587,7 +578,7 @@ Event handlers + daemon I/O + main loop.
(reverse (coerce (nth (st :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; Down arrow
((or (eq ch :down) (eql ch 258))
((eq ch :down)
(when (> (st :input-hpos) 0)
(decf (st :input-hpos))
(let ((h (st :input-history)))
@@ -597,12 +588,12 @@ Event handlers + daemon I/O + main loop.
nil))
(setf (st :dirty) (list nil nil t)))))
;; PageUp — scroll back by page (10 lines)
((or (eq ch :ppage) (eql ch 339))
((eq ch :ppage)
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 10))))
(setf (st :dirty) (list nil t nil)))
;; PageDown — scroll forward by page
((or (eq ch :npage) (eql ch 338))
((eq ch :npage)
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 10)))
(setf (st :dirty) (list nil t nil)))
;; Printable
@@ -613,7 +604,7 @@ Event handlers + daemon I/O + main loop.
(t nil))))
(when (and chr (graphic-char-p chr))
(input-insert-char chr)
(setf (st :dirty) (list nil nil t))))))))
(setf (st :dirty) (list nil nil t)))))))
;; v0.7.2 — resolve-hitl-panel: marks panel as resolved after approve/deny
(defun resolve-hitl-panel (decision)
@@ -844,7 +835,7 @@ Event handlers + daemon I/O + main loop.
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
(curr-fb (cl-tty.rendering:make-framebuffer w h)))
;; Initial render
(redraw be curr-fb w h)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb)
(loop while (st :running) do
@@ -893,7 +884,7 @@ Event handlers + daemon I/O + main loop.
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear curr-fb)
(redraw be curr-fb w h)
(redraw curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb))
(sleep 0.1))))

23
org/channel-tui-view.org
View File

@@ -45,12 +45,25 @@ that the TUI actuator attaches to the response plist before transmission.
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout.channel-tui)
(defun word-wrap (text width)
"Wrap TEXT to at most WIDTH columns. Splits on word boundaries.
Returns a list of strings, one per line."
(let ((lines nil))
(loop while (> (length text) width)
do (let ((break (or (position #\Space text :end width :from-end t)
width)))
(push (subseq text 0 break) lines)
(setf text (string-left-trim '(#\Space)
(subseq text break)))))
(push text lines)
(nreverse lines)))
(defun view-status (fb w)
(let ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
(let* ((degraded (and (find-package :passepartout)
(boundp (find-symbol "*SYSTEM-HEALTH*" :passepartout))
(member (symbol-value (find-symbol "*SYSTEM-HEALTH*" :passepartout))
'(:degraded :unhealthy))))
(bg (if degraded :bright-yellow nil)))
;; Line 1: Connection, mode, msgs, scroll, rules, streaming/busy
(cl-tty.backend:draw-text fb 1 1
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"

2
passepartout
View File

@@ -402,7 +402,7 @@ case "$COMMAND" in
:direction :output :if-exists :supersede :if-does-not-exist :create)
(format f "CRASH: ~a~%~%" c) (sb-debug:print-backtrace :count 50 :stream f) (finish-output f)))
(format t "~%=== TUI CRASH ===~%CRASH: ~a~%" c)
(format t "Full backtrace saved to ~/.cache/passepartout/tui-crash.log~%")
(format t "Full backtrace saved to ~~/.cache/passepartout/tui-crash.log~%")
(sleep 3) (finish-output) (uiop:quit 1))))
(passepartout.channel-tui:tui-main))
LISPEOF