luv

Workshop wiki

hud.lisp

luvcraft/agent/hud.lisp

system luvcraft/agent · 53 definitions · on GitHub

in-package#:luvcraft.agent

The cassette HUD: the current turn drawn as cards in the corner (#9K823O, #14ZP6S).

A McCLIM frame composited over the view, the way the hotbar and the legend are. Every frame the overlay reads the turn and repaints when anything it shows has changed -- a call's status, its elapsed tenths of a second, a new line of thought -- so a running call's clock ticks and a finished one flips in place. The drawing itself is presentation methods under the cassette view, one per kind of record, so a wall can draw the same cards later from the same objects.

defparameter*agent-hud-width*640
defparameter*agent-hud-height*560
defparameter*agent-hud-margin*16
defparameter*agent-hud-columns*62"Characters per wrapped line at the body text size."
defparameter*hud-panel-ink*
make-rgb-color0.090.090.085
defparameter*hud-edge-ink*
make-rgb-color0.360.360.33
defparameter*hud-text-ink*
make-rgb-color0.910.890.82
defparameter*hud-muted-ink*
make-rgb-color0.580.580.53
defparameter*hud-thought-ink*
make-rgb-color0.550.800.82
defparameter*hud-card-ink*
make-rgb-color0.150.150.14
defparameter*hud-output-ink*
make-rgb-color0.700.720.70
defparameter*hud-error-ink*
make-rgb-color0.900.450.40
defparameter*hud-running-ink*
make-rgb-color0.900.720.30
defparameter*hud-ok-ink*
make-rgb-color0.550.780.50

--------------------------------------------------------------------- Tool identity: one colour per command, the way the stylesheet had one template pair per tool name.

defgenericcommand-ink
command
:documentation

The colour that identifies command's cassettes.

:method
commandt
make-rgb-color0.350.720.70
defmethodcommand-ink
command
eql'com-place-block-at
make-rgb-color0.920.550.28
defmethodcommand-ink
command
eql'com-block-at
make-rgb-color0.400.780.52
defmethodcommand-ink
command
eql'com-where-am-i
make-rgb-color0.900.720.30
defmethodcommand-ink
command
eql'com-eval
make-rgb-color0.680.850.35
defmethodcommand-ink
command
eql'com-describe-handle
make-rgb-color0.700.550.90
defuntool-call-ink
call
command-ink
command-tool-command
tool-call-toolcall

--------------------------------------------------------------------- Wrapping

defunwrap-words
textcolumns

text as lines of at most columns characters, broken on spaces.

let
lines'
current
make-string-output-stream
flet
flush
let
line
get-output-stream-stringcurrent
when
plusp
lengthline
pushlinelines
setflength0
dolist
paragraph
uiop:split-stringtext:separator'
#\Newline
dolist
word
remove""
uiop:split-stringparagraph:separator'
#\Space
:test#'string=
loopwhile
>
lengthword
columns
do
flush
push
subseqword0columns
lines
setfword
subseqwordcolumns
when
and
plusplength
>columns
flush
when
plusplength
write-char#\Spacecurrent
incflength
write-stringwordcurrent
incflength
lengthword
flush
nreverselines

--------------------------------------------------------------------- The cassette view.

Each presentation method draws from the stream's cursor row downward and leaves the cursor below what it drew, so a sequence of present calls stacks cards the way a stylesheet stacks templates.

They are invoked with FUNCALL-PRESENTATION-GENERIC-FUNCTION rather than present: drawing inside WITH-OUTPUT-AS-PRESENTATION reaches the GPU medium as a replayed output record, and nothing shows. Until the HUD wants clickable presentations, the methods are called as plain drawing.

defparameter*cassette-text-size*15
defuncassette-left
stream
declare
ignorestream
*agent-hud-margin*
defuncassette-right
stream
-
bounding-rectangle-widthstream
*agent-hud-margin*
defuncassette-top
stream
nth-value1
stream-cursor-positionstream
defunadvance-cassette
streambottom
setf
stream-cursor-positionstream
valuesbottom
defundraw-cassette-lines
streamlinestop&key
indent0
face:roman

Draw lines from top, one per line height; return the bottom.

let
ytop
dolist
linelines
draw-text*streamline
+indent
+y11
:align-y:center:text-sizesize:text-faceface:inkink
y
defunstatus-spine
call

The spine glyph and its ink for call's status.

ecase
tool-call-statuscall
:running
:ok
values"+"
:error
defuntool-call-window-lines
call&optional

The lines a cassette's window shows for call: the output, folded to *CASSETTE-OUTPUT-LINES* with a count of what is left.

let
lines
wrap-words
if
string=
tool-call-outputcall
""
if
eq:running
tool-call-statuscall
"running"""
tool-call-outputcall
columns
if
append
list
formatnil"... ~D more lines"
lines
defuntool-call-cassette-height
call&optional

How tall call's cassette is, header and window.

define-presentation-methodpresent
callstream&key
let*

The card.

draw-rectangle*streamlefttoprightbottom:ink*hud-card-ink*

The spine.

multiple-value-bind
glyphspine-ink
draw-rectangle*streamlefttop
+left26
+topheader-height
:inkspine-ink
draw-text*streamglyph
+left13
+top14
:align-x:center:align-y:center:text-size16:text-face:bold:ink*hud-panel-ink*

Name, arguments, clock.

draw-text*stream
+left34
+top14
:align-y:center:text-size16:text-face:bold:ink
let
name-width
text-sizestream:text-style
make-text-stylenil:bold16
clock
formatnil"~,1Fs"
draw-text*streamclock
-right8
+top14
:align-x:right:align-y:center:text-size13:ink*hud-muted-ink*
let*
available
-right850
+left34name-width10
arguments-lines
wrap-wordsarguments
max8
flooravailable8
whenarguments-lines
draw-text*stream
firstarguments-lines
+left34name-width10
+top14
:align-y:center:text-size13:ink*hud-muted-ink*

The window.

draw-cassette-linesstreamoutput-lines
+topheader-height2
:indent12:ink
if
eq:error
tool-call-statuscall
*hud-error-ink**hud-output-ink*
advance-cassettestream
+bottom6
define-presentation-methodpresent

Prompt.

let
top
advance-cassettestream
draw-cassette-linesstream
wrap-words
formatnil"> ~A"
turn-promptturn
*agent-hud-columns*
top:ink*hud-text-ink*:face:bold

Thought bubble, as text for now.

unless
string=
turn-thoughtturn
""
let*
lines
if
>
lengthlines
5
lastlines5
lines

Calls, oldest first.

dolist
funcall-presentation-generic-functionpresentcall'tool-callstreamview

What it said.

when
turn-errorturn

--------------------------------------------------------------------- The frame and the overlay

defclassagent-hud-pane
application-pane
define-application-frameluvcraft-agent-hud
agent:initarg:agent:readeragent-hud-agent
visible-state:initformnil:accessoragent-hud-visible-state
:menu-barnil
:panes
sheet
make-pane'agent-hud-pane
:layouts
default
horizontallysheet
defunagent-hud-state

Everything the HUD shows, as a key: repaint when it changes.

let
andturn
list
turn-statusturn
length
turn-thoughtturn
length
turn-textturn
and
turn-errorturn
t
mapcar
lambda
call
list
tool-call-statuscall
length
tool-call-outputcall
defmethodhandle-repaint
region
declare
ignoreregion
let*
frame
pane-framepane
agent
agent-hud-agentframe
with-bounding-rectangle*
lefttoprightbottom
pane
progn
draw-rectangle*panelefttoprightbottom:ink*hud-panel-ink*
draw-rectangle*panelefttoprightbottom:fillednil:line-thickness2:ink*hud-edge-ink*
draw-text*pane"agent"*agent-hud-margin*26:align-y:center:text-size20:text-face:bold:ink*hud-text-ink*
draw-text*pane
formatnil"~A~@[ · ~(~A~)~]"
openai:agent-modelagent
andturn
turn-statusturn
26:align-x:right:align-y:center:text-size14:ink*hud-muted-ink*
setf
stream-cursor-positionpane
ifturn
funcall-presentation-generic-functionpresentturn'turnpane+cassette-view+
draw-text*pane"waiting to be asked"*agent-hud-margin*60:align-y:center:text-size13:text-face:italic:ink*hud-muted-ink*
defunrepaint-agent-hud
let
mirror
sheet-direct-mirror
frame-top-level-sheetframe
check-typemirrormcluv:luv-gpu-mirror
setf
agent-hud-visible-stateframe
frame
defmethodluvcraft:luvcraft-overlay-stage
declare
ignoreoverlay
:hud
defunagent-hud-top-margin
session

Return the HUD's ordinary margin below application-level top surfaces.

multiple-value-bind
lefttoprightbottom
declare
ignoreleftrightbottom
+20.0top
defunagent-hud-screen-state
overlay

Top right corner, at its own size.

One pane pixel is one screen pixel unless the viewport cannot hold it: shrinking the pane shrinks its type, and small type is what reads as soft.

let*
session
mcluv:widget-overlay-sessionoverlay
viewport-size
multiple-value-list
luv:canvas-logical-size
luvcraft:luvcraft-session-canvassession
source-width
firstsource-size
source-height
secondsource-size
viewport-width
firstviewport-size
viewport-height
secondviewport-size
top-margin
scale
min1.0
/
-viewport-width40.0
source-width
/
-viewport-height76.0top-margin
source-height
half-width
/
*source-widthscale
viewport-width
half-height
/
*source-heightscale
viewport-height
margin-x
/20.0viewport-width
margin-y
/top-marginviewport-height
center-x
-1.0margin-xhalf-width
center-y
+-1.0margin-yhalf-height
make-array12:element-type'single-float:initial-contents
mapcar
lambda
value
coercevalue'single-float
listcenter-xcenter-y0.01.0half-width0.00.00.00.0half-height0.00.0
defmethodluvcraft:encode-luvcraft-overlay
sessionpasssurface-texture
declare
ignorepass
overlay
defmethodluvcraft:refresh-luvcraft-overlay
declare
ignoresession
let
frame
mcluv:widget-overlay-frameoverlay
unless
equal
agent-hud-visible-stateframe
overlay

A HUD, not a thing in the world: never targeted, never focused.

defmethodluvcraft:luvcraft-focus-score
declare
ignoreoverlaysession
nil

--------------------------------------------------------------------- Opening and closing

defunfind-agent-hud
session
find-if
lambda
overlay
luvcraft:luvcraft-session-overlayssession
defunopen-agent-hud

Attach the cassette HUD for agent to its session.

let*
port
find-port:server-path'
:luv-gpu
manager
or
first
climi::frame-managersport
make-instance'mcluv:luv-frame-manager:portport
frame
let
mcluv:*embedded-mirror-target*
luvcraft:luvcraft-session-canvassession
mcluv:*embedded-mirror-context*
luvcraft:luvcraft-session-contextsession
mcluv:*embedded-mirror-device*
luvcraft:luvcraft-session-devicesession
make-application-frame'luvcraft-agent-hud:frame-managermanager:enablet:agentagent
setf
frame-pretty-nameframe
"luvcraft agent"
let*
mirror
sheet-direct-mirror
frame-top-level-sheetframe
overlay
make-instance'luvcraft-agent-hud-overlay:sessionsession:frameframe:mirrormirror
setf
mcluv:mirror-compositormirror
overlay
overlay
defunclose-agent-hud

Put the agent HUD away.

alexandria:when-let
overlay
andsession
t