3 Commits

Author SHA1 Message Date
Hermes
edfcfcd7e1 docs: update v0.8.0+ roadmap for cl-tty, Emacs-style bottom panel
- Sidebar: Croatoan window → cl-tty framebuffer draw-text
- Overlay mode: absolute-positioned ncurses → Emacs minibuffer-style
  bottom panel (shrink chat height, render in freed rows)
- Command palette: Croatoan window overlay → framebuffer bottom panel
- TrueColor: Croatoan set-rgb → cl-tty hex-to-rgb + SGR 38/48
- Tool viz: Croatoan init-pair/color-pair → cl-tty draw-text fg/bg
- Mouse: Croatoan mouse-enabled-p → cl-tty v1.1.0 SGR mouse parsing
2026-05-12 22:47:42 +00:00
Hermes
e674dcb2e3 docs: mark all v0.7.3 cl-tty TUI migration items DONE
All 8 roadmap items complete:
- .asd swapped :croatoan → :cl-tty
- Package cleaned in state.org
- Main loop rewritten (with-raw-terminal + with-terminal + framebuffer)
- View functions use cl-tty.backend:draw-text
- render-styled fixed (Croatoan references removed)
- Org artifacts cleaned from tangled lisp files
- Compilation verified (ql:quickload :passepartout/tui)
- Branch pushed to Gitea
2026-05-12 21:35:47 +00:00
Hermes
757541c83b fix: close defun on-key with missing paren, complete cl-tty TUI migration
- Added missing closing paren for defun on-key in org/channel-tui-main.org
  line 616 (was 7 trailing ), now 8)
- Replaced #\) character literal with (code-char 41) to avoid reader
  ambiguity with paren-delimiter counting
- All 3 TUI org files tangled and verified compilable
- passepartout/tui loads without errors under SBCL 2.5.2
2026-05-12 21:35:14 +00:00
9 changed files with 684 additions and 297 deletions

View File

