luv

Workshop wiki

body.lisp

luvcraft/body.lisp

system luvcraft/core · 48 definitions · on GitHub

The player's own body as seen from inside it, and what its hands hold.

#S27JKR is the design; this is what it turned into.

The camera has always been a disembodied eye. This gives it a pair of arms hanging into the bottom of the view, hands on the ends of them, and a grip protocol so that a hand can hold something: brought up out of a pocket, held while walking, put away again.

The body is an SDF like the embodied agents. In first person its visible slice is the arms and hands, sphere-traced in the *view* frame -- x to the right, y up, z forward, origin at the eye -- so the body stays attached to the camera while the head looks around. Held things retain their own geometry and grip protocol: an analytic hand can still hold a round-corner phone with a live terminal on it.

The first thing a hand can hold is a phone (phone.LISP). It is deliberately a little too large: a slab of near-black glass with a live terminal on it, held up in front of the face like everyone holds theirs.

in-package#:luvcraft
defconstant+player-body-box-limit+40

The most box-equivalents (36 vertices) the body and its held item may emit per frame; a rounded slab counts for several.

defconstant+player-body-equip-rate+7.0d0"How quickly a held item rises into view or drops out of it, per second."
defconstant+player-body-bob-rate+9.0d0"Radians of walking bob per second at full walking speed."

The eye bobs with the body. The head is highest passing over the standing leg and lowest at each footfall, so the eye rises twice per bob cycle and sways once; the arms above already follow the same phase, so the two motions read as one body walking. These are knobs so the gait can be tuned from play without a rebuild.

defparameter*player-view-bob-lift*0.07d0"Peak-to-trough rise of the eye over one step, in cells."
defparameter*player-view-bob-sway*0.035d0"Sideways amplitude of the eye over one stride, in cells."
defparameter*player-view-land-dip*0.035d0"Eye dip per cell-per-second of landing speed, in cells."
defparameter*player-view-land-seconds*0.28d0"How long the landing dip takes to go down and come back."
define-knobview-bob-lift
:group:player:label"bob lift":quantity
:quantity:player-eye-height:unit:cell
:typedouble-float:minimum0d0:maximum0.15d0:step0.005d0
*player-view-bob-lift*
define-knobview-bob-sway
:group:player:label"bob sway":quantity
:quantity:player-eye-height:unit:cell
:typedouble-float:minimum0d0:maximum0.1d0:step0.005d0
*player-view-bob-sway*

--------------------------------------------------------------------- What a hand can hold.

defgenerichand-item-name
item
:documentation

A short lowercase noun for item, as the title shows it.

defgenericmap-hand-item-boxes
itembodyfunction
:documentation

Call function for each textured box of item as held by body.

function receives (X Y Z HALF-X HALF-Y HALF-Z TILE &KEY TILT STRETCH-P EMISSION), like map-critter-boxes with three extras: TILT is a (PITCH YAW ROLL) triple of radians turning the box about its own centre, STRETCH-P stretches the whole atlas tile over each face instead of keeping texels cell-sized, and EMISSION is the face's own light. Coordinates are in the grip frame: origin at the palm, x across the fingers, y up the item, z away from the player.

defgenerichand-item-box-count
item
:documentation

How many boxes map-hand-item-boxes emits for item.

defgenericemit-hand-item
itembodyverticespalmrightupforwardsky-levelblock-level
:documentation

Append item's geometry, held by body, to vertices.

palm is the world point of the grip and right up forward its unit frame. The default method emits the item's map-hand-item-boxes; an item whose shape is not a heap of boxes -- a slab with genuinely round corners -- adds to that here.

defgenerichand-item-carry-pose
itembody
:documentation

Where body holds item: (X Y Z PITCH YAW ROLL) of the grip in the view frame, before walking bob is added.

defgenerichand-item-taken-out
itembodysession
:documentation

Notify item that body has just taken it in hand.

defmethodhand-item-taken-out
itembodysession
declare
ignoreitembodysession
nil
defgenerichand-item-put-away
itembodysession
:documentation

