luv

Workshop wiki

decode.lisp

libav/decode.lisp

system luv/libav · 50 definitions · on GitHub

Opening a video file and pulling rgba pictures out of it.

The shape of FFmpeg's decode loop is not obvious from its names, so it is worth stating once. Demuxing and decoding are separate rates: one packet may produce no frames, or several. So the loop is a pump with two ends -- avcodec_send_packet feeds it, avcodec_receive_frame drains it -- and each end may answer EAGAIN meaning "I want the other end first". At the file's end the codec is flushed with a null packet, after which it keeps handing back the frames it had buffered until it finally says EOF.

This is the software path: the decoder writes planes into ordinary memory and swscale converts them to rgba. It exists to get pictures onto a surface at all. The hardware path -- a VideoToolbox, VAAPI, or Vulkan frame whose data never touches the CPU -- reuses everything here except the last step, and is the reason the AVFrame binding knows what frame-hardware-p means.

in-package#:luv.libav
defclassstream-decoder
pathname:initarg:pathname:readervideo-pathname
format-context:initarg:format-context:accessorvideo-format-context
codec-context:initarg:codec-context:accessorvideo-codec-context
stream-index:initarg:stream-index:readervideo-stream-index

The decoder's own output, reused across every frame in the file.

frame:initarg:frame:readervideo-frame
packet:initarg:packet:accessorvideo-packet
drained-p:initformnil:accessorvideo-drained-p
:documentation

One demuxer and one decoder on one stream of an open file.

The pump in decode-next-frame is the same whatever the stream carries; a video adds pictures and their conversion, an audio-track adds samples. The accessors keep the VIDEO- prefix they were born with: the picture path came first, and every caller of it says video.

defclassvideo
width:initarg:width:readervideo-width
height:initarg:height:readervideo-height
frame-rate:initarg:frame-rate:readervideo-frame-rate

Lazily built, because its size depends on what the caller asks for.

scaler:initformnil:accessorvideo-scaler
scaler-key:initformnil:accessorvideo-scaler-key

The rgba staging buffer swscale writes into, kept across frames so a player is not allocating megabytes per picture.

staging:initformnil:accessorvideo-staging
staging-size:initform0:accessorvideo-staging-size
hardware-cleanup:initarg:hardware-cleanup:initformnil:accessorvideo-hardware-cleanup
:documentation

An open video file and its decoder.

Demuxing.

cffi:defcfun
"avformat_open_input"%avformat-open-input
:int
context:pointer
url:string
format:pointer
options:pointer
cffi:defcfun
"avformat_close_input"%avformat-close-input
:void
context:pointer
cffi:defcfun
"avformat_find_stream_info"%avformat-find-stream-info
:int
context:pointer
options:pointer
cffi:defcfun
"av_find_best_stream"%av-find-best-stream
:int
context:pointer
type:int
wanted:int
related:int
decoder:pointer
flags:int
cffi:defcfun
"av_read_frame"%av-read-frame
:int
context:pointer
packet:pointer
cffi:defcfun
"av_seek_frame"%av-seek-frame
:int
context:pointer
stream:int
timestamp:int64
flags:int

Decoding.

cffi:defcfun
"avcodec_alloc_context3"%avcodec-alloc-context3
:pointer
codec:pointer
cffi:defcfun
"avcodec_free_context"%avcodec-free-context
:void
context:pointer
cffi:defcfun
"avcodec_parameters_to_context"%avcodec-parameters-to-context
:int
context:pointer
parameters:pointer
cffi:defcfun
"avcodec_open2"%avcodec-open2
:int
context:pointer
codec:pointer
options:pointer
cffi:defcfun
"avcodec_flush_buffers"%avcodec-flush-buffers
:void
context:pointer
cffi:defcfun
"avcodec_send_packet"%avcodec-send-packet
:int
context:pointer
packet:pointer
cffi:defcfun
"avcodec_receive_frame"%avcodec-receive-frame
:int
context:pointer
frame:pointer
cffi:defcfun
"av_hwdevice_ctx_create"%av-hwdevice-context-create
:int
reference:pointer
type:int
device:pointer
options:pointer
flags:int
cffi:defcfun
"av_hwdevice_ctx_alloc"%av-hwdevice-context-allocate
:pointer
type:int
cffi:defcfun
"av_hwdevice_ctx_init"%av-hwdevice-context-initialize
:int
reference:pointer
cffi:defcfun
"av_buffer_ref"%av-buffer-reference
:pointer
reference:pointer
cffi:defcfun
"av_buffer_unref"%av-buffer-unreference
:void
reference:pointer
cffi:defcfun
"av_calloc"%av-calloc
:pointer
count:size
size:size
cffi:defcfun
"av_strdup"%av-strdup
:pointer
string:string
cffi:defcfun
"av_free"%av-free
:void
pointer:pointer
cffi:defcfun
"av_packet_alloc"%av-packet-alloc
:pointer
cffi:defcfun
"av_packet_free"%av-packet-free
:void
packet:pointer
cffi:defcfun
"av_packet_unref"%av-packet-unref
:void
packet:pointer

