luv

Workshop wiki

persistence.lisp

luvcraft/persistence.lisp

system luvcraft/core · 45 definitions · on GitHub

Durable descriptions and asynchronous checkpoints for the little world.

A save contains the procedural source and sparse authored edits. Resident chunks and their derived products are deliberately absent. The render owner captures an immutable description; a dedicated latest-value worker performs printing and atomic replacement without file I/O in a frame.

in-package#:luvcraft
define-conditioninvalid-luvcraft-save
error
reason:initarg:reason:readerinvalid-luvcraft-save-reason
:report
lambda
conditionstream
formatstream"Invalid luvcraft save: ~A"
invalid-luvcraft-save-reasoncondition
defuninvalid-luvcraft-save
control&restarguments
error'invalid-luvcraft-save:reason
apply#'formatnilcontrolarguments
defunvalidate-description-plist
plistcontext
unless
listpplist
invalid-luvcraft-save"~A must be a property list, not ~S."contextplist
unless
evenp
lengthplist
invalid-luvcraft-save"~A has an odd property list: ~S."contextplist
plist
defundescription-value
plistkeycontext&keyoptionaldefault
let
missing
gensym"MISSING-"
let
value
getfplistkeymissing
if
eqvaluemissing
ifoptionaldefault
invalid-luvcraft-save"~A has no ~S field."contextkey
value
defuntagged-description-values
descriptioncontext
unless
and
conspdescription
keywordp
firstdescription
invalid-luvcraft-save"~A needs a keyword kind, not ~S."contextdescription
values
firstdescription
defgenericblock-save-description
block
:documentation

Return the portable value description stored for block in a world save.

defgenericrestore-block-save-description
kinddescription
:documentation

Resolve a portable block value with keyword kind and property description.

defmethodblock-save-description
blocknull
'
:air
defmethodblock-save-description
list:block:name
block-kind-nameblock
defmethodrestore-block-save-description
kind
eql:air
description
unless
nulldescription
invalid-luvcraft-save"An :AIR value has unexpected fields ~S."description
nil
defmethodrestore-block-save-description
kind
eql:block
description
let
name
description-valuedescription:name"block value"
unless
keywordpname
invalid-luvcraft-save"A block name must be a keyword, not ~S."name
or
invalid-luvcraft-save"No block kind is named ~S."name
defmethodrestore-block-save-description
kindt
description
declare
ignoredescription
invalid-luvcraft-save"No block value reader handles ~S."kind
defunrestore-block-value
description
multiple-value-bind
kindfields
tagged-description-valuesdescription"block value"
defuncoordinate-key<
leftright
or
<
firstleft
firstright
and
=
firstleft
firstright
or
<
secondleft
secondright
and
=
secondleft
secondright
<
thirdleft
thirdright
defunblock-edit-overlay-save-descriptions
overlay

Return overlay's current values in deterministic world-coordinate order.

check-typeoverlayblock-edit-overlay
sort
loopforcoordinatebeingthehash-keysof
block-edit-overlay-entriesoverlay
using
hash-valueblock
collect
list:at
copy-listcoordinate
:value
#'coordinate-key<:key
lambda
edit
getfedit:at
defunrestore-world-edit-block-value
description

Restore one authored edit, migrating the retired gnome block to air.

Gnomes became embodied agents rather than terrain after save format version 1 had already written them as block edits. This compatibility belongs at the world-edit boundary: a legacy gnome occupied a cell, so removing that obsolete occupant means an explicit air edit. Other uses of block descriptions remain strict; in particular a selected or carried block cannot silently become air.

multiple-value-bind
kindfields
tagged-description-valuesdescription"block value"
if
and
eqkind:block
eq
description-valuefields:name"block value"
:gnome
nil
defunrestore-block-edit-overlay
descriptions
unless
listpdescriptions
invalid-luvcraft-save"World edits must be a list, not ~S."descriptions
let
dolist
descriptiondescriptionsoverlay
let*
coordinate
description-valuedescription:at"world edit"
value
description-valuedescription:value"world edit"
unless
and
listpcoordinate
=
lengthcoordinate
3
every#'integerpcoordinate
invalid-luvcraft-save"A world edit coordinate must contain three integers, not ~S."coordinate
destructuring-bind
xyz
coordinate
defgenericworld-source-save-description
source
:documentation

