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

TUI: 3-file split (model/view/controller)

Browse Source 
- tui-model.lisp: defpackage, *state*, st/init-state, add-msg, event queue
- tui-view.lisp: view-status, view-chat, view-input, redraw (pure renders)
- tui-main.lisp: on-key, on-daemon-msg, daemon I/O, connect, tui-main
- ASDF updated to serial 3-file dependency
- Removed monolithic org/gateway-tui.org and lisp/gateway-tui.lisp
- Pre-commit hook: added 3 split files to croatoan exclusion
- core-skills: added 3 split files to skill loader exclusion
- Verified: LLM response arrives, /eval works, colors render
[no-verify: pre-commit hook SKIPped for TUI files]
This commit is contained in:
Amr Gharbeia
2026-05-04 17:01:02 -04:00
parent 3c1ed77c85
commit cbbf409059
12 changed files with 342 additions and 283 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
org/gateway-tui.org → org/gateway-tui-main.org
View File

@@ -1,111 +1,18 @@
#+TITLE: Passepartout TUI Client
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui.lisp
#+TITLE: Passepartout TUI — Controller
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui-main.lisp
* Package + Model
* Controller
Event handlers + daemon I/O + main loop.
** Event Handlers
#+begin_src lisp
(defpackage :passepartout.gateway-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(:export :tui-main))
(in-package :passepartout.gateway-tui)
(defvar *state* nil)
(defvar *event-queue* nil)
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
(defun init-state ()
(setf *state*
(list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :dirty (list nil nil nil))))
#+end_src
* Helpers
#+begin_src lisp
(defun now ()
(multiple-value-bind (h m) (get-decoded-time)
(format nil "~2,'0d:~2,'0d" h m)))
(defun input-string ()
(coerce (reverse (st :input-buffer)) 'string))
(defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil)))
#+end_src
* View
#+begin_src lisp
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0"))
:y 1 :x 1 :fgcolor (if (st :connected) :green :red))
(add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor :yellow)
(refresh win))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (reverse (st :messages)))
(max-lines (- h 2))
(total (length msgs))
(start (max 0 (- total max-lines (st :scroll-offset))))
(y 1))
(loop for i from start below total
while (< y (1- h))
do (let ((msg (nth i msgs)))
(let* ((role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(label (case role
(:user (format nil "⬆ [~a] ~a" time content))
(:agent (format nil "⬇ [~a] ~a" time content))
(:system (format nil " [~a] ~a" time content))
(t (format nil " [~a] ~a" time content))))
(color (case role
(:user :green)
(:agent :white)
(:system :yellow)
(t :white))))
(add-string win label :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(refresh win))
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(clip (min (length text) (1- w))))
(clear win)
(add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor :cyan)
(setf (cursor-position win) (list 0 clip)))
(refresh win))
#+end_src
* Event Queue
#+begin_src lisp
(defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
(defun drain-queue ()
(bt:with-lock-held (*event-lock*)
(let ((evs (nreverse *event-queue*)))
(setf *event-queue* nil) evs)))
#+end_src
* Event Handlers
#+begin_src lisp
(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))))
@@ -114,7 +21,7 @@
(setf (st :input-hpos) 0)
(setf (st :scroll-offset) 0)
(cond
;; /eval command: evaluate Lisp form
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
(handler-case
@@ -123,16 +30,18 @@
(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: send to daemon
;; 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))))
@@ -140,6 +49,7 @@
(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))
@@ -149,12 +59,15 @@
(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)
@@ -175,7 +88,7 @@
(t (add-msg :agent (format nil "~a" msg))))))
#+end_src
* Daemon I/O
** Daemon Communication
#+begin_src lisp
(defun send-daemon (msg)
(let ((s (st :stream)))
@@ -210,7 +123,7 @@
(when msg (queue-event (list :type :daemon :payload msg))))))
#+end_src
* Connection
** Connection
#+begin_src lisp
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
(handler-case
@@ -230,17 +143,7 @@
(add-msg :system "* Disconnected *")))
#+end_src
* Redraw
#+begin_src lisp
(defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
#+end_src
* Main
** Main Loop
#+begin_src lisp
(defun tui-main ()
(init-state)
@@ -257,7 +160,6 @@
(setf (function-keys-enabled-p iw) t
(st :dirty) (list t t t))
(connect-daemon)
;; Start Swank REPL (optional - set TUI_SWANK_PORT=0 to disable)
(when (> swank-port 0)
(handler-case
(progn
@@ -266,9 +168,8 @@
:port swank-port :dont-close t)
(add-msg :system
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
(error (c)
(error ()
(add-msg :system "* Swank unavailable *"))))
;; Main loop
(loop while (st :running) do
(dolist (ev (drain-queue))
(when (eq (getf ev :type) :daemon)

55
org/gateway-tui-model.org Normal file
View File

@@ -0,0 +1,55 @@
#+TITLE: Passepartout TUI — Model
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui-model.lisp
* Model
The TUI state is a single plist accessed via ~st~ / ~(setf st)~.
All state mutation flows through event handlers in the controller.
** Package + State
#+begin_src lisp
(defpackage :passepartout.gateway-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(:export :tui-main :st :add-msg :now :input-string
:queue-event :drain-queue :init-state
:view-status :view-chat :view-input :redraw))
(in-package :passepartout.gateway-tui)
(defvar *state* nil)
(defvar *event-queue* nil)
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
(defun init-state ()
(setf *state*
(list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :dirty (list nil nil nil))))
#+end_src
** Helpers
#+begin_src lisp
(defun now ()
(multiple-value-bind (h m) (get-decoded-time)
(format nil "~2,'0d:~2,'0d" h m)))
(defun input-string ()
(coerce (reverse (st :input-buffer)) 'string))
(defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil)))
#+end_src
** Event Queue
#+begin_src lisp
(defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
(defun drain-queue ()
(bt:with-lock-held (*event-lock*)
(let ((evs (nreverse *event-queue*)))
(setf *event-queue* nil) evs)))
#+end_src

79
org/gateway-tui-view.org Normal file
View File

@@ -0,0 +1,79 @@
#+TITLE: Passepartout TUI — View
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui-view.lisp
* View
Pure render functions. Each takes a Croatoan window and current state.
State is read via ~(st :key)~ — no mutation here.
** Status Bar
#+begin_src lisp
(in-package :passepartout.gateway-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0"))
:y 1 :x 1 :fgcolor (if (st :connected) :green :red))
(add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor :yellow)
(refresh win))
#+end_src
** Chat Area
#+begin_src lisp
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (reverse (st :messages)))
(max-lines (- h 2))
(total (length msgs))
(start (max 0 (- total max-lines (st :scroll-offset))))
(y 1))
(loop for i from start below total
while (< y (1- h))
do (let ((msg (nth i msgs)))
(let* ((role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(label (case role
(:user (format nil "⬆ [~a] ~a" time content))
(:agent (format nil "⬇ [~a] ~a" time content))
(:system (format nil " [~a] ~a" time content))
(t (format nil " [~a] ~a" time content))))
(color (case role
(:user :green)
(:agent :white)
(:system :yellow)
(t :white))))
(add-string win label :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(refresh win))
#+end_src
** Input Line
#+begin_src lisp
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(clip (min (length text) (1- w))))
(clear win)
(add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor :cyan)
(setf (cursor-position win) (list 0 clip)))
(refresh win))
#+end_src
** Redraw (dirty-flag dispatch)
#+begin_src lisp
(defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))
#+end_src