Notify item that body has just pocketed it.

defmethodhand-item-put-away
itembodysession
declare
ignoreitembodysession
nil
defgenerichand-item-use
itembodysessionbutton
:documentation

The player clicked button while body held item. Return true when the item did something with the click, so it does not go on to edit the world; the default hand holds things but does nothing with them.

defmethodhand-item-use
itembodysessionbutton
declare
ignoreitembodysessionbutton
nil
defgenericadvance-hand-item
itembodyseconds
:documentation

Let item ease its own state by seconds while body holds it.

defmethodadvance-hand-item
itembodyseconds
declare
ignoreitembodyseconds
nil

--------------------------------------------------------------------- The body.

defclassplayer-body
hand-item:initformnil:accessorplayer-body-hand-item

Items the body owns but is not holding. A pocketed item keeps its state -- the phone keeps its shell -- and comes back out as it was.

pocket:initformnil:accessorplayer-body-pocket

How far the held item has come up into view, 0 (pocketed) to 1 (held). Eased toward its target every frame so taking something out is a motion rather than a cut.

equip-amount:initform0d0:typedouble-float:accessorplayer-body-equip-amount

The walking bob, accumulated from ground speed so standing still stands still.

bob-phase:initform0d0:typedouble-float:accessorplayer-body-bob-phase
bob-amount:initform0d0:typedouble-float:accessorplayer-body-bob-amount

The landing: the last downward speed seen while airborne, whether the body was on the ground last frame, and how deep and how far along the current landing dip is.

airborne-speed:initform0d0:typedouble-float:accessorplayer-body-airborne-speed
grounded-p:initformt:accessorplayer-body-grounded-p
land-depth:initform0d0:typedouble-float:accessorplayer-body-land-depth
land-elapsed:initform1d0:typedouble-float:accessorplayer-body-land-elapsed

A time base for the small breathing sway of a body that is not walking anywhere.

clock:initform0d0:typedouble-float:accessorplayer-body-clock

The lower-screen proxy and live shader are render resources owned by the body itself once it is attached to a session.

sdf-pipeline:initformnil:accessorplayer-body-sdf-pipeline
sdf-vertex-buffer:initformnil:accessorplayer-body-sdf-vertex-buffer
sdf-instance-buffer:initformnil:accessorplayer-body-sdf-instance-buffer
sdf-instance-data:initformnil:accessorplayer-body-sdf-instance-data
:documentation

The first-person body: two arms and what they hold.

defmethodluvcraft-overlay-stage
declare
ignorebody
:viewmodel
defmethodluvcraft-overlay-live-shader-pipelines
when
player-body-sdf-pipelinebody
list
player-body-sdf-pipelinebody
defunplace-player-body-sdf
body

Publish body's current view-local palms to its SDF instance buffer.

let
data
player-body-sdf-instance-databody
loopforposeinforoffsetin'
04
do
destructuring-bind
xyzpitchyawroll
pose
declare
ignorepitchyawroll
setf
arefdataoffset
coercex'single-float
arefdata
+offset1
coercey'single-float
arefdata
+offset2
coercez'single-float
arefdata
+offset3
1.0
write-buffer
player-body-sdf-instance-bufferbody
data
body
defmethodencode-luvcraft-overlay
sessionpasssurface-texture
when
player-body-sdf-pipelinebody
let
frame
luvcraft-frame-statesessionsurface-texture
set-pipelinepass
live-shader-pipeline-native-pipeline
player-body-sdf-pipelinebody
set-vertex-bufferpass0
player-body-sdf-vertex-bufferbody
set-vertex-bufferpass1
player-body-sdf-instance-bufferbody
set-bind-grouppass0
luvcraft-frame-scene-bind-groupframe
drawpass61
body
defmethodrelease-luvcraft-overlay
when
player-body-sdf-pipelinebody
release-live-shader-pipeline
player-body-sdf-pipelinebody
dolist
resource
list
player-body-sdf-instance-bufferbody
player-body-sdf-vertex-bufferbody
whenresource
destroyresource
setf
player-body-sdf-pipelinebody
nil
player-body-sdf-instance-bufferbody
nil
player-body-sdf-vertex-bufferbody
nil
player-body-sdf-instance-databody
nil
values
defunattach-player-body-sdf
session

