luv

Workshop wiki

legend.lisp

luvcraft/clim/legend.lisp

system luvcraft · 42 definitions · on GitHub

in-package#:luvcraft.clim

The keymap legend: what the keys do, read off the tables that decide it.

Nothing here is a written-down list of bindings. The rows are gathered by walking the same command tables dispatch walks, so rebinding a key or adding a command changes what the game says about itself, and a legend can never quietly drift out of date with the thing it describes.

Escape slides it up. Escape again puts it away -- and since taking focus hands the pointer back, escape also does what escape has always done here, which is get the player their cursor.

--------------------------------------------------------------------- Reading a table.

defunkeystroke-item-command
itemgesture

Return the command a keystroke item stands for, or NIL.

A :function item builds its command from the gesture that reached it -- which is how one entry serves nine quickbar slots or four walking directions -- so asking what it means is asking it.

case
command-menu-item-typeitem
:command
command-menu-item-valueitem
:function
ignore-errors
funcall
command-menu-item-valueitem
gesture1
tnil
defgenericluvcraft-command-legend-label
nameargumentstable
:documentation

What a legend should call the command name applied to arguments.

Rows are merged by this label, so it decides how coarse the legend is: one line per argument where the argument is the point, one line for the whole family where it is not. Walking forward and sprinting are different lines because they are different things to do; the nine quickbar slots are one line because nobody needs to be told about each of them separately.

:method
nameargumentstable
declare
ignorearguments
string-downcase
or
command-line-name-for-commandnametable:errorpnil
substitute#\Space#\-
symbol-namename
defmethodluvcraft-command-legend-label
name
eql'com-start-walking
argumentstable
declare
ignoretable
if
eq:sprint
firstarguments
"sprint"
formatnil"walk ~(~A~)"
firstarguments
defmethodluvcraft-command-legend-label
name
eql'com-start-looking
argumentstable
declare
ignoreargumentstable

look

defmethodluvcraft-command-legend-label
name
eql'com-select-quickbar-slot
argumentstable
declare
ignoreargumentstable

select block

defmethodluvcraft-command-legend-label
name
eql'com-set-terminal-mode
argumentstable
declare
ignoretable
formatnil"~(~A~) mode"
firstarguments
defuncommand-table-legend-rows

Return table's keystrokes as (label . KEYS) rows, one row per label.