Return source as portable semantic data, excluding resident chunks.

defgenericrestore-world-source-save-description
kinddescription
:documentation

Restore a world source named by keyword kind from description.

defmethodworld-source-save-description
list:little-world:source-version+little-world-source-version+:seed
little-world-source-seedsource
:edits
block-edit-overlay-save-descriptions
little-world-source-editssource
defmethodrestore-world-source-save-description
kind
eql:little-world
description
let
version
description-valuedescription:source-version"little-world source"
seed
description-valuedescription:seed"little-world source"
edits
description-valuedescription:edits"little-world source"
unless
invalid-luvcraft-save"Little-world source version ~S is unsupported; expected ~D."version+little-world-source-version+
unless
integerpseed
invalid-luvcraft-save"A little-world seed must be an integer, not ~S."seed
make-instance'little-world-source:seedseed:edits
defmethodrestore-world-source-save-description
kindt
description
declare
ignoredescription
invalid-luvcraft-save"No world source reader handles ~S."kind
defgenericworld-save-description
world
:documentation

Return world as a portable description without resident materializations.

defgenericrestore-world-save-description
kinddescription
:documentation

Restore a world named by keyword kind from description.

defmethodworld-save-description
let*
space
block-world-spaceworld
shape
voxel-space-chunk-shapespace
list:block-world:space
list:chunk-shape
list
chunk-shape-widthshape
chunk-shape-heightshape
chunk-shape-depthshape
:cell-extent
vec3-list
voxel-space-cell-extentspace
:source
world-source-save-description
block-world-sourceworld
defmethodrestore-world-save-description
kind
eql:block-world
description
let*
space
description-valuedescription:space"block world"
shape
description-valuespace:chunk-shape"voxel space"
extent
description-valuespace:cell-extent"voxel space"
source-description
description-valuedescription:source"block world"
unless
and
listpshape
=
lengthshape
3
every
lambda
typepdimension'
integer1
shape
invalid-luvcraft-save"A chunk shape must contain three positive integers, not ~S."shape
unless
and
listpextent
=
lengthextent
3
every
lambda
component
and
realpcomponent
pluspcomponent
extent
invalid-luvcraft-save"A cell extent must contain three positive reals, not ~S."extent
multiple-value-bind
source-kindsource-fields
tagged-description-valuessource-description"world source"
let
source
destructuring-bindshape
make-block-world:id
list:saved-worldsource-kind
:chunk-widthwidth:chunk-heightheight:chunk-depthdepth:cell-extentextent:sourcesource
defmethodrestore-world-save-description
kindt
description
declare
ignoredescription
invalid-luvcraft-save"No world reader handles ~S."kind
defunluvcraft-resume-save-description
cameraplayerselected-block&optionalcarried

carried are the blocks the player holds that are worth writing down: per-instance ones such as films, which no palette would give back.

when
andcameraplayer
list:player-position
vec3-list
player-positionplayer
:look
list:yaw:pitch
:selected-block:carried
mapcar#'block-save-descriptioncarried
defunmake-luvcraft-save-description
world&keycameraplayerselected-blockcarried

Capture one immutable, printable checkpoint description. See #TR2JNQ.

list:luvcraft-world:format-version+luvcraft-save-format-version+:world:resume
luvcraft-resume-save-descriptioncameraplayerselected-blockcarried
defunrestore-luvcraft-resume-save-description
description

Return CAMERA, PLAYER, selected block, and carried blocks restored from description.

