Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Add (setf (function-keys-enabled-p input-win) t) and for chat-win, otherwise Croatoan returns raw escape sequences instead of :up, :down, :ppage, :npage keywords. Also symlink project into quicklisp/local-projects so ql:quickload :passepartout/tui works without manual ASDF push.
494 lines
16 KiB
Org Mode
494 lines
16 KiB
Org Mode
#+TITLE: Passepartout TUI Client (Standalone)
|
|
#+STARTUP: content
|
|
#+FILETAGS: :tui:ux:client:
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui.lisp
|
|
|
|
* Overview: Architectural Intent
|
|
|
|
The TUI Client is a standalone ncurses application built on Croatoan that
|
|
connects to the daemon via TCP. It provides a three-pane interface: a status
|
|
bar at top, scrollable chat history in the middle, and a fixed input line at
|
|
the bottom.
|
|
|
|
Unlike the CLI gateway (which is a single request-response cycle), the TUI
|
|
is a persistent connection. It maintains a background reader thread that
|
|
listens for incoming messages from the daemon and enqueues them for display.
|
|
This allows the agent to send messages to the user asynchronously — tool
|
|
results, heartbeat notifications, and autonomous decisions appear in the
|
|
chat window without the user having to ask.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
|
|
The TUI lives in its own package (~passepartout.gateway-tui~) so it doesn't pollute the harness namespace. It depends on Croatoan (ncurses bindings), usocket (TCP client), and bordeaux-threads (background reader).
|
|
|
|
#+begin_src lisp
|
|
(in-package :cl-user)
|
|
(defpackage :passepartout.gateway-tui
|
|
(:use :cl :croatoan :usocket :bordeaux-threads)
|
|
(:export :main))
|
|
(in-package :passepartout.gateway-tui)
|
|
#+end_src
|
|
|
|
** Connection state
|
|
|
|
The daemon host and port. Defaults to localhost:9105.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *daemon-host* "localhost")
|
|
#+end_src
|
|
|
|
** *daemon-port*
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *daemon-port* 9105)
|
|
#+end_src
|
|
|
|
** Socket and stream
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *socket* nil)
|
|
#+end_src
|
|
|
|
** *stream*
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *stream* nil)
|
|
#+end_src
|
|
|
|
** Chat history
|
|
|
|
Each message is a list ~(:text "..." :time ...)~ for structured rendering.
|
|
The third value is the display string with timestamp prepended.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *chat-history* nil)
|
|
#+end_src
|
|
|
|
** Chat scroll position
|
|
|
|
Offset from the bottom of the history. 0 = latest messages visible.
|
|
Positive values scroll back. Protected by ~*queue-lock*~.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *chat-scroll-pos* 0)
|
|
#+end_src
|
|
|
|
** Input buffer
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *input-buffer* nil)
|
|
#+end_src
|
|
|
|
** Input history
|
|
|
|
Previous commands for recall via up/down arrows.
|
|
|
|
- ~*input-history*~: list of submitted command strings, newest first.
|
|
- ~*input-history-pos*~: current position in the history list (0 = newest,
|
|
nil = fresh input).
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *input-history* nil)
|
|
(defvar *input-history-pos* nil)
|
|
#+end_src
|
|
|
|
** Running flag
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *is-running* t)
|
|
#+end_src
|
|
|
|
** Incoming message queue
|
|
|
|
Thread-safe queue for messages received by the background reader.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
|
|
#+end_src
|
|
|
|
** *incoming*
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defvar *incoming* nil)
|
|
#+end_src
|
|
|
|
** Utility functions
|
|
|
|
*** Debug logging
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun log-debug (msg &rest args)
|
|
(ignore-errors
|
|
(with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
|
|
(format s "[~a] " (get-universal-time))
|
|
(apply #'format s msg args)
|
|
(terpri s)
|
|
(finish-output s))))
|
|
#+end_src
|
|
|
|
*** Message queue (message-queue-push)
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun message-queue-push (msg)
|
|
(bt:with-lock-held (*queue-lock*)
|
|
(setf *incoming* (append *incoming* (list msg)))))
|
|
#+end_src
|
|
|
|
*** Message queue (message-queue-drain)
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun message-queue-drain ()
|
|
(bt:with-lock-held (*queue-lock*)
|
|
(let ((msgs *incoming*))
|
|
(setf *incoming* nil)
|
|
msgs)))
|
|
#+end_src
|
|
|
|
*** Timestamp formatting
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun timestamp-now ()
|
|
"Return a short HH:MM timestamp string."
|
|
(multiple-value-bind (s m h) (decode-universal-time (get-universal-time))
|
|
(declare (ignore s))
|
|
(format nil "~2,'0d:~2,'0d" h m)))
|
|
#+end_src
|
|
|
|
** Input rendering
|
|
|
|
Draws the input line with a ~▶~ prompt. Handles the case where the input
|
|
buffer is empty (shows a dimmed hint).
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun input-render (win)
|
|
(clear win)
|
|
(let ((text (coerce (reverse *input-buffer*) 'string)))
|
|
(if (> (length text) 0)
|
|
(add-string win (format nil "▶ ~a" text) :y 0 :x 1)
|
|
(add-string win "▶ " :y 0 :x 1)))
|
|
(refresh win))
|
|
#+end_src
|
|
|
|
** Rendering (chat-render / status-render)
|
|
|
|
*** Chat history renderer
|
|
|
|
Renders the chat history with scroll support. ~offset~ is the number of
|
|
lines from the bottom to skip (0 = newest visible). Each message is shown
|
|
with its timestamp.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun chat-render (win h &optional (offset 0))
|
|
(when (and win (integerp h))
|
|
(clear win)
|
|
(box win 0 0)
|
|
(let* ((view-height (- h 2))
|
|
(history *chat-history*)
|
|
(len (length history))
|
|
(start (max 0 (- len view-height offset)))
|
|
(end (min len (+ start view-height))))
|
|
(loop for i from start below end
|
|
for msg in (subseq history start end)
|
|
for row from 1
|
|
do (add-string win (format nil "│ ~a" msg) :y row :x 2)))
|
|
(refresh win)))
|
|
#+end_src
|
|
|
|
*** Status bar renderer
|
|
|
|
Draws a compact status line showing connection status, message count, and
|
|
scroll indicator.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun status-render (win)
|
|
(when win
|
|
(clear win)
|
|
(box win 0 0)
|
|
(let* ((status (if (and *stream* (open-stream-p *stream*)) "●" "○"))
|
|
(msgs (length *chat-history*))
|
|
(scroll-indicator (if (> *chat-scroll-pos* 0)
|
|
(format nil " ↑~a" *chat-scroll-pos*)
|
|
""))
|
|
(time (timestamp-now)))
|
|
(add-string win (format nil "│ ~a PASSEPARTOUT [~a msgs]~a ~a"
|
|
status msgs scroll-indicator time)
|
|
:y 1 :x 2)))
|
|
(refresh win))
|
|
#+end_src
|
|
|
|
** Input handling
|
|
|
|
*** Handle backspace
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun input-backspace ()
|
|
(pop *input-buffer*))
|
|
#+end_src
|
|
|
|
*** Save current buffer to history
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun input-history-push (cmd)
|
|
(when (> (length cmd) 0)
|
|
(setf *input-history* (cons cmd *input-history*))
|
|
(setf *input-history-pos* nil)))
|
|
#+end_src
|
|
|
|
*** Navigate input history
|
|
|
|
Moves ~*input-history-pos*~ backward (up) or forward (down). Returns the
|
|
appropriate history entry, or nil if at the end.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun input-history-nav (direction)
|
|
(let ((len (length *input-history*)))
|
|
(if (= len 0)
|
|
nil
|
|
(case direction
|
|
(:up
|
|
(let ((pos (if *input-history-pos*
|
|
(min (1+ *input-history-pos*) (1- len))
|
|
0)))
|
|
(setf *input-history-pos* pos)
|
|
(nth pos *input-history*)))
|
|
(:down
|
|
(if *input-history-pos*
|
|
(if (= *input-history-pos* 0)
|
|
(progn (setf *input-history-pos* nil) nil)
|
|
(let ((pos (1- *input-history-pos*)))
|
|
(setf *input-history-pos* pos)
|
|
(nth pos *input-history*)))
|
|
nil))))))
|
|
#+end_src
|
|
|
|
*** Handle return
|
|
|
|
Sends the accumulated input as a framed protocol message to the daemon.
|
|
Also handles ~/exit~ and ~/clear~ client-side commands.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun input-submit (stream)
|
|
(let ((cmd (coerce (reverse *input-buffer*) 'string)))
|
|
(setf *input-buffer* nil)
|
|
(setf *input-history-pos* nil)
|
|
(log-debug "SUBMITTING: '~a'" cmd)
|
|
(when (> (length cmd) 0)
|
|
(input-history-push cmd)
|
|
(let* ((ts (timestamp-now))
|
|
(display (format nil "⬆ [~a] ~a" ts cmd)))
|
|
(push display *chat-history*))
|
|
(handler-case
|
|
(progn
|
|
(if (and stream (open-stream-p stream))
|
|
(let* ((msg (list :TYPE :EVENT
|
|
:META (list :SOURCE :tui)
|
|
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
|
|
(payload (format nil "~s" msg))
|
|
(len (length payload)))
|
|
(format stream "~6,'0x~a" len payload)
|
|
(finish-output stream)
|
|
(log-debug "SENT WIRE: ~a" payload))
|
|
(push "⬇ [--:--] ERROR: Not connected." *chat-history*)))
|
|
(error (c)
|
|
(log-debug "SEND ERROR: ~a" c)
|
|
(push (format nil "⬇ [--:--] ERROR: ~a" c) *chat-history*)
|
|
(setf *is-running* nil))))
|
|
(when (string= cmd "/exit") (setf *is-running* nil))
|
|
(when (string= cmd "/clear") (setf *chat-history* nil) (setf *chat-scroll-pos* 0))))
|
|
#+end_src
|
|
|
|
** Background Reader (reader-start)
|
|
|
|
A dedicated thread that continuously reads framed messages from the daemon's
|
|
TCP stream. Messages are parsed and enqueued with timestamps for the main
|
|
loop to display.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun reader-start (stream)
|
|
(bt:make-thread
|
|
(lambda ()
|
|
(loop while *is-running* do
|
|
(handler-case
|
|
(let* ((len-buf (make-string 6))
|
|
(count (read-sequence len-buf stream)))
|
|
(if (= count 6)
|
|
(let* ((msg-len (parse-integer len-buf :radix 16))
|
|
(msg-buf (make-string msg-len)))
|
|
(read-sequence msg-buf stream)
|
|
(log-debug "DAEMON MSG: ~a" msg-buf)
|
|
(let* ((msg (read-from-string msg-buf))
|
|
(payload (getf msg :payload))
|
|
(ts (timestamp-now)))
|
|
(cond
|
|
((eq (getf payload :action) :handshake)
|
|
(message-queue-push (format nil "⬇ [~a] * Connected *" ts)))
|
|
(t
|
|
(let ((text (or (getf payload :text) (format nil "~a" payload))))
|
|
(message-queue-push (format nil "⬇ [~a] ~a" ts text)))))))
|
|
(sleep 0.05)))
|
|
(error (c)
|
|
(when *is-running*
|
|
(log-debug "READER ERROR: ~a" c)
|
|
(message-queue-push "⬇ [--:--] ERROR: Connection lost.")
|
|
(setf *is-running* nil))))))
|
|
:name "passepartout-tui-reader"))
|
|
#+end_src
|
|
|
|
** Main Entry Point (main)
|
|
|
|
Top-level entry point with three-pane layout:
|
|
|
|
```
|
|
┌─────────────────────┐
|
|
│ Status bar (1 row) │
|
|
├─────────────────────┤
|
|
│ Chat (h-6) │
|
|
├─────────────────────┤
|
|
│ Input (1 row) │
|
|
└─────────────────────┘
|
|
```
|
|
|
|
Keybindings:
|
|
- Enter / Return — submit current input
|
|
- Backspace — delete last character
|
|
- Up / Down — navigate input history
|
|
- Page Up / Page Down — scroll chat history
|
|
- /exit — disconnect and quit
|
|
- /clear — clear chat history
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun main ()
|
|
(log-debug "=== START ===")
|
|
(handler-case
|
|
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
|
(error (e) (format t "Offline: ~a~%" e) (return-from main)))
|
|
(setf *stream* (usocket:socket-stream *socket*))
|
|
|
|
(unwind-protect
|
|
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
|
|
(let* ((h (or (height scr) 24))
|
|
(w (or (width scr) 80))
|
|
(status-h 3)
|
|
(input-h 1)
|
|
(chat-h (- h status-h input-h 1))
|
|
(status-win (make-instance 'window :height status-h :width (- w 2) :y 0 :x 1))
|
|
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y status-h :x 1))
|
|
(input-win (make-instance 'window :height input-h :width (- w 2) :y (- h input-h 1) :x 1)))
|
|
(setf (input-blocking input-win) nil)
|
|
(setf (function-keys-enabled-p input-win) t)
|
|
(setf (function-keys-enabled-p chat-win) t)
|
|
(reader-start *stream*)
|
|
(loop :while *is-running* :do
|
|
(let ((msgs (message-queue-drain)))
|
|
(when msgs
|
|
(dolist (m msgs) (push m *chat-history*))
|
|
(when (> *chat-scroll-pos* 0)
|
|
(incf *chat-scroll-pos* (length msgs)))
|
|
(chat-render chat-win chat-h *chat-scroll-pos*)
|
|
(status-render status-win)))
|
|
(let ((ch (get-char input-win)))
|
|
(when (and ch (not (equal ch -1)))
|
|
(log-debug "KEY: ~s" ch)
|
|
(cond
|
|
;; Enter / Return — submit
|
|
((or (eql ch 10) (eql ch 13) (eq ch :enter)
|
|
(eql ch #\Newline) (eql ch #\Return))
|
|
(setf *chat-scroll-pos* 0)
|
|
(input-submit *stream*)
|
|
(chat-render chat-win chat-h 0)
|
|
(status-render status-win))
|
|
;; Backspace
|
|
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
|
|
(input-backspace)
|
|
(input-render input-win))
|
|
;; Up arrow — history back
|
|
((or (eq ch :up) (eql ch 259))
|
|
(let ((prev (input-history-nav :up)))
|
|
(when prev
|
|
(setf *input-buffer* (reverse (coerce prev 'list)))
|
|
(input-render input-win))))
|
|
;; Down arrow — history forward
|
|
((or (eq ch :down) (eql ch 258))
|
|
(let ((next (input-history-nav :down)))
|
|
(if next
|
|
(setf *input-buffer* (reverse (coerce next 'list)))
|
|
(setf *input-buffer* nil))
|
|
(input-render input-win)))
|
|
;; Page Up — scroll chat back
|
|
((or (eq ch :ppage) (eql ch 339))
|
|
(let* ((hist-len (length *chat-history*))
|
|
(view-h (- chat-h 2))
|
|
(max-offset (max 0 (- hist-len view-h))))
|
|
(setf *chat-scroll-pos*
|
|
(min (+ *chat-scroll-pos* view-h) max-offset))
|
|
(chat-render chat-win chat-h *chat-scroll-pos*)
|
|
(status-render status-win)))
|
|
;; Page Down — scroll chat forward
|
|
((or (eq ch :npage) (eql ch 338))
|
|
(setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* (- chat-h 2))))
|
|
(chat-render chat-win chat-h *chat-scroll-pos*)
|
|
(status-render status-win))
|
|
;; Printable character
|
|
((characterp ch)
|
|
(push ch *input-buffer*)
|
|
(input-render input-win))
|
|
;; Integer key code → character
|
|
((integerp ch)
|
|
(let ((converted (code-char ch)))
|
|
(when (graphic-char-p converted)
|
|
(push converted *input-buffer*)
|
|
(input-render input-win))))))
|
|
;; Re-render input on every tick (no key = buffer unchanged)
|
|
(input-render input-win))
|
|
(sleep 0.01))))
|
|
(setf *is-running* nil)
|
|
(when *socket* (ignore-errors (usocket:socket-close *socket*)))))
|
|
#+end_src
|
|
|
|
** REPL test script (tmux)
|
|
|
|
#+begin_src bash :tangle no
|
|
#!/bin/bash
|
|
SESSION="oct-tui-test"
|
|
tmux new-session -d -s "$SESSION" \
|
|
-e OC_CONFIG_DIR="$HOME/.config/passepartout" \
|
|
-e PASSEPARTOUT_DATA_DIR="$HOME/.local/share/passepartout" \
|
|
-e TERM="screen-256color" \
|
|
"sbcl --non-interactive \
|
|
--eval '(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))' \
|
|
--eval '(push (truename \"$HOME/.local/share/passepartout/\") asdf:*central-registry*)' \
|
|
--eval '(ql:quickload :passepartout/tui)' \
|
|
--eval '(passepartout.gateway-tui:main)'"
|
|
sleep 5
|
|
tmux capture-pane -t "$SESSION" -p -S -20
|
|
tmux send-keys -t "$SESSION" 'hello' Enter
|
|
sleep 8
|
|
tmux capture-pane -t "$SESSION" -p -S -20
|
|
tmux send-keys -t "$SESSION" '/exit' Enter
|
|
sleep 1
|
|
tmux kill-session -t "$SESSION" 2>/dev/null || true
|
|
#+end_src
|