Attach session's first-person SDF body and its owned GPU resources.

let
body
luvcraft-session-bodysession
when
player-body-sdf-pipelinebody
return-fromattach-player-body-sdfbody
let*
device
luvcraft-session-devicesession
instance-data
make-array8:element-type'single-float
vertex-buffernil
instance-buffernil
pipelinenil
transferred-pnil
completed-pnil
unwind-protect
progn
setfvertex-buffer
createdevice
make-buffer-descriptor:label"player SDF proxy":size
*4
lengthvertex-data
:usage'
:vertex:copy-dst
instance-buffer
createdevice
make-buffer-descriptor:label"player SDF palms":size
*4
lengthinstance-data
:usage'
:vertex:copy-dst
pipeline
make-live-shader-pipeline:role:player-body-sdf:vertex-role:player-body-sdf:label"player body SDF pipeline":devicedevice:layout
live-shader-pipeline-layout
:vertex-buffers'
:array-stride12:attributes
:shader-location0:offset0:format:float32x3
:array-stride32:step-mode:instance:attributes
:shader-location1:offset0:format:float32x4
:shader-location2:offset16:format:float32x4
:target-format+luvcraft-scene-color-format+:target-blend:premultiplied-alpha:primitive'
:topology:triangle-list
:depth-stencil'
:format:depth32-float:depth-write-enablednil:depth-compare:always
write-buffervertex-buffervertex-data
setf
player-body-sdf-pipelinebody
pipeline
player-body-sdf-vertex-bufferbody
vertex-buffer
player-body-sdf-instance-bufferbody
instance-buffer
player-body-sdf-instance-databody
instance-data

ADD owns BODY and its installed resources from this point, including the terminal-rejection cleanup path.

setftransferred-pt
setfcompleted-pt
body
unless
orcompleted-ptransferred-p
whenpipeline
ignore-errors
wheninstance-buffer
ignore-errors
destroyinstance-buffer
whenvertex-buffer
ignore-errors
destroyvertex-buffer
defunput-away-hand-item
bodysession

Pocket whatever body holds and return it, or NIL when the hand was empty.

let
item
player-body-hand-itembody
whenitem
setf
player-body-hand-itembody
nil
pushnewitem
player-body-pocketbody
hand-item-put-awayitembodysession
item
defuntake-out-hand-item
bodysessionitem

Put item in body's hand, pocketing whatever was there, and return it.

unless
eqitem
player-body-hand-itembody
setf
player-body-pocketbody
removeitem
player-body-pocketbody
player-body-hand-itembody
item
let
completed-pnil
unwind-protect
progn
hand-item-taken-outitembodysession
setfcompleted-pt

An item whose display or other live attachment failed to open is not nevertheless published in the hand as an inert shell. Pocket it so the next take-out is a real retry.

unlesscompleted-p
setf
player-body-hand-itembody
nil
pushnewitem
player-body-pocketbody
item
defuntoggle-hand-item
bodysessiontype

Take out body's item of type -- from the pocket, or newly made -- or put it away when it is already the thing in hand. Returns what is now held.

let
held
player-body-hand-itembody
if
typepheldtype
take-out-hand-itembodysession
or
find-if
lambda
item
typepitemtype
player-body-pocketbody
make-instancetype
player-body-hand-itembody
defunadvance-player-body
bodysessionseconds

Ease body's held item and walking bob by seconds.