if
nulldescription
values
make-instance'fly-camera
nil*stone-block*nil
let*
position
description-valuedescription:player-position"resume state"
look
description-valuedescription:look"resume state"
yaw
description-valuelook:yaw"saved look"
pitch
description-valuelook:pitch"saved look"
selected
description-valuedescription:selected-block"resume state"
carried
description-valuedescription:carried"resume state":optionalt:defaultnil
unless
listpcarried
invalid-luvcraft-save"Carried blocks must be a list, not ~S."carried
unless
invalid-luvcraft-save"A player position must contain three reals, not ~S."position
unless
and
realpyaw
realppitch
invalid-luvcraft-save"Saved yaw and pitch must be real, not ~S and ~S."yawpitch
destructuring-bind
xyz
position
values
make-instance'fly-camera:yawyaw:pitchpitch
make-instance'block-world-player:position
make-vec3
coercex'double-float
coercey'double-float
coercez'double-float
let
block
unless
typepblock'block-kind
invalid-luvcraft-save"The selected value must name a block kind, not ~S."selected
block
mapcar#'restore-block-valuecarried
defunrestore-luvcraft-save-description
description

Return the world and resume description represented by description.

multiple-value-bind
kindfields
tagged-description-valuesdescription"luvcraft save"
unless
eqkind:luvcraft-world
invalid-luvcraft-save"Expected :LUVCRAFT-WORLD, not ~S."kind
let
version
description-valuefields:format-version"luvcraft save"
world-description
description-valuefields:world"luvcraft save"
resume-description
description-valuefields:resume"luvcraft save":optionalt:defaultnil
unless
invalid-luvcraft-save"Format version ~S is unsupported; expected ~D."version+luvcraft-save-format-version+
multiple-value-bind
world-kindworld-fields
tagged-description-valuesworld-description"saved world"
values
restore-world-save-descriptionworld-kindworld-fields
resume-description
defunread-luvcraft-save
pathname

Read and validate one luvcraft save from pathname.

Return the restored world and its still-portable resume description.

with-open-file
streampathname:direction:input:external-format:utf-8
let
*read-eval*nil
*readtable*
copy-readtablenil
eof
gensym"EOF-"
let
description
readstreamnileof
when
eqdescriptioneof
invalid-luvcraft-save"~A is empty."pathname
unless
eq
readstreamnileof
eof
invalid-luvcraft-save"~A contains more than one form."pathname
defuncheckpoint-temporary-pathname
pathname
let
name
pathname-namepathname
type
pathname-typepathname
make-pathname:name
formatnil"~A~@[.~A~]"nametype
:type"new":defaultspathname
defunwrite-luvcraft-save-description
descriptionpathname

Atomically replace pathname with the printable save description.

let*
target
pathnamepathname
ensure-directories-existtarget
unwind-protect
progn
with-open-file
streamtemporary:direction:output:if-exists:supersede:if-does-not-exist:create:external-format:utf-8
let
*print-readably*t
*print-pretty*t
*print-circle*nil
writedescription:streamstream:prettyt
terpristream
finish-outputstream
uiop:rename-file-overwriting-targettemporarytarget
when
probe-filetemporary
ignore-errors
delete-filetemporary
pathname
defclassworld-checkpoint-writer
pathname:initarg:pathname:readerworld-checkpoint-writer-pathname
mailbox:readerworld-checkpoint-writer-mailbox
lock:readerworld-checkpoint-writer-lock
pending:initformnil:accessorworld-checkpoint-writer-pending
pending-p:initformnil:accessorworld-checkpoint-writer-pending-p
active-p:initformnil:accessorworld-checkpoint-writer-active-p
wake-p:initformnil:accessorworld-checkpoint-writer-wake-p
running-p:initformt:accessorworld-checkpoint-writer-running-p
next-ticket:initform0:accessorworld-checkpoint-writer-next-ticket
completed-ticket:initform0:accessorworld-checkpoint-writer-completed-ticket
condition:initformnil:accessorworld-checkpoint-writer-condition
thread:initformnil:accessorworld-checkpoint-writer-thread
defgenericperform-world-checkpoint
writerdescription
:documentation

Persist immutable description on writer's worker thread.

