Amr Gharbeia
a0f7bd7671
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Gate trace: cognitive-verify accumulates (:gate name :result status) for each deterministic gate. Trace prepended to action plist via list*. TUI on-daemon-msg extracts :gate-trace and stores on message object. add-msg accepts &key gate-trace for future rendering (collapsible Tab). Rule counter: TUI actuator enriches response payload with :rule-count =(hash-table-count *hitl-pending*). TUI status bar shows 'Rules:N'. Focus map: TUI actuator adds :foveal-id from signal context. TUI stores in state and renders second status line '[Focus: id]'. Status bar: now two lines — line 1 (connection, mode, msgs, scroll, rules, thinking spinner), line 2 (focus map, timestamp). Test: 112/0 across 14 suites (reason 15/0 including gate-trace assertions)
73 lines
2.7 KiB
Common Lisp
73 lines
2.7 KiB
Common 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
|
|
:on-key :on-daemon-msg :send-daemon
|
|
:connect-daemon :disconnect-daemon
|
|
:*tui-theme* :theme-color))
|
|
(in-package :passepartout.gateway-tui)
|
|
|
|
(defvar *state* nil)
|
|
(defvar *event-queue* nil)
|
|
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
|
|
|
|
(defvar *tui-theme*
|
|
'(:user :green :agent :white :system :yellow :input :cyan
|
|
:connected :green :disconnected :red :timestamp :yellow)
|
|
"Color theme plist. Keys are semantic roles, values are Croatoan colors.")
|
|
|
|
(defun theme-color (role)
|
|
"Returns the Croatoan color for a semantic role."
|
|
(or (getf *tui-theme* role) :white))
|
|
|
|
(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 (make-array 16 :adjustable t :fill-pointer 0)
|
|
:scroll-offset 0 :busy nil :cursor-pos 0
|
|
:dirty (list nil nil nil))))
|
|
|
|
(defun now ()
|
|
(multiple-value-bind (s m h) (get-decoded-time)
|
|
(declare (ignore s))
|
|
(format nil "~2,'0d:~2,'0d" h m)))
|
|
|
|
(defun input-string ()
|
|
(coerce (reverse (st :input-buffer)) 'string))
|
|
|
|
(defun input-insert-char (ch)
|
|
"Insert character at cursor position into the input buffer."
|
|
(let* ((buf (st :input-buffer))
|
|
(pos (or (st :cursor-pos) 0))
|
|
(s (coerce (reverse buf) 'string))
|
|
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
|
|
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
|
(setf (st :cursor-pos) (1+ pos))))
|
|
|
|
(defun input-delete-char ()
|
|
"Delete character before cursor position (standard backspace)."
|
|
(let* ((buf (st :input-buffer))
|
|
(pos (or (st :cursor-pos) 0)))
|
|
(when (and buf (> pos 0))
|
|
(let* ((s (coerce (reverse buf) 'string))
|
|
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
|
|
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
|
(setf (st :cursor-pos) (1- pos))))))
|
|
|
|
(defun add-msg (role content &key gate-trace)
|
|
(vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
|
|
(setf (st :dirty) (list t t nil)))
|
|
|
|
(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)))
|