luv

Workshop wiki

video-screen.lisp

luvcraft/video-screen.lisp

system luvcraft/core · 25 definitions · on GitHub

A decoded video playing on a rectangle in the block world.

The screen is the plainest drawable luvcraft has: one instanced quad, one sampled texture, no shading model. Everything interesting happens between frames rather than inside them -- a decoder is a clock, and the question is what to do when the wall clock and the film's clock disagree.

The answer here is the simple one: catch up by decoding, never by waiting. advance-video-screen decodes as many pictures as have come due since the last frame and uploads only the last of them, so a slow render drops pictures instead of falling behind, and a fast render uploads nothing. That is what makes playback keep time with the world rather than with the frame rate the world happens to be running at.

Software pictures pass through swscale and one reusable rgba texture. Hardware pictures cross the backend video-import protocol as one retained two-plane cohort. Both arrive here as the same atomically published decoded-video-picture; platform surfaces and synchronization stay in the bridge files beside their GPU backends.

in-package#:luvcraft
defclassvideo-screen
video:initarg:video:accessorvideo-screen-video
width:initarg:width:readervideo-screen-texture-width
height:initarg:height:readervideo-screen-texture-height

The rgba words swscale writes into, reused for every picture.

words:initarg:words:initformnil:readervideo-screen-words
importer:initarg:importer:initformnil:accessorvideo-screen-importer
picture:initarg:picture:accessorvideo-screen-picture
retired-pictures:initformnil:accessorvideo-screen-retired-pictures
hardware-p:initarg:hardware-p:initformnil:readervideo-screen-hardware-p
sampler:initarg:sampler:readervideo-screen-sampler
layout:initarg:layout:readervideo-screen-layout

The argument table remains live through submission, then the next world's frame replaces it after that submission has been committed.

bind-group:initformnil:accessorvideo-screen-bind-group
pipeline:initarg:pipeline:accessorvideo-screen-pipeline
vertex-buffer:initarg:vertex-buffer:readervideo-screen-vertex-buffer
instance-buffer:initarg:instance-buffer:readervideo-screen-instance-buffer

Playback state. START is the internal real time the film began at, and SHOWN is the index of the picture currently on the texture.

start:initformnil:accessorvideo-screen-start
shown:initform-1:accessorvideo-screen-shown
loop-p:initarg:loop-p:initformt:readervideo-screen-loop-p

The soundtrack, when the film has one; then it is also the clock.

sound:initarg:sound:initformnil:accessorvideo-screen-sound
passes:initform0:accessorvideo-screen-passes:documentation"Which pass of the sound the picture is on."
center:initarg:center:initformnil:readervideo-screen-center:documentation

The screen's middle in the world: where its sound comes from.

resources:initarg:resources:accessorvideo-screen-resources
:documentation

A video file playing on one world rectangle.

defparameter*video-screen-texture-width*512

The width every picture is scaled to before upload.

A fixed size keeps one texture and one swscale context alive for the whole film, and costs nothing a video wall would notice: the screen is a few metres of world at most.

defunvideo-screen-texture-size

Return the texture width and height for video, preserving its aspect.

let*
height
max1
round
*width
/
libav:video-heightvideo
libav:video-widthvideo

Keep the height even: swscale is happier, and a video is never an odd number of lines in practice anyway.

defunmake-video-screen-instances
originright-edgeup-edge

Return the one 36-byte instance record describing the screen rectangle.

let
data
make-array9:element-type'single-float
loopforvaluein
list
vec3-xorigin
vec3-yorigin
vec3-zorigin
vec3-xright-edge
vec3-yright-edge
vec3-zright-edge
vec3-xup-edge
vec3-yup-edge
vec3-zup-edge
forindexfrom0do
setf
arefdataindex
coercevalue'single-float
data
defunvideo-screen-rectangle-before-camera

Return the lower-left corner and edge vectors of a screen facing camera.

The screen hangs distance ahead of the camera and lift above its eye, sized width by height in cells, square to the camera's own basis.

multiple-value-bind
rightupforward
let*
center
world-text-point
camera-positioncamera
forwardupdistancelift1.0
origin
world-text-pointcenterrightup1.0
right-edge
make-vec3
*width
vec3-xright
*width
vec3-yright
*width
vec3-zright
up-edge
make-vec3
*height
vec3-xup
*height
vec3-yup
*height
vec3-zup
valuesoriginright-edgeup-edge
defunmake-video-screen
devicecamerapathnametarget-format&key
lift4.0
rectangle
loop-pt
hardware:auto

Open pathname and build a world screen playing it, facing camera.

