8.3 KiB
8.3 KiB
Passepartout TUI — Controller
Controller
Event handlers + daemon I/O + main loop.
Contract
- (on-key ch): dispatches key presses: Enter triggers send, Backspace deletes, arrows scroll chat. Non-printable keys are ignored.
- (on-daemon-msg msg): processes inbound daemon messages. Routes responses to chat display, routes errors to log.
- (send-daemon msg): serializes and sends a message to the daemon over the framed TCP protocol.
- (handle-return stream): processes the return key: extracts the
input buffer, sends to daemon, clears buffer. Handles connection
loss gracefully (enqueues error to
*incoming-msgs*). - (tui-main): the main loop — connects to daemon, initializes
Croatoan windows, runs render/input event loop at
30fps.
Event Handlers
(in-package :passepartout.gateway-tui)
(defun on-key (&rest args)
(let ((ch (car args)))
(cond
;; Enter
((or (eql ch 10) (eql ch 13) (eq ch :enter)
(eql ch #\Newline) (eql ch #\Return))
(let ((text (string-trim '(#\Space #\Tab) (input-string))))
(when (> (length text) 0)
(push text (st :input-history))
(setf (st :input-hpos) 0)
(setf (st :scroll-offset) 0)
(cond
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
(handler-case
(let* ((*read-eval* t)
(*package* (find-package :passepartout.gateway-tui))
(r (eval (read-from-string (subseq text 6)))))
(add-msg :system (format nil "=> ~s" r)))
(error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
;; Normal message
(t
(add-msg :user text)
(send-daemon (list :type :event
:payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil)
(setf (st :dirty) (list t t t)))))
;; Backspace
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
(when (st :input-buffer) (pop (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))
;; Up arrow
((or (eq ch :up) (eql ch 259))
(let* ((h (st :input-history)) (p (st :input-hpos)))
(when (and h (< p (1- (length h))))
(incf (st :input-hpos))
(setf (st :input-buffer)
(reverse (coerce (nth (st :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; Down arrow
((or (eq ch :down) (eql ch 258))
(when (> (st :input-hpos) 0)
(decf (st :input-hpos))
(let ((h (st :input-history)))
(setf (st :input-buffer)
(if (and h (< (st :input-hpos) (length h)))
(reverse (coerce (nth (st :input-hpos) h) 'list))
nil))
(setf (st :dirty) (list nil nil t)))))
;; PageUp
((or (eq ch :ppage) (eql ch 339))
(incf (st :scroll-offset) 5)
(setf (st :dirty) (list nil t nil)))
;; PageDown
((or (eq ch :npage) (eql ch 338))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
(setf (st :dirty) (list nil t nil)))
;; Printable
(t
(let ((chr (typecase ch
(character ch)
(integer (code-char ch))
(t nil))))
(when (and chr (graphic-char-p chr))
(push chr (st :input-buffer))
(setf (st :dirty) (list nil nil t))))))))
(defun on-daemon-msg (msg)
(let* ((payload (getf msg :payload))
(text (getf payload :text))
(action (getf payload :action)))
(cond
(text (add-msg :agent text))
((eq action :handshake)
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
(t (add-msg :agent (format nil "~a" msg))))))Daemon Communication
(defun send-daemon (msg)
(let ((s (st :stream)))
(when (and s (open-stream-p s))
(handler-case
(progn
(format s "~a" (frame-message msg))
(finish-output s))
(error (c) (log-message "TUI-SEND: ~a" c))))))
(defun recv-daemon (s)
(handler-case
(let* ((hdr (make-string 6)) (n 0))
(loop while (< n 6)
do (let ((ch (read-char s nil)))
(unless ch (return-from recv-daemon nil))
(setf (char hdr n) ch) (incf n)))
(let* ((len (parse-integer hdr :radix 16 :junk-allowed t))
(buf (make-string (or len 0))))
(when (and len (> len 0))
(loop for i from 0 below len
do (let ((ch (read-char s nil)))
(unless ch (return-from recv-daemon nil))
(setf (char buf i) ch)))
(let ((*read-eval* nil))
(read-from-string buf)))))
(error (c) (log-message "TUI-RECV: ~a" c) nil)))
(defun reader-loop (s)
(loop while (and (st :running) (open-stream-p s))
do (let ((msg (recv-daemon s)))
(when msg (queue-event (list :type :daemon :payload msg))))))Connection
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
(handler-case
(let ((s (usocket:socket-connect host port :element-type 'character)))
(setf (st :stream) (usocket:socket-stream s) (st :connected) t)
(bt:make-thread (lambda () (reader-loop (st :stream))) :name "tui-reader")
(add-msg :system "* Connected *")
t)
(error (c)
(add-msg :system (format nil "* Connection failed: ~a *" c))
nil)))
(defun disconnect-daemon ()
(when (st :stream)
(ignore-errors (close (st :stream)))
(setf (st :stream) nil (st :connected) nil)
(add-msg :system "* Disconnected *")))Main Loop
(defun tui-main ()
(init-state)
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
(let* ((h (or (height scr) 24))
(w (or (width scr) 80))
(sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
(ch (- h 5))
(cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
(iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
(swank-port (or (ignore-errors
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
4006)))
(setf (function-keys-enabled-p iw) t
(st :dirty) (list t t t))
(connect-daemon)
(when (> swank-port 0)
(handler-case
(progn
(ql:quickload :swank :silent t)
(funcall (find-symbol "CREATE-SERVER" "SWANK")
:port swank-port :dont-close t)
(add-msg :system
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
(error ()
(add-msg :system "* Swank unavailable *"))))
(loop while (st :running) do
(dolist (ev (drain-queue))
(when (eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload))))
(let ((ch (get-char iw)))
(when (and ch (not (equal ch -1)))
(on-key ch)))
(redraw sw cw ch iw)
(refresh scr)
(sleep 0.03))
(disconnect-daemon))))Test Suite
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-tests
(:use :cl :passepartout)
(:export #:tui-suite))
(in-package :passepartout-tui-tests)
(fiveam:def-suite tui-suite :description "Verification of the TUI parsing and styling logic")
(fiveam:in-suite tui-suite)
(fiveam:test test-tui-connection-drop
"Contract 4: handle-return enqueues error on connection loss."
(let ((passepartout.gateway-tui::*incoming-msgs* nil)
(passepartout.gateway-tui::*input-buffer* (make-array 5 :element-type 'character :initial-contents "hello" :fill-pointer 5 :adjustable t))
(mock-stream (make-string-output-stream)))
(close mock-stream)
(passepartout.gateway-tui::handle-return mock-stream)
(fiveam:is (member "ERROR: Connection to daemon lost." passepartout.gateway-tui::*incoming-msgs* :test #'string=))))