(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 nil :scroll-offset 0 :busy nil :dirty (list nil nil nil)))) (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))) (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)))