height is the screen's height in cells; its width follows the film's aspect. When rectangle is supplied, it is called with that aspect and returns the lower-left origin, right edge, and up edge of an authored world rectangle. hardware is NIL, :AUTO, or :REQUIRED. :REQUIRED rejects a file unless its first decoded picture actually lives in a hardware surface.

check-typehardware
membernil:auto:required
multiple-value-bind
decoder-hardwaredecoder-configuration
ifhardware
valuesnilnil
let*
video
libav:open-videopathname:hardwaredecoder-hardware:hardware-configurationdecoder-configuration
resourcesnil
pipelinenil
importernil
picturenil
soundnil
completed-pnil
flet
keep
resource
pushresourceresources
resource
unwind-protect
let*
hardware-p
not
null
andfirst-frame
when
and
eqhardware:required
nothardware-p
error"FFmpeg could not hardware-decode ~A on this device."pathname
whenhardware-p
setfimporter
unlessimporter
error"No hardware-video importer exists for ~S."device
multiple-value-bind
texture-widthtexture-height
ifhardware-p
values
libav:video-widthvideo
libav:video-heightvideo
let*
aspect
/
libav:video-widthvideo
libav:video-heightvideo
multiple-value-bind
originright-edgeup-edge
ifrectangle
funcallrectangleaspect
let*
instance-data
make-video-screen-instancesoriginright-edgeup-edge
sampler
keep
createdevice
make-sampler-descriptor:label"world video screen sampler":mag-filter:linear:min-filter:linear:mipmap-filter:nearest
layout
keep
createdevice
make-bind-group-layout-descriptor:label"world video screen layout":entries
ifhardware-p'
:binding0:type:texture
:binding1:type:sampler
:binding2:type:uniform-buffer
:binding3:type:texture
'
:binding0:type:texture
:binding1:type:sampler
:binding2:type:uniform-buffer
vertex-buffer
keep
createdevice
make-buffer-descriptor:label"world video screen quad":size
*4
lengthvertex-data
:usage'
:vertex:copy-dst
instance-buffer
keep
createdevice
make-buffer-descriptor:label"world video screen instance":size
*4
lengthinstance-data
:usage'
:vertex:copy-dst
setfpicture
ifhardware-p
adopt-decoded-video-frameimporterfirst-frametexture-widthtexture-height
make-decoded-video-picture-from-planesdevice1
lambda
plane
declare
ignoreplane
createdevice
make-texture-descriptor:label"world video screen picture":size
listtexture-widthtexture-height
:dimensions:2d:format:rgba8-unorm-srgb:usage'
:copy-dst:texture-binding
setfpipeline
make-live-shader-pipeline:role
ifhardware-p:video-screen-hardware:video-screen
:vertex-role:video-screen:label"world video screen pipeline":devicedevice:layoutlayout:vertex-buffers'
:array-stride12:attributes
:shader-location0:offset0:format:float32x3
:array-stride36:step-mode:instance:attributes
:shader-location1:offset0:format:float32x3
:shader-location2:offset12:format:float32x3
:shader-location3:offset24:format:float32x3
:target-formattarget-format:primitive'
:topology:triangle-list
:depth-stencil'
:format:depth32-float:depth-write-enabledt:depth-compare:less
write-buffervertex-buffervertex-data
write-bufferinstance-bufferinstance-data
let
screen
make-instance'video-screen:videovideo:widthtexture-width:heighttexture-height:words
unlesshardware-p
make-array
listtexture-heighttexture-width
:element-type'
unsigned-byte32
:importerimporter:picturepicture:samplersampler:hardware-phardware-p:layoutlayout:pipelinepipeline:vertex-buffervertex-buffer:instance-bufferinstance-buffer:loop-ploop-p:center
make-vec3
+
vec3-xorigin
*0.5
+
vec3-xright-edge
vec3-xup-edge
+
vec3-yorigin
*0.5
+
vec3-yright-edge
vec3-yup-edge
+
vec3-zorigin
*0.5
+
vec3-zright-edge
vec3-zup-edge
:resourcesresources

The sound starts as soon as the screen exists; the first picture goes up against its clock.

setfsound
open-film-soundpathname:loop-ploop-p
video-screen-soundscreen
sound
whenfirst-frame
unlesshardware-p
setf
video-screen-shownscreen
0
setfcompleted-pt
screen
unlesscompleted-p

The caller is already being told why the screen could not be built, so trouble unwinding it is a warning beside that.

with-release-warnings
release-video-screen-or-retain
make-instance'video-screen:videovideo:width0:height0:importerimporter:picturepicture:samplernil:layoutnil:pipelinepipeline:vertex-buffernil:instance-buffernil:soundsound:resourcesresources
defunrelease-video-screen
screen

