hedgewars/uVideoRec.pas
author Stepan777 <stepik-777@mail.ru>
Sun, 24 Jun 2012 20:57:02 +0400
changeset 7280 fd707afbc3a2
parent 7235 baa69bd025d9
child 7286 068adc6948e3
permissions -rw-r--r--
pagevideos is now much better that before: 1. Display list of video files. 2. For each file in progress display progress bar. 3. Description for each file (size, duration etc). 4. It is possible to remove and rename files. 5. Video file can be launched in external media player. 6. ... also fixed some bugs http://postimage.org/image/hk87cuqm9/

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2012 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 *)

{$INCLUDE "options.inc"}

unit uVideoRec;

{$IFDEF UNIX}
    {$LINKLIB avwrapper}
    {$LINKLIB avutil}
    {$LINKLIB avcodec}
    {$LINKLIB avformat}
{$ENDIF}

interface

var flagPrerecording: boolean = false;

function BeginVideoRecording: Boolean;
function LoadNextCameraPosition: LongInt;
procedure EncodeFrame;
procedure StopVideoRecording;

procedure BeginPreRecording;
procedure StopPreRecording;
procedure SaveCameraPosition;

procedure freeModule;

implementation

uses uVariables, uUtils, GLunit, SDLh, SysUtils, uIO;

{$IFDEF WIN32}
const AVWrapperLibName = 'libavwrapper.dll';
{$ENDIF}

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

{$IFDEF WIN32}
procedure AVWrapper_Init(
              AddLog: TAddFileLogRaw;
              filename, desc, soundFile, format, vcodec, acodec, preset: PChar;
              width, height, framerateNum, framerateDen, vquality, aquality: LongInt); cdecl; external AVWrapperLibName;
procedure AVWrapper_Close; cdecl; external AVWrapperLibName;
procedure AVWrapper_WriteFrame( pY, pCb, pCr: PByte ); cdecl; external AVWrapperLibName;
{$ELSE}
procedure AVWrapper_Init(
              AddLog: TAddFileLogRaw;
              filename, desc, soundFile, format, vcodec, acodec, preset: PChar;
              width, height, framerateNum, framerateDen, vquality, aquality: LongInt); cdecl; external;
procedure AVWrapper_Close; cdecl; external;
procedure AVWrapper_WriteFrame( pY, pCb, pCr: PByte ); cdecl; external;
{$ENDIF}

type TFrame = record
                  ticks: 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: LongWord;
    cameraFilePath, soundFilePath: shortstring;

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

    numPixels:= cScreenWidth*cScreenHeight;

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

    desc:= '';
    if UserNick <> '' then
        desc+= 'Player: ' + UserNick + #10;
    if recordFileName <> '' then
        desc+= 'Record: ' + recordFileName + #10;
    if cMapName <> '' then
        desc+= 'Map: ' + cMapName + #10;
    if Theme <> '' then
        desc+= 'Theme: ' + Theme + #10;
    desc+= #0;

    filename:= UserPathPrefix + '/VideoTemp/' + cRecPrefix + #0;
    soundFilePath:= UserPathPrefix + '/VideoTemp/' + cRecPrefix + '.sw' + #0;
    cAVFormat+= #0;
    cAudioCodec+= #0;
    cVideoCodec+= #0;
    cVideoPreset+= #0;
    AVWrapper_Init(@AddFileLogRaw, @filename[1], @desc[1], @soundFilePath[1], @cAVFormat[1], @cVideoCodec[1], @cAudioCodec[1], @cVideoPreset[1],
                   cScreenWidth, cScreenHeight, cVideoFramerateNum, cVideoFramerateDen, cAudioQuality, cVideoQuality);

    YCbCr_Planes[0]:= GetMem(numPixels);
    YCbCr_Planes[1]:= GetMem(numPixels div 4);
    YCbCr_Planes[2]:= GetMem(numPixels div 4);

    if (YCbCr_Planes[0] = nil) or (YCbCr_Planes[1] = nil) or (YCbCr_Planes[2] = nil) then
    begin
        AddFileLog('Error: Could not allocate memory for video recording (YCbCr buffer).');
        exit(false);
    end;

    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;

    BeginVideoRecording:= true;
end;

