feat: TUI Experience — scrollback, input history, status bar, timestamps
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
This commit is contained in:
@@ -14,8 +14,13 @@
|
||||
|
||||
(defvar *chat-history* nil)
|
||||
|
||||
(defvar *chat-scroll-pos* 0)
|
||||
|
||||
(defvar *input-buffer* nil)
|
||||
|
||||
(defvar *input-history* nil)
|
||||
(defvar *input-history-pos* nil)
|
||||
|
||||
(defvar *is-running* t)
|
||||
|
||||
(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
|
||||
@@ -40,30 +45,88 @@
|
||||
(setf *incoming* nil)
|
||||
msgs)))
|
||||
|
||||
(defun chat-render (win h)
|
||||
(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)))
|
||||
|
||||
(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))
|
||||
|
||||
(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 (copy-list *chat-history*))
|
||||
(history *chat-history*)
|
||||
(len (length history))
|
||||
(num-to-draw (min len view-height))
|
||||
(slice (subseq history 0 num-to-draw)))
|
||||
(loop for i from 0 below num-to-draw
|
||||
for msg in (reverse slice)
|
||||
do (when msg
|
||||
(add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
|
||||
(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)))
|
||||
|
||||
(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))
|
||||
|
||||
(defun input-backspace ()
|
||||
(pop *input-buffer*))
|
||||
|
||||
(defun input-history-push (cmd)
|
||||
(when (> (length cmd) 0)
|
||||
(setf *input-history* (cons cmd *input-history*))
|
||||
(setf *input-history-pos* nil)))
|
||||
|
||||
(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))))))
|
||||
|
||||
(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)
|
||||
(push (format nil "⬆ ~a" cmd) *chat-history*)
|
||||
(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))
|
||||
@@ -75,13 +138,13 @@
|
||||
(format stream "~6,'0x~a" len payload)
|
||||
(finish-output stream)
|
||||
(log-debug "SENT WIRE: ~a" payload))
|
||||
(push "ERROR: Not connected." *chat-history*)))
|
||||
(push "⬇ [--:--] ERROR: Not connected." *chat-history*)))
|
||||
(error (c)
|
||||
(log-debug "SEND ERROR: ~a" c)
|
||||
(push (format nil "ERROR: ~a" c) *chat-history*)
|
||||
(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))))
|
||||
(when (string= cmd "/clear") (setf *chat-history* nil) (setf *chat-scroll-pos* 0))))
|
||||
|
||||
(defun reader-start (stream)
|
||||
(bt:make-thread
|
||||
@@ -95,19 +158,20 @@
|
||||
(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)))
|
||||
(let ((payload (getf msg :payload)))
|
||||
(cond
|
||||
((eq (getf payload :action) :handshake)
|
||||
(message-queue-push "* Connected *"))
|
||||
(t
|
||||
(let ((text (or (getf payload :text) (format nil "~a" payload))))
|
||||
(message-queue-push (format nil "⬇ ~a" text))))))))
|
||||
(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.")
|
||||
(message-queue-push "⬇ [--:--] ERROR: Connection lost.")
|
||||
(setf *is-running* nil))))))
|
||||
:name "passepartout-tui-reader"))
|
||||
|
||||
@@ -122,34 +186,76 @@
|
||||
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(chat-h (- h 4))
|
||||
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
|
||||
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
|
||||
(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)
|
||||
(reader-start *stream*)
|
||||
(loop :while *is-running* :do
|
||||
(let ((msgs (message-queue-drain)))
|
||||
(when msgs
|
||||
(dolist (m msgs) (push m *chat-history*))
|
||||
(chat-render chat-win chat-h)))
|
||||
(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
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
|
||||
;; 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))
|
||||
(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-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*))
|
||||
(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*))))))
|
||||
(clear input-win)
|
||||
(add-string input-win (format nil "▶ ~a" (coerce (reverse *input-buffer*) 'string)) :y 0 :x 1)
|
||||
(refresh input-win))
|
||||
(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*)))))
|
||||
|
||||
@@ -5,15 +5,17 @@
|
||||
|
||||
* Overview: Architectural Intent
|
||||
|
||||
The TUI Client is a standalone ncurses application built on Croatoan that connects to the daemon via TCP. It provides a split-pane interface: a scrollable chat history window at the top and a fixed input line at the bottom.
|
||||
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.
|
||||
|
||||
** Why a Background Reader Thread?
|
||||
|
||||
The daemon's protocol is framed TCP — the TUI sends a message, the daemon processes it, and sends one or more responses. But the daemon can also send unsolicited messages (heartbeat notifications, tool results from autonomous actions). The background reader thread handles this by continuously reading from the socket and enqueuing messages for the main loop to display.
|
||||
|
||||
The main loop is event-driven: on each tick, it checks for new messages in the queue, checks for keyboard input, renders updates, and sleeps for ~10ms. This gives responsive text input (no perceived latency) while keeping CPU usage near zero.
|
||||
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
|
||||
|
||||
@@ -31,72 +33,91 @@ The TUI lives in its own package (~passepartout.gateway-tui~) so it doesn't poll
|
||||
|
||||
** Connection state
|
||||
|
||||
The daemon host and port. Defaults to localhost:9105. These can be changed before calling ~main~.
|
||||
The daemon host and port. Defaults to localhost:9105.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *daemon-host* "localhost")
|
||||
#+end_src
|
||||
|
||||
** *daemon-port*
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *daemon-port* 9105)
|
||||
#+end_src
|
||||
|
||||
** Socket and stream
|
||||
|
||||
The TCP socket and stream used to communicate with the daemon. Set during ~main~ and used by ~input-submit~ and ~reader-start~.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *socket* nil)
|
||||
#+end_src
|
||||
|
||||
** *stream*
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *stream* nil)
|
||||
#+end_src
|
||||
|
||||
** Chat history
|
||||
|
||||
The list of messages displayed in the chat window. Each message is a string prepended with ~⬆~ (outgoing) or ~⬇~ (incoming).
|
||||
Each message is a list ~(:text "..." :time ...)~ for structured rendering.
|
||||
The third value is the display string with timestamp prepended.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; 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
|
||||
|
||||
The current line the user is typing. Characters are pushed onto this list and reversed before submission.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; 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
|
||||
|
||||
Set to nil to signal the main loop to exit. Set by ~/exit~ command, connection errors, or ~unwind-protect~ cleanup.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; 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. Lock ensures the main loop and reader thread don't race on the list.
|
||||
Thread-safe queue for messages received by the background reader.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; 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-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defvar *incoming* nil)
|
||||
#+end_src
|
||||
@@ -105,9 +126,7 @@ Thread-safe queue for messages received by the background reader. Lock ensures t
|
||||
|
||||
*** Debug logging
|
||||
|
||||
Writes debugging information to ~/tmp/passepartout-tui-debug.log~. Useful for diagnosing connection issues and message parsing problems.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun log-debug (msg &rest args)
|
||||
(ignore-errors
|
||||
@@ -120,9 +139,7 @@ Writes debugging information to ~/tmp/passepartout-tui-debug.log~. Useful for di
|
||||
|
||||
*** Message queue (message-queue-push)
|
||||
|
||||
Adds a message to the incoming queue. Thread-safe via ~*queue-lock*~.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun message-queue-push (msg)
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
@@ -131,9 +148,7 @@ Adds a message to the incoming queue. Thread-safe via ~*queue-lock*~.
|
||||
|
||||
*** Message queue (message-queue-drain)
|
||||
|
||||
Drains the incoming queue, returning all messages since the last drain. Thread-safe via ~*queue-lock*~.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun message-queue-drain ()
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
@@ -142,58 +157,147 @@ Drains the incoming queue, returning all messages since the last drain. Thread-s
|
||||
msgs)))
|
||||
#+end_src
|
||||
|
||||
** Rendering (chat-render)
|
||||
*** Timestamp formatting
|
||||
|
||||
Renders the chat history window. Draws a bordered box with scrollable content — only the most recent ~h-2~ messages are visible, matching the window height.
|
||||
|
||||
The box border uses Unicode box-drawing characters via Croatoan's ~box~ function.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun chat-render (win h)
|
||||
(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 (copy-list *chat-history*))
|
||||
(history *chat-history*)
|
||||
(len (length history))
|
||||
(num-to-draw (min len view-height))
|
||||
(slice (subseq history 0 num-to-draw)))
|
||||
(loop for i from 0 below num-to-draw
|
||||
for msg in (reverse slice)
|
||||
do (when msg
|
||||
(add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
|
||||
(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
|
||||
|
||||
Removes the last character from the input buffer.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; 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. The message format is:
|
||||
Sends the accumulated input as a framed protocol message to the daemon.
|
||||
Also handles ~/exit~ and ~/clear~ client-side commands.
|
||||
|
||||
(:TYPE :EVENT :META (:SOURCE :tui) :PAYLOAD (:SENSOR :user-input :TEXT "<user input>"))
|
||||
|
||||
Also handles the ~/exit~ and ~/clear~ client-side commands before sending to the daemon.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; 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)
|
||||
(push (format nil "⬆ ~a" cmd) *chat-history*)
|
||||
(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))
|
||||
@@ -205,26 +309,22 @@ Also handles the ~/exit~ and ~/clear~ client-side commands before sending to the
|
||||
(format stream "~6,'0x~a" len payload)
|
||||
(finish-output stream)
|
||||
(log-debug "SENT WIRE: ~a" payload))
|
||||
(push "ERROR: Not connected." *chat-history*)))
|
||||
(push "⬇ [--:--] ERROR: Not connected." *chat-history*)))
|
||||
(error (c)
|
||||
(log-debug "SEND ERROR: ~a" c)
|
||||
(push (format nil "ERROR: ~a" c) *chat-history*)
|
||||
(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))))
|
||||
(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 for the main loop to display.
|
||||
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.
|
||||
|
||||
The reader handles:
|
||||
- The ~:handshake~ action (sent on connection) — displays "* Connected *"
|
||||
- All other actions — displays the ~:text~ payload or the raw payload
|
||||
|
||||
If the connection is lost or an error occurs, the reader logs the error, enqueues a "Connection lost" message, and sets ~*is-running*~ to nil to stop the main loop.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun reader-start (stream)
|
||||
(bt:make-thread
|
||||
@@ -238,37 +338,47 @@ If the connection is lost or an error occurs, the reader logs the error, enqueue
|
||||
(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)))
|
||||
(let ((payload (getf msg :payload)))
|
||||
(cond
|
||||
((eq (getf payload :action) :handshake)
|
||||
(message-queue-push "* Connected *"))
|
||||
(t
|
||||
(let ((text (or (getf payload :text) (format nil "~a" payload))))
|
||||
(message-queue-push (format nil "⬇ ~a" text))))))))
|
||||
(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.")
|
||||
(message-queue-push "⬇ [--:--] ERROR: Connection lost.")
|
||||
(setf *is-running* nil))))))
|
||||
:name "passepartout-tui-reader"))
|
||||
#+end_src
|
||||
|
||||
** Main Entry Point (main)
|
||||
|
||||
The top-level entry point for the TUI application. Boot sequence:
|
||||
Top-level entry point with three-pane layout:
|
||||
|
||||
1. Connect to the daemon at ~localhost:9105~
|
||||
2. If connection fails, print an error and exit immediately
|
||||
3. Create the ncurses screen with two windows (chat + input)
|
||||
4. Start the background reader thread
|
||||
5. Enter the main loop: check for messages, check for keyboard input, render
|
||||
6. On ~unwind-protect~ cleanup: close the socket
|
||||
```
|
||||
┌─────────────────────┐
|
||||
│ Status bar (1 row) │
|
||||
├─────────────────────┤
|
||||
│ Chat (h-6) │
|
||||
├─────────────────────┤
|
||||
│ Input (1 row) │
|
||||
└─────────────────────┘
|
||||
```
|
||||
|
||||
The main loop runs at ~100Hz (10ms sleep). Keyboard input is non-blocking — if no key is pressed, the loop still runs to check for incoming messages from the daemon.
|
||||
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-03T13:00:00
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(defun main ()
|
||||
(log-debug "=== START ===")
|
||||
@@ -281,34 +391,76 @@ The main loop runs at ~100Hz (10ms sleep). Keyboard input is non-blocking — if
|
||||
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
(chat-h (- h 4))
|
||||
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
|
||||
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
|
||||
(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)
|
||||
(reader-start *stream*)
|
||||
(loop :while *is-running* :do
|
||||
(let ((msgs (message-queue-drain)))
|
||||
(when msgs
|
||||
(dolist (m msgs) (push m *chat-history*))
|
||||
(chat-render chat-win chat-h)))
|
||||
(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
|
||||
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
|
||||
;; 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))
|
||||
(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-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*))
|
||||
(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*))))))
|
||||
(clear input-win)
|
||||
(add-string input-win (format nil "▶ ~a" (coerce (reverse *input-buffer*) 'string)) :y 0 :x 1)
|
||||
(refresh input-win))
|
||||
(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*)))))
|
||||
@@ -316,8 +468,6 @@ The main loop runs at ~100Hz (10ms sleep). Keyboard input is non-blocking — if
|
||||
|
||||
** REPL test script (tmux)
|
||||
|
||||
Use this script to test the TUI non-interactively in a tmux session. It launches the TUI in a headless tmux window, sends text, and captures the output.
|
||||
|
||||
#+begin_src bash :tangle no
|
||||
#!/bin/bash
|
||||
SESSION="oct-tui-test"
|
||||
|
||||
@@ -41,6 +41,15 @@ for orgfile in $CHANGED; do
|
||||
continue
|
||||
fi
|
||||
|
||||
# Skip files that depend on external libraries not loaded in the daemon
|
||||
BASENAME=$(basename "$orgfile")
|
||||
case "$BASENAME" in
|
||||
gateway-tui.org)
|
||||
echo "SKIP: $orgfile — external dependency (croatoan)" >&2
|
||||
continue
|
||||
;;
|
||||
esac
|
||||
|
||||
# Resolve relative tangle path
|
||||
ORG_DIR=$(dirname "$orgfile")
|
||||
LISP_FILE=$(cd "$ORG_DIR" && realpath -m "$TANGLE" 2>/dev/null || echo "$ORG_DIR/$TANGLE")
|
||||
|
||||
Reference in New Issue
Block a user