10 KiB
10 KiB
Passepartout TUI — View
View
Pure render functions. Each takes a Croatoan window and current state.
State is read via (st :key) — no mutation here.
Contract
- (view-status win): renders the status bar with connection info, msg count, scroll offset, rule counter, focus map (v0.4.0), and timestamp. Two lines: line 1 (status + rules), line 2 (focus + time).
- (view-chat win h): renders the scrolled chat message list. Takes window and available height. Messages are color-coded: green (user), white (agent), yellow (system).
- (view-input win): renders the input line with cursor and typing indicator.
- (redraw sw cw ch iw): dispatches redraws based on
(st :dirty)flags (status, chat, input). Minimizes terminal writes. - (char-width ch): returns the terminal column width of character CH. ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8. Used by word-wrap for accurate line counting (v0.7.0).
- (view-status win): v0.7.0 — timestamp right-aligned at (- w 12) on line 2, focus info at :x 1. No overlap.
Implementation
Unicode width (v0.7.0)
(in-package :passepartout)
(defun char-width (ch)
"Returns the terminal column width of character CH.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(let ((code (char-code ch)))
(cond
((= code 9) 8) ; tab
((= code 0) 0) ; null
((< code 32) 0) ; control chars
((<= code 127) 1) ; ASCII
;; CJK Unified Ideographs
((<= #x4E00 code #x9FFF) 2)
((<= #x3400 code #x4DBF) 2) ; CJK Extension A
;; Fullwidth Forms
((<= #xFF01 code #xFF60) 2)
((<= #xFFE0 code #xFFE6) 2)
;; Hiragana, Katakana
((<= #x3040 code #x309F) 2)
((<= #x30A0 code #x30FF) 2)
;; Hangul
((<= #xAC00 code #xD7AF) 2)
((<= #x1100 code #x11FF) 2)
;; Emoji + Misc Symbols
((<= #x1F300 code #x1F9FF) 2) ; Emoji, Symbols, Supplement
((<= #x1FA00 code #x1FA6F) 2) ; Chess, Symbols Extended
((<= #x2600 code #x27BF) 2) ; Misc Symbols, Dingbats
((<= #x2300 code #x23FF) 2) ; Misc Technical
;; Combining marks (zero-width)
((<= #x0300 code #x036F) 0) ; Combining Diacritical Marks
((<= #x1AB0 code #x1AFF) 0) ; Combining Diacritical Extended
((<= #x1DC0 code #x1DFF) 0) ; Combining Diacritical Supplement
((<= #x20D0 code #x20FF) 0) ; Combining Diacritical for Symbols
((<= #xFE00 code #xFE0F) 0) ; Variation Selectors
((<= #xFE20 code #xFE2F) 0) ; Combining Half Marks
;; Default
(t 1))))Status Bar
The status bar, as of v0.4.0, renders Passepartout's three differentiator visualizations — data only available because of the deterministic gate architecture:
- Rule counter (
Rules:N): the number of pending HITL actions from the Dispatcher's*hitl-pending*hash table. The user watches this tick up as they teach the agent their preferences through approve/deny decisions. - Focus map (
[Focus: <id>]): the foveal focus from the daemon's signal context. Shows the user what the agent is currently looking at. - Gate trace (not rendered in status bar — attached to individual
messages via
:gate-tracefield for future collapsible rendering per message).
All three enrichments cost 0 LLM tokens — they are daemon-state queries that the TUI actuator attaches to the response plist before transmission.
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :busy) " …thinking" ""))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))Chat Area
(defun word-wrap (text width)
"Break text into lines at word boundaries, each <= width chars.
Returns list of trimmed strings. Single words wider than width are split."
(let ((lines '())
(pos 0)
(len (length text)))
(loop while (< pos len)
do (let ((end (min len (+ pos width))))
(cond
((>= end len)
(push (string-trim '(#\Space) (subseq text pos len)) lines)
(setf pos len))
((char= (char text (1- end)) #\Space)
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))
(t
(let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
(if (and last-space (> last-space pos))
(progn
(push (string-trim '(#\Space) (subseq text pos last-space)) lines)
(setf pos (1+ last-space)))
(progn
(push (string-trim '(#\Space) (subseq text pos end)) lines)
(setf pos end))))))))
(nreverse lines)))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(y 1))
;; Count visible messages from end, accounting for word wrap
(let* ((msg-count 0)
(lines-remaining max-lines))
(loop for i from (1- total) downto 0
while (> lines-remaining 0)
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(wrapped (word-wrap line-text (- w 2)))
(nlines (length wrapped)))
(if (<= nlines lines-remaining)
(progn (decf lines-remaining nlines) (incf msg-count))
(setf lines-remaining 0))))
;; Render from the correct starting message
(let* ((scroll-skip (st :scroll-offset))
(start (max 0 (- total msg-count scroll-skip))))
(loop for i from start below total
while (< y (1- h))
do (let* ((msg (aref msgs i))
(role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
(prefix (case role (:user "⬆") (:agent "⬇") (t " ")))
(line-text (format nil "~a [~a] ~a" prefix time content))
(wrapped (word-wrap line-text (- w 2))))
(dolist (line wrapped)
(when (< y (1- h))
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y))))))))
(refresh win))Input Line
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))Redraw (dirty-flag dispatch)
(defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))Test Suite
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-view-tests
(:use :cl :fiveam :passepartout)
(:export #:tui-view-suite))
(in-package :passepartout-tui-view-tests)
(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)
(test test-char-width-ascii
"Contract 5: ASCII characters (< 128) have width 1."
(is (= 1 (passepartout::char-width #\a)))
(is (= 1 (passepartout::char-width #\Space)))
(is (= 1 (passepartout::char-width #\@))))
(test test-char-width-tab
"Contract 5: tab character has width 8."
(is (= 8 (passepartout::char-width #\Tab))))
(test test-char-width-cjk
"Contract 5: CJK characters have width 2."
(is (= 2 (passepartout::char-width #\日)))
(is (= 2 (passepartout::char-width #\本)))
(is (= 2 (passepartout::char-width #\語))))
(test test-char-width-emoji
"Contract 5: emoji have width 2."
(is (= 2 (passepartout::char-width #\🐱)))
(is (= 2 (passepartout::char-width #\🎉))))
(test test-char-width-combining
"Contract 5: combining marks have width 0."
(is (= 0 (passepartout::char-width #\Combining_Grave_Accent))))
(test test-char-width-null
"Contract 5: null character has width 0."
(is (= 0 (passepartout::char-width #\Nul))))