procedure StopVideoRecording;
begin
    AddFileLog('StopVideoRecording');
    FreeMem(YCbCr_Planes[0], numPixels);
    FreeMem(YCbCr_Planes[1], numPixels div 4);
    FreeMem(YCbCr_Planes[2], numPixels div 4);
    FreeMem(RGB_Buffer, 4*numPixels);
    Close(cameraFile);
    AVWrapper_Close();
    DeleteFile(cameraFilePath);
    DeleteFile(soundFilePath);
    SendIPC(_S'v');
end;

function pixel(x, y, color: LongInt): LongInt;
begin
    pixel:= RGB_Buffer[(cScreenHeight-y-1)*cScreenWidth*4 + x*4 + color];
end;

procedure EncodeFrame;
var x, y, r, g, b: LongInt;
begin
    // read pixels from OpenGL
    glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_RGBA, GL_UNSIGNED_BYTE, RGB_Buffer);

    // convert to YCbCr 4:2:0 format
    // Y
    for y := 0 to cScreenHeight-1 do
        for x := 0 to cScreenWidth-1 do
            YCbCr_Planes[0][y*cScreenWidth + x]:= Byte(16 + ((16828*pixel(x,y,0) + 33038*pixel(x,y,1) + 6416*pixel(x,y,2)) shr 16));

    // Cb and Cr
    for y := 0 to cScreenHeight div 2 - 1 do
        for x := 0 to cScreenWidth div 2 - 1 do
        begin
            r:= pixel(2*x,2*y,0) + pixel(2*x+1,2*y,0) + pixel(2*x,2*y+1,0) + pixel(2*x+1,2*y+1,0);
            g:= pixel(2*x,2*y,1) + pixel(2*x+1,2*y,1) + pixel(2*x,2*y+1,1) + pixel(2*x+1,2*y+1,1);
            b:= pixel(2*x,2*y,2) + pixel(2*x+1,2*y,2) + pixel(2*x,2*y+1,2) + pixel(2*x+1,2*y+1,2);
            YCbCr_Planes[1][y*(cScreenWidth div 2) + x]:= Byte(128 + ((-2428*r - 4768*g + 7196*b) shr 16));
            YCbCr_Planes[2][y*(cScreenWidth div 2) + x]:= Byte(128 + (( 7196*r - 6026*g - 1170*b) shr 16));
        end;

    AVWrapper_WriteFrame(YCbCr_Planes[0], YCbCr_Planes[1], YCbCr_Planes[2]);

    // inform frontend that we have encoded new frame (p for progress)
    SendIPC(_S'p');
end;

// returns new game ticks
function LoadNextCameraPosition: LongInt;
var frame: TFrame;
begin
{$IOCHECKS OFF}
    if eof(cameraFile) then
        exit(-1);
    BlockRead(cameraFile, frame, 1);
{$IOCHECKS ON}
    WorldDx:= frame.CamX;
    WorldDy:= frame.CamY + cScreenHeight div 2;
    zoom:= frame.zoom*cScreenWidth;
    ZoomValue:= zoom;
    LoadNextCameraPosition:= frame.ticks;
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 BeginPreRecording;
var format: word;
    filePrefix, filename: shortstring;
    frequency, channels: LongInt;
begin
    AddFileLog('BeginPreRecording');

    numFrames:= 0;
    startTime:= SDL_GetTicks();

    filePrefix:= FormatDateTime('YYYY-MM-DD_HH-mm-ss', Now());

    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/' + filePrefix + '.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/' + filePrefix + '.txtout';
    Assign(cameraFile, filename);
    Rewrite(cameraFile);
    if IOResult <> 0 then
    begin
        AddFileLog('Error: Could not write to ' + filename);
        exit;
    end;

    BlockWrite(audioFile, frequency, 4);
    BlockWrite(audioFile, channels, 4);
{$IOCHECKS ON}

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

    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();
end;

procedure SaveCameraPosition;
var curTime: LongInt;
    frame: TFrame;
begin
    curTime:= SDL_GetTicks();
    while Int64(curTime - startTime)*cVideoFramerateNum > Int64(numFrames)*cVideoFramerateDen*1000 do
    begin
        frame.ticks:= GameTicks;
        frame.CamX:= WorldDx;
        frame.CamY:= WorldDy - cScreenHeight div 2;
        frame.zoom:= zoom/cScreenWidth;
        BlockWrite(cameraFile, frame, 1);
        inc(numFrames);
    end;
end;

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

end.