Release screen's pipeline, GPU resources, and open film.

Each step is contained so that a failure early on cannot strand the film's decoder or the resources after it; the failures travel out through whatever release report is running. See with-release-report.

when
video-screen-bind-groupscreen
when
releasing:video-screen-bind-group
destroy
video-screen-bind-groupscreen
t
setf
video-screen-bind-groupscreen
nil
when
video-screen-pipelinescreen
when
releasing:video-screen-pipeline
release-live-shader-pipeline
video-screen-pipelinescreen
t
setf
video-screen-pipelinescreen
nil
setf
video-screen-resourcesscreen
delete-if
lambda
resource
releasing:video-screen-resource
destroyresource
t
video-screen-resourcesscreen
release-decoded-video-picture
video-screen-picturescreen
when
decoded-video-picture-released-p
video-screen-picturescreen
setf
video-screen-picturescreen
nil
let
remainingnil
dolist
picture
video-screen-retired-picturesscreen
unless
pushpictureremaining
setf
video-screen-retired-picturesscreen
nreverseremaining

Picture handles can disappear as soon as their native teardown transfers into the HAL retirement ledger. This therefore requests importer closure after logical retirement; each adopted plane's owner callback keeps the backend-native importer state alive until physical retirement succeeds.

when
and
decoded-video-picture-released-p
video-screen-picturescreen
null
video-screen-retired-picturesscreen
video-screen-importerscreen
when
releasing:video-frame-importer
release-video-frame-importer
video-screen-importerscreen
t
setf
video-screen-importerscreen
nil
when
video-screen-soundscreen
when
releasing:video-screen-sound
close-film-sound
video-screen-soundscreen
t
setf
video-screen-soundscreen
nil
when
video-screen-videoscreen
when
releasing:video-screen-film
libav:close-video
video-screen-videoscreen
t
setf
video-screen-videoscreen
nil
values
defunvideo-screen-released-p
screen

True when screen retains no logical owner which a caller could retry.

and
null
video-screen-bind-groupscreen
null
video-screen-pipelinescreen
null
video-screen-resourcesscreen
decoded-video-picture-released-p
video-screen-picturescreen
null
video-screen-retired-picturesscreen
null
video-screen-importerscreen
null
video-screen-soundscreen
null
video-screen-videoscreen
defvar*video-screen-release-backlog*nil"Exceptional startup-owned screens whose logical release needs a retry."
defvar*video-screen-release-backlog-lock*
sb-thread:make-mutex:name"luvcraft video screen release backlog"
defunretain-video-screen-release-backlog
screen

Process-root an incompletely released startup screen for later retry.

screen
defunrelease-video-screen-or-retain
screen

Release screen, retaining it globally across an exceptional unwind.

screen
defunretry-video-screen-release-backlog

Retry every screen retained by an earlier failed startup unwind.

values
defunvideo-screen-native-pipeline
screen
live-shader-pipeline-native-pipeline
video-screen-pipelinescreen
defunrefresh-video-screen-bind-group
screendeviceuniform-buffer

Bind screen's current picture for this frame and retain it through submit.

when
video-screen-bind-groupscreen

Encoding has already committed the preceding frame before the next callback begins. Destroying the old semantic argument table now is safe; destroying the new one before submit is not.

destroy
video-screen-bind-groupscreen
setf
video-screen-bind-groupscreen
nil
setf
video-screen-bind-groupscreen
createdevice
make-bind-group-descriptor:label"world video screen frame bindings":layout
video-screen-layoutscreen
:entries`
:binding0:resource,
decoded-video-picture-view
video-screen-picturescreen
0
:binding1:resource,
video-screen-samplerscreen
:binding2:resource,uniform-buffer
,@
when
video-screen-hardware-pscreen
`
:binding3:resource,
decoded-video-picture-view
video-screen-picturescreen
1
defunretry-video-screen-retired-pictures
screen

Retry screen's previously failed picture retirements, retaining failures.

let
remainingnil
with-release-warnings
dolist
picture
video-screen-retired-picturesscreen
unless
pushpictureremaining
setf
video-screen-retired-picturesscreen
nreverseremaining
screen
defuninstall-hardware-video-picture
screen&optionalframe

Adopt and atomically publish screen's current decoded hardware frame.

The complete candidate is built before screen changes. If adoption signals, the preceding picture remains published; after publication its replacement is retired with warnings so teardown trouble cannot roll the screen backward.

