luv

Workshop wiki

locomotion.lisp

luvcraft/locomotion.lisp

system luvcraft/core · 22 definitions · on GitHub

Destinational movement for any body in the block world.

A Move To request is intentionally discrete: an integer place, a short path of standable cells, and a terminal result. Its realization is not. The body keeps an ordinary continuous position and velocity and reaches each waypoint through the same acceleration, gravity, step-up, and voxel collision motor as held player input. This is the two-authority model in #YPGXKI: a compact intention above an honest physical body.

in-package#:luvcraft
defparameter*body-path-horizontal-radius*10"Farthest horizontal cell distance accepted by one Move To action."
defparameter*body-path-vertical-radius*4"Farthest vertical cell distance accepted by one Move To action."
defparameter*body-path-visit-limit*1200"Maximum cells considered by one nearby path search."
defparameter*body-movement-stuck-seconds*1.75d0"Time without useful progress before a Move To action replans."
defparameter*body-movement-arrival-radius*0.09d0"Horizontal distance from a cell centre which counts as arriving."
defclassbody-move-action
body:initarg:body:readerbody-move-action-body
start:initarg:start:readerbody-move-action-start
destination:initarg:destination:readerbody-move-action-destination
path:initarg:path:accessorbody-move-action-path
status:initform:running:accessorbody-move-action-status
detail:initformnil:accessorbody-move-action-detail
elapsed:initform0d0:accessorbody-move-action-elapsed
deadline:initarg:deadline:readerbody-move-action-deadline
best-distance:initformmost-positive-double-float:accessorbody-move-action-best-distance
stuck-seconds:initform0d0:accessorbody-move-action-stuck-seconds
replans:initform0:accessorbody-move-action-replans
lock:initform
sb-thread:make-mutex:name"body Move To action"
:readerbody-move-action-lock
completion:initform
sb-concurrency:make-mailbox:name"body Move To completion"
:readerbody-move-action-completion
:documentation

One bounded, waitable request for a continuous body to reach a cell.

defunbody-cell
body

Return the integer X, Y, Z cell whose floor contains body's base centre.

defunbody-cell-list
body
multiple-value-list
defunbody-standable-at-p
bodyworldxyz

Whether body can stand centred in cell X,Y,Z on resident solid support.

multiple-value-bind
supportresidency
world-block-atworldx
1-y
z
and
eqresidency:resident
body-position-clear-pbodyworld
+x0.5d0
y
+z0.5d0
defunnearby-body-cell-p
cellstart
destructuring-bind
xyz
cell
destructuring-bind
start-xstart-ystart-z
start
defunbody-cell-neighbors
bodyworldcellstart

Standable horizontal neighbors of cell, allowing one-cell steps up/down.

destructuring-bind
xyz
cell
loopfor
dxdz
in'
01
10
0-1
-10
append
loopfordyin'
01-1
fornext=
list
+xdx
+ydy
+zdz
when
and
body-standable-at-pbodyworld
firstnext
secondnext
thirdnext
collectnext
defunreconstruct-body-path
parentsstartdestination
let
pathnil
celldestination
loopuntil
equalcellstart
do
pushcellpath
setfcell
gethashcellparents
path
defunfind-body-path
bodyworlddestination&key

Find a bounded four-connected path of standable cells to destination.

The returned path excludes start and includes destination. NIL also denotes the already-there path; the second value distinguishes that from failure.

unless
and
=3
lengthdestination
every#'integerpdestination
error"A body destination must be three integer cells, got ~S."destination
unless
nearby-body-cell-pdestinationstart
return-fromfind-body-path
valuesnilnil
formatnil"destination ~{~D~^ ~} is not nearby (start ~{~D~^ ~})"destinationstart
unless
or
equaldestinationstart
apply#'body-standable-at-pbodyworlddestination
return-fromfind-body-path
valuesnilnil
formatnil"destination ~{~D~^ ~} is not a clear supported cell"destination
when
equaldestinationstart
return-fromfind-body-path
valuesniltnil
let
parents
make-hash-table:test#'equal
seen
make-hash-table:test#'equal
queue
make-array32:adjustablet:fill-pointer0
head0
visits0
setf
gethashstartseen
t
vector-push-extendstartqueue
loopwhileforcell=
arefqueuehead
do
incfhead
incfvisits
dolist
next
unless
gethashnextseen
setf
gethashnextseen
t
gethashnextparents
cell
when
equalnextdestination
return-fromfind-body-path
values
reconstruct-body-pathparentsstartdestination
tnil
vector-push-extendnextqueue
valuesnilnil
formatnil"no nearby walkable path reaches ~{~D~^ ~}"destination
defunbody-move-action-terminal-p
member
body-move-action-statusaction
'
:arrived:failed:cancelled
defunfinish-body-move-action
actionstatus&optionaldetail

