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

fix(tui): Definitive repair of parenthesis balance in TUI client
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Details

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-19 20:41:25 -04:00
parent b7622feb38
commit 6be28ba790
2 changed files with 70 additions and 130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
src/communication.lisp
View File

@@ -1,15 +1,12 @@
(in-package :opencortex) (in-package :opencortex)
(defvar *actuator-registry* (make-hash-table :test 'equalp) (defvar *actuator-registry* (make-hash-table :test 'equalp))
"Global registry mapping target keywords to their physical actuator functions.")
(defun register-actuator (name fn) (defun register-actuator (name fn)
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
(setf (gethash key *actuator-registry*) fn))) (setf (gethash key *actuator-registry*) fn)))
(defun frame-message (msg-plist) (defun frame-message (msg-plist)
"Frames a Lisp plist with a 6-character hex length and a newline for stream integrity."
(let* ((*print-pretty* nil) (let* ((*print-pretty* nil)
(*print-circle* nil) (*print-circle* nil)
(msg-string (format nil "~s" msg-plist)) (msg-string (format nil "~s" msg-plist))
@@ -17,41 +14,25 @@
(format nil "~6,'0x~a~%" len msg-string))) (format nil "~6,'0x~a~%" len msg-string)))
(defun read-framed-message (stream) (defun read-framed-message (stream)
"Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace."
(let ((length-buffer (make-string 6))) (let ((length-buffer (make-string 6)))
(handler-case (handler-case
(progn (progn
;; 1. Skip leading whitespace (newlines, spaces, etc.)
(loop for char = (peek-char nil stream nil :eof) (loop for char = (peek-char nil stream nil :eof)
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
do (read-char stream)) do (read-char stream))
;; 2. Read the 6-char hex length
(let ((count (read-sequence length-buffer stream))) (let ((count (read-sequence length-buffer stream)))
(cond ((< count 6) :eof) (if (< count 6) :eof
(t (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
(if (not len) (if (not len) :error
(progn
(harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
:error)
(let ((msg-buffer (make-string len))) (let ((msg-buffer (make-string len)))
(read-sequence msg-buffer stream) (read-sequence msg-buffer stream)
(let ((*read-eval* nil) (let ((*read-eval* nil) (*print-pretty* nil))
(*print-pretty* nil))
(handler-case (handler-case
(let ((msg (read-from-string msg-buffer))) (let ((msg (read-from-string msg-buffer)))
(validate-communication-protocol-schema msg) (validate-communication-protocol-schema msg)
msg) msg)
(error (c) (error (c) :error)))))))))
(harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer) (error (c) :error))))
:error))))))))))
(error (c)
(harness-log "PROTOCOL READ ERROR: ~a" c)
:error))))
(defun make-hello-message (version) (defun make-hello-message (version)
"Constructs the standard HELLO handshake message." (list :TYPE :EVENT :PAYLOAD (list :ACTION :handshake :VERSION version :CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
(list :TYPE :EVENT
:PAYLOAD (list :ACTION :handshake
:VERSION version
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))

103
src/tui-client.lisp
View File

@@ -1,35 +1,26 @@
(in-package :cl-user) (in-package :cl-user)
(defpackage :opencortex.tui (defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
(:use :cl :croatoan)
(:export :main))
(in-package :opencortex.tui) (in-package :opencortex.tui)
(defvar *daemon-host* "127.0.0.1") (defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105) (defvar *daemon-port* 9105)
(defvar *socket* nil) (defvar *socket* nil)
(defvar *stream* nil) (defvar *stream* nil)
(defvar *chat-history* (list)) (defvar *chat-history* nil)
(defvar *status-text* "Connecting...") (defvar *status-text* "Connecting...")
(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 *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)
(defun enqueue-msg (msg) (defun enqueue-msg (msg) (bt:with-lock-held (*queue-lock*) (push msg *incoming-msgs*)))
(bt:with-lock-held (*queue-lock*) (defun dequeue-msgs () (bt:with-lock-held (*queue-lock*) (let ((msgs (nreverse *incoming-msgs*))) (setf *incoming-msgs* nil) msgs)))
(push msg *incoming-msgs*)))
(defun dequeue-msgs ()
(bt:with-lock-held (*queue-lock*)
(let ((msgs (nreverse *incoming-msgs*)))
(setf *incoming-msgs* nil)
msgs)))
(defun clean-keywords (msg) (defun clean-keywords (msg)
(if (listp msg) (if (listp msg)
(let ((clean nil)) (let ((clean nil))
(loop for (k v) on msg by #'cddr (loop for (k v) on msg by #'cddr
do (push (intern (string k) :keyword) clean) do (push (intern (string-upcase (string k)) :keyword) clean)
(push v clean)) (push v clean))
(nreverse clean)) (nreverse clean))
msg)) msg))
@@ -41,23 +32,17 @@
(let ((raw-msg (opencortex:read-framed-message *stream*))) (let ((raw-msg (opencortex:read-framed-message *stream*)))
(unless (member raw-msg '(:eof :error)) (unless (member raw-msg '(:eof :error))
(let* ((msg (clean-keywords raw-msg)) (let* ((msg (clean-keywords raw-msg))
(type (or (getf msg :TYPE) (getf msg :type))) (type (getf msg :TYPE))
(payload (or (getf msg :PAYLOAD) (getf msg :payload)))) (payload (getf msg :PAYLOAD)))
(cond ((and (listp msg) (eq type :EVENT)) (cond ((eq type :EVENT)
(let ((action (or (getf payload :ACTION) (getf payload :action))) (when (eq (getf payload :ACTION) :HANDSHAKE) (setf *status-text* "Ready")))
(text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message)))) ((eq type :STATUS)
(cond ((eq action :handshake) (setf *status-text* "Ready")) (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (getf msg :SCRIBE) (getf msg :GARDENER))))
(text (enqueue-msg (format nil "SYSTEM: ~a" text)))))) ((eq type :CHAT)
((and (listp msg) (eq type :STATUS)) (let ((text (getf msg :TEXT))) (when text (enqueue-msg text))))
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (t (enqueue-msg (format nil "MSG: ~s" msg))))))
(or (getf msg :SCRIBE) (getf msg :scribe)) (when (eq raw-msg :eof) (setf *is-running* nil))))
(or (getf msg :GARDENER) (getf msg :gardener))))) (error (c) (setf *is-running* nil)))
((and (listp msg) (eq type :CHAT))
(let ((text (or (getf msg :TEXT) (getf msg :text)))) (when text (enqueue-msg text))))
(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)))
(sleep 0.05))) (sleep 0.05)))
(defun main () (defun main ()
@@ -65,69 +50,43 @@
(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: ~a~%" 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)
(unwind-protect (unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t) (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-win (make-instance 'window :height (- h 2) :width w :position (list 0 0))) (chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0)))
(status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0))) (status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0)))
(input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0))) (input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
(last-status nil)) (last-status nil))
(setf (function-keys-enabled-p input-win) t) (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 (let ((new (dequeue-msgs)))
(let ((new-msgs (dequeue-msgs))) (when new
(when new-msgs (dolist (m new) (push m *chat-history*))
(dolist (msg new-msgs)
(push msg *chat-history*)
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
(clear chat-win) (clear chat-win)
(let ((line-num 0)) (let ((line 0)) (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3))))) (add-string chat-win m :y line :x 0) (incf line)))
(dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3)))))
(add-string chat-win m :y line-num :x 0)
(incf line-num)))
(refresh chat-win))) (refresh chat-win)))
;; 2. Render Status Bar ONLY if changed
(unless (equal *status-text* last-status) (unless (equal *status-text* last-status)
(clear status-win) (clear status-win) (add-string status-win *status-text* :attributes '(:reverse)) (refresh status-win) (setf last-status *status-text*))
(add-string status-win *status-text* :attributes '(:reverse)) (let* ((ev (get-wide-event input-win)) (ch (and ev (typep ev 'event) (event-key ev))))
(refresh status-win)
(setf last-status *status-text*))
;; 3. Handle Keyboard Input
(let* ((event (get-wide-event input-win))
(ch (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))
(let ((cmd (coerce *input-buffer* 'string))) (let ((cmd (coerce *input-buffer* 'string)))
(setf (fill-pointer *input-buffer*) 0) (setf (fill-pointer *input-buffer*) 0)
(when (> (length cmd) 0) (when (> (length cmd) 0)
;; Local Echo
(enqueue-msg (concatenate 'string "> " cmd)) (enqueue-msg (concatenate 'string "> " cmd))
;; Send to Brain (let ((framed (opencortex:frame-message (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :TEXT cmd)))))
(let ((framed (opencortex:frame-message (format nil "~s" (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :TEXT cmd))))))
(format *stream* "~a" framed) (format *stream* "~a" framed)
(finish-output *stream*))) (finish-output *stream*))
(when (string= cmd "/exit") (setf *is-running* nil)))) (when (string= cmd "/exit") (setf *is-running* nil)))))
((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del)) ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout))
(when (> (length *input-buffer*) 0) (when (> (length *input-buffer*) 0) (decf (fill-pointer *input-buffer*))))
(decf (fill-pointer *input-buffer*))))
((characterp ch) ((characterp ch)
(vector-push-extend ch *input-buffer*)))) (vector-push-extend ch *input-buffer*))))
(clear input-win) (clear input-win)
(add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string))) (add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
(move input-win 0 (+ 2 (length *input-buffer*))) (move input-win 0 (+ 2 (length *input-buffer*)))
(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* (usocket:socket-close *socket*))))