let*
decoded-frame
orframe
libav:video-frame
video-screen-videoscreen
candidate
adopt-decoded-video-frame
video-screen-importerscreen
decoded-frame
video-screen-texture-widthscreen
video-screen-texture-heightscreen
previous
video-screen-picturescreen
setf
video-screen-picturescreen
candidate

Put PREVIOUS somewhere durable before attempting teardown. A failed destroy therefore remains owned and retryable rather than falling out of reach behind the newly published candidate.

pushprevious
video-screen-retired-picturesscreen
screen
defunvideo-screen-due-picture
screen

Return the index of the picture that should be showing now.

The film starts on the first call rather than when the screen was built, so a slow world load does not begin the film in the middle.

let
rate
libav:video-frame-rate
video-screen-videoscreen
now
get-internal-real-time
unless
video-screen-startscreen
setf
video-screen-startscreen
now
if
andrate
plusprate
floor
*
/
-now
video-screen-startscreen
internal-time-units-per-second
rate
1+
video-screen-shownscreen
defunupload-video-screen-picture
screendevice
let
video
video-screen-videoscreen
width
video-screen-texture-widthscreen
height
video-screen-texture-heightscreen
libav:frame-rgba-wordsvideowidthheight:array
video-screen-wordsscreen
write-texture
make-texture-copy:texture
first
decoded-video-picture-textures
video-screen-picturescreen
video-screen-wordsscreen
make-texture-data-layout:bytes-per-row:rows-per-imageheight
defparameter*video-screen-catch-up-limit*4

How many pictures one world frame may decode to catch up.

Catching up has to be bounded, because the debt is not: a world frame that stalls for a second owes a second of film, and paying that back inside the next frame stalls the world again. Past the limit the film simply slips, which nobody watching a screen on a wall will mind.

defunvideo-screen-sound-due-picture
screensound

The picture due by the soundtrack's clock, or NIL to hold the last one.

When the sound has started over, the picture starts over with it; while the previous pass's tail is still sounding, the last picture holds.

let
rate
libav:video-frame-rate
video-screen-videoscreen
cond
/=
film-sound-passessound
video-screen-passesscreen
when
>=time0
libav:rewind-video
video-screen-videoscreen
setf
video-screen-shownscreen
-1
video-screen-passesscreen
film-sound-passessound
if
andrate
plusprate
floor
*timerate
0
<time0
nil
andrate
plusprate
floor
*timerate
t
1+
video-screen-shownscreen
defunadvance-video-screen
screendevice

Decode up to the picture that is due now and upload it. Return true if so.

Pictures that came due while the last world frame was being drawn are decoded and discarded rather than shown, so the film keeps the world's time instead of the renderer's. A film with sound keeps the sound's time instead: the ear is the stricter judge, so the speaker is the clock and the picture follows.

let*
video
video-screen-videoscreen
sound
video-screen-soundscreen
decoded-pnil
rewound-pnil
looprepeat*video-screen-catch-up-limit*while
<
video-screen-shownscreen
due
do
cond
incf
video-screen-shownscreen
setfdecoded-pt

At most one rewind per call. A film that decodes nothing at all would otherwise rewind and fail forever inside one world frame, which is a hang rather than a dropped picture. With sound, the sound says when to start over; a picture that runs out first just holds.

and
video-screen-loop-pscreen
notrewound-p
nullsound
setfrewound-pt
video-screen-startscreen
get-internal-real-time
video-screen-shownscreen
-1
due0
t
setf
video-screen-shownscreen
due

Whatever the loop managed, the film's clock now reads whatever SHOWN says, so the next call asks for the picture after this one instead of trying to make up the same difference all over again. (The sound's clock is not ours to move: it simply drops the pictures it must.)

when
and
nullsound
>due
video-screen-shownscreen
setf
video-screen-startscreen
-
get-internal-real-time
video-screen-picture-spanscreen
video-screen-shownscreen
whendecoded-p
if
video-screen-hardware-pscreen
decoded-p
defunvideo-screen-picture-span
screencount

Return the internal-time span count pictures of screen's film occupy.

let
rate
libav:video-frame-rate
video-screen-videoscreen
if
andrate
plusprate
pluspcount
round
*count
/internal-time-units-per-secondrate
0
defunplace-video-screen-listener
screencamera

Hear screen's film from where camera stands, facing as it faces.

alexandria:when-let
sound
video-screen-soundscreen
when
video-screen-centerscreen
multiple-value-bind
rightupforward
declare
ignoreupforward
place-film-sound-listenersound
video-screen-centerscreen
camera-positioncamera
right
screen
defunhush-video-screen
screen

Stop screen's sound now, leaving the picture to keep its own time.

alexandria:when-let
sound
video-screen-soundscreen
setf
video-screen-soundscreen
nil
screen