hedgewars/uVideoRec.pas
author koda
Sun, 20 Mar 2016 03:08:51 -0400
changeset 11612 b7d5d75469ee
parent 11532 bf86c6cb9341
child 11821 d8844d4c67de
permissions -rw-r--r--
Move pixel format conversion from uVideoRec to AVWrapper This has several benefits, being in C-land allows us to better use libav API and avoid mixing memory allocated from Pascal. Also the C code for the conversion loop generated by GCC or Clang is probably more optimized than by Freepascal. Finally it will simplify code in the future if we are going to enable any other pixel format than yuv420p. Change the coefficients to improve color accuracy during conversion.

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * 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; version 2 of the License
 *
 * 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; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 *)


{$INCLUDE "options.inc"}

unit uVideoRec;

{$IFNDEF USE_VIDEO_RECORDING}
interface
implementation
end.
{$ELSE}

{$IFNDEF WIN32}
    {$linklib avwrapper}
{$ENDIF}

interface

var flagPrerecording: boolean = false;

function BeginVideoRecording: Boolean;
function LoadNextCameraPosition(out newRealTicks, newGameTicks: LongInt): Boolean;
procedure EncodeFrame;
procedure StopVideoRecording;

procedure BeginPreRecording;
procedure StopPreRecording;
procedure SaveCameraPosition;

procedure initModule;
procedure freeModule;

implementation
uses uVariables, uUtils, GLunit, SDLh, SysUtils, uIO, uMisc, uTypes, uDebug;

type TAddFileLogRaw = procedure (s: pchar); cdecl;
const AvwrapperLibName = 'libavwrapper';

function AVWrapper_Init(
              AddLog: TAddFileLogRaw;
              filename, desc, soundFile, format, vcodec, acodec: PChar;
              width, height, framerateNum, framerateDen, vquality: LongInt): LongInt; cdecl; external AvwrapperLibName;
function AVWrapper_Close: LongInt; cdecl; external AvwrapperLibName;
function AVWrapper_WriteFrame(rgb: PByte): LongInt; cdecl; external AvwrapperLibName;

type TFrame = record
                  realTicks: LongWord;
                  gameTicks: LongWord;
                  CamX, CamY: LongInt;
                  zoom: single;
              end;

var YCbCr_Planes: array[0..2] of PByte;
    RGB_Buffer: PByte;
    cameraFile: File of TFrame;
    audioFile: File;
    numPixels: LongWord;
    startTime, numFrames, curTime, progress, maxProgress: LongWord;
    soundFilePath: shortstring;
    thumbnailSaved : Boolean;

function BeginVideoRecording: Boolean;
var filename, desc: shortstring;
begin
    AddFileLog('BeginVideoRecording');

{$IOCHECKS OFF}
    // open file with prerecorded camera positions
    filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.txtin';
    Assign(cameraFile, filename);
    Reset(cameraFile);
    maxProgress:= FileSize(cameraFile);
    if IOResult <> 0 then
    begin
        AddFileLog('Error: Could not read from ' + filename);
        exit(false);
    end;
{$IOCHECKS ON}

    // store some description in output file
    desc:= '';
    if UserNick <> '' then
        desc:= desc + 'Player: ' + UserNick + #10;
    if recordFileName <> '' then
        desc:= desc + 'Record: ' + recordFileName + #10;
    if cMapName <> '' then
        desc:= desc + 'Map: ' + cMapName + #10;
    if Theme <> '' then
        desc:= desc + 'Theme: ' + Theme + #10;
    desc:= desc + 'prefix[' + RecPrefix + ']prefix';

    filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix;
    soundFilePath:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.sw';

    if checkFails(AVWrapper_Init(@AddFileLogRaw
        , PChar(ansistring(filename))
        , PChar(ansistring(desc))
        , PChar(ansistring(soundFilePath))
        , PChar(ansistring(cAVFormat))
        , PChar(ansistring(cVideoCodec))
        , PChar(ansistring(cAudioCodec))
        , cScreenWidth, cScreenHeight, cVideoFramerateNum, cVideoFramerateDen, cVideoQuality) >= 0,
        'AVWrapper_Init failed',
        true) then exit(false);

    numPixels:= cScreenWidth*cScreenHeight;

    RGB_Buffer:= GetMem(4*numPixels);
    if RGB_Buffer = nil then
    begin
        AddFileLog('Error: Could not allocate memory for video recording (RGB buffer).');
        exit(false);
    end;

    curTime:= 0;
    numFrames:= 0;
    progress:= 0;
    BeginVideoRecording:= true;
end;

procedure StopVideoRecording;
begin
    AddFileLog('StopVideoRecording');
    FreeMem(RGB_Buffer, 4*numPixels);
    Close(cameraFile);
    if AVWrapper_Close() < 0 then
        halt(-1);
    Erase(cameraFile);
    DeleteFile(soundFilePath);
    SendIPC(_S'v'); // inform frontend that we finished
end;

procedure EncodeFrame;
var s: shortstring;
begin
    // read pixels from OpenGL
    glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_RGBA, GL_UNSIGNED_BYTE, RGB_Buffer);

    if AVWrapper_WriteFrame(RGB_Buffer) < 0 then
        halt(-1);

    // inform frontend that we have encoded new frame
    s[0]:= #3;
    s[1]:= 'p'; // p for progress
    SDLNet_Write16(progress*10000 div maxProgress, @s[2]);
    SendIPC(s);
    inc(numFrames);
end;