Keys are merged rather than listed once each, because a cheatsheet wants to say that the quickbar is 1-9 rather than saying `select block' nine times.

let
rowsnil
map-over-command-table-keystrokes
lambda
menu-namegestureitem
declare
ignoremenu-name
alexandria:when-let*
command
name
command-namecommand
label
luvcraft-command-legend-labelname
command-argumentscommand
table
let
row
assoclabelrows:test#'string=
ifrow
pushnew
cdrrow
:test#'string=
push
conslabel
list
rows
table:inheritednil
mapcar
lambda
row
cons
carrow
reverse
cdrrow
nreverserows
defparameter*legend-sections*'
"In the world"luvcraft-world
"Any time"luvcraft-window

Which tables the legend shows, in the order a player meets them.

Each is read without inheritance, so a command appears under the layer that actually owns it rather than once per table that inherits it.

defunluvcraft-legend-sections

Return (TITLE . ROWS) for every section that has anything to say.

loopfor
titletable
in*legend-sections*forrows=whenrowscollect
constitlerows

--------------------------------------------------------------------- The panel.

defparameter*legend-width*620
defparameter*legend-margin*26
defparameter*legend-row-height*30
defparameter*legend-section-gap*22
defparameter*legend-title-height*52
defparameter*legend-keys-right*300

Where the key column ends; labels begin a gutter to its right.

Wide enough for the longest run of keys one command answers to, which is the whole number row.

defparameter*legend-panel-ink*
make-rgb-color0.110.110.105
defparameter*legend-row-ink*
make-rgb-color0.1550.1550.147
defparameter*legend-key-ink*
make-rgb-color0.580.780.54
defparameter*legend-text-ink*
make-rgb-color0.910.890.82
defparameter*legend-muted-ink*
make-rgb-color0.600.600.55
defparameter*legend-edge-ink*
make-rgb-color0.420.420.38
defclasslegend-pane
application-pane
define-application-frameluvcraft-legend
session:initarg:session:readerlegend-session

Gathered when the frame is made, so the very first paint already has them: a pane realized by ENABLE-FRAME draws before anyone can fill a slot in afterwards.

sections:initform:accessorlegend-sections
:menu-barnil
:panes
sheet
make-pane'legend-pane
:layouts
default
horizontallysheet
defundraw-legend-row
panerowtop
destructuring-bind
label.keys
row
draw-text*pane
formatnil"~{~A~^ ~}"keys
*legend-keys-right*:align-x:right:align-y:center:text-size16:text-face:bold:ink*legend-key-ink*
draw-text*panelabel:align-y:center:text-size16:ink*legend-text-ink*
defmethodhandle-repaint
region
declare
ignoreregion
let
sections
legend-sections
pane-framepane
with-bounding-rectangle*
lefttoprightbottom
pane
progn
draw-rectangle*panelefttoprightbottom:ink*legend-panel-ink*
draw-rectangle*panelefttoprightbottom:fillednil:line-thickness2:ink*legend-edge-ink*
draw-text*pane"keys"*legend-margin*34:align-y:center:text-size22:text-face:bold:ink*legend-text-ink*
draw-text*pane"Esc closes"34:align-x:right:align-y:center:text-size14:ink*legend-muted-ink*
let
dolist
sectionsections
draw-text*pane
carsection
*legend-margin*
+y14
:align-y:center:text-size14:text-face:bold:ink*legend-muted-ink*
dolist
row
cdrsection
defunrepaint-legend
let
mirror
sheet-direct-mirror
frame-top-level-sheetframe
check-typemirrormcluv:luv-gpu-mirror
frame

--------------------------------------------------------------------- The overlay: a panel in the middle of the screen.

defmethodluvcraft:luvcraft-overlay-stage
declare
ignoreoverlay
:hud
defunlegend-screen-state
overlay

Place the panel at its own size in the middle of the viewport.

let*
viewport-size
luv:canvas-extent
luvcraft:luvcraft-session-context
mcluv:widget-overlay-sessionoverlay
source-width
firstsource-size
source-height
secondsource-size
viewport-width
firstviewport-size
viewport-height
secondviewport-size
scale
min1.0
/
-viewport-width48.0
source-width
/
-viewport-height48.0
source-height
half-width
/
*source-widthscale
viewport-width
half-height
/
*source-heightscale
viewport-height
make-array12:element-type'single-float:initial-contents
mapcar
lambda
value
coercevalue'single-float
list0.00.00.01.0half-width0.00.00.00.0half-height0.00.0
defmethodluvcraft:encode-luvcraft-overlay
sessionpasssurface-texture
declare
ignorepass
mcluv:prepare-direct-widget-overlayoverlaysessionsurface-texture
overlay

A legend is a tool rather than a thing in the world: the camera stays put, and the crosshair never targets it.

defmethodluvcraft:luvcraft-focus-score
declare
ignoreoverlaysession
nil
defmethodluvcraft:luvcraft-focus-camera-pose

Stay exactly where the player was standing.

A legend is a tool, not a thing in the world: nothing is framed, nothing is approached, and the view a player looks back at afterwards is the one they were already looking at.

declare
ignoresession
let
camera
luvcraft:luvcraft-session-camera
mcluv:widget-overlay-sessionoverlay
defmethodluvcraft:luvcraft-focus-entered

Focusing released mouse look, and closing this panel should not silently take it back: escape has always been how a player gets their cursor, and a legend is what you open when you have lost track of the controls.

setf
luvcraft:luvcraft-session-pointer-capture-suspended-psession
nil
overlay
defmethodluvcraft:handle-luvcraft-focus-event
declare
ignorecanvas
when
member
luv:canvas-key-event-key-nameevent
'
:escape:return
close-luvcraft-legendoverlaysession
t
defmethodluvcraft:handle-luvcraft-focus-event
declare
ignoreoverlaysessioncanvasevent
t

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

defunfind-luvcraft-legend
session
find-if
lambda
overlay
luvcraft:luvcraft-session-overlayssession
defunopen-luvcraft-legend
session&key
title"luvcraft keys"

Create, attach, and focus session's keymap legend.

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-legend:frame-managermanager:enablet:sessionsession
setf
frame-pretty-nameframe
title
legend-sectionsframe
sections
let*
mirror
sheet-direct-mirror
frame-top-level-sheetframe
overlay
make-instance'luvcraft-legend-overlay:sessionsession:frameframe:mirrormirror
setf
mcluv:mirror-compositormirror
overlay
overlay
defunclose-luvcraft-legend
overlaysession

Put the legend away.

when
eqoverlay
luvcraft:luvcraft-session-modal-focussession
nil
defuntoggle-luvcraft-legend
session

Show session's keymap legend, or put it away if it is already up.

alexandria:if-let
overlay
close-luvcraft-legendoverlaysession
t

Escape shows the keys. It keeps its old meaning too: focusing the legend releases mouse look, and the legend refuses to take it back on the way out.

define-command
com-show-keymap:command-tableluvcraft-world:name"Show Keys":keystroke
:escape