flet
ease
currenttargetrate
let
step
*rateseconds
cond
>targetcurrent
mintarget
+currentstep
<targetcurrent
maxtarget
-currentstep
tcurrent
incf
player-body-clockbody
seconds
setf
player-body-equip-amountbody
ease
player-body-equip-amountbody
if
player-body-hand-itembody
1d00d0
+player-body-equip-rate+
alexandria:when-let
item
player-body-hand-itembody
advance-hand-itemitembodyseconds
let*
player
luvcraft-session-playersession
speed
if
andplayer
player-grounded-pplayer
let
velocity
player-velocityplayer
sqrt
+
expt
vec3-xvelocity
2
expt
vec3-zvelocity
2
0d0
fraction
ifplayer
min1d0
/speed
0d0
incf
player-body-bob-phasebody
setf
player-body-bob-amountbody
ease
player-body-bob-amountbody
fraction6d0
whenplayer
let
grounded-p
player-grounded-pplayer
cond
notgrounded-p
setf
player-body-airborne-speedbody
min
player-body-airborne-speedbody
not
player-body-grounded-pbody

Touchdown: the knees take the fall speed.

setf
player-body-land-depthbody
min0.3d0
**player-view-land-dip*
max0d0
-
player-body-airborne-speedbody
player-body-land-elapsedbody
0d0
player-body-airborne-speedbody
0d0
setf
player-body-grounded-pbody
grounded-p
incf
player-body-land-elapsedbody
seconds
unless
or
let
focus
luvcraft-session-modal-focussession
place-player-viewbodyplayer
luvcraft-session-camerasession
body
defunplayer-body-view-offset
body

The eye's displacement from the player's nominal eye point, as (SWAY LIFT): SWAY along the camera's right, LIFT along world up.

let*
phase
player-body-bob-phasebody
bob
player-body-bob-amountbody
elapsed
player-body-land-elapsedbody
dip
if
*
player-body-land-depthbody
0d0
valuessway
-liftdip
defunplace-player-view
bodyplayercamera

Put camera at player's eye, displaced by body's walking bob and landing.

multiple-value-bind
swaylift
let
position
camera-positioncamera
yaw
incf
vec3-xposition
*sway
cosyaw
incf
vec3-zposition
-
*sway
sinyaw
incf
vec3-yposition
lift
camera

--------------------------------------------------------------------- Boxes in a frame.

defunrotate-frame
rightupforwardpitchyawroll

Return right up forward turned by yaw about up, then pitch about the new right, then roll about the new forward. A positive yaw turns forward toward the right; a positive pitch tips the top away from the viewer.

flet
rotate

Rotate vectors A and B in their own plane by angle.

let
values
make-vec3
+
*c
vec3-xa
*s
vec3-xb
+
*c
vec3-ya
*s
vec3-yb
+
*c
vec3-za
*s
vec3-zb
make-vec3
-
*c
vec3-xb
*s
vec3-xa
-
*c
vec3-yb
*s
vec3-ya
-
*c
vec3-zb
*s
vec3-za
unless
zeropyaw
multiple-value-setq
forwardright
rotateforwardrightyaw
unless
zeroppitch
multiple-value-setq
upforward
rotateupforwardpitch
unless
zeroproll
multiple-value-setq
rightup
rotaterightuproll
valuesrightupforward
defunframe-point
originrightupforwardxyz

The world point at X right + Y up + Z forward from origin.

make-vec3
+
vec3-xorigin
*x
vec3-xright
*y
vec3-xup
*z
vec3-xforward
+
vec3-yorigin
*x
vec3-yright
*y
vec3-yup
*z
vec3-yforward
+
vec3-zorigin
*x
vec3-zright
*y
vec3-zup
*z
vec3-zforward
defunemit-framed-box
verticesoriginrightupforwardhalf-xhalf-yhalf-ztilesky-levelblock-levelemissionstretch-p

Append one box centred on origin with axes right up forward to vertices.

The box's local x, y, z are those axes; right up forward must be a unit orthonormal frame, so the face normals come out unit too.

