luv

Workshop wiki

wall.lisp

luvcraft/agent/wall.lisp

system luvcraft/agent · 28 definitions · on GitHub

in-package#:luvcraft.agent

The agent's wall: the transcript on a terminal wall, drawn the way the phone and the shell walls are drawn -- Ghostty cells as Slug glyph geometry, sharp at any distance (#GJUPMQ) -- rather than through a McCLIM mirror.

The wall is a terminal-display with no PTY. What it shows is VT bytes the agent writes into its Ghostty terminal: the prompt the player types at it, the thought as it streams, and each tool call as an ANSI cassette (#9K823O) once it has finished. The terminal does the scrolling and the wrapping; we do the colours.

Two threads meet here and one thing crosses between them, the way the Telegram wall already does it: the turn's thread formats text and posts it to an outbox; the canvas thread drains the outbox into the terminal at the frame boundary, where it also reads the terminal to draw it. Nothing writes the terminal from anywhere else.

defclassagent-terminal-display
agent:initarg:agent:accessoragent-wall-agent
outbox:initform
sb-concurrency:make-mailbox:name"agent wall outbox"
:readeragent-wall-outbox
draft:initform"":accessoragent-wall-draft:documentation"What the player has typed at the wall so far."
line-open-p:initformnil:accessoragent-wall-line-open-p:documentation"Whether streamed text has left the cursor mid-line."
printed:initform
make-hash-table:test#'eq
:readeragent-wall-printed:documentation"Per turn, (THOUGHT-LENGTH . TEXT-LENGTH) already written."
observer:initformnil:accessoragent-wall-observer
:documentation

A terminal wall showing one agent's transcript.

--------------------------------------------------------------------- Writing

defuncrlf
text

text with every newline made a carriage return and line feed.

There is no tty discipline between us and Ghostty to do it.

with-output-to-string
out
loopforcharacrosstextdo
when
char=char#\Newline
write-char#\Returnout
write-charcharout
defunagent-wall-write
displaytext

Queue text for display's terminal; the frame boundary writes it.

sb-concurrency:send-message
agent-wall-outboxdisplay
crlftext
display
defunagent-wall-close-line
display
when
agent-wall-line-open-pdisplay
agent-wall-writedisplay
string#\Newline
setf
agent-wall-line-open-pdisplay
nil
defmethodluvcraft:refresh-luvcraft-overlay:before
declare
ignoresession
let
terminal
luvcraft::terminal-display-terminaldisplay
wrote-pnil
loopfor
textreceived-p
=
multiple-value-list
sb-concurrency:receive-message-no-hang
agent-wall-outboxdisplay
whilereceived-pdo
setfwrote-pt
whenwrote-p
setf
luvcraft::terminal-display-dirty-pdisplay
t

--------------------------------------------------------------------- ANSI: the cassette as escape sequences.

defclassansi-view
textual-view
:documentation

Text with SGR colour, for a terminal wall.

defparameter+ansi-view+
make-instance'ansi-view
defvar*ansi-columns*80"The width of the terminal an ANSI presentation is being written for."
defunsgr-foreground
color
multiple-value-bind
rgb
formatnil"~C[38;2;~D;~D;~Dm"#\Escape
round
*255r
round
*255g
round
*255b
defunsgr-background
color
multiple-value-bind
rgb
formatnil"~C[48;2;~D;~D;~Dm"#\Escape
round
*255r
round
*255g
round
*255b
defunsgr-reset
formatnil"~C[0m"#\Escape
defunsgr-bold
formatnil"~C[1m"#\Escape
defunsgr-dim
formatnil"~C[2m"#\Escape
defunsgr-italic
formatnil"~C[3m"#\Escape
define-presentation-methodpresent
callstream&key
multiple-value-bind
glyphspine-ink
let*
clock
formatnil"~,1Fs"
head
formatnil" ~A ~A ~A"glyphnamearguments

Header: spine, name, arguments, clock at the right edge.

formatstream"~A~A ~A ~A~A~A~A~A ~A~A~A~A~A~A~A~%"glyphnamearguments
make-stringpad:initial-element#\Space
clock

Window: a few lines of output, indented under the spine.

let*
text
tool-call-outputcall
lines
if
string=text""
'
shown
if
append
list
formatnil"... ~D more lines"
lines
dolist
lineshown
formatstream" ~A~A~A~%"line

--------------------------------------------------------------------- Following a turn

defunagent-wall-columns
display
values
ghostty:terminal-size
luvcraft::terminal-display-terminaldisplay
defunagent-wall-note-turn-started
displayturn
setf
gethashturn
agent-wall-printeddisplay
cons00

Whatever prompt line was waiting -- typed here or not -- is replaced by the turn's own first line.

agent-wall-writedisplay
formatnil"~C~C[2K~A> ~A~A~%"#\Return#\Escape
turn-promptturn
defunagent-wall-note-streamed
displayturnkind

Write whatever of turn's thought or text (kind) has not been written.

let*
printed
or
gethashturn
agent-wall-printeddisplay
setf
gethashturn
agent-wall-printeddisplay
cons00
whole
ecasekind
:thought
turn-thoughtturn
:text
turn-textturn
done
ecasekind
:thought
carprinted
:text
cdrprinted
when
>
lengthwhole
done
let
fresh
subseqwholedone
unless
agent-wall-line-open-pdisplay
agent-wall-writedisplay
ecasekind
agent-wall-writedisplayfresh
setf
agent-wall-line-open-pdisplay
t
ecasekind
:thought
setf
carprinted
lengthwhole
:text
setf
cdrprinted
lengthwhole
defunagent-wall-note-turn-finished
displayturn
when
turn-errorturn
agent-wall-writedisplay
formatnil"~Afailed: ~A~A~%"
turn-errorturn
agent-wall-writedisplay
formatnil"~%> "
remhashturn
agent-wall-printeddisplay
defunmake-agent-wall-observer
display
lambda
agentkindobject
declare
ignoreagent
casekind
:turn-started
:thought
agent-wall-note-streameddisplayobject:thought
:text
agent-wall-note-streameddisplayobject:text
:call-started
:call-finished
:turn-finished

--------------------------------------------------------------------- Typing at the wall

defmethodluvcraft:handle-luvcraft-focus-event
declare
ignorecanvas
let
name
luv:canvas-key-event-key-nameevent
char
luv:canvas-key-event-characterevent
cond
eqname:return
let
prompt
string-trim" "
agent-wall-draftdisplay
setf
agent-wall-draftdisplay
""
unless
string=prompt""
askprompt:agent
agent-wall-agentdisplay
eqname:backspace
let
draft
agent-wall-draftdisplay
when
plusp
lengthdraft
setf
agent-wall-draftdisplay
subseqdraft0
1-
lengthdraft
agent-wall-writedisplay
formatnil"~C ~C"#\Backspace#\Backspace
andchar
graphic-char-pchar
not
intersection'
:control:meta:super
luv:canvas-key-event-modifiersevent
setf
agent-wall-draftdisplay
concatenate'string
agent-wall-draftdisplay
stringchar
agent-wall-writedisplay
stringchar
t

--------------------------------------------------------------------- Opening one

defunattach-agent-wall
displayagent

Give display its agent: an observer in, a prompt out, no PTY at all.

setf
agent-wall-agentdisplay
agent
agent-wall-observerdisplay
add-agent-observeragent
agent-wall-observerdisplay
agent-wall-writedisplay
formatnil"~A~Aluvcraft agent~A ~A~A~A~%~%> "
openai:agent-modelagent
display
defmethodluvcraft:release-luvcraft-overlay:after
when
and
slot-boundpdisplay'agent
agent-wall-observerdisplay
remove-agent-observer
agent-wall-agentdisplay
agent-wall-observerdisplay
defunopen-agent-wall

Open agent's transcript on the terminal wall the player is looking at.

hit may name another terminal block; by default it is the one under the crosshair, as when activating a wall.

let
unlesshit
error"Look at a terminal block to open the agent's wall on it."
let
display
luvcraft::open-activated-wall-displaysessionhitluvcraft::*terminal-block*
lambda
display
attach-agent-walldisplayagent
:class'agent-terminal-display
unlessdisplay
error"That is not a terminal wall."
display
define-command
com-open-agent-wall:command-tableluvcraft.clim::luvcraft-world:name"Open Agent Wall"
"Put the agent's transcript on the terminal wall under the crosshair."