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

v0.10.2: voice system — all speakers use │, neuro-thinking bg bar, blinking cursor

Browse Source 
- Theme: added :agent-border, :thinking-bg, :symbolic-border to all 13
  presets with theme-load fallback for saved themes.
- Agent output now draws │ with :agent-border color (muted tan).
- Neuro-thinking (streaming): draw-rect at column 0 with :thinking-bg
  (dark grey block) instead of a grey │ character. No border text.
- Gate traces: │ with :symbolic-border (was ╎ with :dim).
- Tool calls: │ with tool status color (was ╎).
- Removed > prompt prefix from input line.
- Added position-cursor function: blinking block cursor at insertion
  point, called every frame from the main loop after sleep.
This commit is contained in:
Amr Gharbeia
2026-05-16 09:10:39 -04:00
parent 2189745f40
commit bad7686d4e
3 changed files with 74 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
org/channel-tui-main.org
View File

@@ -1065,8 +1065,10 @@ Returns T on success, nil on failure. Does NOT wait or retry."
(cl-tty.backend:draw-text be 0 (- h 3)
(format nil "> ~a" (or filter ""))
(theme-color :input-prompt) bg-p))
(cl-tty.backend:end-sync be))
(sleep 0.1)))
(cl-tty.backend:end-sync be))
(sleep 0.1)
;; Show cursor at input position every frame
(passepartout.channel-tui:position-cursor be w h)))
(progn (disconnect-daemon)))))
#+END_SRC

36
org/channel-tui-state.org
View File

