(defpackage :passepartout.channel-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.channel-tui) (defvar *state* nil) (defvar *event-queue* nil) (defvar *event-lock* (bt:make-lock "tui-event-lock")) (defvar *tui-theme* ;; Roles '(:user :green :agent :white :system :yellow ;; Content :input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow ;; Status :connected :green :disconnected :red :busy :magenta :idle :white ;; Gate trace :gate-passed :green :gate-blocked :red :gate-approval :yellow :hitl :magenta ;; Tools (future use) :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white ;; Display :scroll-indicator :cyan :border :white :background :black ;; Differentiator (v0.4.0) :rule-count :cyan :focus-map :yellow ;; UI :dim :white :highlight :cyan :accent :green) "Color theme plist. 27 semantic keys → Croatoan color values. See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).") (defvar *tui-theme-presets* '(:dark (:user :green :agent :white :system :yellow :input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow :connected :green :disconnected :red :busy :magenta :idle :white :gate-passed :green :gate-blocked :red :gate-approval :yellow :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white :scroll-indicator :cyan :border :white :background :black :rule-count :cyan :focus-map :yellow :dim :white :highlight :cyan :accent :green) :light (:user :blue :agent :black :system :red :input :black :timestamp :yellow :help :blue :error :red :warning :yellow :connected :green :disconnected :red :busy :magenta :idle :black :gate-passed :green :gate-blocked :red :gate-approval :yellow :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black :scroll-indicator :blue :border :black :background :white :rule-count :blue :focus-map :red :dim :white :highlight :blue :accent :green) :gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f" :input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f" :connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984" :gate-passed "#b8bb26" :gate-blocked "#fb4934" :gate-approval "#fabd2f" :tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2" :scroll-indicator "#83a598" :border "#a89984" :background "#282828" :rule-count "#83a598" :focus-map "#fabd2f" :dim "#928374" :highlight "#83a598" :accent "#b8bb26") :solarized (:user "#268bd2" :agent "#839496" :system "#b58900" :input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900" :connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83" :gate-passed "#859900" :gate-blocked "#dc322f" :gate-approval "#b58900" :tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496" :scroll-indicator "#2aa198" :border "#657b83" :background "#002b36" :rule-count "#2aa198" :focus-map "#b58900" :dim "#586e75" :highlight "#2aa198" :accent "#859900") :nord (:user "#81a1c1" :agent "#d8dee9" :system "#ebcb8b" :input "#d8dee9" :timestamp "#4c566a" :help "#88c0d0" :error "#bf616a" :warning "#ebcb8b" :connected "#a3be8c" :disconnected "#bf616a" :busy "#b48ead" :idle "#616e88" :gate-passed "#a3be8c" :gate-blocked "#bf616a" :gate-approval "#ebcb8b" :hitl "#b48ead" :tool-running "#b48ead" :tool-success "#a3be8c" :tool-failure "#bf616a" :tool-output "#d8dee9" :scroll-indicator "#88c0d0" :border "#4c566a" :background "#2e3440" :rule-count "#88c0d0" :focus-map "#ebcb8b" :dim "#616e88" :highlight "#88c0d0" :accent "#5e81ac") :tokyonight (:user "#7aa2f7" :agent "#c0caf5" :system "#e0af68" :input "#c0caf5" :timestamp "#565f89" :help "#7dcfff" :error "#f7768e" :warning "#e0af68" :connected "#9ece6a" :disconnected "#f7768e" :busy "#bb9af7" :idle "#565f89" :gate-passed "#9ece6a" :gate-blocked "#f7768e" :gate-approval "#e0af68" :hitl "#bb9af7" :tool-running "#bb9af7" :tool-success "#9ece6a" :tool-failure "#f7768e" :tool-output "#c0caf5" :scroll-indicator "#7dcfff" :border "#1f2335" :background "#1a1b26" :rule-count "#7dcfff" :focus-map "#e0af68" :dim "#565f89" :highlight "#7dcfff" :accent "#7aa2f7") :catppuccin (:user "#89b4fa" :agent "#cdd6f4" :system "#f9e2af" :input "#cdd6f4" :timestamp "#585b70" :help "#94e2d5" :error "#f38ba8" :warning "#f9e2af" :connected "#a6e3a1" :disconnected "#f38ba8" :busy "#cba6f7" :idle "#6c7086" :gate-passed "#a6e3a1" :gate-blocked "#f38ba8" :gate-approval "#f9e2af" :hitl "#cba6f7" :tool-running "#cba6f7" :tool-success "#a6e3a1" :tool-failure "#f38ba8" :tool-output "#cdd6f4" :scroll-indicator "#94e2d5" :border "#45475a" :background "#1e1e2e" :rule-count "#94e2d5" :focus-map "#f9e2af" :dim "#6c7086" :highlight "#94e2d5" :accent "#89b4fa") :monokai (:user "#a6e22e" :agent "#f8f8f2" :system "#e6db74" :input "#f8f8f2" :timestamp "#75715e" :help "#66d9ef" :error "#f92672" :warning "#e6db74" :connected "#a6e22e" :disconnected "#f92672" :busy "#ae81ff" :idle "#75715e" :gate-passed "#a6e22e" :gate-blocked "#f92672" :gate-approval "#e6db74" :hitl "#ae81ff" :tool-running "#ae81ff" :tool-success "#a6e22e" :tool-failure "#f92672" :tool-output "#f8f8f2" :scroll-indicator "#66d9ef" :border "#49483e" :background "#272822" :rule-count "#66d9ef" :focus-map "#e6db74" :dim "#75715e" :highlight "#66d9ef" :accent "#a6e22e")) "Named theme presets. /theme loads one into *tui-theme*.") (defvar *tui-theme-current-name* :dark "Name of the currently active theme preset.") (defun theme-save () "Persist current theme to disk." (let ((path (merge-pathnames ".cache/passepartout/theme.lisp" (user-homedir-pathname)))) (uiop:ensure-all-directories-exist (list path)) (with-open-file (out path :direction :output :if-exists :supersede :if-does-not-exist :create) (format out ";; Passepartout TUI theme — auto-generated~%") (format out "(setf passepartout.channel-tui::*tui-theme* '~s)~%" *tui-theme*) (format out "(setf passepartout.channel-tui::*tui-theme-current-name* ~s)~%" *tui-theme-current-name*)) t)) (defun theme-load () "Load persisted theme from disk. Called at startup." (let ((path (merge-pathnames ".cache/passepartout/theme.lisp" (user-homedir-pathname)))) (when (uiop:file-exists-p path) (ignore-errors (load path))))) (defun theme-switch (name) "Switch to a named theme preset. Returns the preset name or nil if not found." (let* ((key (intern (string-upcase (string name)) :keyword)) (preset (getf *tui-theme-presets* key))) (when preset (setf *tui-theme* (copy-list preset) *tui-theme-current-name* key) (theme-save) (setf (st :dirty) (list t t t)) key))) (defun theme-color (role) "Returns the Croatoan color for a semantic role. Keyword or hex string values are returned as-is; hex strings are converted to integers that Croatoan can process." (let ((val (or (getf *tui-theme* role) :white))) (if (and (stringp val) (> (length val) 0) (eql (char val 0) #\#)) (handler-case (parse-integer (subseq val 1) :radix 16) (error () val)) val))) ;; v0.8.0: TrueColor helpers (defun theme-hex-to-rgb (hex-string) "Parse #RRGGBB to (values r g b). Returns (255 255 255) for invalid input." (if (and (stringp hex-string) (= 7 (length hex-string)) (eql (char hex-string 0) #\#)) (handler-case (let ((r (parse-integer (subseq hex-string 1 3) :radix 16)) (g (parse-integer (subseq hex-string 3 5) :radix 16)) (b (parse-integer (subseq hex-string 5 7) :radix 16))) (values r g b)) (error () (values 255 255 255))) (values 255 255 255))) (defun theme-init-truecolor () "Register hex colors from *tui-theme* with Croatoan's init-color." (handler-case (loop for (key val) on *tui-theme* by #'cddr when (and (stringp val) (= 7 (length val)) (eql (char val 0) #\#)) do (multiple-value-bind (r g b) (theme-hex-to-rgb val) (init-color key (/ r 255.0) (/ g 255.0) (/ b 255.0)))) (error () nil))) (defun sidebar-toggle () "Toggle sidebar visibility. Sets dirty flags for full redraw." (setf (st :sidebar-visible) (not (st :sidebar-visible))) (setf (st :dirty) (list t t t))) (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 :pending-ctrl-x nil :scroll-at-bottom t :scroll-notify nil :streaming-text nil :url-buffer nil ; v0.7.1 :collapsed-gates nil ; v0.7.2 :search-mode nil :search-query "" ; v0.7.2 :search-matches nil :search-match-idx 0 :sidebar-visible nil ; v0.8.0 :minibuffer-mode nil :minibuffer-selected-idx 0 ; v0.8.0 :minibuffer-filter "" ; v0.8.0 :wizard-mode :provider-list ; v0.9.0 :wizard-selected-idx 0 :wizard-input "" ; v0.9.0 :wizard-error nil ; v0.9.0 :wizard-providers nil :wizard-current-provider nil ; v0.9.0 :wizard-cascade '(:fg-prob nil :bg-prob nil :fg-det nil :bg-det nil) ; v0.9.0 :wizard-cascade-slot :fg-prob ; v0.9.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 panel) (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace :panel panel) (st :messages)) ;; v0.7.0: notify when scrolled up and new msg arrives (unless (st :scroll-at-bottom) (setf (st :scroll-notify) t)) (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)))