Amr Gharbeia
b9a4318ef8
- Changed all 50 org file :tangle targets from ../lisp/ to ~/.local/share/passepartout/lisp/ (XDG data dir) - Removed 49 generated .lisp files from project lisp/ directory - Removed tests/system-integration-tests.lisp (generated) - Removed lisp/*.fasl (compiled, stale) - Updated core-manifest.org to tangle .asd to XDG root - Remapped quicklisp symlink: local-projects/passepartout → XDG TUI fixes in channel-tui-main.org: - Removed with-raw-terminal (stty raw breaks fd 0 reads in this SBCL) - Use cat subprocess + pipe for keyboard input (via :input :interactive) - Blocking read-char on pipe with with-timeout 0.1s for daemon processing - Key events queued via drain-queue alongside daemon messages - Full dialog key routing (Escape, Up/Down, Enter, filters, Backspace) - SIGWINCH resize handling - Post-handshake backend-size re-query - Daemon version in status bar (was v0.5.0 hardcoded) - Handshake version stored in state, no add-msg - :daemon-version and :size-queried in state plist - view-status uses draw-rect for background - Test section gated with #+passepartout-tests
173 lines
7.7 KiB
Org Mode
173 lines
7.7 KiB
Org Mode
#+TITLE: Passepartout TUI
|
|
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui.lisp
|
|
|
|
* TUI
|
|
|
|
Direct-rendering TUI using cl-tty backend + framebuffer. Layout by
|
|
~compute-layout~. Three zones: status (3 lines), chat, input.
|
|
|
|
#+begin_src lisp :tangle /home/user/.local/share/passepartout/lisp/channel-tui.lisp
|
|
(in-package :cl-user)
|
|
|
|
(ql:quickload :cl-tty :silent t)
|
|
(ql:quickload :passepartout :silent t)
|
|
(ql:quickload :usocket :silent t)
|
|
(ql:quickload :bordeaux-threads :silent t)
|
|
|
|
(defpackage :passepartout.tui
|
|
(:use :cl :cl-tty.backend :cl-tty.input :cl-tty.rendering :cl-tty.layout)
|
|
(:export #:tui-main))
|
|
(in-package :passepartout.tui)
|
|
|
|
(defvar *messages* (make-array 0 :fill-pointer 0 :adjustable t))
|
|
(defvar *daemon-stream* nil)
|
|
(defvar *event-queue* nil)
|
|
(defvar *event-lock* (bt:make-lock "tui-event"))
|
|
(defvar *streaming-text* nil)
|
|
(defvar *input-buf* nil)
|
|
(defvar *cursor-pos* 0)
|
|
(defvar *connected* nil)
|
|
(defvar *running* t)
|
|
|
|
;; Input
|
|
(defun input-insert-char (ch)
|
|
(let ((pos *cursor-pos*))
|
|
(setf *input-buf* (concatenate 'list (subseq *input-buf* 0 pos) (list ch)
|
|
(subseq *input-buf* pos)))
|
|
(incf *cursor-pos*)))
|
|
|
|
(defun input-delete-char ()
|
|
(when (and *input-buf* (> *cursor-pos* 0))
|
|
(setf *input-buf* (nconc (subseq *input-buf* 0 (1- *cursor-pos*))
|
|
(subseq *input-buf* *cursor-pos*)))
|
|
(decf *cursor-pos*)))
|
|
|
|
(defun input-string () (coerce (reverse *input-buf*) 'string))
|
|
|
|
(defun input-submit ()
|
|
(let ((text (string-trim '(#\Space) (input-string))))
|
|
(when (> (length text) 0)
|
|
(vector-push-extend (list :role :user :content text) *messages*)
|
|
(send-daemon `(:type :event :payload (:sensor :user-input :text ,text)))
|
|
(setf *input-buf* nil *cursor-pos* 0))))
|
|
|
|
;; Daemon
|
|
(defun send-daemon (msg)
|
|
(let ((s *daemon-stream*))
|
|
(when (and s (open-stream-p s))
|
|
(handler-case
|
|
(let ((str (prin1-to-string msg)))
|
|
(format s "~6,'0X~A" (length str) str)
|
|
(finish-output s))
|
|
(error () nil)))))
|
|
|
|
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
|
|
(handler-case
|
|
(let ((s (usocket:socket-connect host port :timeout 5)))
|
|
(setf *daemon-stream* (usocket:socket-stream s) *connected* t)
|
|
(bt:make-thread (lambda () (reader-loop)) :name "tui-reader")
|
|
(vector-push-extend '(:role :system :content "* Connected *") *messages*))
|
|
(error (c)
|
|
(vector-push-extend (list :role :system :content
|
|
(format nil "* Connection failed: ~A *" c))
|
|
*messages*))))
|
|
|
|
(defun reader-loop ()
|
|
(loop while *running*
|
|
for msg = (handler-case
|
|
(let* ((hdr (make-string 6)) (n 0))
|
|
(loop while (< n 6)
|
|
do (let ((ch (read-char *daemon-stream* nil)))
|
|
(unless ch (return-from reader-loop 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 *daemon-stream* nil)))
|
|
(unless ch (return-from reader-loop nil))
|
|
(setf (char buf i) ch)))
|
|
(let ((*read-eval* nil)) (read-from-string buf)))))
|
|
(error () nil))
|
|
if msg do (bt:with-lock-held (*event-lock*) (push msg *event-queue*))
|
|
else do (sleep 0.5)))
|
|
|
|
;; Render
|
|
(defun render-frame (fb w h)
|
|
(backend-clear fb)
|
|
(let ((fg (if *connected* "#00FF00" "#FF4444")))
|
|
(draw-text fb 1 1
|
|
(format nil " Passepartout ~a [CHAT] msgs:~d"
|
|
(if *connected* "● Connected" "○ Disconnected")
|
|
(length *messages*))
|
|
fg nil)
|
|
(draw-text fb 1 2 " Ctrl+P: palette Ctrl+Q: quit /help: help" "#888888" nil))
|
|
(let ((y 4))
|
|
(loop for i from (1- (length *messages*)) downto 0
|
|
for msg = (aref *messages* i)
|
|
do (let* ((role (getf msg :role))
|
|
(content (getf msg :content))
|
|
(fg (case role (:user "#00FF00") (:agent "#FFFFFF")
|
|
(:system "#FFFF00") (t "#888888")))
|
|
(pfx (case role (:user "> ") (:agent " ") (:system "* ") (t " ")))))
|
|
(draw-text fb 1 y (concatenate 'string pfx content) fg nil)
|
|
(incf y))
|
|
(when (> y (- h 3)) (loop-finish))))
|
|
(draw-text fb 1 (- h 1) (concatenate 'string "> " (input-string)) "#FFFFFF" "#0F3460"))
|
|
|
|
;; Event loop
|
|
(defun tui-main ()
|
|
(setf *running* t *messages* (make-array 0 :fill-pointer 0 :adjustable t))
|
|
(connect-daemon)
|
|
(with-raw-terminal
|
|
(with-terminal (be w h)
|
|
(let ((prev-fb (make-framebuffer w h))
|
|
(curr-fb (make-framebuffer w h)))
|
|
(loop while *running* do
|
|
(bt:with-lock-held (*event-lock*)
|
|
(dolist (msg (nreverse *event-queue*))
|
|
(let* ((payload (getf msg :payload)) (text (getf payload :text))
|
|
(type (getf msg :type)))
|
|
(cond
|
|
((and (eq type :stream-chunk) text (not (string= text "")))
|
|
(if *streaming-text*
|
|
(setf *streaming-text* (concatenate 'string *streaming-text* text))
|
|
(setf *streaming-text* text
|
|
*messages* (let ((v (make-array (1+ (length *messages*))
|
|
:fill-pointer (1+ (length *messages*))
|
|
:adjustable t)))
|
|
(loop for i below (length *messages*)
|
|
do (setf (aref v i) (aref *messages* i)))
|
|
(setf (aref v (length *messages*))
|
|
(list :role :thinking :content text))
|
|
v))))
|
|
((and (eq type :stream-chunk) (string= text ""))
|
|
(setf *streaming-text* nil))
|
|
(text
|
|
(vector-push-extend (list :role :agent :content text) *messages*)))))
|
|
(setf *event-queue* nil))
|
|
(multiple-value-bind (type data) (read-event be :timeout 0)
|
|
(declare (ignore type))
|
|
(when (key-event-p data)
|
|
(let ((k (key-event-key data)))
|
|
(cond
|
|
((eq k :escape) (when *streaming-text* (setf *streaming-text* nil)))
|
|
((eq k :enter) (input-submit))
|
|
((eq k :backspace) (input-delete-char))
|
|
((eq k :left) (when (> *cursor-pos* 0) (decf *cursor-pos*)))
|
|
((eq k :right) (when (< *cursor-pos* (length *input-buf*))
|
|
(incf *cursor-pos*)))
|
|
((eq k :ctrl-u) (setf *input-buf* nil *cursor-pos* 0))
|
|
((eq k :ctrl-a) (setf *cursor-pos* 0))
|
|
((eq k :ctrl-e) (setf *cursor-pos* (length *input-buf*)))
|
|
((eq k :ctrl-d) (when (null *input-buf*) (setf *running* nil)))
|
|
((eq k :ctrl-q) (setf *running* nil))
|
|
(t (let ((chr (when (keywordp k)
|
|
(let ((s (string k)))
|
|
(when (= (length s) 1) (char-downcase (char s 0)))))))
|
|
(when chr (input-insert-char chr))))))))
|
|
(render-frame curr-fb w h)
|
|
(flush-framebuffer prev-fb curr-fb be)
|
|
(rotatef prev-fb curr-fb)
|
|
(sleep 0.05))))))
|
|
#+end_src |