@@ -22,7 +22,8 @@ All state mutation flows through event handlers in the controller.
(:use :cl :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
:view-status :view-chat :view-input :redraw
:position-cursor
:on-key :on-daemon-msg :send-daemon
:connect-daemon :disconnect-daemon
:*tui-theme* :theme-color))
@@ -33,8 +34,8 @@ All state mutation flows through event handlers in the controller.
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defvar *tui-theme*
'(:user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
:agent-header "#d4956a" :agent-fg "#e8e8e8"
'( :user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
:agent-border "#c0a080" :agent-header "#d4956a" :agent-fg "#e8e8e8"
:system "#808080"
:input-prompt "#fab283" :input-fg "#e8e8e8"
:hint "#606060"
@@ -45,17 +46,20 @@ All state mutation flows through event handlers in the controller.
:bg-input "#2e2e2e"
:error "#e06c75"
:tool-running "#fab283" :tool-done "#7fd88f" :tool-error "#e06c75"
:thinking-bg "#3a3a3a" :symbolic-border "#707070"
:separator "#3c3c3c" :accent "#fab283" :dim "#606060")
"Dark-neutral color theme with warm amber accent. Backgrounds are dark grays,
semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:text-muted, :user-fg/bg/border, :agent-header/fg, :system, :input-prompt/fg,
:hint, :status-bg/fg, :bg-input, :dot-connected/disconnected, :error, :tool-*,
:text-muted, :user-fg/bg/border, :agent-border/header/fg, :system,
:input-prompt/fg, :hint, :status-bg/fg, :bg-input, :thinking-bg,
:symbolic-border, :dot-connected/disconnected, :error, :tool-*,
:separator, :accent, :dim.")
(defvar *tui-theme-presets*
'(:amber
(:user-fg "#fab283" :user-bg "#1e1e1e" :user-border "#fab283"
:agent-header "#d4956a" :agent-fg "#e8e8e8"
:agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
:system "#808080"
:input-prompt "#fab283" :input-fg "#e8e8e8"
:hint "#606060"
@@ -70,6 +74,7 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:gold
(:user-fg "#ffd700" :user-bg "#1e1e1e" :user-border "#ffd700"
:agent-header "#d4a574" :agent-fg "#e8e8e8"
:agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
:system "#808080"
:input-prompt "#ffd700" :input-fg "#e8e8e8"
:hint "#606060"
@@ -84,6 +89,7 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:terracotta
(:user-fg "#e87a5d" :user-bg "#1e1e1e" :user-border "#e87a5d"
:agent-header "#d4956a" :agent-fg "#e0c8b0"
:agent-border "#c0a080" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
:system "#808080"
:input-prompt "#e87a5d" :input-fg "#e0c8b0"
:hint "#606060"
@@ -153,7 +159,8 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:separator "#3c3c3c" :accent "#d8a657" :dim "#606060")
:light-amber
(:user-fg "#cc6600" :user-bg "#f5f5f5" :user-border "#cc6600"
:agent-header "#8b6914" :agent-fg "#3a2a1a"
:agent-header "#8b6914" :agent-fg "#3a2a1a"
:agent-border "#a08060" :thinking-bg "#d4d4d4" :symbolic-border "#b0b0b0"
:system "#808080"
:input-prompt "#cc6600" :input-fg "#3a2a1a"
:hint "#a0a0a0"
@@ -167,7 +174,8 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:separator "#d4d4d4" :accent "#cc6600" :dim "#a0a0a0")
:catppuccin
(:user-fg "#fab387" :user-bg "#1e1e2e" :user-border "#fab387"
:agent-header "#cba6f7" :agent-fg "#cdd6f4"
:agent-header "#cba6f7" :agent-fg "#cdd6f4"
:agent-border "#a6adc8" :thinking-bg "#363650" :symbolic-border "#6c7086"
:system "#808080"
:input-prompt "#fab387" :input-fg "#cdd6f4"
:hint "#6c7086"
@@ -181,7 +189,8 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:separator "#313244" :accent "#fab387" :dim "#585b70")
:tokyonight
(:user-fg "#ff9e64" :user-bg "#1a1b26" :user-border "#ff9e64"
:agent-header "#7aa2f7" :agent-fg "#a9b1d6"
:agent-header "#7aa2f7" :agent-fg "#a9b1d6"
:agent-border "#7982a8" :thinking-bg "#363b54" :symbolic-border "#565f89"
:system "#808080"
:input-prompt "#ff9e64" :input-fg "#a9b1d6"
:hint "#565f89"
@@ -195,7 +204,8 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:separator "#292e42" :accent "#ff9e64" :dim "#444b6a")
:dracula
(:user-fg "#ff9580" :user-bg "#1e1f2b" :user-border "#ff9580"
:agent-header "#bd93f9" :agent-fg "#f8f8f2"
:agent-header "#bd93f9" :agent-fg "#f8f8f2"
:agent-border "#c0c0e0" :thinking-bg "#3a3b50" :symbolic-border "#6272a4"
:system "#808080"
:input-prompt "#ff9580" :input-fg "#f8f8f2"
:hint "#6272a4"
@@ -209,7 +219,8 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:separator "#34354a" :accent "#ff9580" :dim "#5a5b7a")
:gemini
(:user-fg "#87afff" :user-bg "#1a1a1a" :user-border "#87afff"
:agent-header "#d7afff" :agent-fg "#ffffff"
:agent-header "#d7afff" :agent-fg "#ffffff"
:agent-border "#d0d0d0" :thinking-bg "#3a3a3a" :symbolic-border "#707070"
:system "#808080"
:input-prompt "#87afff" :input-fg "#ffffff"
:hint "#606060"
@@ -223,7 +234,8 @@ semantic text colors for context. Keys: :bg (deepest), :bg-panel, :bg-element,
:separator "#3a3a3a" :accent "#87afff" :dim "#5f5f5f")
:mono
(:user-fg "#e0e0e0" :user-bg "#1a1a1a" :user-border "#808080"
:agent-header "#c0c0c0" :agent-fg "#d0d0d0"
:agent-header "#c0c0c0" :agent-fg "#d0d0d0"
:agent-border "#a0a0a0" :thinking-bg "#3a3a3a" :symbolic-border "#808080"
:system "#808080"
:input-prompt "#ffffff" :input-fg "#d0d0d0"
:hint "#606060"
@@ -263,7 +275,7 @@ Adds any missing keys with defaults to handle saved themes from older versions."
;; Fill in any missing keys from the default preset
(let ((defaults (getf *tui-theme-presets* *tui-theme-current-name*)))
(when defaults
(dolist (key '(:bg-input :bg-element :text-muted))
(dolist (key '(:bg-input :bg-element :text-muted :agent-border :thinking-bg :symbolic-border))
(unless (getf *tui-theme* key)
(let ((val (getf defaults key)))
(when val (setf (getf *tui-theme* key) val)))))))))

68
org/channel-tui-view.org
View File

@@ -95,9 +95,9 @@ Returns a list of strings, one per line."
(chat-w (- w sidebar-w))
(msgs (st :messages)) (total (length msgs))
(max-lines (- h 7)) (is-search (st :search-mode))
(bordered-w (- chat-w (* 2 hpad) 2))
(unbordered-w (- chat-w (* 2 hpad)))
(y 0))
(bordered-w (- chat-w (* 2 hpad) 2))
(unbordered-w (- chat-w (* 2 hpad)))
(y 0))
(when is-search
(let* ((matches (st :search-matches)) (idx (st :search-match-idx))
(query (st :search-query))
@@ -111,7 +111,9 @@ Returns a list of strings, one per line."
(content (getf msg :content))
(cs (if is-search (search-highlight content (st :search-query)) content))
(pairs nil)
(dim-fg (theme-color :dim))
(think-bg (theme-color :thinking-bg))
(sym-bdr (theme-color :symbolic-border))
(agent-bdr (theme-color :agent-border))
(user-bdr (theme-color :user-border))
(user-fg (theme-color :user-fg))
(agent-fg (theme-color :agent-fg))
@@ -120,34 +122,35 @@ Returns a list of strings, one per line."
(:user
(dolist (l (cl-tty.box:word-wrap cs bordered-w))
(push (list "│" user-bdr l user-fg) pairs)))
(:agent
( :agent
(let* ((streaming (getf msg :streaming))
(bdr-color (if streaming dim-fg nil))
(bdr-str (if streaming "│" ""))
(wrap-w (if streaming bordered-w unbordered-w))
(think-rect (if streaming think-bg nil))
(bdr (if streaming nil agent-bdr))
(bstr (if streaming nil "│"))
(wrap-w (if streaming unbordered-w bordered-w))
(nodes (cl-tty.markdown:parse-blocks cs))
(raw-body (or (and nodes (cl-tty.markdown:render-md nodes)) (list "")))
(body (mapcan (lambda (l) (cl-tty.box:word-wrap l wrap-w)) raw-body)))
(dolist (l body)
(push (list bdr-str bdr-color l agent-fg) pairs))))
(push (list bstr bdr l agent-fg think-rect) pairs))))
(t (dolist (l (cl-tty.box:word-wrap cs unbordered-w))
(push (list "" nil l system-fg) pairs))))
(push (list nil nil l system-fg) pairs))))
;; Gate trace
(let ((gt (getf msg :gate-trace)))
(when (and gt (eq role :agent))
(if (member i (st :collapsed-gates))
(push (list "╎" dim-fg (format nil "Gate trace: ~a gates" (length gt)) dim-fg) pairs)
(push (list "│" sym-bdr (format nil "Gate trace: ~a gates" (length gt)) sym-bdr) pairs)
(dolist (entry (passepartout::gate-trace-lines gt))
(let ((ec (theme-color (getf (cdr entry) :fgcolor))))
(dolist (l (cl-tty.box:word-wrap (car entry) bordered-w))
(push (list "╎" dim-fg l ec) pairs)))))))
(push (list "│" sym-bdr l ec) pairs)))))))
;; Tool calls
(let ((tc (getf msg :tool-calls)))
(when tc
(if (member i (st :collapsed-tools))
(let* ((n (or (getf (first tc) :name) "tool"))
(d (or (getf (first tc) :duration) 0.0)))
(push (list "╎" dim-fg (format nil "~a … ~,1fs" n d) (theme-color :tool-done)) pairs))
(push (list "│" (theme-color :tool-done) (format nil "~a … ~,1fs" n d) (theme-color :tool-done)) pairs))
(dolist (call tc)
(let* ((name (or (getf call :name) "tool"))
(dur (or (getf call :duration) 0.0))
@@ -159,9 +162,9 @@ Returns a list of strings, one per line."
(t :tool-done))))
(pfx (cond ((eq st :error) "✗") ((eq st :running) "●") (t "✓")))
(ol (when out (cl-tty.box:word-wrap out bordered-w))))
(push (list "╎" bc (format nil "~a ~a ~,1fs" pfx name dur) bc) pairs)
(push (list "│" bc (format nil "~a ~a ~,1fs" pfx name dur) bc) pairs)
(dolist (l ol)
(push (list "╎" bc l bc) pairs)))))))
(push (list "│" bc l bc) pairs)))))))
(setf (aref msg-lines i) (nreverse pairs))
(setf (aref msg-heights i) (length pairs))))
(let ((msg-count 0) (lines-remaining max-lines))
@@ -177,11 +180,13 @@ Returns a list of strings, one per line."
do (let ((pairs (aref msg-lines i)))
(dolist (pair pairs)
(when (>= y (- h 7)) (return))
(destructuring-bind (bstr bcolor tstr tcolor) pair
(let ((has-border (and bstr (> (length bstr) 0))))
(when has-border
(cl-tty.backend:draw-text fb hpad y bstr bcolor nil))
(cl-tty.backend:draw-text fb (+ hpad (if has-border 2 0)) y tstr tcolor nil)))
(destructuring-bind (bstr bcolor tstr tcolor &optional rect-bg) pair
(when rect-bg
(cl-tty.backend:draw-rect fb 0 y 1 1 :bg rect-bg))
(let ((has-border (and bstr (> (length bstr) 0))))
(when has-border
(cl-tty.backend:draw-text fb hpad y bstr bcolor nil))
(cl-tty.backend:draw-text fb (+ hpad (if has-border 2 0)) y tstr tcolor nil)))
(incf y)))))))))
#+END_SRC
@@ -205,7 +210,7 @@ Returns a list of strings, one per line."
;; Light grey input panel: h-7 to h-4 (4 rows), indented by hpad
(cl-tty.backend:draw-rect fb hpad (- h 7) inner-w 4 :bg bg-i)
;; Prompt at h-6, second row at h-5 (placeholder for expansion)
(cl-tty.backend:draw-text fb hpad (- h 6) (format nil"> ~a" visible) input-fg nil)
(cl-tty.backend:draw-text fb hpad (- h 6) visible input-fg nil)
;; Hint — lowercase, right-aligned at h-2
(let ((hint "ctrl+p | /help"))
(cl-tty.backend:draw-text fb (- chat-w (length hint) 2) (- h 2) hint hint-fg (theme-color :bg)))))
@@ -279,7 +284,23 @@ Returns a list of strings, one per line."
(when (sidebar-visible-p w)
(view-sidebar fb w h))
(cl-tty.backend:end-sync fb)
(position-cursor fb w h)
(setf (st :dirty) (list nil nil nil))))
(defun position-cursor (fb w h)
"Move blinking block cursor to the input insertion point."
(let* ((sw (if (sidebar-visible-p w) (or (st :sidebar-width) 42) 0))
(cw (- w sw))
(hpad 2)
(text (input-string))
(pos (or (st :cursor-pos) 0))
(prompt-w (- cw (* 2 hpad) 2))
(display-start (max 0 (- pos (1- prompt-w))))
(cx (+ hpad (- pos display-start)))
(cy (- h 6)))
(cl-tty.backend:cursor-move fb cx cy)
(cl-tty.backend:cursor-style fb :block :blink t)
(cl-tty.backend:cursor-show fb)))
#+END_SRC
* Implementation — v0.7.0 additions
@@ -624,10 +645,13 @@ and current sidebar mode."
(is (getf passepartout.channel-tui::*tui-theme* :status-bg)))
(test test-new-theme-keys
"v0.10.0: theme has new :bg, :bg-panel, :bg-element, :bg-input, :text-muted keys."
"v0.10.0: theme has all zone keys."
(is (getf passepartout.channel-tui::*tui-theme* :bg))
(is (getf passepartout.channel-tui::*tui-theme* :bg-panel))
(is (getf passepartout.channel-tui::*tui-theme* :bg-element))
(is (getf passepartout.channel-tui::*tui-theme* :bg-input))
(is (getf passepartout.channel-tui::*tui-theme* :agent-border))
(is (getf passepartout.channel-tui::*tui-theme* :thinking-bg))
(is (getf passepartout.channel-tui::*tui-theme* :symbolic-border))
(is (getf passepartout.channel-tui::*tui-theme* :text-muted)))
#+END_SRC