Converting.

cffi:defcfun
"sws_getContext"%sws-get-context
:pointer
source-width:int
source-height:int
source-format:int
target-width:int
target-height:int
target-format:int
flags:int
source-filter:pointer
target-filter:pointer
parameters:pointer
cffi:defcfun
"sws_freeContext"%sws-free-context
:void
context:pointer
cffi:defcfun
"sws_scale"%sws-scale
:int
context:pointer
source-planes:pointer
source-pitches:pointer
source-y:int
source-height:int
target-planes:pointer
target-pitches:pointer
defunstream-pointer
format-contextindex

Return the INDEXth AVStream of format-context.

cffi:mem-aref
cffi:foreign-slot-valueformat-context'
:structav-format-context
'streams
:pointerindex
defunrational-value
pointertypeslot

Return the AVRational in slot as a Lisp rational, or NIL when undefined.

let*
rational
cffi:foreign-slot-pointerpointertypeslot
numerator
cffi:foreign-slot-valuerational'
:structav-rational
'numerator
denominator
cffi:foreign-slot-valuerational'
:structav-rational
'denominator
unless
zeropdenominator
/numeratordenominator
cffi:defcallbackchoose-videotoolbox-format:int
context:pointer
formats:pointer
declare
ignorecontext
let
wanted
cffi:foreign-enum-value'pixel-format:videotoolbox
loopforindexfrom0forformat=
cffi:mem-arefformats:intindex
until
=format
cffi:foreign-enum-value'pixel-format:none
when
=formatwanted
returnformatfinally
return
cffi:mem-arefformats:int0
defunallocate-foreign-string-vector
strings
let*
strings
coercestrings'list

AVVulkanDeviceContext takes these arrays over. Allocate them with libavutil too: a Nix process can contain a second libc via the host SBCL, making CFFI's malloc incompatible with av_free.

pointers
mapcar#'%av-strdupstrings
vector
ifpointers
%av-calloc
lengthpointers
cffi:foreign-type-size:pointer
cffi:null-pointer
loopforpointerinpointersforindexfrom0do
setf
cffi:mem-arefvector:pointerindex
pointer
valuesvector
lambda
dolist
pointerpointers
%av-freepointer
unless
cffi:null-pointer-pvector
%av-freevector
defunenable-vulkan-decoding
codec-contextconfiguration

Decode into AVVkFrames allocated on the renderer's existing VkDevice.

configuration is a plist containing :INSTANCE, :PHYSICAL-DEVICE, :DEVICE, :GET-INSTANCE-PROC-ADDR, extension lists, and :QUEUE-FAMILIES. FFmpeg borrows the Vulkan handles; the caller must therefore close the video before the device.