function LoadNextCameraPosition(out newRealTicks, newGameTicks: LongInt): Boolean;
var frame: TFrame = (realTicks: 0; gameTicks: 0; CamX: 0; CamY: 0; zoom: 0);
begin
    // we need to skip or duplicate frames to match target framerate
    while Int64(curTime)*cVideoFramerateNum <= Int64(numFrames)*cVideoFramerateDen*1000 do
    begin
    {$IOCHECKS OFF}
        if eof(cameraFile) then
            exit(false);
        BlockRead(cameraFile, frame, 1);
    {$IOCHECKS ON}
        curTime:= frame.realTicks;
        WorldDx:= frame.CamX;
        WorldDy:= frame.CamY + cScreenHeight div 2;
        zoom:= frame.zoom*cScreenWidth;
        ZoomValue:= zoom;
        inc(progress);
        newRealTicks:= frame.realTicks;
        newGameTicks:= frame.gameTicks;
    end;
    LoadNextCameraPosition:= true;
end;

// Callback which records sound.
// This procedure may be called from different thread.
procedure RecordPostMix(udata: pointer; stream: PByte; len: LongInt); cdecl;
begin
    udata:= udata; // avoid warning
{$IOCHECKS OFF}
    BlockWrite(audioFile, stream^, len);
{$IOCHECKS ON}
end;

procedure SaveThumbnail;
var thumbpath: shortstring;
    k: LongInt;
begin
    thumbpath:= '/VideoTemp/' + RecPrefix;
    AddFileLog('Saving thumbnail ' + thumbpath);
    k:= max(max(cScreenWidth, cScreenHeight) div 400, 1); // here 400 is minimum size of thumbnail
    MakeScreenshot(thumbpath, k, 0);
    thumbnailSaved:= true;
end;

// copy file (free pascal doesn't have copy file function)
procedure CopyFile(src, dest: shortstring);
var inF, outF: file;
    buffer: array[0..1023] of byte;
    result: LongInt;
    i: integer;
begin
{$IOCHECKS OFF}
    result:= 0; // avoid compiler hint and warning
    for i:= 0 to 1023 do
        buffer[i]:= 0;

    Assign(inF, src);
    Reset(inF, 1);
    if IOResult <> 0 then
    begin
        AddFileLog('Error: Could not read from ' + src);
        exit;
    end;

    Assign(outF, dest);
    Rewrite(outF, 1);
    if IOResult <> 0 then
    begin
        AddFileLog('Error: Could not write to ' + dest);
        exit;
    end;

    repeat
        BlockRead(inF, buffer, 1024, result);
        BlockWrite(outF, buffer, result);
    until result < 1024;
{$IOCHECKS ON}
end;

procedure BeginPreRecording;
var format: word;
    filename: shortstring;
    frequency, channels: LongInt;
begin
    AddFileLog('BeginPreRecording');

    thumbnailSaved:= false;
    RecPrefix:= 'hw-' + FormatDateTime('YYYY-MM-DD_HH-mm-ss-z', Now());

    // If this video is recorded from demo executed directly (without frontend)
    // then we need to copy demo so that frontend will be able to find it later.
    if recordFileName <> '' then
    begin
        if GameType <> gmtDemo then // this is save and game demo is not recording, abort
            exit;
        CopyFile(recordFileName, UserPathPrefix + '/VideoTemp/' + RecPrefix + '.hwd');
    end;

    Mix_QuerySpec(@frequency, @format, @channels);
    AddFileLog('sound: frequency = ' + IntToStr(frequency) + ', format = ' + IntToStr(format) + ', channels = ' + IntToStr(channels));
    if format <> $8010 then
    begin
        // TODO: support any audio format
        AddFileLog('Error: Unexpected audio format ' + IntToStr(format));
        exit;
    end;

{$IOCHECKS OFF}
    // create sound file
    filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.sw';
    Assign(audioFile, filename);
    Rewrite(audioFile, 1);
    if IOResult <> 0 then
    begin
        AddFileLog('Error: Could not write to ' + filename);
        exit;
    end;

    // create file with camera positions
    filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.txtout';
    Assign(cameraFile, filename);
    Rewrite(cameraFile);
    if IOResult <> 0 then
    begin
        AddFileLog('Error: Could not write to ' + filename);
        exit;
    end;

    // save audio parameters in sound file
    BlockWrite(audioFile, frequency, 4);
    BlockWrite(audioFile, channels, 4);
{$IOCHECKS ON}

    // register callback for actual audio recording
    Mix_SetPostMix(@RecordPostMix, nil);

    startTime:= SDL_GetTicks();
    flagPrerecording:= true;
end;

procedure StopPreRecording;
begin
    AddFileLog('StopPreRecording');
    flagPrerecording:= false;

    // call SDL_LockAudio because RecordPostMix may be executing right now
    SDL_LockAudio();
    Close(audioFile);
    Close(cameraFile);
    Mix_SetPostMix(nil, nil);
    SDL_UnlockAudio();

    if not thumbnailSaved then
        SaveThumbnail();
end;

procedure SaveCameraPosition;
var frame: TFrame;
begin
    if (not thumbnailSaved) and (ScreenFade = sfNone) then
        SaveThumbnail();

    frame.realTicks:= SDL_GetTicks() - startTime;
    frame.gameTicks:= GameTicks;
    frame.CamX:= WorldDx;
    frame.CamY:= WorldDy - cScreenHeight div 2;
    frame.zoom:= zoom/cScreenWidth;
    BlockWrite(cameraFile, frame, 1);
end;

procedure initModule;
begin
    // we need to make sure these variables are initialized before the main loop
    // or the wrapper will keep the default values of preinit
    cScreenWidth:= max(cWindowedWidth, 640);
    cScreenHeight:= max(cWindowedHeight, 480);
end;

procedure freeModule;
begin
    if flagPrerecording then
        StopPreRecording();
end;

end.

{$ENDIF} // USE_VIDEO_RECORDING