defmethodperform-world-checkpoint
description
write-luvcraft-save-descriptiondescription
world-checkpoint-writer-pathnamewriter
defuntake-world-checkpoint
writer
sb-thread:with-mutex
world-checkpoint-writer-lockwriter
setf
world-checkpoint-writer-wake-pwriter
nil
when
world-checkpoint-writer-pending-pwriter
destructuring-bind
ticketdescription
world-checkpoint-writer-pendingwriter
setf
world-checkpoint-writer-pendingwriter
nil
world-checkpoint-writer-pending-pwriter
nil
world-checkpoint-writer-active-pwriter
t
valuesticketdescriptiont
defunfinish-world-checkpoint
writerticketcondition
sb-thread:with-mutex
world-checkpoint-writer-lockwriter
setf
world-checkpoint-writer-active-pwriter
nil
world-checkpoint-writer-completed-ticketwriter
ticket

Retain an earlier failure until shutdown reports it. A later successful coalesced checkpoint must not make lost durability look like an entirely successful writer lifetime.

world-checkpoint-writer-conditionwriter
orcondition
world-checkpoint-writer-conditionwriter
defunrun-world-checkpoint-writer
writer
loop
multiple-value-bind
messagereceived-p
sb-concurrency:receive-message
world-checkpoint-writer-mailboxwriter
declare
ignorereceived-p
ecasemessage
:stop
:work
loop
multiple-value-bind
ticketdescriptionpresent-p
unlesspresent-p
let
conditionnil
handler-case
perform-world-checkpointwriterdescription
error
caught
setfconditioncaught
format*error-output*"luvcraft save: ~A~%"caught
finish-output*error-output*
finish-world-checkpointwriterticketcondition
defunmake-world-checkpoint-writer
pathname

Make a sleeping latest-value worker for atomic world checkpoints.

let
writer
make-instance'world-checkpoint-writer:pathname
pathnamepathname
setf
slot-valuewriter'mailbox
sb-concurrency:make-mailbox:name"luvcraft checkpoint requests"
slot-valuewriter'lock
sb-thread:make-mutex:name"luvcraft checkpoint state"
world-checkpoint-writer-threadwriter
sb-thread:make-thread:name"luvcraft checkpoint writer"
writer
defunrequest-world-checkpoint
writerdescription

Submit immutable description without waiting for filesystem I/O.

Only the latest checkpoint which has not begun is retained. Return its monotonic ticket.

check-typewriterworld-checkpoint-writer
let
wake-pnil
ticketnil
sb-thread:with-mutex
world-checkpoint-writer-lockwriter
unless
world-checkpoint-writer-running-pwriter
error"Checkpoint writer for ~A has stopped."
world-checkpoint-writer-pathnamewriter
setfticket
incf
world-checkpoint-writer-next-ticketwriter
world-checkpoint-writer-pendingwriter
listticketdescription
world-checkpoint-writer-pending-pwriter
t
unless
or
world-checkpoint-writer-active-pwriter
world-checkpoint-writer-wake-pwriter
setf
world-checkpoint-writer-wake-pwriter
t
wake-pt
whenwake-p
sb-concurrency:send-message
world-checkpoint-writer-mailboxwriter
:work
ticket
defunstop-world-checkpoint-writer
writer&key
timeout10.0

Flush the latest requested checkpoint, stop writer, and join its thread.

check-typewriterworld-checkpoint-writer
let
stop-pnil
requested-ticketnil
sb-thread:with-mutex
world-checkpoint-writer-lockwriter
setfrequested-ticket
world-checkpoint-writer-next-ticketwriter
when
world-checkpoint-writer-running-pwriter
setf
world-checkpoint-writer-running-pwriter
nil
stop-pt
whenstop-p
sb-concurrency:send-message
world-checkpoint-writer-mailboxwriter
:stop
multiple-value-bind
valuestate
sb-thread:join-thread
world-checkpoint-writer-threadwriter
:timeouttimeout:default:timeout
declare
ignorevalue
when
eqstate:timeout
error"Checkpoint writer for ~A did not stop within ~,2F seconds."
world-checkpoint-writer-pathnamewriter
timeout
unless
=requested-ticket
world-checkpoint-writer-completed-ticketwriter
error"Checkpoint writer for ~A stopped before ticket ~D was written."
world-checkpoint-writer-pathnamewriter
requested-ticket
let
condition
world-checkpoint-writer-conditionwriter
whencondition
errorcondition
nil