v0.10.2: voice system — all speakers use │, neuro-thinking bg bar, blinking cursor
- 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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user