multiple-value-bind
instance-extensionsfree-instance-extensions
allocate-foreign-string-vector
getfconfiguration:instance-extensions
multiple-value-bind
device-extensionsfree-device-extensions
allocate-foreign-string-vector
getfconfiguration:device-extensions
let
completed-pnil
reference
%av-hwdevice-context-allocate
cffi:foreign-enum-value'hardware-device-type:vulkan
when
cffi:null-pointer-preference
error"Could not allocate FFmpeg's Vulkan device context."
unwind-protect
let*
base
cffi:foreign-slot-valuereference'
:structav-buffer-reference
'data
vulkan
cffi:foreign-slot-valuebase'
:structav-hardware-device-context
'hardware-context
families
cffi:foreign-slot-pointervulkan'
:structav-vulkan-device-context
'queue-families
features
cffi:foreign-slot-pointervulkan'
:structav-vulkan-device-context
'device-features
queue-families
getfconfiguration:queue-families
loopforindexbelow
cffi:foreign-type-size'
:structvk-physical-device-features-2
do
setf
cffi:mem-areffeatures:uint8index
0
setf
cffi:foreign-slot-valuefeatures'
:structvk-physical-device-features-2
'structure-type
1000059000
cffi:foreign-slot-value
cffi:foreign-slot-pointerfeatures'
:structvk-physical-device-features-2
'features
'
:structvk-physical-device-features
'shader-int64
1
setf
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'allocator
cffi:null-pointer
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'get-instance-procedure-address
getfconfiguration:get-instance-proc-addr
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'instance
getfconfiguration:instance
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'physical-device
getfconfiguration:physical-device
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'device
getfconfiguration:device
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'instance-extensions
instance-extensions
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'instance-extension-count
length
getfconfiguration:instance-extensions
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'device-extensions
device-extensions
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'device-extension-count
length
getfconfiguration:device-extensions
cffi:foreign-slot-valuevulkan'
:structav-vulkan-device-context
'queue-family-count
lengthqueue-families
loopfordescriptioninqueue-familiesforindexfrom0forfamily=
cffi:mem-aptrfamilies'
:structav-vulkan-device-queue-family
index
do
setf
cffi:foreign-slot-valuefamily'
:structav-vulkan-device-queue-family
'index
getfdescription:index
cffi:foreign-slot-valuefamily'
:structav-vulkan-device-queue-family
'count
1
cffi:foreign-slot-valuefamily'
:structav-vulkan-device-queue-family
'flags
getfdescription:flags
cffi:foreign-slot-valuefamily'
:structav-vulkan-device-queue-family
'video-capabilities
or
getfdescription:video-capabilities
0
check-code
%av-hwdevice-context-initializereference
'enable-vulkan-decoding
setf
cffi:foreign-slot-valuecodec-context'
:structav-codec-context
'hardware-device-context
%av-buffer-referencereference
cffi:foreign-slot-valuecodec-context'
:structav-codec-context
'get-format

The default C callback chooses FFmpeg's first offered format, which is Vulkan once HWDEVICE_CTX is attached. Keeping this callback in C also avoids re-entering SBCL from the middle of avcodec_receive_frame.

or
cffi:foreign-symbol-pointer"avcodec_default_get_format"
error"FFmpeg has no default pixel-format selector."
setfcompleted-pt
cffi:with-foreign-object
cell:pointer
setf
cffi:mem-refcell:pointer
reference
%av-buffer-unreferencecell
unlesscompleted-p
funcallfree-device-extensions
funcallfree-instance-extensions
valuescodec-context

FFmpeg releases the extension arrays with its Vulkan context.

lambda
nil
defunenable-videotoolbox-decoding
codec-context

Ask FFmpeg to decode into reference-counted CVPixelBuffers.

#+darwin (cffi:with-foreign-object (reference-cell :pointer) (setf (cffi:mem-ref reference-cell :pointer) (cffi:null-pointer)) (check-code (%av-hwdevice-context-create reference-cell (cffi:foreign-enum-value 'hardware-device-type :videotoolbox) (cffi:null-pointer) (cffi:null-pointer) 0) 'enable-videotoolbox-decoding) (unwind-protect (let ((reference (%av-buffer-reference (cffi:mem-ref reference-cell :pointer)))) (when (cffi:null-pointer-p reference) (error "Could not retain FFmpeg's VideoToolbox device context.")) (setf (cffi:foreign-slot-value codec-context '(:struct av-codec-context) 'hardware-device-context) reference (cffi:foreign-slot-value codec-context '(:struct av-codec-context) 'get-format) (cffi:callback choose-videotoolbox-format))) (%av-buffer-unreference reference-cell)))#-darwin
declare
ignorablecodec-context
codec-context
defunopen-video
pathname&key
hardware:auto
hardware-configuration

Open pathname, find its best video stream, and start a decoder for it.

Returns a video. The caller owns it and must close-video it.