let
dolist
let*
normal
block-face-neighborface
nx
voxel-direction-dxnormal
ny
voxel-direction-dynormal
nz
voxel-direction-dznormal
world-normal
frame-point
make-vec30d00d00d0
rightupforwardnxnynz
shade
critter-face-shade
vec3-yworld-normal
multiple-value-bind
scale-uscale-v
ifstretch-p
values1d01d0
critter-face-texture-scalesfacehalf-xhalf-yhalf-z
let
origin-u
*0.5d0
-1d0scale-u
origin-v
*0.5d0
-1d0scale-v
dolist
index'
012023
let*
corner
nthindex
block-face-cornersface
local-x
*
-
firstcorner
0.5d0
2d0half-x
local-y
*
-
secondcorner
0.5d0
2d0half-y
local-z
*
-
thirdcorner
0.5d0
2d0half-z
point
frame-pointoriginrightupforwardlocal-xlocal-ylocal-z
multiple-value-bind
uv
let
tile-u
+origin-u
*uscale-u
tile-v
+origin-v
*vscale-v
push-block-vertex-componentsvertices
vec3-xpoint
vec3-ypoint
vec3-zpoint
tile-utile-vshade
vec3-xworld-normal
vec3-yworld-normal
vec3-zworld-normal
sky-levelblock-levelemissiontile+block-face-edge-flush++block-face-edge-flush++block-face-edge-flush++block-face-edge-flush+
vertices

--------------------------------------------------------------------- The body's boxes.

defunplayer-body-light-levels
session

The normalized sky and block light where the eye is.

let
camera
luvcraft-session-camerasession
multiple-value-bind
skyblockstatus
world-light-at
luvcraft-session-worldsession
if
eqstatus:resident
values
/sky15.0
/block15.0
values1.00.0
defunlerp-pose
abamount
mapcar
lambda
xy
+x
*
-yx
amount
ab
defunplayer-body-hand-pose
bodyside

Where side's (:LEFT or :RIGHT) palm is in the view frame, and its tilt.

Returns (X Y Z PITCH YAW ROLL). The right hand is where a held item lives; the left just hangs into the corner of the view.

let*
clock
player-body-clockbody
bob-phase
player-body-bob-phasebody
bob
player-body-bob-amountbody
breathe
*0.006d0
sin
*1.3d0clock
bob-x
*bob0.020d0
sinbob-phase
bob-y
*bob0.028d0
abs
sinbob-phase
item
player-body-hand-itembody
equip
player-body-equip-amountbody
ecaseside
:right
let*
empty'
0.43d0-0.25d00.64d0-0.30d0-0.35d00.20d0
pocket'
0.40d0-0.72d00.55d0-0.60d0-0.35d00.20d0
pose
ifitem
lerp-posepocketempty
-1d0equip
destructuring-bind
xyzpitchyawroll
pose
list
+xbob-x
+ybob-ybreathe
z
+pitch
*bob0.05d0
sinbob-phase
yawroll
:left
destructuring-bind
xyzpitchyawroll
'
-0.43d0-0.25d00.64d0-0.30d00.35d0-0.20d0
list
-xbob-x
+y
*0.7d0bob-y
-breathe
z
-pitch
*bob0.05d0
sinbob-phase
yawroll
defunplayer-body-grip-frame
session

The world-space frame of the right hand's grip this frame.

Returns the palm point and the unit RIGHT, UP, and FORWARD of the grip. A held item's boxes are placed in this frame, and a display drawn on a held item (the phone's terminal) expresses the camera in it.

let
camera
luvcraft-session-camerasession
body
luvcraft-session-bodysession
multiple-value-bind
rightupforward
destructuring-bind
xyzpitchyawroll
multiple-value-bind
grip-rightgrip-upgrip-forward
rotate-framerightupforwardpitchyawroll
values
frame-point
camera-positioncamera
rightupforwardxyz
grip-rightgrip-upgrip-forward
defunemit-player-body
verticessession

Append session's held item; its arms and hands are the SDF scene overlay.