Publish action's terminal status exactly once and wake its waiting caller.

let
finished-pnil
sb-thread:with-mutex
body-move-action-lockaction
unless
setf
body-move-action-statusaction
status
body-move-action-detailaction
detail
finished-pt
whenfinished-p
let
body
body-move-action-bodyaction
setf
vec3-x
0d0
vec3-z
0d0
sb-concurrency:send-message
body-move-action-completionaction
action
action
defuncancel-body-movement
body&optional
detail"superseded"

Cancel body's current Move To action, if any.

alexandria:when-let
defunstart-body-move-to
bodyworldxyz

Start body moving to integer cell X,Y,Z and return its waitable action.

let*
destination
listxyz
multiple-value-bind
pathfound-pfailure
find-body-pathbodyworlddestination:startstart
let
action
make-instance'body-move-action:bodybody:startstart:destinationdestination:pathpath:deadline
max8d0
*3d0
cond
nullpath
finish-body-move-actionaction:arrived"already there"
action
defunawait-body-move-action

Block the calling worker until action reaches a terminal state.

The canvas thread must never call this; it advances action a little each frame. A provider/tool thread may wait here without stalling rendering.

unless
sb-concurrency:receive-message
body-move-action-completionaction
action
defunbody-waypoint-distance
bodywaypoint
destructuring-bind
xyz
waypoint
sqrt
+
expt
-
+x0.5d0
body-xbody
2
expt
-
+z0.5d0
body-zbody
2
defunbody-reached-waypoint-p
bodywaypoint
destructuring-bind
xyz
waypoint
defunreplan-body-move-action
actionworld
multiple-value-bind
pathfound-pfailure
find-body-path
body-move-action-bodyaction
world
body-move-action-destinationaction
cond
found-p
setf
body-move-action-pathaction
path
body-move-action-best-distanceaction
most-positive-double-float
body-move-action-stuck-secondsaction
0d0
t
defunadvance-body-movement
bodyworldseconds

Advance body's current discrete destination through continuous physics.

let
unless
andaction
eq:running
body-move-action-statusaction
incf
body-move-action-elapsedaction
seconds
when
>
body-move-action-elapsedaction
body-move-action-deadlineaction
return-fromadvance-body-movement
finish-body-move-actionaction:failed"movement timed out"
loopwhile
and
body-move-action-pathaction
body-reached-waypoint-pbody
first
body-move-action-pathaction
do
pop
body-move-action-pathaction
setf
body-move-action-best-distanceaction
most-positive-double-float
body-move-action-stuck-secondsaction
0d0
let
waypoint
first
body-move-action-pathaction
if
nullwaypoint
progn
step-walking-bodybodyworld0d00d0seconds
let
velocity
when
and
<
sqrt
+
expt
vec3-xvelocity
2
expt
vec3-zvelocity
2
0.12d0
finish-body-move-actionaction:arrived"destination reached"
destructuring-bind
xyz
waypoint
declare
ignorey
let*
dx
-
+x0.5d0
body-xbody
dz
-
+z0.5d0
body-zbody
distance
max1d-9
sqrt
+
*dxdx
*dzdz
step-walking-bodybodyworld
*speed
*speed
seconds
let
if
<distance
-
body-move-action-best-distanceaction
0.015d0
setf
body-move-action-best-distanceaction
distance
body-move-action-stuck-secondsaction
0d0
incf
body-move-action-stuck-secondsaction
seconds
when
>
body-move-action-stuck-secondsaction
*body-movement-stuck-seconds*
if
<
incf
body-move-action-replansaction
3
finish-body-move-actionaction:failed"body remained blocked after replanning"
action