Amr Gharbeia
c8964d0249
char-width: contract 5, 4 tests (6 assertions), 100% pass ASCII=1, CJK/Hangul/Kana/halfwidth=2, combining marks=0, tab=8 Pure Lisp, ~25 lines, no deps. Used by word-wrap for unicode. status bar: contract 6, timestamp right-aligned at (- w 12) Fixes overlap where focus map and timestamp both drew at :y 2 :x 1
226 lines
8.7 KiB
Org Mode
226 lines
8.7 KiB
Org Mode
#+TITLE: Passepartout TUI — View
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/channel-tui-view.lisp
|
|
|
|
* View
|
|
|
|
Pure render functions. Each takes a Croatoan window and current state.
|
|
State is read via ~(st :key)~ — no mutation here.
|
|
|
|
** Contract
|
|
|
|
1. (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).
|
|
2. (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).
|
|
3. (view-input win): renders the input line with cursor and typing
|
|
indicator.
|
|
4. (redraw sw cw ch iw): dispatches redraws based on ~(st :dirty)~
|
|
flags (status, chat, input). Minimizes terminal writes.
|
|
5. (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).
|
|
6. (view-status win): v0.7.0 — timestamp right-aligned at (- w 12)
|
|
on line 2, focus info at :x 1. No overlap.
|
|
|
|
** 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-trace~ field 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.
|
|
|
|
#+begin_src lisp
|
|
(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))
|
|
#+end_src
|
|
|
|
** Chat Area
|
|
#+begin_src lisp
|
|
(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))
|
|
#+end_src
|
|
|
|
** Input Line
|
|
#+begin_src lisp
|
|
(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))
|
|
#+end_src
|
|
|
|
** Redraw (dirty-flag dispatch)
|
|
#+begin_src lisp
|
|
(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))))
|
|
#+end_src
|
|
|
|
* Implementation — v0.7.0 additions
|
|
#+begin_src lisp
|
|
(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)
|
|
((< code 32) 0)
|
|
((<= code 127) 1)
|
|
((<= #x4E00 code #x9FFF) 2)
|
|
((<= #x3400 code #x4DBF) 2)
|
|
((<= #x3040 code #x309F) 2)
|
|
((<= #x30A0 code #x30FF) 2)
|
|
((<= #xAC00 code #xD7AF) 2)
|
|
((<= #xFF01 code #xFF60) 2)
|
|
((<= #xFFE0 code #xFFE6) 2)
|
|
((<= #x1F300 code #x1F9FF) 2)
|
|
((<= #x2600 code #x27BF) 2)
|
|
((<= #x0300 code #x036F) 0)
|
|
((<= #x20D0 code #x20FF) 0)
|
|
((<= #xFE00 code #xFE0F) 0)
|
|
(t 1))))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
#+begin_src lisp
|
|
(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 #\日))))
|
|
|
|
(test test-char-width-null
|
|
"Contract 5: null has width 0."
|
|
(is (= 0 (passepartout::char-width #\Nul))))
|
|
#+end_src
|