let*
body
luvcraft-session-bodysession
item
player-body-hand-itembody
whenitem
multiple-value-bind
skyblock
multiple-value-bind
palmgrip-rightgrip-upgrip-forward
emit-hand-itemitembodyverticespalmgrip-rightgrip-upgrip-forwardskyblock
vertices
defmethodemit-hand-item
itembodyverticespalmrightupforwardsky-levelblock-level
map-hand-item-boxesitembody
lambda
bxbybzhalf-xhalf-yhalf-ztile&key
tilt'
0d00d00d0
stretch-p
emission0.0
multiple-value-bind
box-rightbox-upbox-forward
apply#'rotate-framerightupforwardtilt
emit-framed-boxvertices
frame-pointpalmrightupforwardbxbybz
box-rightbox-upbox-forwardhalf-xhalf-yhalf-ztilesky-levelblock-levelemissionstretch-p
vertices

--------------------------------------------------------------------- A slab with round corners.

defunrounded-rectangle-outline
half-xhalf-yradiussegments

Return the (X . Y) corners of a rounded rectangle, counter-clockwise from the right side's lower end, with segments arcs per corner.

let
pointsnil
x
-half-xradius
y
-half-yradius

Corner centres and the angle each arc starts at: lower right, upper right, upper left, lower left, each arc turning a quarter.

loopfor
cxcystart
in
list
listx
-y
*-0.5d0pi
listxy0d0
list
-x
y
*0.5d0pi
list
-x
-y
pi
do
dotimes
i
1+segments
let
angle
+start
*
/isegments
0.5d0pi
push
cons
+cx
*radius
+cy
*radius
points
nreversepoints
defunemit-rounded-slab
verticesoriginrightupforwardhalf-xhalf-yhalf-zradiustilesky-levelblock-level&key
segments6
emission0.0

Append a slab centred on origin with axes right up forward whose four corners are rounded to radius in the RIGHT/UP plane: two flat faces and a band of quads around the edge, all wearing tile stretched once around.

let*
outline
rounded-rectangle-outlinehalf-xhalf-yradiussegments
count
lengthoutline
labels
world-normal
nxnynz
frame-point
make-vec30d00d00d0
rightupforwardnxnynz
vertex
xyznormaluv
let
point
frame-pointoriginrightupforwardxyz
push-block-vertex-componentsvertices
vec3-xpoint
vec3-ypoint
vec3-zpoint
uv
critter-face-shade
vec3-ynormal
vec3-xnormal
vec3-ynormal
vec3-znormal
sky-levelblock-levelemissiontile+block-face-edge-flush++block-face-edge-flush++block-face-edge-flush++block-face-edge-flush+
face-uv
xy
values
+0.5d0
/x
*2half-x
-0.5d0
/y
*2half-y

The two flat faces, as fans from the centre. The front (-z) face is wound to face the eye; the back the other way.

dolist
side'
-11
let*
z
*sidehalf-z
normal
world-normal0d00d0side
loopforibelowcountfora=
nthioutline
forb=
nth
mod
1+i
count
outline
do
multiple-value-bind
auav
face-uv
cara
cdra
multiple-value-bind
bubv
face-uv
carb
cdrb
vertex0d00d0znormal0.5d00.5d0
if
minuspside
progn
vertex
carb
cdrb
znormalbubv
vertex
cara
cdra
znormalauav
progn
vertex
cara
cdra
znormalauav
vertex
carb
cdrb
znormalbubv

The rim: one quad per outline edge, its normal the edge's outward perpendicular, the tile running once around it.

loopforibelowcountfora=
nthioutline
forb=
nth
mod
1+i
count
outline
forex=
-
carb
cara
forey=
-
cdrb
cdra
forlength=
max1d-9
sqrt
+
*exex
*eyey
fornormal=
world-normal0d0
foru0=
/icount
foru1=
/
1+i
count
do
vertex
cara
cdra
-half-z
normalu00d0
vertex
carb
cdrb
-half-z
normalu10d0
vertex
carb
cdrb
half-znormalu11d0
vertex
cara
cdra
-half-z
normalu00d0
vertex
carb
cdrb
half-znormalu11d0
vertex
cara
cdra
half-znormalu01d0
vertices
defunplayer-body-vertices
session

Build the block-pipeline stream for the player's held item this frame.

let
vertices
make-array:element-type'single-float:adjustablet:fill-pointer0
emit-player-bodyverticessession
vertices