let
truename
uiop:native-namestring
truenamepathname
format-contextnil
codec-contextnil
hardware-cleanupnil
unwind-protect
with-libav-native-environment
cffi:with-foreign-objects
context-cell:pointer
decoder-cell:pointer
setf
cffi:mem-refcontext-cell:pointer
cffi:null-pointer
check-code
%avformat-open-inputcontext-celltruename
cffi:null-pointer
cffi:null-pointer
'open-video
setfformat-context
cffi:mem-refcontext-cell:pointer
check-code
%avformat-find-stream-infoformat-context
cffi:null-pointer
'open-video
setf
cffi:mem-refdecoder-cell:pointer
cffi:null-pointer
let*
index
check-code
%av-find-best-streamformat-context
cffi:foreign-enum-value'media-type:video
-1-1decoder-cell0
'open-video
decoder
cffi:mem-refdecoder-cell:pointer
stream
stream-pointerformat-contextindex
parameters
cffi:foreign-slot-valuestream'
:structav-stream
'codec-parameters
when
cffi:null-pointer-pdecoder
error"No decoder is available for the video stream in ~A."pathname
setfcodec-context
%avcodec-alloc-context3decoder
when
cffi:null-pointer-pcodec-context
error"Could not allocate a decoder context for ~A."pathname
check-code
%avcodec-parameters-to-contextcodec-contextparameters
'open-video
when
and#+darwint#-darwinnil
memberhardware'
:auto:required
handler-case
error
condition
when
eqhardware:required
errorcondition
warn"VideoToolbox decode unavailable; using software: ~A"condition
when
and
eqhardware:vulkan
hardware-configuration
handler-case
multiple-value-setq
codec-contexthardware-cleanup
enable-vulkan-decodingcodec-contexthardware-configuration
error
condition
warn"Vulkan decode unavailable; using software: ~A"condition
check-code
%avcodec-open2codec-contextdecoder
cffi:null-pointer
'open-video
setfvideo
make-instance'video:pathnamepathname:format-contextformat-context:codec-contextcodec-context:hardware-cleanuphardware-cleanup:stream-indexindex:width
cffi:foreign-slot-valuecodec-context'
:structav-codec-context
'width
:height
cffi:foreign-slot-valuecodec-context'
:structav-codec-context
'height
:frame-rate
rational-valuestream'
:structav-stream
'average-frame-rate
:frame:packet
%av-packet-alloc
setfformat-contextnilcodec-contextnil
video

Only reached when something above signalled: release whatever of the half-built decoder we had taken ownership of.

progn
whencodec-context
cffi:with-foreign-object
cell:pointer
setf
cffi:mem-refcell:pointer
codec-context
%avcodec-free-contextcell
whenhardware-cleanup
funcallhardware-cleanup
whenformat-context
cffi:with-foreign-object
cell:pointer
setf
cffi:mem-refcell:pointer
format-context
%avformat-close-inputcell
defunvideo-open-p
not
null
video-format-contextvideo
defunclose-video

Release video's decoder, demuxer, frame, and scaler. Idempotent.

Teardown computes too: swscale and the demuxer both do float arithmetic on the way out. An unmasked trap here would signal from inside whatever was releasing the video -- for luvcraft, the middle of closing the game -- and abandon everything that had not been released yet.

video
defunclose-video-1
when
when
video-scalervideo
%sws-free-context
video-scalervideo
setf
video-scalervideo
nil
video-scaler-keyvideo
nil
when
video-stagingvideo
cffi:foreign-free
video-stagingvideo
setf
video-stagingvideo
nil
video-staging-sizevideo
0
when
video-packetvideo
cffi:with-foreign-object
cell:pointer
setf
cffi:mem-refcell:pointer
video-packetvideo
%av-packet-freecell
setf
video-packetvideo
nil
when
video-codec-contextvideo
cffi:with-foreign-object
cell:pointer
setf
cffi:mem-refcell:pointer
video-codec-contextvideo
%avcodec-free-contextcell
setf
video-codec-contextvideo
nil
when
and
video-hardware-cleanupvideo
funcall
video-hardware-cleanupvideo
setf
video-hardware-cleanupvideo
nil
when
video-format-contextvideo
cffi:with-foreign-object
cell:pointer
setf
cffi:mem-refcell:pointer
video-format-contextvideo
%avformat-close-inputcell
setf
video-format-contextvideo
nil
video
defmacrowith-video
variablepathname
&bodybody

Evaluate body with variable bound to PATHNAME's decoder, closing it after.

