(*

 * 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 WINDOWS}

    {$linklib avwrapper}

{$ENDIF}

interface

var flagPrerecording: boolean = false;

function BeginVideoRecording: Boolean;

function LoadNextCameraPosition(var newRealTicks, newGameTicks: LongInt): Boolean;

procedure EncodeFrame;

procedure StopVideoRecording;

procedure BeginPreRecording;

procedure StopPreRecording;

procedure SaveCameraPosition;

procedure initModule;

procedure freeModule;

implementation

type TAddFileLogRaw = procedure (s: pchar); cdecl;

const AvwrapperLibName = {$IFDEF WIN32_VCPKG}'avwrapper'{$ELSE}'libavwrapper'{$ENDIF};

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 RGB_Buffer: PByte;

    cameraFile: File;

    cameraFileName: shortstring;

    audioFile: File;

    numPixels: LongWord;

    startTime, numFrames, curTime, progress, maxProgress: LongWord;

    soundFilePath: shortstring;

    thumbnailSaved: boolean;

    recordAudio: boolean;

function BeginVideoRecording: Boolean;

var filename, desc: shortstring;

    filenameA, descA, soundFilePathA, cAVFormatA, cVideoCodecA, cAudioCodecA: ansistring;

begin

    AddFileLog('BeginVideoRecording');

{$IOCHECKS OFF}

    // open file with prerecorded camera positions

    cameraFileName:= shortstring(UserPathPrefix) + '/VideoTemp/' + shortstring(RecPrefix) + '.txtin';

    Assign(cameraFile, cameraFileName);

    Reset(cameraFile, SizeOf(TFrame));

    maxProgress:= FileSize(cameraFile);

    if IOResult <> 0 then

    begin

        AddFileLog('Error: Could not read from ' + cameraFileName);

        exit(false);

    end;

{$IOCHECKS ON}

    { Store some description in output file.

    The comment must follow a particular format and must be in English.

    This will be parsed by the frontend.

    The frontend will parse lines of this format:

        Key: Value

    The key names will be localized in the frontend.

    If you add a key/value pair, don't forget to add a localization

    in the frontend! }

    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:= shortstring(UserPathPrefix) + '/VideoTemp/' + shortstring(RecPrefix);

    recordAudio:= (cAudioCodec <> 'no');

    if recordAudio then

        soundFilePath:= shortstring(UserPathPrefix) + '/VideoTemp/' + shortstring(RecPrefix) + '.sw'

    else

        soundFilePath:= '';

    filenameA:= ansistring(filename);

    descA:= ansistring(desc);

    soundFilePathA:= ansistring(soundFilePath);

    cAVFormatA:= ansistring(cAVFormat);

    cVideoCodecA:= ansistring(cVideoCodec);

    cAudioCodecA:= ansistring(cAudioCodec);

    if checkFails(AVWrapper_Init(@AddFileLogRaw

        , PChar(filenameA)

        , PChar(descA)

        , PChar(soundFilePathA)

        , PChar(cAVFormatA)

        , PChar(cVideoCodecA)

        , PChar(cAudioCodecA)

        , 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

        begin

        OutError('AVWrapper_Close() has failed.', true);

        end;

{$IOCHECKS OFF}

    if FileExists(cameraFileName) then

        DeleteFile(cameraFileName)

    else

        AddFileLog('Warning: Tried to delete the cameraFile but it was already deleted');

{$IOCHECKS ON}

    if recordAudio and FileExists(soundFilePath) then

        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

        begin

        OutError('AVWrapper_WriteFrame(RGB_Buffer) has failed.', true);

        end;

    // 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(var newRealTicks, newGameTicks: LongInt): Boolean;

var frame: TFrame = (realTicks: 0; gameTicks: 0; CamX: 0; CamY: 0; zoom: 0);

    res: LongInt;

begin

    // we need to skip or duplicate frames to match target framerate

    while Int64(curTime)*cVideoFramerateNum <= Int64(numFrames)*cVideoFramerateDen*1000 do

    begin

    res:= 0;

    {$IOCHECKS OFF}

        if eof(cameraFile) then

            exit(false);

        BlockRead(cameraFile, frame, 1, res);

    {$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;

var result: LongInt;

begin

    result:= 0; // avoid warning

    udata:= udata; // avoid warning

{$IOCHECKS OFF}

    BlockWrite(audioFile, stream^, len, result);

{$IOCHECKS ON}

end;

procedure SaveThumbnail;

var thumbpath: shortstring;

    k: LongInt;

begin

    thumbpath:= '/VideoThumbnails/' + 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, result2: LongInt;

    i: integer;

begin

{$IOCHECKS OFF}

    result:= 0; // avoid compiler hint and warning

    result2:= 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, result2);

    until result < 1024;

{$IOCHECKS ON}

end;

procedure BeginPreRecording;

var format: word;

    filename: shortstring;

    frequency, channels: LongInt;

    result: LongInt;

begin

    result:= 0;

    AddFileLog('BeginPreRecording');

    // Videos don't work if /lua command was used, so we forbid them

    if luaCmdUsed then

        begin

        // TODO: Show message to player

        PlaySound(sndDenied);

        AddFileLog('Pre-recording prevented; /lua command was used before');

        exit;

        end;

    thumbnailSaved:= false;

    RecPrefix:= 'hw-' + FormatDateTime('YYYY-MM-DD_HH-mm-ss-z', TDateTime(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, shortstring(UserPathPrefix) + '/VideoTemp/' + shortstring(RecPrefix) + '.hwd');

    end;

    if cIsSoundEnabled then

        begin

        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:= shortstring(UserPathPrefix) + '/VideoTemp/' + shortstring(RecPrefix) + '.sw';

        Assign(audioFile, filename);

        Rewrite(audioFile, 1);

        if IOResult <> 0 then

            begin

            AddFileLog('Error: Could not write to ' + filename);

            exit;

            end;

        end;

    // create file with camera positions

    filename:= shortstring(UserPathPrefix) + '/VideoTemp/' + shortstring(RecPrefix) + '.txtout';

    Assign(cameraFile, filename);

    Rewrite(cameraFile, SizeOf(TFrame));

    if IOResult <> 0 then

        begin

        AddFileLog('Error: Could not write to ' + filename);

        exit;

        end;

    if cIsSoundEnabled then

        begin

        // save audio parameters in sound file

        BlockWrite(audioFile, frequency, 4, result);

        BlockWrite(audioFile, channels, 4, result);

{$IOCHECKS ON}

        // register callback for actual audio recording

        Mix_SetPostMix(@RecordPostMix, nil);

        end;

    startTime:= SDL_GetTicks();

    flagPrerecording:= true;

end;

procedure StopPreRecording;

begin

    AddFileLog('StopPreRecording');

    flagPrerecording:= false;

    if cIsSoundEnabled then

        begin

        // call SDL_LockAudio because RecordPostMix may be executing right now

        SDL_LockAudio();

        Close(audioFile);

        end;

    Close(cameraFile);

    if cIsSoundEnabled then

        begin

        Mix_SetPostMix(nil, nil);

        SDL_UnlockAudio();

        end;

    if not thumbnailSaved then

        SaveThumbnail();

end;

procedure SaveCameraPosition;

var frame: TFrame;

    result: LongInt;

begin

    result:= 0;

    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, result);

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