@@ -1514,15 +1514,23 @@ Content (ordered vertically):
6. ~Cost~ — session cost (~$0.12 this session~) updating after each LLM call.
7. ~Protection~ — gate effectiveness counter: "Gates blocked: 3 destructive, 7 network exfil, 12 secrets." Updated on each gate decision. This is the specific-value-proposition panel — no competitor has deterministic gates to count.
Implementation uses a fourth Croatoan ~window~ (sidebar on right) or a panel overlay. All data is already in the daemon's response plist (~:rule-count~, ~:foveal-id~, ~:gate-trace~). The gate block counts come from a new ~*dispatcher-block-counts*~ alist tracked in ~dispatcher-check~. ~200 lines (includes panel 7 addition).
|Implementation uses cl-tty's framebuffer-backend: render the sidebar panels—Gate trace, focus, rules, context gauge, files, cost, protection—to the right region of the framebuffer (offset x = width - 42). In the Emacs minibuffer-style approach (below), the panel content renders at the bottom of the terminal instead. All data is already in the daemon's response plist (~:rule-count~, ~:foveal-id~, ~:gate-trace~). The gate block counts come from a new ~*dispatcher-block-counts*~ alist tracked in ~dispatcher-check~. ~200 lines (includes panel 7 addition).
*** TODO Sidebar overlay mode (< 120 cols)
*** TODO Information panel — Emacs minibuffer-style bottom region
:PROPERTIES:
:ID: id-v070-sidebar-overlay
:CREATED: [2026-05-08 Fri]
:END:
When terminal width < 120, sidebar becomes an absolute-positioned overlay with semi-transparent backdrop (ncurses ~opaque~ + themed background). Toggle via ~/sidebar~ or ~Ctrl+X+B~. The chat area fills the full width when sidebar is hidden. ~30 lines.
Replaces the Croatoan overlay approach. Uses cl-tty's framebuffer: the
chat area height shrinks by N lines and the panel content (gate trace,
focus, rules, context gauge, cost, protection counters) renders into the
freed rows at the bottom. No z-ordering or transparency needed. Dismissal
restores chat to full height.
Toggle via ~/sidebar~ or ~Ctrl+X+B~. When terminal width < 120, the side
panel info renders here. At ≥ 120 columns, renders as right sidebar
instead (offset x = width - 42). ~30 lines.
*** TODO Command palette (Ctrl+P)
:PROPERTIES:
@@ -1532,11 +1540,12 @@ When terminal width < 120, sidebar becomes an absolute-positioned overlay with s
Single entry point for all actions. Mirrors OpenCode's pattern — fuzzy-searchable, categorized, keyboard-navigable:
- ~Ctrl+P~ opens palette as overlay dialog
- Categories: Session (~/focus~, ~/scope~, ~/unfocus~, ~/rename~), Agent (~/rules~, ~/approve~, ~/config~), View (~/theme~, ~/sidebar~, ~/clear~), System (~/eval~, ~/status~, ~/reconnect~, ~/quit~)
- Fuzzy text filter; Up/Down to navigate; Enter to execute; Esc to dismiss
- Also shows keyboard shortcuts for each command as hints
- Implemented as a Croatoan ~window~ overlay with ~add-string~-based rendering and ~get-char~-based filtering. ~100 lines.
|- ~Ctrl+P~ opens palette in the bottom panel area
|- Categories: Session (~/focus~, ~/scope~, ~/unfocus~, ~/rename~), Agent (~/rules~, ~/approve~, ~/config~), View (~/theme~, ~/sidebar~, ~/clear~), System (~/eval~, ~/status~, ~/reconnect~, ~/quit~)
|- Fuzzy text filter; Up/Down to navigate; Enter to execute; Esc to dismiss
|- Also shows keyboard shortcuts for each command as hints
|- Implemented using cl-tty's framebuffer ~draw-text~ in the bottom panel
region, with keyboard input from ~read-event~. ~100 lines.
*** TODO TrueColor theme expansion (8 presets)
:PROPERTIES:
@@ -1544,7 +1553,9 @@ Single entry point for all actions. Mirrors OpenCode's pattern — fuzzy-searcha
:CREATED: [2026-05-08 Fri]
:END:
All 27 existing theme keys wired into rendering. Use Croatoan's ~set-rgb~ for 24-bit hex color support (already available in Croatoan; currently unused). Add 4 new presets to the existing 4:
|All 27 existing theme keys wired into rendering. cl-tty's modern-backend
|supports 24-bit RGB via hex-to-rgb + SGR 38/48 escapes — the theme-color
|function already returns hex strings. Add 4 new presets to the existing 4:
- ~nord~: blue-gray backgrounds, frost accent (#5E81AC key, #BF616A error, #A3BE8C success)
- ~tokyonight~: purple-blue backgrounds, teal accent (#7AA2F7 key, #F7768E error, #9ECE6A success)
@@ -1584,7 +1595,8 @@ When the agent invokes a tool:
- Output collapsed by default to single-line summary. Tab on a tool invocation toggles full output.
- Diff display: ~+~ (green) / ~-~ (red) coloring for file edits. 3 lines of context around changes. The ~:tool-output~ theme color provides the background.
Uses Croatoan's ~init-pair~ + ~color-pair~ for 256-color backgrounds on tool state regions. ~100 lines.
|Uses cl-tty's ~draw-text~ with foreground/background color arguments to
|color tool state regions. ~100 lines.
*** TODO Mouse support
:PROPERTIES:
@@ -1592,7 +1604,10 @@ Uses Croatoan's ~init-pair~ + ~color-pair~ for 256-color backgrounds on tool sta
:CREATED: [2026-05-08 Fri]
:END:
Croatoan supports ncurses mouse mode via ~(setf mouse-enabled-p)~. Enable:
|cl-tty v1.1.0 supports SGR mouse events via ~enable-mouse~ (already called
|in ~initialize-backend~). ~read-event~ now returns ~mouse-event~ structs
|with ~:press~/~:release~ types, button keywords, and 0-based coordinates.
|Mouse support provides:
- Scroll wheel: PageUp/PageDown equivalent, scrolls chat by viewport height
- Click to position cursor in input area
@@ -2606,3 +2621,136 @@ World models, temporal reasoning, goal persistence across restarts.
- World models: Predictive models of user behavior, project dynamics, system state.
- Temporal reasoning: Scheduling, deadlines, elapsed duration awareness.
- Goal persistence: Goals survive restarts. Long-term projects in memory-objects.
* v0.7.3: cl-tty TUI Migration
** Summary
Replace Croatoan (ncurses CFFI) with cl-tty (pure CL, no FFI) as the
terminal rendering backend for the TUI channels. Original rationale:
Croatoan is broken, cl-tty was purpose-built for this use case.
** Architecture decisions
1. Keep passepartout's state model (plist via ~st~/~(setf st)~) and
event dispatch (~on-key~, ~on-daemon-msg~) unchanged. Only the
output path changes.
2. Use cl-tty's framebuffer-backend for rendering: draw to framebuffer
cells, then diff+flush to the real backend. This gives minimal
terminal writes for free (only changed cells are sent).
3. Main loop: ~cl-tty.input:with-raw-terminal~ + ~cl-tty.backend:with-terminal~
replaces ~croatoan:with-screen~.
4. Input: ~cl-tty.input:read-event~ with ~:timeout 0~ replaces
~croatoan:get-char~ + ~code-key~/~key-name~ conversion.
5. Resize: cl-tty's SIGWINCH handler + ~:resize~ event replaces
Croatoan's KEY_RESIZE (410).
6. Markdown rendering: drop passepartout's hand-rolled ~render-styled~
(no longer called from view-chat). Wire cl-tty's built-in markdown
renderer as a follow-up.
** Remaining work (in order)
*** DONE Update .asd: swap :croatoan for :cl-tty
The ~:passepartout/tui~ system no longer depends on ~:croatoan~.
Depends on ~:cl-tty~ instead.
*** DONE Remove Croatoan from package (state.org)
~:use :cl :croatoan ...~~:use :cl ...~. Export list unchanged.
~theme-color~ returns hex strings (cl-tty compatible) instead of
Croatoan color keywords.
*** DONE Rewrite main loop (main.org)
~tui-main~ now uses ~with-raw-terminal~ + ~with-terminal~ + framebuffer.
Key dispatch uses ~read-event~ returning structured events instead of
raw Croatoan codes / ~code-key~ conversion. Resize handled by cl-tty's
~:resize~ event type.
*** DONE Rewrite view functions (view.org)
~view-status~, ~view-chat~, ~view-input~, ~redraw~ all rewritten to
take a framebuffer-backend and use ~cl-tty.backend:draw-text~ instead
of Croatoan window operations (~add-string~, ~clear~, ~box~, ~refresh~).
*** DONE Fix render-styled (view.org)
~render-styled~ (Implementation section, v0.7.1 Markdown Rendering block)
still uses Croatoan's ~add-string~ and ~height~. This function is no
longer called from ~view-chat~ (replaced with plain ~draw-text~), but
it still exists in the source and causes a compile error because the
Croatoan package is no longer loaded.
Fix: Either (a) replace ~add-string~/~height~ with cl-tty equivalents
and keep the function for future styled markdown, or (b) remove it
entirely since it's dead code. Option (a) is preferred for
forward-compatibility.
Also remove ~height~ window dimension access (only used in
~render-styled~). Remove ~parse-markdown-spans~ if it's only called
from ~render-styled~ (it's not — it's used in the old view-chat
Croatoan code which has been replaced).
*** DONE Clean up render-styled's Croatoan references
~parse-markdown-spans~, ~syntax-highlight~, ~parse-markdown-blocks~,
and ~gate-trace-lines~ are all pure CL utility functions that don't
depend on Croatoan. Only ~render-styled~ itself uses Croatoan window
operations.
Concrete changes to ~render-styled~:
src="org/channel-tui-view.org" lang="diff"
-(defun render-styled (win segments y x w)
- "Render markdown segments to Croatoan window. Returns next y."
- (dolist (seg segments)
- (when (>= y (height win)) (return y))
- (let* ((text (or (car seg) ""))
- (attrs (cdr seg))
- (bold (getf attrs :bold))
- (code (getf attrs :code))
- (underline (getf attrs :underline))
- (url (getf attrs :url)))
- (add-string win text :y y :x x :n (max 1 (- w x))
- :bold bold :underline underline
- :bgcolor (when code (theme-color :dim))
- :fgcolor (cond (url (theme-color :highlight))
- (t (theme-color (or (getf attrs :role) :agent)))))
- (incf x (length text))))
- y)
+(defun render-styled (fb segments y x w)
+ "Render markdown segments to framebuffer. Returns next y."
+ (dolist (seg segments)
+ (let* ((text (or (car seg) ""))
+ (attrs (cdr seg))
+ (bold (getf attrs :bold))
+ (code (getf attrs :code))
+ (url (getf attrs :url)))
+ (cl-tty.backend:draw-text fb x y text
+ (cond (url (theme-color :highlight))
+ (t (theme-color (or (getf attrs :role) :agent))))
+ nil :bold bold)
+ (incf x (length text))))
+ y)
"""
*** DONE Tangled view.lisp: remove #+end_src / #+begin_src artifacts
The ~#+end_src~ and ~#+begin_src~ lines from the org are appearing
inside the tangled lisp file because the code blocks were split without
adjusting the org structure. Clean up any org artifacts in the generated
.lisp files.
*** DONE Verify compilation
1. ~cl-tty.input:with-raw-terminal~ resolves (stty-based, defined in
text-input.org → input.lisp, exported from cl-tty.input package)
2. ~cl-tty.backend:draw-text~ resolves on framebuffer-backend
3. ~cl-tty.rendering:flush-framebuffer~, ~make-framebuffer~ resolve
4. ~cl-tty.input:read-event~ returns structured events
5. ~cl-tty.input:*terminal-resized-p*~ exported
6. ~cl-tty.rendering:backend-clear~ dispatches on framebuffer-backend
*** DONE Push branch and let user test

View File

@@ -0,0 +1,234 @@
#+TITLE: cl-tty TUI Migration Plan
#+AUTHOR: Hermes
#+DATE: 2026-05-12
Croatoan is not working and passepartout's TUI needs a reliable rendering
backend. cl-tty was built for exactly this use case. This plan details the
migration from Croatoan (ncurses via CFFI) to cl-tty (pure CL, no FFI).
* Current Architecture (Croatoan)
3 org files, ~2K LOC total:
- **state.org (191 lines):** state plist, theme presets, event queue, helpers
- **main.org (1370 lines):** key dispatch, daemon protocol, main loop
- **view.org (480 lines):** render functions, markdown rendering, gate trace
Croatoan API calls used:
| Croatoan call | Purpose | Count |
|------------------------|----------------------------------|-------|
| ~with-screen~ | Terminal init (raw, no echo) | 1 |
| ~make-instance 'window~| Window creation for layout | ~10 |
| ~add-string~ | Render text w/ fg, bg, attrs | ~20 |
| ~get-char~ | Read keypress | 1 |
| ~code-key~/~key-name~ | Convert raw code → keyword | 2 |
| ~clear~ | Clear window contents | 3 |
| ~refresh~ | Flush window to terminal | ~8 |
| ~box~ | Draw border around window | 2 |
| ~width~/~height~ | Query window dimensions | ~6 |
| ~(setf cursor-position)~| Set cursor location | 1 |
| ~function-keys-enabled-p~| Enable function key codes | 2 |
| ~input-blocking~ | Non-blocking input mode | 2 |
* Migration Strategy: Option C (Hybrid)
Replace the rendering backend only. Keep passepartout's application logic
(state machine, event handlers, daemon protocol, markdown parser) intact.
Don't rewrite the event handling into cl-tty's component/keymap system.
Don't replace the state plist with cl-tty components.
Replace Croatoan window operations with cl-tty backend primitives.
**Why not pure component tree (Option B):**
The 1370-line event handler in main.org is deeply coupled to the plist state
model. Untangling it into cl-tty component event handlers would be churn
with no user-visible benefit. The markdown renderer, gate trace, search
mode, HITL panels, streaming text, and undo/redo are all app-specific logic
that cl-tty doesn't need to know about. Keep them as-is, just swap the
output path.
* Step-by-step Plan
**Step 1: Add cl-tty dependency (5 min)**
- Add ~:cl-tty~ to ~passepartout/tui~ system dependencies in .asd
- Remove ~:croatoan~ dependency
- Add cl-tty to Quicklisp/local-projects or install path
**Step 2: Replace ~with-screen~ with cl-tty init (30 min)**
Replace:
#+BEGIN_SRC lisp
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
...)
#+END_SRC
With:
#+BEGIN_SRC lisp
(sb-posix:with-raw-terminal
(let* ((be (cl-tty.backend:detect-backend))
(w (nth-value 0 (cl-tty.backend:backend-size be)))
(h (nth-value 1 (cl-tty.backend:backend-size be))))
(cl-tty.backend:initialize-backend be)
(unwind-protect
(tui-loop be w h)
(cl-tty.backend:shutdown-backend be))))
#+END_SRC
**Step 3: Replace windows with cl-tty rendering (view.org, 2-3 hours)**
Replace Croatoan window operations in view-status, view-chat, view-input:
~add-string~~cl-tty.backend:draw-text~
~box~~cl-tty.backend:draw-border~
~clear~ → framebuffer clear or ~cl-tty.backend:backend-clear~
~refresh~ → framebuffer flush (~flush-framebuffer~)
Each render function (view-status, view-chat, view-input) takes:
- cl-tty backend instance (instead of Croatoan window)
- x/y/w/h region (instead of ~width~/~height~ on window)
**Step 4: Wire framebuffer diffing (view.org + main.org, 1 hour)**
Replace per-window ~clear~+~refresh~ with cl-tty's framebuffer:
1. Create framebuffer at terminal size
2. Each render function draws render commands into the framebuffer
3. Main loop calls ~flush-framebuffer~ which diffs and writes only changed cells
The existing dirty-flag system (~(st :dirty)~ as ~(list status chat input)~)
maps naturally: each dirty flag maps to which regions of the framebuffer
need rebuilding.
**Step 5: Replace input handling (main.org, 1 hour)**
Replace ~get-char~ + ~code-key~/~key-name~ conversion with ~cl-tty.input:read-event~:
- ~read-event~ returns structured ~key-event~ structs with ~:key~ and ~:modifiers~
- No manual integer → keyword conversion needed
- Arrow keys, Enter, Backspace, Tab, PageUp/Down all come as keywords
- Ctrl+letter codes come as ~(make-key-event :key 'a :ctrl t)~
Key mapping table:
| Croatoan code | Current convert | cl-tty event |
|---------------|-----------------|-------------------------|
| 263/127/8 | :backspace | ~(key :backspace)~ |
| 259 | :up | ~(key :up)~ |
| 258 | :down | ~(key :down)~ |
| 260 | :left | ~(key :left)~ |
| 261 | :right | ~(key :right)~ |
| 339 | :ppage | ~(key :page-up)~ |
| 338 | :npage | ~(key :page-down)~ |
| 13/10 | :enter | ~(key :enter)~ |
| 9 | :tab | ~(key :tab)~ |
| 27 | 27 | ~(key :escape)~ |
| 410 | KEY_RESIZE | (needs signal handler) |
| 21 (C-u) | 21 | ~(key #\u :ctrl t)~ |
| 1 (C-a) | 1 | ~(key #\a :ctrl t)~ |
| 5 (C-e) | 5 | ~(key #\e :ctrl t)~ |
Replace the ~cond~ dispatcher in ~on-key~: change integer checks to keyword
comparisons. The logic stays identical — only the key representation changes.
**Step 6: Handle SIGWINCH (main.org, 30 min)**
cl-tty doesn't have built-in resize handling. Add a ~sb-sys:with-deadline~
or SIGWINCH handler that sets a ~resize-pending~ flag. The main loop checks
this flag and calls ~backend-size~ to get new dimensions, then marks all
dirty flags.
Add to ~init-state~:
#+BEGIN_SRC lisp
:resize-pending nil
#+END_SRC
Add a SIGWINCH handler:
#+BEGIN_SRC lisp
(sb-sys:enable-interrupt sb-posix:sigwinch
(lambda () (setf (st :resize-pending) t)))
#+END_SRC
In the main loop, check before rendering:
#+BEGIN_SRC lisp
(when (st :resize-pending)
(setf (st :resize-pending) nil)
(multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(setf (st :dirty) (list t t t)))
#+END_SRC
**Step 7: Tone down to 10fps (main.org, 5 min)**
The current 30fps (~(sleep 0.03)~) is overkill for a chat UI. Change to
~(sleep 0.1)~ for 10fps. The framebuffer only sends changes — idle frames
cost nothing.
**Step 8: Map theme colors (state.org, 30 min)**
passepartout has 27 semantic theme keys. Croatoan uses keyword colors
(~:green~, ~:red~, ~:cyan~, ~:yellow~, ~:magenta~, ~:blue~, ~:white~,
~:black~) while cl-tty uses hex strings (~"#00FF00"~) for truecolor or
named colors.
Solution: keep passepartout's ~*tui-theme*~ plist as-is. Change
~theme-color~ to return hex strings compatible with cl-tty:
#+BEGIN_SRC lisp
(defun theme-color-to-hex (role)
(let ((val (getf *tui-theme* role)))
(cond
((stringp val) val) ; already hex like "#ebdbb2"
((keywordp val) ; named Croatoan color → hex
(case val
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(t "#FFFFFF"))))))
#+END_SRC
The gruvbox and solarized presets already use hex strings — they work
directly with cl-tty. Only the dark and light presets use Croatoan keywords
and need mapping.
**Step 9: Remove Croatoan TUI system (5 min)**
The ~passepartout/tui~ system no longer needs ~:croatoan~. Update the
ASDF definition.
* What cl-tty Gains From This
This is the litmus test for cl-tty. If it can serve as the rendering
backend for a real application, it validates the architecture. Specific
needs that would drive cl-tty improvements:
1. **SIGWINCH handling** — cl-tty should provide a ~with-resize-handler~
macro or similar. Currently the application has to set this up manually.
2. **Framebuffer coordinate management** — the framebuffer API needs to
support partial region updates (the passepartout dirty flags map to
specific areas: status bar rows 0-2, chat rows 3 to h-2, input row h-1).
3. **Non-blocking read-event** — already supported via ~:timeout~ keyword
but should be documented as the main loop pattern.
* Files to Modify
| File | Change |
|-------------------------------|--------------------------------------|
| ~passepartout.asd~ | Add ~:cl-tty~, remove ~:croatoan~ |
| ~org/channel-tui-state.org~ | Package uses, theme-color returns hex|
| ~org/channel-tui-main.org~ | Replace main loop, input handling |
| ~org/channel-tui-view.org~ | Replace all Croatoan window ops |
* Verification
After each step, the TUI should:
1. Compile without Croatoan dependency
2. Start and show status bar, empty chat, input line
3. Accept keyboard input and display typed text
4. Connect to daemon and show messages
5. Support all keybindings (arrows, Ctrl, Tab, PageUp/Down)
6. Support resize via SIGWINCH
7. Render markdown (bold, code, URLs, code blocks)
8. Show gate traces with collapsible toggle
9. All view and markdown tests pass (test-char-width, parse-markdown-spans, etc.)

View File

@@ -80,7 +80,7 @@
when content
do (let ((pos (or (search "https://" content) (search "http://" content))))
(when pos
(let ((end (or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
(let ((end (or (position-if (lambda (c) (find c (list #\Space #\Newline #\Tab (code-char 41))))
content :start pos)
(length content))))
(setf url (subseq content pos end))
@@ -781,21 +781,10 @@
(init-state)
(load-history)
(theme-load)
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
(let* ((h (or (height scr) 24))
(w (or (width scr) 80))
(sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
(ch (- h 5))
(cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
(iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
(swank-port (or (ignore-errors
(let* ((swank-port (or (ignore-errors
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
4006)))
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t)
;; Store windows in state for SIGWINCH handler
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
(setf (st :dirty) (list t t t))
(connect-daemon)
(when (> swank-port 0)
(handler-case
@@ -807,10 +796,14 @@
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
(error ()
(add-msg :system "* Swank unavailable *"))))
;; Initial render before the main loop — otherwise the screen stays
;; blank until the first keystroke (get-char blocks).
(redraw sw cw ch iw)
(refresh scr)
(cl-tty.input:with-raw-terminal
(cl-tty.backend:with-terminal (be w h)
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
(curr-fb (cl-tty.rendering:make-framebuffer w h)))
;; Initial render
(redraw be curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb)
(loop while (st :running) do
(dolist (ev (drain-queue))
(cond
@@ -820,30 +813,47 @@
(setf (st :connected) nil
(st :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
(let ((ch (get-char iw)))
(multiple-value-bind (type data)
(cl-tty.input:read-event be :timeout 0)
(cond
((or (not ch) (equal ch -1)) nil)
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
((eql ch 410)
(let* ((new-h (or (height scr) 24))
(new-w (or (width scr) 80))
(new-ch (- new-h 5)))
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
ch new-ch
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
w new-w
h new-h)
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t)
(st :sw) sw (st :cw) cw (st :iw) iw)
(redraw sw cw ch iw)
(refresh scr)))
(t (on-key ch))))
(redraw sw cw ch iw)
(refresh scr)
(sleep 0.03))
((eq type :resize)
(multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(setf prev-fb (cl-tty.rendering:make-framebuffer w h)
curr-fb (cl-tty.rendering:make-framebuffer w h))
(setf (st :dirty) (list t t t)))
(data
(let ((ch (typecase data
(cl-tty.input:key-event
(cl-tty.input:key-event-key data))
(t data))))
(cond
((eql ch :escape)
(when (st :streaming-text)
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0)
(let ((idx (1- (length (st :messages)))))
(setf (getf (aref (st :messages) idx) :content)
(concatenate 'string
(getf (aref (st :messages) idx) :content)
" [interrupted]"))
(setf (getf (aref (st :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now))))
(setf (st :streaming-text) nil)
(setf (st :busy) nil)
(setf (st :dirty) (list t t nil)))
(when (st :search-mode)
(setf (st :search-mode) nil
(st :search-matches) nil
(st :search-query) "")
(setf (st :dirty) (list nil t nil))
(add-msg :system "Search exited")))
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear curr-fb)
(redraw be curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb))
(sleep 0.1))))
(disconnect-daemon))))
(eval-when (:compile-toplevel :load-toplevel :execute)

View File

@@ -1,5 +1,5 @@
(defpackage :passepartout.channel-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(: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
@@ -101,8 +101,15 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
key)))
(defun theme-color (role)
"Returns the Croatoan color for a semantic role."
(or (getf *tui-theme* role) :white))
"Returns a hex color string for a semantic role, suitable for cl-tty."
(let ((val (or (getf *tui-theme* role) :white)))
(cond
((stringp val) val)
(t (case val
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))

View File

@@ -1,27 +1,25 @@
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(defun view-status (fb w)
(let ((line1 (format nil
" Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
(if (st :busy) " …thinking" "")))))
(cl-tty.backend:draw-text fb 1 1 line1
(theme-color (if (st :connected) :connected :disconnected))
nil)
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) nil)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) nil)))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
@@ -40,11 +38,8 @@
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
@@ -56,7 +51,7 @@
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Count visible messages from end, accounting for word wrap
@@ -103,37 +98,29 @@
(theme-color :hitl))))
(dolist (line wrapped)
(when (< y (1- h))
(if (eq role :agent)
(let ((segments (parse-markdown-spans line)))
(setf y (render-styled win segments y 1 w)))
(progn
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y)))
;; v0.7.2: gate trace below agent messages
(let ((gate-trace (getf msg :gate-trace)))
(when (and gate-trace (not (member i (st :collapsed-gates))))
(dolist (entry (passepartout::gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
(cl-tty.backend:draw-text fb 3 y (car entry)
(or (getf (cdr entry) :fgcolor) :dim) nil)
(incf y)))))))))))
(defun view-input (win)
(defun view-input (fb w)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
(defun redraw (sw cw ch iw)
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(when sd (view-status fb w))
(when cd (view-chat fb w (- h 5)))
(when id (view-input fb w))
(setf (st :dirty) (list nil nil nil))))
(in-package :passepartout)
@@ -200,21 +187,20 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(t (push (cons (subseq text pos) nil) results) (return))))))))
(nreverse results)))
(defun render-styled (win segments y x w)
"Render markdown segments to Croatoan window. Returns next y."
(defun render-styled (fb segments y x w)
"Render markdown segments to cl-tty backend. Returns next y."
(dolist (seg segments)
(when (>= y (height win)) (return y))
(let* ((text (or (car seg) ""))
(attrs (cdr seg))
(bold (getf attrs :bold))
(code (getf attrs :code))
(underline (getf attrs :underline))
(url (getf attrs :url)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bold bold :underline underline
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(declare (ignore code))
(cl-tty.backend:draw-text fb x y text
(cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent))))
nil
:bold bold)
(incf x (length text))))
y)

View File

@@ -31,7 +31,7 @@ Event handlers + daemon I/O + main loop.
render/input event loop at ~30fps.
** Event Handlers
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(in-package :passepartout.channel-tui)
(defun on-key (&rest args)
@@ -114,7 +114,7 @@ Event handlers + daemon I/O + main loop.
when content
do (let ((pos (or (search "https://" content) (search "http://" content))))
(when pos
(let ((end (or (position-if (lambda (c) (find c '(#\Space #\Newline #\Tab #\))))
(let ((end (or (position-if (lambda (c) (find c (list #\Space #\Newline #\Tab (code-char 41))))
content :start pos)
(length content))))
(setf url (subseq content pos end))
@@ -729,10 +729,10 @@ Event handlers + daemon I/O + main loop.
((eq action :handshake)
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
(t (add-msg :agent (format nil "~a" msg))))))
#+end_src
#+END_SRC
** Daemon Communication
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(defun send-daemon (msg)
(let ((s (st :stream)))
(when (and s (open-stream-p s))
@@ -783,10 +783,10 @@ Event handlers + daemon I/O + main loop.
while line
do (push line (st :input-history))))
(setf (st :input-history) (nreverse (st :input-history))))))
#+end_src
#+END_SRC
** Connection
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
(add-msg :system "* Connecting to daemon... *")
(loop for attempt from 1 to 3
@@ -816,29 +816,18 @@ Event handlers + daemon I/O + main loop.
(ignore-errors (close (st :stream)))
(setf (st :stream) nil (st :connected) nil)
(add-msg :system "* Disconnected *")))
#+end_src
#+END_SRC
** Main Loop
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(defun tui-main ()
(init-state)
(load-history)
(theme-load)
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
(let* ((h (or (height scr) 24))
(w (or (width scr) 80))
(sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
(ch (- h 5))
(cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
(iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
(swank-port (or (ignore-errors
(let* ((swank-port (or (ignore-errors
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
4006)))
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t)
;; Store windows in state for SIGWINCH handler
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
(setf (st :dirty) (list t t t))
(connect-daemon)
(when (> swank-port 0)
(handler-case
@@ -850,10 +839,14 @@ Event handlers + daemon I/O + main loop.
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
(error ()
(add-msg :system "* Swank unavailable *"))))
;; Initial render before the main loop — otherwise the screen stays
;; blank until the first keystroke (get-char blocks).
(redraw sw cw ch iw)
(refresh scr)
(cl-tty.input:with-raw-terminal
(cl-tty.backend:with-terminal (be w h)
(let ((prev-fb (cl-tty.rendering:make-framebuffer w h))
(curr-fb (cl-tty.rendering:make-framebuffer w h)))
;; Initial render
(redraw be curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb)
(loop while (st :running) do
(dolist (ev (drain-queue))
(cond
@@ -863,36 +856,52 @@ Event handlers + daemon I/O + main loop.
(setf (st :connected) nil
(st :busy) nil)
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
(let ((ch (get-char iw)))
(multiple-value-bind (type data)
(cl-tty.input:read-event be :timeout 0)
(cond
((or (not ch) (equal ch -1)) nil)
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
((eql ch 410)
(let* ((new-h (or (height scr) 24))
(new-w (or (width scr) 80))
(new-ch (- new-h 5)))
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
ch new-ch
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
w new-w
h new-h)
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t)
(st :sw) sw (st :cw) cw (st :iw) iw)
(redraw sw cw ch iw)
(refresh scr)))
(t (on-key ch))))
(redraw sw cw ch iw)
(refresh scr)
(sleep 0.03))
((eq type :resize)
(multiple-value-setq (w h) (cl-tty.backend:backend-size be))
(setf prev-fb (cl-tty.rendering:make-framebuffer w h)
curr-fb (cl-tty.rendering:make-framebuffer w h))
(setf (st :dirty) (list t t t)))
(data
(let ((ch (typecase data
(cl-tty.input:key-event
(cl-tty.input:key-event-key data))
(t data))))
(cond
((eql ch :escape)
(when (st :streaming-text)
(send-daemon (list :type :event :payload '(:action :cancel-stream)))
(when (> (length (st :messages)) 0)
(let ((idx (1- (length (st :messages)))))
(setf (getf (aref (st :messages) idx) :content)
(concatenate 'string
(getf (aref (st :messages) idx) :content)
" [interrupted]"))
(setf (getf (aref (st :messages) idx) :streaming) nil)
(setf (getf (aref (st :messages) idx) :time) (now))))
(setf (st :streaming-text) nil)
(setf (st :busy) nil)
(setf (st :dirty) (list t t nil)))
(when (st :search-mode)
(setf (st :search-mode) nil
(st :search-matches) nil
(st :search-query) "")
(setf (st :dirty) (list nil t nil))
(add-msg :system "Search exited")))
(t (on-key ch)))))))
(when (or (first (st :dirty)) (second (st :dirty)) (third (st :dirty)))
(cl-tty.backend:backend-clear curr-fb)
(redraw be curr-fb w h)
(cl-tty.rendering:flush-framebuffer prev-fb curr-fb be)
(rotatef prev-fb curr-fb))
(sleep 0.1))))
(disconnect-daemon))))
#+end_src
#+END_SRC
* Test Suite
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-main.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
@@ -1367,4 +1376,4 @@ Event handlers + daemon I/O + main loop.
(setf (st :scroll-offset) 3)
(on-key :npage)
(fiveam:is (= 0 (st :scroll-offset))))
#+end_src
#+END_SRC

View File

@@ -17,9 +17,9 @@ All state mutation flows through event handlers in the controller.
reader loop. (drain-queue) returns and clears the queue.
** Package + State
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defpackage :passepartout.channel-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(: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
@@ -121,8 +121,15 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
key)))
(defun theme-color (role)
"Returns the Croatoan color for a semantic role."
(or (getf *tui-theme* role) :white))
"Returns a hex color string for a semantic role, suitable for cl-tty."
(let ((val (or (getf *tui-theme* role) :white)))
(cond
((stringp val) val)
(t (case val
(:green "#00FF00") (:red "#FF0000") (:cyan "#00FFFF")
(:yellow "#FFFF00") (:magenta "#FF00FF") (:blue "#0000FF")
(:white "#FFFFFF") (:black "#000000")
(t "#FFFFFF"))))))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
@@ -140,10 +147,10 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
:search-mode nil :search-query "" ; v0.7.2
:search-matches nil :search-match-idx 0
:dirty (list nil nil nil))))
#+end_src
#+END_SRC
** Helpers
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defun now ()
(multiple-value-bind (s m h) (get-decoded-time)
(declare (ignore s))
@@ -177,10 +184,10 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(unless (st :scroll-at-bottom)
(setf (st :scroll-notify) t))
(setf (st :dirty) (list t t nil)))
#+end_src
#+END_SRC
** Event Queue
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-state.lisp
(defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
@@ -188,4 +195,4 @@ See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
(bt:with-lock-held (*event-lock*)
(let ((evs (nreverse *event-queue*)))
(setf *event-queue* nil) evs)))
#+end_src
#+END_SRC

View File

@@ -3,8 +3,8 @@
* View
Pure render functions. Each takes a Croatoan window and current state.
State is read via ~(st :key)~ — no mutation here.
|Pure render functions. Each takes the cl-tty backend and current state.
|State is read via ~(st :key)~ — no mutation here.
** Contract
@@ -42,31 +42,29 @@ architecture:
All three enrichments cost 0 LLM tokens — they are daemon-state queries
that the TUI actuator attaches to the response plist before transmission.
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout.channel-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(defun view-status (fb w)
(let ((line1 (format nil
" Passepartout ~a [~a] msgs:~a scroll:~a Rules:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(or (st :rule-count) 0)
(if (st :streaming-text) " [streaming]"
(if (st :busy) " …thinking" "")))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
(if (st :busy) " …thinking" "")))))
(cl-tty.backend:draw-text fb 1 1 line1
(theme-color (if (st :connected) :connected :disconnected))
nil)
;; Second line: Focus map (left) + timestamp (right-aligned, v0.7.0)
(let ((focus-info (or (st :foveal-id) "")))
(when (and focus-info (> (length focus-info) 0))
(add-string win (format nil " [Focus: ~a]" focus-info)
:y 2 :x 1 :fgcolor (theme-color :timestamp))))
(add-string win (format nil " ~a" (now))
:y 2 :x (max 1 (- (width win) 12))
:fgcolor (theme-color :timestamp))
(refresh win))
(cl-tty.backend:draw-text fb 1 2 (format nil " [Focus: ~a]" focus-info)
(theme-color :timestamp) nil)))
(cl-tty.backend:draw-text fb (max 1 (- w 12)) 2 (format nil " ~a" (now))
(theme-color :timestamp) nil)))
;; v0.7.2: search-highlight — wrap matching text in **bold** for markdown
(defun search-highlight (content query)
@@ -85,11 +83,8 @@ that the TUI actuator attaches to the response plist before transmission.
(setf result (concatenate 'string result (subseq content pos)))
(if (string= result "") content result))))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (st :messages))
(defun view-chat (fb w h)
(let* ((msgs (st :messages))
(total (length msgs))
(max-lines (- h 2))
(is-search (st :search-mode))
@@ -101,7 +96,7 @@ that the TUI actuator attaches to the response plist before transmission.
(query (st :search-query))
(header (format nil "Search: ~d matches for '~a' (~d/~d) — Esc to exit"
(length matches) query (1+ idx) (length matches))))
(add-string win header :y y :x 1 :n (1- w) :fgcolor (theme-color :highlight))
(cl-tty.backend:draw-text fb 1 y header (theme-color :highlight) nil)
(incf y)
(decf max-lines)))
;; Count visible messages from end, accounting for word wrap
@@ -148,48 +143,40 @@ that the TUI actuator attaches to the response plist before transmission.
(theme-color :hitl))))
(dolist (line wrapped)
(when (< y (1- h))
(if (eq role :agent)
(let ((segments (parse-markdown-spans line)))
(setf y (render-styled win segments y 1 w)))
(progn
(add-string win line :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(cl-tty.backend:draw-text fb 1 y line color nil)
(incf y)))
;; v0.7.2: gate trace below agent messages
(let ((gate-trace (getf msg :gate-trace)))
(when (and gate-trace (not (member i (st :collapsed-gates))))
(dolist (entry (passepartout::gate-trace-lines gate-trace))
(when (< y (1- h))
(add-string win (car entry) :y y :x 3 :n (- w 4) :fgcolor (or (getf (cdr entry) :fgcolor) :dim))
(incf y))))))))))
(refresh win))
#+end_src
(cl-tty.backend:draw-text fb 3 y (car entry)
(or (getf (cdr entry) :fgcolor) :dim) nil)
(incf y)))))))))))
#+END_SRC
** Input Line
#+begin_src lisp
(defun view-input (win)
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(defun view-input (fb w)
(let* ((text (input-string))
(w (or (width win) 78))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
(cl-tty.backend:draw-text fb 0 0 (format nil "~a " visible) (theme-color :input) nil)))
#+end_src
** Redraw (dirty-flag dispatch)
#+begin_src lisp
(defun redraw (sw cw ch iw)
(defun redraw (fb w h)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(when sd (view-status fb w))
(when cd (view-chat fb w (- h 5)))
(when id (view-input fb w))
(setf (st :dirty) (list nil nil nil))))
#+end_src
#+END_SRC
* Implementation — v0.7.0 additions
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun char-width (ch)
@@ -213,10 +200,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
((<= #x20D0 code #x20FF) 0)
((<= #xFE00 code #xFE0F) 0)
(t 1))))
#+end_src
#+END_SRC
* v0.7.1 — Markdown Rendering
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun parse-markdown-spans (text)
@@ -257,21 +244,20 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(t (push (cons (subseq text pos) nil) results) (return))))))))
(nreverse results)))
(defun render-styled (win segments y x w)
"Render markdown segments to Croatoan window. Returns next y."
(defun render-styled (fb segments y x w)
"Render markdown segments to cl-tty backend. Returns next y."
(dolist (seg segments)
(when (>= y (height win)) (return y))
(let* ((text (or (car seg) ""))
(attrs (cdr seg))
(bold (getf attrs :bold))
(code (getf attrs :code))
(underline (getf attrs :underline))
(url (getf attrs :url)))
(add-string win text :y y :x x :n (max 1 (- w x))
:bold bold :underline underline
:bgcolor (when code (theme-color :dim))
:fgcolor (cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent)))))
(declare (ignore code))
(cl-tty.backend:draw-text fb x y text
(cond (url (theme-color :highlight))
(t (theme-color (or (getf attrs :role) :agent))))
nil
:bold bold)
(incf x (length text))))
y)
@@ -336,10 +322,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
:keyword :function))) r)
(setf p fe)))))))))
(nreverse r)))
#+end_src
#+END_SRC
* v0.7.2 — Gate Trace
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(in-package :passepartout)
(defun gate-trace-lines (trace)
@@ -366,10 +352,10 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(if (eq result :approval) " (HITL required)" ""))))
(push (cons text (list :fgcolor color)) lines)))
(nreverse lines)))
#+end_src
#+END_SRC
* Test Suite
#+begin_src lisp
#+BEGIN_SRC lisp :tangle ../lisp/channel-tui-view.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
@@ -477,4 +463,4 @@ ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
(passepartout.channel-tui::init-state)
(let ((cg (passepartout.channel-tui::st :collapsed-gates)))
(is (null cg))))
#+end_src
#+END_SRC

View File

@@ -16,7 +16,7 @@
(:file "lisp/core-pipeline")))
(defsystem :passepartout/tui
:depends-on (:passepartout :croatoan :usocket :bordeaux-threads)
:depends-on (:passepartout :cl-tty :usocket :bordeaux-threads)
:serial t
:components ((:file "lisp/channel-tui-state")
(:file "lisp/channel-tui-view")