`
let
unwind-protect
progn,@body
defunerror-again-p
code
=code
-+eagain+
defundecode-next-frame

Decode until video's frame holds the next picture. Return the frame or NIL.

NIL means the file is exhausted; video's frame is left holding the last picture that was decoded.

unless
error"The video ~A has been closed."
video-pathnamevideo
defundecode-next-frame-1
let
codec-context
video-codec-contextvideo
frame-pointer
frame-pointer
video-framevideo
packet
video-packetvideo
loop

Drain first: the codec may still be holding pictures from packets it was given earlier, and at end of file that is the only source left.

let
code
%avcodec-receive-framecodec-contextframe-pointer
cond
zeropcode
return
video-framevideo
=code+error-eof+
when
video-drained-pvideo

The codec wants more input. Read packets until one belongs to our stream, or the file ends and we flush with a null packet instead.

let
code
loopforstatus=
%av-read-frame
video-format-contextvideo
packet
do
cond
minuspstatus
returnstatus
=
cffi:foreign-slot-valuepacket'
:structav-packet
'stream-index
video-stream-indexvideo
t
%av-packet-unrefpacket
cond
zeropcode
unwind-protect
check-code
%avcodec-send-packetcodec-contextpacket
'decode-next-frame
%av-packet-unrefpacket
t

End of file, or a read error we treat as one. A null packet tells the codec to hand back everything it has buffered.

setf
video-drained-pvideo
t
%avcodec-send-packetcodec-context
cffi:null-pointer
defunrewind-video

Seek video back to its start and reset the decoder.

with-libav-native-environment
check-code
%av-seek-frame
video-format-contextvideo
video-stream-indexvideo
0+seek-backward+
'rewind-video
%avcodec-flush-buffers
video-codec-contextvideo
setf
video-drained-pvideo
nil
video

Converting a decoded picture to rgba.

The scaler is cached against the size it was built for, since building one per frame would discard the filter tables it exists to precompute. A changed target size -- or a decoder that changed its mind about the source format mid-stream, which happens -- rebuilds it.

defunensure-video-scaler
let*
frame
video-framevideo
source-format
cffi:foreign-slot-value
frame-pointerframe
'
:structav-frame
'format
key
listsource-format
frame-widthframe
frame-heightframe
widthheight
unless
and
video-scalervideo
equalkey
video-scaler-keyvideo
when
video-scalervideo
%sws-free-context
video-scalervideo
let
scaler
%sws-get-context
frame-widthframe
frame-heightframe
source-formatwidthheight
cffi:foreign-enum-value'pixel-format:rgba
cffi:foreign-enum-value'swscale-flags:bilinear
cffi:null-pointer
cffi:null-pointer
cffi:null-pointer
when
cffi:null-pointer-pscaler
error"Could not build a swscale context for ~Dx~D ~A to ~Dx~D RGBA."
frame-widthframe
frame-heightframe
pixel-format-namesource-format
widthheight
setf
video-scalervideo
scaler
video-scaler-keyvideo
key
video-scalervideo
defunensure-video-staging
videosize

Return video's rgba staging buffer, growing it to at least size bytes.

when
<
video-staging-sizevideo
size
when
video-stagingvideo
cffi:foreign-free
video-stagingvideo
setf
video-stagingvideo
cffi:foreign-alloc:uint8:countsize
video-staging-sizevideo
size
video-stagingvideo
defunscale-frame-into
videopointerwidthheightpitch

Convert video's current picture into pointer as width by height rgba.

pitch is the destination's byte stride, which may exceed width times four when the caller is writing into a larger image.

defunscale-frame-into-1
videopointerwidthheightpitch
let
frame
frame-pointer
video-framevideo
cffi:with-foreign-objects
planes:pointer4
pitches:int4
setf
cffi:mem-arefplanes:pointer0
pointer
setf
cffi:mem-arefpitches:int0
pitch
dotimes
index3
setf
cffi:mem-arefplanes:pointer
1+index
cffi:null-pointer
setf
cffi:mem-arefpitches:int
1+index
0
%sws-scalescaler
cffi:foreign-slot-pointerframe'
:structav-frame
'data
cffi:foreign-slot-pointerframe'
:structav-frame
'pitches
0
cffi:foreign-slot-valueframe'
:structav-frame
'height
planespitches
values
defunframe-rgba-words
videowidthheight&keyarray
alpha255

Return video's current picture as a height by width array of rgba words.

Each word is red in its low byte through alpha in its high byte, which is the packing luvcraft's block atlas uses. array is filled and returned when given, so a player can convert into the same array every frame.

alpha is written rather than taken from the conversion. swscale leaves the alpha of an rgba target undefined when the source has no alpha of its own, and in the block atlas that byte is not opacity at all -- it is the material's surface height -- so the caller has to say what it means.

let
words
orarray
make-array:element-type'
unsigned-byte32
copy-rgba-wordspixelswords
ashalpha24
words
defuncopy-rgba-words
pixelswordscountopacity

Copy count packed words out of foreign pixels into words, forcing opacity.

This is a per-picture inner loop -- a modest 512-wide screen is two hundred thousand words every time the film advances -- so it reads the foreign memory through a system area pointer rather than one CFFI call per pixel.

declare
type
simple-array
unsigned-byte32
words
typefixnumcount
type
unsigned-byte32
opacity
optimize
speed3
safety0
#+sbcl
let
sap
sb-sys:int-sap
cffi:pointer-addresspixels
dotimes
indexcount
setf
row-major-arefwordsindex
logior
logand
sb-sys:sap-ref-32sap
thefixnum
*4index
#x00ffffff
opacity
#-sbcl (dotimes (index count) (setf (row-major-aref words index) (logior (logand (cffi:mem-aref pixels :uint32 index) #x00ffffff) opacity)))words