{* UltraStar Deluxe - Karaoke Game
*
* UltraStar Deluxe is the legal property of its developers, whose names
* are too numerous to list here. Please refer to the COPYRIGHT
* file distributed with this source distribution.
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA.
*
* $URL$
* $Id$
*}
unit UVideo;
{*
* based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/)
*}
// uncomment if you want to see the debug stuff
{.$define DebugDisplay}
{.$define DebugFrames}
{.$define VideoBenchmark}
{.$define Info}
interface
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{$I switches.inc}
// use BGR-format for accelerated colorspace conversion with swscale
{$IFDEF UseSWScale}
{$DEFINE PIXEL_FMT_BGR}
{$ENDIF}
implementation
uses
SysUtils,
Math,
ctypes,
SDL,
avcodec,
avformat,
avutil,
avio,
rational,
{$IFDEF UseSWScale}
swscale,
{$ENDIF}
gl,
glu,
glext,
textgl,
UMediaCore_FFmpeg,
UCommon,
UConfig,
ULog,
UMusic,
UGraphicClasses,
UGraphic,
UPath;
{$DEFINE PIXEL_FMT_BGR}
const
{$IFDEF PIXEL_FMT_BGR}
PIXEL_FMT_OPENGL = GL_BGR;
{$IF FFMPEG_VERSION_INT < 1001000}
PIXEL_FMT_FFMPEG = PIX_FMT_BGR24;
{$ELSE}
PIXEL_FMT_FFMPEG = AV_PIX_FMT_BGR24;
{$ENDIF}
PIXEL_FMT_SIZE = 3;
// looks strange on linux:
//PIXEL_FMT_OPENGL = GL_RGBA;
//PIXEL_FMT_FFMPEG = PIX_FMT_BGR32;
//PIXEL_FMT_SIZE = 4;
{$ELSE}
// looks strange on linux:
PIXEL_FMT_OPENGL = GL_RGB;
{$IF FFMPEG_VERSION_INT < 1001000}
PIXEL_FMT_FFMPEG = PIX_FMT_BGR24;
{$ELSE}
PIXEL_FMT_FFMPEG = AV_PIX_FMT_BGR24;
{$ENDIF}
PIXEL_FMT_SIZE = 3;
{$ENDIF}
ReflectionH = 0.5; //reflection height (50%)
type
IVideo_FFmpeg = interface (IVideo)
['{E640E130-C8C0-4399-AF02-67A3569313AB}']
function Open(const FileName: IPath): boolean;
end;
TVideo_FFmpeg = class( TInterfacedObject, IVideo_FFmpeg )
private
fOpened: boolean; //**< stream successfully opened
fPaused: boolean; //**< stream paused
fEOF: boolean; //**< end-of-file state
fLoop: boolean; //**< looping enabled
fStream: PAVStream;
fStreamIndex : integer;
fFormatContext: PAVFormatContext;
fCodecContext: PAVCodecContext;
fCodec: PAVCodec;
fAVFrame: PAVFrame;
fAVFrameRGB: PAVFrame;
fFrameBuffer: Pcuint8; //**< stores a FFmpeg video frame
fFrameTex: GLuint; //**< OpenGL texture for FrameBuffer
fFrameTexValid: boolean; //**< if true, fFrameTex contains the current frame
fTexWidth, fTexHeight: cardinal;
{$IFDEF UseSWScale}
fSwScaleContext: PSwsContext;
{$ENDIF}
fScreen: integer; //actual screen to draw on
fPosX: double;
fPosY: double;
fPosZ: double;
fWidth: double;
fHeight: double;
fFrameRange: TRectCoords;
fAlpha: double;
fReflectionSpacing: double;
fAspect: real; //**< width/height ratio
fAspectCorrection: TAspectCorrection;
fFrameDuration: extended; //**< duration of a video frame in seconds (= 1/fps)
fFrameTime: extended; //**< video time position (absolute)
fLoopTime: extended; //**< start time of the current loop
fPboEnabled: boolean;
fPboId: GLuint;
procedure Reset();
function DecodeFrame(): boolean;
procedure SynchronizeTime(Frame: PAVFrame; var pts: double);
procedure GetVideoRect(var ScreenRect, TexRect: TRectCoords);
procedure DrawBorders(ScreenRect: TRectCoords);
procedure DrawBordersReflected(ScreenRect: TRectCoords; AlphaUpper, AlphaLower: double);
procedure ShowDebugInfo();
public
constructor Create;
destructor Destroy; override;
function Open(const FileName: IPath): boolean;
procedure Close;
procedure Play;
procedure Pause;
procedure Stop;
procedure SetLoop(Enable: boolean);
function GetLoop(): boolean;
procedure SetPosition(Time: real);
function GetPosition: real;
procedure SetScreen(Screen: integer);
function GetScreen(): integer;
procedure SetScreenPosition(X, Y, Z: double);
procedure GetScreenPosition(var X, Y, Z: double);
procedure SetWidth(Width: double);
function GetWidth(): double;
procedure SetHeight(Height: double);
function GetHeight(): double;
{**
* Sub-image of the video frame to draw.
* This can be used for zooming or similar purposes.
*}
procedure SetFrameRange(Range: TRectCoords);
function GetFrameRange(): TRectCoords;
function GetFrameAspect(): real;
procedure SetAspectCorrection(AspectCorrection: TAspectCorrection);
function GetAspectCorrection(): TAspectCorrection;
procedure SetAlpha(Alpha: double);
function GetAlpha(): double;
procedure SetReflectionSpacing(Spacing: double);
function GetReflectionSpacing(): double;
procedure GetFrame(Time: Extended);
procedure Draw();
procedure DrawReflection();
end;
TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback )
private
fInitialized: boolean;
public
function GetName: String;
function Init(): boolean;
function Finalize: boolean;
function Open(const FileName : IPath): IVideo;
end;
var
FFmpegCore: TMediaCore_FFmpeg;
// These are called whenever we allocate a frame buffer.
// We use this to store the global_pts in a frame at the time it is allocated.
function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl;
var
pts: Pint64;
VideoPktPts: Pint64;
begin
Result := avcodec_default_get_buffer(CodecCtx, Frame);
VideoPktPts := CodecCtx^.opaque;
if (VideoPktPts <> nil) then
begin
// Note: we must copy the pts instead of passing a pointer, because the packet
// (and with it the pts) might change before a frame is returned by av_decode_video.
pts := av_malloc(sizeof(int64));
pts^ := VideoPktPts^;
Frame^.opaque := pts;
end;
end;
procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl;
begin
if (Frame <> nil) then
av_freep(@Frame^.opaque);
avcodec_default_release_buffer(CodecCtx, Frame);
end;
{*------------------------------------------------------------------------------
* TVideoPlayback_ffmpeg
*------------------------------------------------------------------------------}
function TVideoPlayback_FFmpeg.GetName: String;
begin
result := 'FFmpeg_Video';
end;
function TVideoPlayback_FFmpeg.Init(): boolean;
begin
Result := true;
if (fInitialized) then
Exit;
fInitialized := true;
FFmpegCore := TMediaCore_FFmpeg.GetInstance();
av_register_all();
end;
function TVideoPlayback_FFmpeg.Finalize(): boolean;
begin
Result := true;
end;
function TVideoPlayback_FFmpeg.Open(const FileName : IPath): IVideo;
var
Video: IVideo_FFmpeg;
begin
Video := TVideo_FFmpeg.Create;
if Video.Open(FileName) then
Result := Video
else
Result := nil;
end;
{* TVideo_FFmpeg *}
constructor TVideo_FFmpeg.Create;
begin
glGenTextures(1, PGLuint(@fFrameTex));
Reset();
end;
destructor TVideo_FFmpeg.Destroy;
begin
Close();
glDeleteTextures(1, PGLuint(@fFrameTex));
end;
function TVideo_FFmpeg.Open(const FileName : IPath): boolean;
var
errnum: Integer;
glErr: GLenum;
AudioStreamIndex: integer;
begin
Result := false;
Reset();
fPboEnabled := PboSupported;
// use custom 'ufile' protocol for UTF-8 support
{$IF LIBAVFORMAT_VERSION < 53001003}
errnum := av_open_input_file(fFormatContext, PAnsiChar('ufile:'+FileName.ToUTF8), nil, 0, nil);
{$ELSEIF LIBAVFORMAT_VERSION < 54029104}
errnum := avformat_open_input(@fFormatContext, PAnsiChar('ufile:'+FileName.ToUTF8), nil, nil);
{$ELSE}
errnum := FFmpegCore.AVFormatOpenInput(@fFormatContext, PAnsiChar('ufile:'+FileName.ToUTF8));
{$IFEND}
if (errnum <> 0) then
begin
Log.LogError('Failed to open file "'+ FileName.ToNative +'" ('+FFmpegCore.GetErrorString(errnum)+')');
Exit;
end;
// update video info
{$IF LIBAVFORMAT_VERSION >= 53002000)}
errnum := avformat_find_stream_info(fFormatContext, nil);
{$ELSE}
errnum := av_find_stream_info(fFormatContext);
{$IFEND}
if (errnum < 0) then
begin
Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
Log.LogInfo('VideoStreamIndex : ' + inttostr(fStreamIndex), 'TVideoPlayback_ffmpeg.Open');
// find video stream
FFmpegCore.FindStreamIDs(fFormatContext, fStreamIndex, AudioStreamIndex);
if (fStreamIndex < 0) then
begin
Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
{$IF LIBAVFORMAT_VERSION <= 52111000} // <= 52.111.0
fStream := fFormatContext^.streams[fStreamIndex];
{$ELSE}
fStream := PPAVStream(PtrUInt(fFormatContext^.streams) + fStreamIndex * Sizeof(pointer))^;
{$IFEND}
fCodecContext := fStream^.codec;
fCodec := avcodec_find_decoder(fCodecContext^.codec_id);
if (fCodec = nil) then
begin
Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
// set debug options
fCodecContext^.debug_mv := 0;
fCodecContext^.debug := 0;
// detect bug-workarounds automatically
fCodecContext^.workaround_bugs := FF_BUG_AUTODETECT;
// error resilience strategy (careful/compliant/agressive/very_aggressive)
//fCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT;
// allow non spec compliant speedup tricks.
//fCodecContext^.flags2 := fCodecContext^.flags2 or CODEC_FLAG2_FAST;
// Note: avcodec_open() and avcodec_close() are not thread-safe and will
// fail if called concurrently by different threads.
FFmpegCore.LockAVCodec();
try
{$IF LIBAVCODEC_VERSION >= 53005000)}
errnum := avcodec_open2(fCodecContext, fCodec, nil);
{$ELSE}
errnum := avcodec_open(fCodecContext, fCodec);
{$IFEND}
finally
FFmpegCore.UnlockAVCodec();
end;
if (errnum < 0) then
begin
Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
// register custom callbacks for pts-determination
fCodecContext^.get_buffer := PtsGetBuffer;
fCodecContext^.release_buffer := PtsReleaseBuffer;
{$ifdef DebugDisplay}
DebugWriteln('Found a matching Codec: '+ fCodecContext^.Codec.Name + sLineBreak +
sLineBreak +
' Width = '+inttostr(fCodecContext^.width) +
', Height='+inttostr(fCodecContext^.height) + sLineBreak +
' Aspect : '+inttostr(fCodecContext^.sample_aspect_ratio.num) + '/' +
inttostr(fCodecContext^.sample_aspect_ratio.den) + sLineBreak +
' Framerate : '+inttostr(fCodecContext^.time_base.num) + '/' +
inttostr(fCodecContext^.time_base.den));
{$endif}
// allocate space for decoded frame and rgb frame
fAVFrame := avcodec_alloc_frame();
fAVFrameRGB := avcodec_alloc_frame();
fFrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG,
fCodecContext^.width, fCodecContext^.height));
if ((fAVFrame = nil) or (fAVFrameRGB = nil) or (fFrameBuffer = nil)) then
begin
Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
// TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT
// (otherwise video will be distorted if width/height is not a multiple of the alignment)
errnum := avpicture_fill(PAVPicture(fAVFrameRGB), fFrameBuffer, PIXEL_FMT_FFMPEG,
fCodecContext^.width, fCodecContext^.height);
if (errnum < 0) then
begin
Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
// calculate some information for video display
fAspect := av_q2d(fCodecContext^.sample_aspect_ratio);
if (fAspect = 0) then
fAspect := fCodecContext^.width /
fCodecContext^.height
else
fAspect := fAspect * fCodecContext^.width /
fCodecContext^.height;
fFrameDuration := 1/av_q2d(fStream^.r_frame_rate);
// hack to get reasonable framerate (for divx and others)
if (fFrameDuration < 0.02) then // 0.02 <-> 50 fps
begin
fFrameDuration := av_q2d(fStream^.r_frame_rate);
while (fFrameDuration > 50) do
fFrameDuration := fFrameDuration/10;
fFrameDuration := 1/fFrameDuration;
end;
Log.LogInfo('Framerate: '+inttostr(floor(1/fFrameDuration))+'fps', 'TVideoPlayback_ffmpeg.Open');
{$IFDEF UseSWScale}
// if available get a SWScale-context -> faster than the deprecated img_convert().
// SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555.
// Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!!
// The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its
// bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up
// could be observed in comparison to the RGB versions.
fSwScaleContext := sws_getContext(
fCodecContext^.width, fCodecContext^.height,
fCodecContext^.pix_fmt,
fCodecContext^.width, fCodecContext^.height,
PIXEL_FMT_FFMPEG,
SWS_FAST_BILINEAR, nil, nil, nil);
if (fSwScaleContext = nil) then
begin
Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open');
Close();
Exit;
end;
{$ENDIF}
fTexWidth := Round(Power(2, Ceil(Log2(fCodecContext^.width))));
fTexHeight := Round(Power(2, Ceil(Log2(fCodecContext^.height))));
if (fPboEnabled) then
begin
glGetError();
glGenBuffersARB(1, @fPboId);
glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, fPboId);
glBufferDataARB(
GL_PIXEL_UNPACK_BUFFER_ARB,
fCodecContext^.width * fCodecContext^.height * PIXEL_FMT_SIZE,
nil,
GL_STREAM_DRAW_ARB);
glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, 0);
glErr := glGetError();
if (glErr <> GL_NO_ERROR) then
begin
fPboEnabled := false;
Log.LogError('PBO initialization failed: ' + gluErrorString(glErr), 'TVideo_FFmpeg.Open');
end;
end;
// we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later.
// Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height.
glBindTexture(GL_TEXTURE_2D, fFrameTex);
glTexImage2D(GL_TEXTURE_2D, 0, 3, fTexWidth, fTexHeight, 0,
PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
fOpened := true;
Result := true;
end;
procedure TVideo_FFmpeg.Reset();
begin
// close previously opened video
Close();
fOpened := False;
fPaused := False;
fFrameDuration := 0;
fFrameTime := 0;
fStream := nil;
fStreamIndex := -1;
fFrameTexValid := false;
fEOF := false;
fLoop := false;
fLoopTime := 0;
fPboId := 0;
fAspectCorrection := acoCrop;
fScreen := 1;
fPosX := 0;
fPosY := 0;
fPosZ := 0;
fWidth := RenderW;
fHeight := RenderH;
fFrameRange.Left := 0;
fFrameRange.Right := 1;
fFrameRange.Upper := 0;
fFrameRange.Lower := 1;
fAlpha := 1;
fReflectionSpacing := 0;
end;
procedure TVideo_FFmpeg.Close;
begin
if (fFrameBuffer <> nil) then
av_free(fFrameBuffer);
if (fAVFrameRGB <> nil) then
av_free(fAVFrameRGB);
if (fAVFrame <> nil) then
av_free(fAVFrame);
fAVFrame := nil;
fAVFrameRGB := nil;
fFrameBuffer := nil;
if (fCodecContext <> nil) then
begin
// avcodec_close() is not thread-safe
FFmpegCore.LockAVCodec();
try
avcodec_close(fCodecContext);
finally
FFmpegCore.UnlockAVCodec();
end;
end;
if (fFormatContext <> nil) then
{$IF LIBAVFORMAT_VERSION < 53024002)}
av_close_input_file(fFormatContext);
{$ELSEIF LIBAVFORMAT_VERSION < 54029104}
avformat_close_input(@fFormatContext);
{$ELSE}
FFmpegCore.AVFormatCloseInput(@fFormatContext);
{$IFEND}
fCodecContext := nil;
fFormatContext := nil;
if (fPboId <> 0) then
glDeleteBuffersARB(1, @fPboId);
fOpened := False;
end;
procedure TVideo_FFmpeg.SynchronizeTime(Frame: PAVFrame; var pts: double);
var
FrameDelay: double;
begin
if (pts <> 0) then
begin
// if we have pts, set video clock to it
fFrameTime := pts;
end else
begin
// if we aren't given a pts, set it to the clock
pts := fFrameTime;
end;
// update the video clock
FrameDelay := av_q2d(fCodecContext^.time_base);
// if we are repeating a frame, adjust clock accordingly
FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5);
fFrameTime := fFrameTime + FrameDelay;
end;
{**
* Decode a new frame from the video stream.
* The decoded frame is stored in fAVFrame. fFrameTime is updated to the new frame's
* time.
* @param pts will be updated to the presentation time of the decoded frame.
* returns true if a frame could be decoded. False if an error or EOF occured.
*}
function TVideo_FFmpeg.DecodeFrame(): boolean;
var
FrameFinished: Integer;
VideoPktPts: int64;
{$IF FFMPEG_VERSION_INT < 1001000}
pbIOCtx: PByteIOContext;
{$ELSE}
pbIOCtx: PAVIOContext;
{$ENDIF}
errnum: integer;
AVPacket: TAVPacket;
pts: double;
fileSize: int64;
urlError: integer;
begin
Result := false;
FrameFinished := 0;
if fEOF then
Exit;
// read packets until we have a finished frame (or there are no more packets)
while (FrameFinished = 0) do
begin
errnum := av_read_frame(fFormatContext, AVPacket);
if (errnum < 0) then
begin
// failed to read a frame, check reason
{$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)}
pbIOCtx := fFormatContext^.pb;
{$ELSE}
pbIOCtx := @fFormatContext^.pb;
{$IFEND}
// check for end-of-file (EOF is not an error)
if (url_feof(pbIOCtx) <> 0) then
begin
fEOF := true;
Exit;
end;
// check for errors
{$IF (LIBAVFORMAT_VERSION >= 52103000)}
urlError := pbIOCtx^.error;
{$ELSE}
urlError := url_ferror(pbIOCtx);
{$IFEND}
if (urlError <> 0) then
begin
Log.LogError('Video decoding file error', 'TVideoPlayback_FFmpeg.DecodeFrame');
Exit;
end;
// url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov)
// so we have to do it this way.
{$IF (LIBAVFORMAT_VERSION >= 53009000)}
fileSize := avio_size(fFormatContext^.pb);
{$ELSE}
fileSize := fFormatContext^.file_size;
{$IFEND}
if ((fileSize <> 0) and (pbIOCtx^.pos >= fileSize)) then
begin
fEOF := true;
Exit;
end;
// error occured, log and exit
Log.LogError('Video decoding error', 'TVideoPlayback_FFmpeg.DecodeFrame');
Exit;
end;
// if we got a packet from the video stream, then decode it
if (AVPacket.stream_index = fStreamIndex) then
begin
// save pts to be stored in pFrame in first call of PtsGetBuffer()
VideoPktPts := AVPacket.pts;
fCodecContext^.opaque := @VideoPktPts;
// decode packet
{$IF LIBAVFORMAT_VERSION < 52012200)}
avcodec_decode_video(fCodecContext, fAVFrame,
frameFinished, AVPacket.data, AVPacket.size);
{$ELSE}
avcodec_decode_video2(fCodecContext, fAVFrame,
frameFinished, @AVPacket);
{$IFEND}
// reset opaque data
fCodecContext^.opaque := nil;
// update pts
if (AVPacket.dts <> AV_NOPTS_VALUE) then
begin
pts := AVPacket.dts;
end
else if ((fAVFrame^.opaque <> nil) and
(Pint64(fAVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then
begin
pts := Pint64(fAVFrame^.opaque)^;
end
else
begin
pts := 0;
end;
if fStream^.start_time <> AV_NOPTS_VALUE then
pts := pts - fStream^.start_time;
pts := pts * av_q2d(fStream^.time_base);
// synchronize time on each complete frame
if (frameFinished <> 0) then
SynchronizeTime(fAVFrame, pts);
end;
// free the packet from av_read_frame
av_free_packet( @AVPacket );
end;
Result := true;
end;
procedure TVideo_FFmpeg.GetFrame(Time: Extended);
var
errnum: Integer;
glErr: GLenum;
CurrentTime: Extended;
TimeDiff: Extended;
DropFrameCount: Integer;
i: Integer;
Success: boolean;
BufferPtr: PGLvoid;
const
SKIP_FRAME_DIFF = 0.010; // start skipping if we are >= 10ms too late
begin
if not fOpened then
Exit;
if fPaused then
Exit;
{*
* Synchronization - begin
*}
// requested stream position (relative to the last loop's start)
if (fLoop) then
CurrentTime := Time - fLoopTime
else
CurrentTime := Time;
// check if current texture still contains the active frame
if (fFrameTexValid) then
begin
// time since the last frame was returned
TimeDiff := CurrentTime - fFrameTime;
{$IFDEF DebugDisplay}
DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak +
'VideoTime: '+inttostr(floor(fFrameTime*1000)) + sLineBreak +
'TimeBase: '+inttostr(floor(fFrameDuration*1000)) + sLineBreak +
'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
{$endif}
// check if time has reached the next frame
if (TimeDiff < fFrameDuration) then
begin
{$ifdef DebugFrames}
// frame delay debug display
GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
{$endif}
{$IFDEF DebugDisplay}
DebugWriteln('not getting new frame' + sLineBreak +
'Time: '+inttostr(floor(Time*1000)) + sLineBreak +
'VideoTime: '+inttostr(floor(fFrameTime*1000)) + sLineBreak +
'TimeBase: '+inttostr(floor(fFrameDuration*1000)) + sLineBreak +
'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
{$endif}
// we do not need a new frame now
Exit;
end;
end;
{$IFDEF VideoBenchmark}
Log.BenchmarkStart(15);
{$ENDIF}
// fetch new frame (updates fFrameTime)
Success := DecodeFrame();
TimeDiff := CurrentTime - fFrameTime;
// check if we have to skip frames
// Either if we are one frame behind or if the skip threshold has been reached.
// Do not skip if the difference is less than fFrameDuration as there is no next frame.
// Note: We assume that fFrameDuration is the length of one frame.
if (TimeDiff >= Max(fFrameDuration, SKIP_FRAME_DIFF)) then
begin
{$IFDEF DebugFrames}
//frame drop debug display
GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000);
{$ENDIF}
{$IFDEF DebugDisplay}
DebugWriteln('skipping frames' + sLineBreak +
'TimeBase: '+inttostr(floor(fFrameDuration*1000)) + sLineBreak +
'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
{$endif}
// update video-time
DropFrameCount := Trunc(TimeDiff / fFrameDuration);
fFrameTime := fFrameTime + DropFrameCount*fFrameDuration;
// skip frames
for i := 1 to DropFrameCount do
Success := DecodeFrame();
end;
// check if we got an EOF or error
if (not Success) then
begin
if fLoop then
begin
// we have to loop, so rewind
SetPosition(0);
// record the start-time of the current loop, so we can
// determine the position in the stream (fFrameTime-fLoopTime) later.
fLoopTime := Time;
end;
Exit;
end;
{*
* Synchronization - end
*}
// TODO: support for pan&scan
//if (fAVFrame.pan_scan <> nil) then
//begin
// Writeln(Format('PanScan: %d/%d', [fAVFrame.pan_scan.width, fAVFrame.pan_scan.height]));
//end;
// otherwise we convert the pixeldata from YUV to RGB
{$IFDEF UseSWScale}
errnum := sws_scale(fSwScaleContext, @fAVFrame.data, @fAVFrame.linesize,
0, fCodecContext^.Height,
@fAVFrameRGB.data, @fAVFrameRGB.linesize);
{$ELSE}
// img_convert from lib/ffmpeg/avcodec.pas is actually deprecated.
// If ./configure does not find SWScale then this gives the error
// that the identifier img_convert is not known or similar.
// I think this should be removed, but am not sure whether there should
// be some other replacement or a warning, Therefore, I leave it for now.
// April 2009, mischi
errnum := img_convert(PAVPicture(fAVFrameRGB), PIXEL_FMT_FFMPEG,
PAVPicture(fAVFrame), fCodecContext^.pix_fmt,
fCodecContext^.width, fCodecContext^.height);
{$ENDIF}
if (errnum < 0) then
begin
Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame');
Exit;
end;
{$IFDEF VideoBenchmark}
Log.BenchmarkEnd(15);
Log.BenchmarkStart(16);
{$ENDIF}
// TODO: data is not padded, so we will need to tell OpenGL.
// Or should we add padding with avpicture_fill? (check which one is faster)
//glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
// glTexEnvi with GL_REPLACE might give a small speed improvement
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
if (not fPboEnabled) then
begin
glBindTexture(GL_TEXTURE_2D, fFrameTex);
glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0,
fCodecContext^.width, fCodecContext^.height,
PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, fAVFrameRGB^.data[0]);
end
else // fPboEnabled
begin
glGetError();
glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, fPboId);
glBufferDataARB(GL_PIXEL_UNPACK_BUFFER_ARB,
fCodecContext^.height * fCodecContext^.width * PIXEL_FMT_SIZE,
nil,
GL_STREAM_DRAW_ARB);
bufferPtr := glMapBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, GL_WRITE_ONLY_ARB);
if(bufferPtr <> nil) then
begin
Move(fAVFrameRGB^.data[0]^, bufferPtr^,
fCodecContext^.height * fCodecContext^.width * PIXEL_FMT_SIZE);
// release pointer to mapping buffer
glUnmapBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB);
end;
glBindTexture(GL_TEXTURE_2D, fFrameTex);
glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0,
fCodecContext^.width, fCodecContext^.height,
PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil);
glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, 0);
glBindTexture(GL_TEXTURE_2D, 0);
glErr := glGetError();
if (glErr <> GL_NO_ERROR) then
Log.LogError('PBO texture stream error: ' + gluErrorString(glErr), 'TVideo_FFmpeg.GetFrame');
end;
// reset to default
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
if (not fFrameTexValid) then
fFrameTexValid := true;
{$ifdef DebugFrames}
//frame decode debug display
GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00);
{$endif}
{$IFDEF VideoBenchmark}
Log.BenchmarkEnd(16);
Log.LogBenchmark('FFmpeg', 15);
Log.LogBenchmark('Texture', 16);
{$ENDIF}
end;
procedure TVideo_FFmpeg.GetVideoRect(var ScreenRect, TexRect: TRectCoords);
var
ScreenAspect: double; // aspect of screen resolution
ScaledVideoWidth, ScaledVideoHeight: double;
begin
// Three aspects to take into account:
// 1. Screen/display resolution (e.g. 1920x1080 -> 16:9)
// 2. Render aspect (fWidth x fHeight -> variable)
// 3. Movie aspect (video frame aspect stored in fAspect)
ScreenAspect := fWidth*((ScreenW/Screens)/RenderW)/(fHeight*(ScreenH/RenderH));
case fAspectCorrection of
acoStretch: begin
ScaledVideoWidth := fWidth;
ScaledVideoHeight := fHeight;
end;
acoCrop: begin
if (ScreenAspect >= fAspect) then
begin
ScaledVideoWidth := fWidth;
ScaledVideoHeight := fHeight * ScreenAspect/fAspect;
end else
begin
ScaledVideoHeight := fHeight;
ScaledVideoWidth := fWidth * fAspect/ScreenAspect;
end;
end;
acoLetterBox: begin
if (ScreenAspect <= fAspect) then
begin
ScaledVideoWidth := fWidth;
ScaledVideoHeight := fHeight * ScreenAspect/fAspect;
end else
begin
ScaledVideoHeight := fHeight;
ScaledVideoWidth := fWidth * fAspect/ScreenAspect;
end;
end else
raise Exception.Create('Unhandled aspect correction!');
end;
//center video
ScreenRect.Left := (fWidth - ScaledVideoWidth) / 2 + fPosX;
ScreenRect.Right := ScreenRect.Left + ScaledVideoWidth;
ScreenRect.Upper := (fHeight - ScaledVideoHeight) / 2 + fPosY;
ScreenRect.Lower := ScreenRect.Upper + ScaledVideoHeight;
// texture contains right/lower (power-of-2) padding.
// Determine the texture coords of the video frame.
TexRect.Left := (fCodecContext^.width / fTexWidth) * fFrameRange.Left;
TexRect.Right := (fCodecContext^.width / fTexWidth) * fFrameRange.Right;
TexRect.Upper := (fCodecContext^.height / fTexHeight) * fFrameRange.Upper;
TexRect.Lower := (fCodecContext^.height / fTexHeight) * fFrameRange.Lower;
end;
procedure TVideo_FFmpeg.DrawBorders(ScreenRect: TRectCoords);
procedure DrawRect(left, right, upper, lower: double);
begin
glColor4f(0, 0, 0, fAlpha);
glBegin(GL_QUADS);
glVertex3f(left, upper, fPosZ);
glVertex3f(right, upper, fPosZ);
glVertex3f(right, lower, fPosZ);
glVertex3f(left, lower, fPosZ);
glEnd;
end;
begin
//upper border
if(ScreenRect.Upper > fPosY) then
DrawRect(fPosX, fPosX+fWidth, fPosY, ScreenRect.Upper);
//lower border
if(ScreenRect.Lower < fPosY+fHeight) then
DrawRect(fPosX, fPosX+fWidth, ScreenRect.Lower, fPosY+fHeight);
//left border
if(ScreenRect.Left > fPosX) then
DrawRect(fPosX, ScreenRect.Left, fPosY, fPosY+fHeight);
//right border
if(ScreenRect.Right < fPosX+fWidth) then
DrawRect(ScreenRect.Right, fPosX+fWidth, fPosY, fPosY+fHeight);
end;
procedure TVideo_FFmpeg.DrawBordersReflected(ScreenRect: TRectCoords; AlphaUpper, AlphaLower: double);
var
rPosUpper, rPosLower: double;
procedure DrawRect(left, right, upper, lower: double);
var
AlphaTop: double;
AlphaBottom: double;
begin
AlphaTop := AlphaUpper+(AlphaLower-AlphaUpper)*(upper-rPosUpper)/(fHeight*ReflectionH);
AlphaBottom := AlphaLower+(AlphaUpper-AlphaLower)*(rPosLower-lower)/(fHeight*ReflectionH);
glBegin(GL_QUADS);
glColor4f(0, 0, 0, AlphaTop);
glVertex3f(left, upper, fPosZ);
glVertex3f(right, upper, fPosZ);
glColor4f(0, 0, 0, AlphaBottom);
glVertex3f(right, lower, fPosZ);
glVertex3f(left, lower, fPosZ);
glEnd;
end;
begin
rPosUpper := fPosY+fHeight+fReflectionSpacing;
rPosLower := rPosUpper+fHeight*ReflectionH;
//upper border
if(ScreenRect.Upper > rPosUpper) then
DrawRect(fPosX, fPosX+fWidth, rPosUpper, ScreenRect.Upper);
//lower border
if(ScreenRect.Lower < rPosLower) then
DrawRect(fPosX, fPosX+fWidth, ScreenRect.Lower, rPosLower);
//left border
if(ScreenRect.Left > fPosX) then
DrawRect(fPosX, ScreenRect.Left, rPosUpper, rPosLower);
//right border
if(ScreenRect.Right < fPosX+fWidth) then
DrawRect(ScreenRect.Right, fPosX+fWidth, rPosUpper, rPosLower);
end;
procedure TVideo_FFmpeg.Draw();
var
ScreenRect: TRectCoords;
TexRect: TRectCoords;
HeightFactor: double;
WidthFactor: double;
begin
// exit if there's nothing to draw
if (not fOpened) then
Exit;
{$IFDEF VideoBenchmark}
Log.BenchmarkStart(15);
{$ENDIF}
// get texture and screen positions
GetVideoRect(ScreenRect, TexRect);
WidthFactor := (ScreenW/Screens) / RenderW;
HeightFactor := ScreenH / RenderH;
glScissor(
round(fPosX*WidthFactor + (ScreenW/Screens)*(fScreen-1)),
round((RenderH-fPosY-fHeight)*HeightFactor),
round(fWidth*WidthFactor),
round(fHeight*HeightFactor)
);
glEnable(GL_SCISSOR_TEST);
glEnable(GL_BLEND);
glDepthRange(0, 10);
glDepthFunc(GL_LEQUAL);
glEnable(GL_DEPTH_TEST);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, fFrameTex);
glColor4f(1, 1, 1, fAlpha);
glBegin(GL_QUADS);
// upper-left coord
glTexCoord2f(TexRect.Left, TexRect.Upper);
glVertex3f(ScreenRect.Left, ScreenRect.Upper, fPosZ);
// lower-left coord
glTexCoord2f(TexRect.Left, TexRect.Lower);
glVertex3f(ScreenRect.Left, ScreenRect.Lower, fPosZ);
// lower-right coord
glTexCoord2f(TexRect.Right, TexRect.Lower);
glVertex3f(ScreenRect.Right, ScreenRect.Lower, fPosZ);
// upper-right coord
glTexCoord2f(TexRect.Right, TexRect.Upper);
glVertex3f(ScreenRect.Right, ScreenRect.Upper, fPosZ);
glEnd;
glDisable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, 0);
//draw black borders
DrawBorders(ScreenRect);
glDisable(GL_DEPTH_TEST);
glDisable(GL_BLEND);
glDisable(GL_SCISSOR_TEST);
{$IFDEF VideoBenchmark}
Log.BenchmarkEnd(15);
Log.LogBenchmark('Draw', 15);
{$ENDIF}
{$IF Defined(Info) or Defined(DebugFrames)}
ShowDebugInfo();
{$IFEND}
end;
procedure TVideo_FFmpeg.DrawReflection();
var
ScreenRect: TRectCoords;
TexRect: TRectCoords;
HeightFactor: double;
WidthFactor: double;
AlphaTop: double;
AlphaBottom: double;
AlphaUpper: double;
AlphaLower: double;
begin
// exit if there's nothing to draw
if (not fOpened) then
Exit;
// get texture and screen positions
GetVideoRect(ScreenRect, TexRect);
WidthFactor := (ScreenW/Screens) / RenderW;
HeightFactor := ScreenH / RenderH;
glScissor(
round(fPosX*WidthFactor + (ScreenW/Screens)*(fScreen-1)),
round((RenderH-fPosY-fHeight-fReflectionSpacing-fHeight*ReflectionH)*HeightFactor),
round(fWidth*WidthFactor),
round(fHeight*HeightFactor*ReflectionH)
);
glEnable(GL_SCISSOR_TEST);
glEnable(GL_BLEND);
glDepthRange(0, 10);
glDepthFunc(GL_LEQUAL);
glEnable(GL_DEPTH_TEST);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, fFrameTex);
//calculate new ScreenRect coordinates for Reflection
ScreenRect.Lower := fPosY + fHeight + fReflectionSpacing
+ (ScreenRect.Upper-fPosY) + (ScreenRect.Lower-ScreenRect.Upper)*ReflectionH;
ScreenRect.Upper := fPosY + fHeight + fReflectionSpacing
+ (ScreenRect.Upper-fPosY);
AlphaUpper := fAlpha-0.3;
AlphaLower := 0;
AlphaTop := AlphaUpper-(AlphaLower-AlphaUpper)*
(ScreenRect.Upper-fPosY-fHeight-fReflectionSpacing)/fHeight;
AlphaBottom := AlphaLower+(AlphaUpper-AlphaLower)*
(fPosY+fHeight+fReflectionSpacing+fHeight*ReflectionH-ScreenRect.Lower)/fHeight;
glBegin(GL_QUADS);
//Top Left
glColor4f(1, 1, 1, AlphaTop);
glTexCoord2f(TexRect.Left, TexRect.Lower);
glVertex3f(ScreenRect.Left, ScreenRect.Upper, fPosZ);
//Bottom Left
glColor4f(1, 1, 1, AlphaBottom);
glTexCoord2f(TexRect.Left, (TexRect.Lower-TexRect.Upper)*(1-ReflectionH));
glVertex3f(ScreenRect.Left, ScreenRect.Lower, fPosZ);
//Bottom Right
glColor4f(1, 1, 1, AlphaBottom);
glTexCoord2f(TexRect.Right, (TexRect.Lower-TexRect.Upper)*(1-ReflectionH));
glVertex3f(ScreenRect.Right, ScreenRect.Lower, fPosZ);
//Top Right
glColor4f(1, 1, 1, AlphaTop);
glTexCoord2f(TexRect.Right, TexRect.Lower);
glVertex3f(ScreenRect.Right, ScreenRect.Upper, fPosZ);
glEnd;
glDisable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, 0);
//draw black borders
DrawBordersReflected(ScreenRect, AlphaUpper, AlphaLower);
glDisable(GL_DEPTH_TEST);
glDisable(GL_BLEND);
glDisable(GL_SCISSOR_TEST);
end;
procedure TVideo_FFmpeg.ShowDebugInfo();
begin
{$IFDEF Info}
if (fFrameTime+fFrameDuration < 0) then
begin
glColor4f(0.7, 1, 0.3, 1);
SetFontStyle (1);
SetFontItalic(False);
SetFontSize(27);
SetFontPos (300, 0);
glPrint('Delay due to negative VideoGap');
glColor4f(1, 1, 1, 1);
end;
{$ENDIF}
{$IFDEF DebugFrames}
glColor4f(0, 0, 0, 0.2);
glbegin(GL_QUADS);
glVertex2f(0, 0);
glVertex2f(0, 70);
glVertex2f(250, 70);
glVertex2f(250, 0);
glEnd;
glColor4f(1, 1, 1, 1);
SetFontStyle (1);
SetFontItalic(False);
SetFontSize(27);
SetFontPos (5, 0);
glPrint('delaying frame');
SetFontPos (5, 20);
glPrint('fetching frame');
SetFontPos (5, 40);
glPrint('dropping frame');
{$ENDIF}
end;
procedure TVideo_FFmpeg.Play;
begin
end;
procedure TVideo_FFmpeg.Pause;
begin
fPaused := not fPaused;
end;
procedure TVideo_FFmpeg.Stop;
begin
end;
procedure TVideo_FFmpeg.SetLoop(Enable: boolean);
begin
fLoop := Enable;
fLoopTime := 0;
end;
function TVideo_FFmpeg.GetLoop(): boolean;
begin
Result := fLoop;
end;
{**
* Sets the stream's position.
* The stream is set to the first keyframe with timestamp <= Time.
* Note that fFrameTime is set to Time no matter if the actual position seeked to is
* at Time or the time of a preceding keyframe. fFrameTime will be updated to the
* actual frame time when GetFrame() is called the next time.
* @param Time new position in seconds
*}
procedure TVideo_FFmpeg.SetPosition(Time: real);
var
SeekFlags: integer;
begin
if not fOpened then
Exit;
if (Time < 0) then
Time := 0;
// TODO: handle fLoop-times
//Time := Time mod VideoDuration;
// Do not use the AVSEEK_FLAG_ANY here. It will seek to any frame, even
// non keyframes (P-/B-frames). It will produce corrupted video frames as
// FFmpeg does not use the information of the preceding I-frame.
// The picture might be gray or green until the next keyframe occurs.
// Instead seek the first keyframe smaller than the requested time
// (AVSEEK_FLAG_BACKWARD). As this can be some seconds earlier than the
// requested time, let the sync in GetFrame() do its job.
SeekFlags := AVSEEK_FLAG_BACKWARD;
fFrameTime := Time;
fEOF := false;
fFrameTexValid := false;
if (av_seek_frame(fFormatContext,
fStreamIndex,
Round(Time / av_q2d(fStream^.time_base)),
SeekFlags) < 0) then
begin
Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition');
Exit;
end;
avcodec_flush_buffers(fCodecContext);
end;
function TVideo_FFmpeg.GetPosition: real;
begin
Result := fFrameTime;
end;
procedure TVideo_FFmpeg.SetScreen(Screen: integer);
begin
fScreen := Screen;
end;
function TVideo_FFmpeg.GetScreen(): integer;
begin
Result := fScreen;
end;
procedure TVideo_FFmpeg.SetScreenPosition(X, Y, Z: double);
begin
fPosX := X;
fPosY := Y;
fPosZ := Z;
end;
procedure TVideo_FFmpeg.GetScreenPosition(var X, Y, Z: double);
begin
X := fPosX;
Y := fPosY;
Z := fPosZ;
end;
procedure TVideo_FFmpeg.SetWidth(Width: double);
begin
fWidth := Width;
end;
function TVideo_FFmpeg.GetWidth(): double;
begin
Result := fWidth;
end;
procedure TVideo_FFmpeg.SetHeight(Height: double);
begin
fHeight := Height;
end;
function TVideo_FFmpeg.GetHeight(): double;
begin
Result := fHeight;
end;
procedure TVideo_FFmpeg.SetFrameRange(Range: TRectCoords);
begin
fFrameRange := Range;
end;
function TVideo_FFmpeg.GetFrameRange(): TRectCoords;
begin
Result := fFrameRange;
end;
function TVideo_FFmpeg.GetFrameAspect(): real;
begin
Result := fAspect;
end;
procedure TVideo_FFmpeg.SetAspectCorrection(AspectCorrection: TAspectCorrection);
begin
fAspectCorrection := AspectCorrection;
end;
function TVideo_FFmpeg.GetAspectCorrection(): TAspectCorrection;
begin
Result := fAspectCorrection;
end;
procedure TVideo_FFmpeg.SetAlpha(Alpha: double);
begin
fAlpha := Alpha;
if (fAlpha>1) then
fAlpha := 1;
if (fAlpha<0) then
fAlpha := 0;
end;
function TVideo_FFmpeg.GetAlpha(): double;
begin
Result := fAlpha;
end;
procedure TVideo_FFmpeg.SetReflectionSpacing(Spacing: double);
begin
fReflectionSpacing := Spacing;
end;
function TVideo_FFmpeg.GetReflectionSpacing(): double;
begin
Result := fReflectionSpacing;
end;
initialization
MediaManager.Add(TVideoPlayback_FFmpeg.Create);
end.