#+TITLE: Passepartout TUI Client #+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui.lisp * Architectural Intent The TUI Client is a Croatoan-based ncurses chat interface for Passepartout. It connects to the daemon over TCP, displays messages in a scrollable window, and provides a mini-buffer-style configuration panel (F2) for managing providers, cascade, and model picks. ** Layout ``` ┌─ Status bar (3 rows) ──────────────────────────────────┐ ├─ Chat area (expandable/contractable) ──────────────────┤ ├─ Config mini-buffer (0-12 rows, visible when F2 open) ─┤ │ [1] Providers [2] Cascade [3] Models [4] View [q] │ │ Provider Status Model │ │ openrouter ✓ │ │ groq ✓ │ │ enter API key for openai: ████████ │ ├─ Input line (1 row) ───────────────────────────────────┤ └────────────────────────────────────────────────────────┘ ``` * Implementation ** State #+begin_src lisp (defpackage :passepartout.gateway-tui (:use :cl :croatoan :passepartout :usocket :bordeaux-threads) (:export :tui-main)) (in-package :passepartout.gateway-tui) (defvar *stream* nil "TCP stream to daemon") (defvar *input-buffer* nil "Current input line as reversed char list") (defvar *input-history* nil "Sent messages (newest first)") (defvar *input-history-pos* 0 "Position in input history for nav") (defvar *chat-history* nil "List of (direction . text) entries") (defvar *chat-scroll-pos* 0 "How many lines from bottom we scrolled up") (defvar *is-running* t "Main loop flag") (defvar *tui-mode* :chat "Current mode: :chat or :config") (defvar *config-selection* 0 "Selected menu item in config panel") (defvar *config-panel-height* 10 "Height of config panel when open") #+end_src ** Protocol helpers #+begin_src lisp (defun send-message (stream msg) "Send a framed s-expression over TCP." (let* ((sexp (format nil "~s" msg)) (len (length sexp)) (header (format nil "~6,'0x" len))) (write-sequence (babel:string-to-octets (concatenate 'string header sexp)) stream) (force-output stream))) (defun read-message (stream) "Read a framed s-expression from TCP." (handler-case (let* ((header (make-array 6 :element-type '(unsigned-byte 8))) (read (read-sequence header stream))) (when (< read 6) (return-from read-message nil)) (let* ((hex (babel:octets-to-string header)) (len (parse-integer hex :radix 16 :junk-allowed t)) (buf (make-array len :element-type '(unsigned-byte 8)))) (read-sequence buf stream) (read-from-string (babel:octets-to-string buf)))) (error () nil))) #+end_src ** Message queue (for background reader thread) #+begin_src lisp (defvar *message-queue* nil "List of incoming daemon messages from reader thread.") (defvar *message-queue-lock* (bt:make-lock "msg-queue-lock") "Lock for thread-safe queue access.") (defun message-queue-push (msg) (bt:acquire-lock *message-queue-lock*) (push msg *message-queue*) (bt:release-lock *message-queue-lock*)) (defun message-queue-drain () "Drain all messages from queue. Returns list in FIFO order." (bt:acquire-lock *message-queue-lock*) (let ((msgs (nreverse *message-queue*))) (setf *message-queue* nil) (bt:release-lock *message-queue-lock*) msgs)) (defun reader-thread (stream) "Background thread: reads daemon messages and enqueues them." (loop while *is-running* do (let ((msg (read-message stream))) (when msg (message-queue-push msg))))) #+end_src ** Input rendering #+begin_src lisp (defun input-text () "Convert input buffer to string." (coerce (reverse *input-buffer*) 'string)) (defun input-backspace () (when *input-buffer* (pop *input-buffer*))) (defun input-submit (stream) "Send current input buffer content to daemon." (let ((text (string-trim '(#\Space) (input-text)))) (when (> (length text) 0) (push text *input-history*) (setf *input-history-pos* 0) (send-message stream (list :type :event :payload (list :sensor :user-input :text text))) (push (cons :sent text) *chat-history*) (setf *input-buffer* nil)))) (defun input-history-nav (dir) "Navigate input history. Returns new value or nil." (let ((len (length *input-history*))) (when (= len 0) (return-from input-history-nav nil)) (case dir (:up (if (< *input-history-pos* (1- len)) (incf *input-history-pos*) nil)) (:down (if (> *input-history-pos* 0) (decf *input-history-pos*) (progn (setf *input-history-pos* 0) nil))))) (when (>= *input-history-pos* 0) (nth *input-history-pos* *input-history*))) #+end_src ** Display helpers #+begin_src lisp (defun timestamp () "Return HH:MM timestamp string." (multiple-value-bind (h m) (get-decoded-time) (format nil "~2,'0d:~2,'0d" h m))) (defun status-render (win) "Draw the status bar." (let ((h (or (height win) 3)) (w (or (width win) 78))) (clear win) (box win 0 0) (add-string win (format nil " Passepartout ~a [~a] msgs:~a scroll:~a" (if *stream* "● Connected" "○ Disconnected") (ecase *tui-mode* (:chat "CHAT") (:config "CONFIG")) (length *chat-history*) (if (> *chat-scroll-pos* 0) (format nil "~a↑" *chat-scroll-pos*) "0")) :y 1 :x 1) (add-string win (format nil " ~a" (timestamp)) :y 2 :x 1) (refresh win))) (defun chat-render (win h) "Draw the chat history within WIN of height H." (clear win) (box win 0 0) (let* ((max-lines (- h 2)) (total (length *chat-history*)) (start (max 0 (- total max-lines *chat-scroll-pos*))) (y 1)) (loop for i from start below total do (let ((entry (nth i *chat-history*))) (when (and (< y (1- h)) (car entry)) (let* ((dir (car entry)) (text (cdr entry)) (prefix (if (eq dir :sent) "⬆" "⬇")) (label (format nil "~a [~a] ~a" prefix (timestamp) text))) (add-string win label :y 1 :x y) (incf y)))))) (refresh win)) (defun input-render (win) "Draw the input line." (clear win) (add-string win (input-text) :y 0 :x 0) (refresh win)) #+end_src ** Config panel #+begin_src lisp (defun config-provider-line (provider) "Return formatted provider line: ' ✓ openrouter' or ' ✗ openrouter'." (format nil " ~:[✗~;✓~] ~(~a~)" (provider-available-p provider) provider)) (defun config-render (win) "Draw the config mini-buffer panel with menu and provider overview." (let ((w (or (width win) 78))) (clear win) (box win 0 0) (add-string win "[1] Providers [2] Cascade [3] Models [4] View [q] Back" :y 1 :x 1) (add-string win (format nil " Set provider: ~a" (mapcar #'config-provider-line *provider-cascade*)) :y 2 :x 1) ;; Show unconfigured but available providers on line 3-8 (let ((y 3) (unconf (remove-if (lambda (p) (provider-available-p p)) (mapcar #'car *provider-configs*))) (conf (count-if #'provider-available-p (mapcar #'car *provider-configs*)))) (add-string win (format nil "~a/~a active" conf (length *provider-configs*)) :y 1 :x (- w 14)) (when (zerop conf) (add-string win "** No providers configured. Press 1 to set up." :y y :x 1) (incf y)) (when unconf (add-string win (format nil "Available: ~{~a~^, ~}" (mapcar (lambda (k) (string-downcase (string k))) unconf)) :y y :x 1) (incf y)) (add-string win (format nil "Free tier: openrouter (openrouter.ai), gemma-4 from google") :y y :x 1) (refresh win)))) (defun config-render-providers (win) "Show all providers with availability status." (let ((w (or (width win) 78))) (clear win) (box win 0 0) (add-string win "[1] Providers [2] Cascade [3] Models [4] View [q] Back" :y 1 :x 1) (add-string win " Provider Status Key Env" :y 2 :x 1) (loop for entry in *provider-configs* for i from 3 do (let* ((provider (car entry)) (config (cdr entry)) (avail (provider-available-p provider)) (key-env (or (getf config :key-env) (getf config :url-env) "--"))) (add-string win (format nil " ~:[ ✗~; ✓~] ~20a ~a" avail provider key-env) :y i :x 1)) (refresh win))) (defun config-render-cascade (win) "Show current PROVIDER_CASCADE." (let ((w (or (width win) 78))) (clear win) (box win 0 0) (add-string win "[1] Providers [2] Cascade [3] Models [4] View [q] Back" :y 1 :x 1) (add-string win (format nil " Cascade order: ~{~a~^ → ~}" (mapcar (lambda (k) (string-downcase (string k))) *provider-cascade*)) :y 2 :x 1) (add-string win " Set PROVIDER_CASCADE in .env to reorder." :y 3 :x 1) (refresh win))) (defun config-render-models (win) "Show per-slot model recommendations." (let ((w (or (width win) 78))) (clear win) (box win 0 0) (add-string win "[1] Providers [2] Cascade [3] Models [4] View [q] Back" :y 1 :x 1) (let ((y 2)) (dolist (slot '(:code :chat :plan :background)) (add-string win (format nil " ~:@(~a~)" slot) :y y :x 1) (incf y) (let ((desc (cdr (or (assoc slot *slot-descriptions*) '(:fallback . "General purpose"))))) (add-string win (subseq desc 0 (min (length desc) (- w 4))) :y y :x 1) (incf y)) (dolist (rec (model-explorer-recommend slot)) (let ((label (format nil " ~a (~a ctx)" (getf rec :name) (if (getf rec :context) (format nil "~dK" (floor (getf rec :context) 1000)) "?")))) (add-string win (subseq label 0 (min (length label) (- w 4))) :y y :x 1) (incf y)))))) (refresh win))) (defun config-render-view (win) "Show current system configuration." (let ((w (or (width win) 78))) (clear win) (box win 0 0) (add-string win "[1] Providers [2] Cascade [3] Models [4] View [q] Back" :y 1 :x 1) (add-string win (format nil " Active backends: ~a" (loop for k being the hash-keys of *probabilistic-backends* collect k)) :y 2 :x 1) (add-string win (format nil " Cascade: ~{~a~^, ~}" (mapcar (lambda (k) (string-downcase (string k))) *provider-cascade*)) :y 3 :x 1) (add-string win (format nil " Model selector: ~a" (if (boundp '*model-selector*) (symbol-value '*model-selector*) "none")) :y 4 :x 1) (refresh win))) #+end_src ** Connection #+begin_src lisp (defun connect-daemon (&optional (host "127.0.0.1") (port 9105)) "Connect to daemon." (handler-case (let ((s (usocket:socket-connect host port :element-type '(unsigned-byte 8)))) (setf *stream* (usocket:socket-stream s)) (setf *message-queue* nil) (bt:make-thread (lambda () (reader-thread *stream*)) :name "tui-reader") (push (cons :system "* Connected *") *chat-history*) (log-message "Connected to ~a:~a" host port) t) (error (c) (push (cons :system (format nil "* Connection failed: ~a *" c)) *chat-history*) nil))) (defun disconnect-daemon () "Disconnect from daemon." (when *stream* (ignore-errors (close *stream*)) (setf *stream* nil) (push (cons :system "* Disconnected *") *chat-history*))) #+end_src ** Main event loop #+begin_src lisp (defun tui-main () "Entry point for the TUI client." (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil) (let* ((h (or (height scr) 24)) (w (or (width scr) 80)) (input-h 1) (config-h 0) (chat-h (- h input-h config-h 3)) (status-win (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1)) (chat-win (make-instance 'window :height chat-h :width (- w 2) :y 3 :x 1)) (config-win (make-instance 'window :height 0 :width (- w 2) :y (- h input-h config-h 1) :x 1)) (input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))) ;; Enable function key processing (must be set per-window) (setf (input-blocking input-win) nil) (setf (function-keys-enabled-p input-win) t) (setf (function-keys-enabled-p chat-win) t) (setf *is-running* t *tui-mode* :chat *input-buffer* nil) (connect-daemon) ;; First-run: no providers configured → show welcome (when (zerop (hash-table-count *probabilistic-backends*)) (push (cons :system "* Welcome to Passepartout! *") *chat-history*) (push (cons :system "No LLM providers configured. Press F2 to open the config panel, then [1] Providers to set up.") *chat-history*) (push (cons :system "For free online models, set OPENROUTER_API_KEY in your .env (or via the TUI).") *chat-history*)) (setf *chat-scroll-pos* 0) (status-render status-win) (chat-render chat-win chat-h) (input-render input-win) (loop :while *is-running* :do ;; drain message queue (dolist (msg (message-queue-drain)) (push (cons :received (let ((p (proto-get msg :payload))) (or (proto-get p :text) (format nil "~a" msg)))) *chat-history*)) ;; handle input (let ((ch (get-char input-win))) (when (and ch (not (equal ch -1))) (log-message "KEY: ~s type=~s" ch (type-of ch)) (cond ;; F2 (or any integer key >= 265): toggle config panel ((and (integerp ch) (>= ch 265) (<= ch 280)) (if (eq *tui-mode* :chat) (progn (setf *tui-mode* :config) (setf *config-panel-height* 10) (setf config-h *config-panel-height*) (setf chat-h (- h input-h config-h 3)) (resize chat-win chat-h (- w 2)) (resize config-win config-h (- w 2)) (config-render config-win)) (progn (setf *tui-mode* :chat) (setf config-h 0) (setf chat-h (- h input-h 3)) (resize chat-win chat-h (- w 2)) (resize config-win 0 (- w 2)) (chat-render chat-win chat-h))) (status-render status-win)) ;; Config mode key handling ((eq *tui-mode* :config) (cond ((or (eql ch #\q) (eql ch #\Q)) (setf *tui-mode* :chat config-h 0 chat-h (- h input-h 3)) (resize chat-win chat-h (- w 2)) (resize config-win 0 (- w 2)) (chat-render chat-win chat-h) (status-render status-win)) ((eql ch #\1) (config-render-providers config-win)) ((eql ch #\2) (config-render-cascade config-win)) ((eql ch #\3) (config-render-models config-win)) ((eql ch #\4) (config-render-view config-win)))) (status-render status-win)) ;; Chat mode key handling (t (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) (input-render input-win) (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 ((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 ((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 ((or (eq ch :ppage) (eql ch 339)) (setf *chat-scroll-pos* (+ *chat-scroll-pos* 10)) (chat-render chat-win chat-h) (status-render status-win)) ;; Page Down ((or (eq ch :npage) (eql ch 338)) (setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* 10))) (chat-render chat-win chat-h) (status-render status-win)) ;; Printable character ((characterp ch) (push ch *input-buffer*) (input-render input-win)) ;; Integer key code ((integerp ch) (let ((converted (code-char ch))) (when (and converted (graphic-char-p converted)) (push converted *input-buffer*) (input-render input-win)))))))) (refresh scr) (sleep 0.01)) (disconnect-daemon)))) #+end_src