amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix(tui): correct unknown event type specifier
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Details

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-27 19:05:57 -04:00
parent 2e8e79a193
commit 43986fda9c
1 changed files with 48 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

129
harness/tui-client.org
View File

@@ -27,7 +27,6 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t)) (defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
(defvar *command-history* (make-array 0 :element-type 't :fill-pointer 0 :adjustable t)) (defvar *command-history* (make-array 0 :element-type 't :fill-pointer 0 :adjustable t))
(defvar *history-index* -1) (defvar *history-index* -1)
(defvar *input-mode* :single) ; :single or :multi
(defvar *is-running* t) (defvar *is-running* t)
(defvar *queue-lock* (bt:make-lock)) (defvar *queue-lock* (bt:make-lock))
(defvar *incoming-msgs* nil) (defvar *incoming-msgs* nil)
@@ -39,29 +38,24 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(defun add-to-history (cmd) (defun add-to-history (cmd)
"Add command to history, preserving most recent." "Add command to history, preserving most recent."
(when (and cmd (> (length cmd) 0)) (when (and cmd (> (length cmd) 0))
;; Don't duplicate the last command
(unless (and (> (length *command-history*) 0) (unless (and (> (length *command-history*) 0)
(string= cmd (aref *command-history* (1- (length *command-history*)))))) (string= cmd (aref *command-history* (1- (length *command-history*)))))
(vector-push-extend cmd *command-history* :adjustable t)) (vector-push-extend cmd *command-history* :adjustable t))
(setf *history-index* (length *command-history*)))) (setf *history-index* (length *command-history*))))
(defun history-previous () (defun history-previous ()
"Navigate to previous command in history."
(when (> (length *command-history*) 0) (when (> (length *command-history*) 0)
(setf *history-index* (max 0 (1- *history-index*))) (setf *history-index* (max 0 (1- *history-index*)))
(let ((cmd (aref *command-history* *history-index*))) (let ((cmd (aref *command-history* *history-index*)))
(setf (fill-pointer *input-buffer*) 0) (setf (fill-pointer *input-buffer*) 0)
(loop for ch across cmd do (vector-push-extend ch *input-buffer*)) (loop for ch across cmd do (vector-push-extend ch *input-buffer*)))))
cmd)))
(defun history-next () (defun history-next ()
"Navigate to next command in history."
(when (and *history-index* (< *history-index* (1- (length *command-history*)))) (when (and *history-index* (< *history-index* (1- (length *command-history*))))
(setf *history-index* (1+ *history-index*)) (setf *history-index* (1+ *history-index*))
(let ((cmd (aref *command-history* *history-index*))) (let ((cmd (aref *command-history* *history-index*)))
(setf (fill-pointer *input-buffer*) 0) (setf (fill-pointer *input-buffer*) 0)
(loop for ch across cmd do (vector-push-extend ch *input-buffer*)) (loop for ch across cmd do (vector-push-extend ch *input-buffer*))))
cmd))
(when (>= *history-index* (1- (length *command-history*))) (when (>= *history-index* (1- (length *command-history*)))
(setf (fill-pointer *input-buffer*) 0))) (setf (fill-pointer *input-buffer*) 0)))
@@ -81,7 +75,6 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
msg)) msg))
(defun format-payload (payload) (defun format-payload (payload)
"Extracts human-readable text from a protocol payload, handling nested tool calls."
(let* ((action (getf payload :ACTION)) (let* ((action (getf payload :ACTION))
(text (getf payload :TEXT)) (text (getf payload :TEXT))
(msg (getf payload :MESSAGE)) (msg (getf payload :MESSAGE))
@@ -102,13 +95,12 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(t (format nil "~s" payload))))) (t (format nil "~s" payload)))))
(defun format-incoming (msg) (defun format-incoming (msg)
"Formats incoming message with styling."
(let ((type (or (getf msg :TYPE) (getf msg :type))) (let ((type (or (getf msg :TYPE) (getf msg :type)))
(payload (or (getf msg :PAYLOAD) (getf msg :payload)))) (payload (or (getf msg :PAYLOAD) (getf msg :payload))))
(cond (cond
((and (listp msg) (eq type :EVENT)) ((and (listp msg) (eq type :EVENT))
(let ((action (or (getf payload :ACTION) (getf payload :action))) (let ((action (or (getf payload :ACTION) (getf payload :action)))
(text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))) (text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
(cond ((eq action :handshake) (format nil "👋 ~a" (or text "Connected"))) (cond ((eq action :handshake) (format nil "👋 ~a" (or text "Connected")))
((eq action :thinking) (format nil "🤔 ~a" (or text "Thinking..."))) ((eq action :thinking) (format nil "🤔 ~a" (or text "Thinking...")))
((eq action :tool-complete) (format nil "🔧 Done")) ((eq action :tool-complete) (format nil "🔧 Done"))
@@ -116,98 +108,81 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(t (format nil "📢 ~s" msg))))) (t (format nil "📢 ~s" msg)))))
((and (listp msg) (eq type :STATUS)) ((and (listp msg) (eq type :STATUS))
(format nil "🔄 Scribe: ~a | Gardener: ~a" (format nil "🔄 Scribe: ~a | Gardener: ~a"
(or (getf msg :SCRIBE) "idle") (or (getf msg :SCRIBE) (getf msg :scribe) "idle")
(or (getf msg :GARDENER) "idle"))) (or (getf msg :GARDENER) (getf msg :gardener) "idle")))
((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG))) ((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
(format-payload payload)) (format-payload payload))
((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT)) ((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
(format nil "🔧 ~a" (getf payload :RESULT))) (format nil "🔧 ~a" (getf payload :RESULT)))
(t (format nil "~s" msg)))) (t (format nil "~s" msg)))))
(defun listen-thread () (defun listen-thread ()
(loop while *is-running* do (loop :while *is-running* :do
(handler-case (handler-case
(when (and *stream* (open-stream-p *stream*)) (when (and *stream* (open-stream-p *stream*))
(let ((raw-msg (opencortex:read-framed-message *stream*))) (let ((raw-msg (opencortex:read-framed-message *stream*)))
(unless (member raw-msg '(:eof :error)) (cond ((eq raw-msg :eof) (setf *is-running* nil))
(let* ((msg (clean-keywords raw-msg)) ((eq raw-msg :error) (setf *status-text* "Protocol Error"))
(type (or (getf msg :TYPE) (getf msg :type))) ((not (null raw-msg))
(payload (or (getf msg :PAYLOAD) (getf msg :payload)))) (let* ((msg (clean-keywords raw-msg))
(cond ((and (listp msg) (eq type :EVENT)) (type (getf msg :TYPE))
(let ((action (or (getf payload :ACTION) (getf payload :action))) (payload (getf msg :PAYLOAD)))
(text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message)))) (cond ((and (eq type :EVENT) (eq (getf payload :ACTION) :handshake))
(cond ((eq action :handshake) (setf *status-text* "Ready")) (setf *status-text* "Ready"))
(text (enqueue-msg (format nil "SYSTEM: ~a" text)))))) ((eq type :STATUS)
((and (listp msg) (eq type :STATUS)) (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]"
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (or (getf msg :SCRIBE) "idle")
(or (getf msg :SCRIBE) (getf msg :scribe)) (or (getf msg :GARDENER) "idle"))))
(or (getf msg :GARDENER) (getf msg :gardener))))) (t (let ((formatted (format-incoming msg)))
((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG))) (when formatted (enqueue-msg formatted))))))))))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
(when (eq raw-msg :eof) (setf *is-running* nil))
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
(error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil))) (error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
(sleep 0.05))) (sleep 0.05)))
(defun main () (defun main ()
(handler-case (handler-case
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*)) (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Error connecting: ~a~%" e) (return-from main))) (error (e) (format t "Error connecting to Brain (port ~a): ~a~%" *daemon-port* e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*)) (setf *stream* (usocket:socket-stream *socket*))
(bt:make-thread #'listen-thread :name "tui-listener") (bt:make-thread #'listen-thread :name "tui-listener")
(unwind-protect (unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t :window-border-chars #\┌#\─#\┐#\│#\└#\┘#\─#\│) (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
(let* ((h (height scr)) (let* ((h (height scr))
(w (width scr)) (w (width scr))
(chat-height (- h 5)) (chat-win (make-instance 'window :height (- h 5) :width (- w 2) :position (list 1 1) :border t))
(chat-win (make-instance 'window :height chat-height :width (- w 2) :position (list 1 1) :border t))
(status-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 4) 1) :border t)) (status-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 4) 1) :border t))
(help-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 3) 1))) (help-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 3) 1)))
(input-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 2) 1) :border t)) (input-win (make-instance 'window :height 1 :width (- w 2) :position (list (- h 2) 1) :border t))
(last-status nil)) (last-status nil))
;; Draw help once (add-string help-win "↑↓ History | Esc Clear | /help /exit" :y 0 :x 0 :attributes '(:bold))
(add-string help-win "↑↓ History | Esc Clear | /help /exit | Multi-line: Shift+Enter" :y 0 :x 0 :attributes '(:bold))
(refresh help-win) (refresh help-win)
(setf (function-keys-enabled-p input-win) t)
(setf (input-blocking input-win) nil) (setf (input-blocking input-win) nil)
(loop while *is-running* do (loop :while *is-running* :do
;; 1. Handle incoming messages ;; 1. Handle incoming messages
(let ((new-msgs (dequeue-msgs))) (let ((new-msgs (dequeue-msgs)))
(when new-msgs (when new-msgs
(dolist (msg new-msgs) (dolist (m new-msgs)
(let ((formatted (format-incoming msg))) (push m *chat-history*)
(when formatted (when (> (length *chat-history*) 500) (setf *chat-history* (subseq *chat-history* 0 500))))
(push formatted *chat-history*)
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))))
(clear chat-win) (clear chat-win)
(let ((line-num 1)) (let ((line-num 1))
(dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- chat-height 3))))) (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- (height chat-win) 2)))))
(add-string chat-win (format nil "│ ~a" m) :y line-num :x 1) (add-string chat-win (format nil "│ ~a" m) :y line-num :x 1)
(incf line-num))) (incf line-num)))
;; Add border line count
(add-string chat-win (format nil "├─ ~d messages" (length *chat-history*)) :y (1- chat-height) :x 1 :attributes '(:dim))
(refresh chat-win))) (refresh chat-win)))
;; 2. Render Status Bar ONLY if changed ;; 2. Render Status Bar
(unless (equal *status-text* last-status) (unless (equal *status-text* last-status)
(clear status-win) (clear status-win)
(add-string status-win (format nil "┤ ~a ┤" *status-text*) :y 0 :x 1 :attributes '(:reverse)) (add-string status-win (format nil "┤ ~a ┤" *status-text*) :y 0 :x 1 :attributes '(:reverse))
(refresh status-win) (refresh status-win)
(setf last-status *status-text*)) (setf last-status *status-text*))
;; 3. Handle Keyboard Input ;; 3. Keyboard Input
(let* ((event (get-wide-event input-win)) (let* ((event (get-event input-win))
(ch (and event (typep event 'event) (event-key event)))) (ch (when (and event (typep event 'event)) (event-key event))))
(when ch (when ch
(cond (cond
((or (eq ch #\Newline) (eq ch #\Return)) ((or (eq ch #\Newline) (eq ch #\Return))
@@ -216,35 +191,27 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(when (> (length cmd) 0) (when (> (length cmd) 0)
(add-to-history cmd) (add-to-history cmd)
(enqueue-msg (format nil "⬆ ~a" cmd)) (enqueue-msg (format nil "⬆ ~a" cmd))
(let ((framed (opencortex:frame-message (list :TYPE :EVENT (handler-case
:META (list :SOURCE :tui :SESSION-ID "default") (when (and *stream* (open-stream-p *stream*))
:PAYLOAD (list :SENSOR :user-input :TEXT cmd))))) (format *stream* "~a" (opencortex:frame-message (list :TYPE :EVENT
(format *stream* "~a" framed) :META (list :SOURCE :tui :SESSION-ID "default")
(finish-output *stream*))) :PAYLOAD (list :SENSOR :user-input :TEXT cmd))))
(finish-output *stream*))
(error (c) (enqueue-msg (format nil "ERROR SENDING: ~a" c)))))
(when (string= cmd "/exit") (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))))
(when (string= cmd "/help") ((or (eq ch :up) (eq ch :key-up)) (history-previous))
(enqueue-msg "Available commands: /help /exit /clear /status") ((or (eq ch :down) (eq ch :key-down)) (history-next))
(enqueue-msg "Use ↑↓ for history, Esc to clear input")))) ((or (eq ch :backspace) (eq ch :key-backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch (code-char 127)))
((eq ch :up) (history-previous))
((eq ch :down) (history-next))
((eq ch :escape)
(setf (fill-pointer *input-buffer*) 0)
(setf *history-index* (length *command-history*)))
((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
(when (> (fill-pointer *input-buffer*) 0) (when (> (fill-pointer *input-buffer*) 0)
(decf (fill-pointer *input-buffer*)))) (decf (fill-pointer *input-buffer*))))
((eq ch :shift-left) ; Shift+Enter for multi-line
(vector-push-extend #\Newline *input-buffer*))
((characterp ch) ((characterp ch)
(vector-push-extend ch *input-buffer*)))) (vector-push-extend ch *input-buffer*))))
(clear input-win) (clear input-win)
(let ((prompt (if (> (fill-pointer *input-buffer*) 0) "│" "▶"))) (add-string input-win (format nil "▶ ~a" (coerce *input-buffer* 'string)) :y 0 :x 1)
(add-string input-win (format nil "~a ~a" prompt (coerce *input-buffer* 'string)) :y 0 :x 1 :attributes (when (> (fill-pointer *input-buffer*) 0) '(:bold))))
(refresh input-win)) (refresh input-win))
(sleep 0.02)))) (sleep 0.02))))
(setf *is-running* nil) (setf *is-running* nil)
(when *socket* (usocket:socket-close *socket*)))) (when *socket* (ignore-errors (usocket:socket-close *socket*)))))
#+end_src #+end_src