1 (*

     2  * Hedgewars, a free turn based strategy game

     3  * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * This program is free software; you can redistribute it and/or modify

     6  * it under the terms of the GNU General Public License as published by

     7  * the Free Software Foundation; version 2 of the License

     8  *

     9  * This program is distributed in the hope that it will be useful,

    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of

    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    12  * GNU General Public License for more details.

    13  *

    14  * You should have received a copy of the GNU General Public License

    15  * along with this program; if not, write to the Free Software

    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

    17  *)

    18 

    19 

    20 {$INCLUDE "options.inc"}

    21 

    22 unit uVideoRec;

    23 

    24 {$IFNDEF USE_VIDEO_RECORDING}

    25 interface

    26 implementation

    27 end.

    28 {$ELSE}

    29 

    30 {$IFNDEF WIN32}

    31     {$LINKLIB ../bin/libavwrapper.a}

    32 {$ENDIF}

    33 

    34 interface

    35 

    36 var flagPrerecording: boolean = false;

    37 

    38 function BeginVideoRecording: Boolean;

    39 function LoadNextCameraPosition(out newRealTicks, newGameTicks: LongInt): Boolean;

    40 procedure EncodeFrame;

    41 procedure StopVideoRecording;

    42 

    43 procedure BeginPreRecording;

    44 procedure StopPreRecording;

    45 procedure SaveCameraPosition;

    46 

    47 procedure freeModule;

    48 

    49 implementation

    50 

    51 uses uVariables, uUtils, GLunit, SDLh, SysUtils, uIO, uMisc, uTypes;

    52 

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

    54 

    55 procedure AVWrapper_Init(

    56               AddLog: TAddFileLogRaw;

    57               filename, desc, soundFile, format, vcodec, acodec: PChar;

    58               width, height, framerateNum, framerateDen, vquality: LongInt); cdecl; external {$IFDEF WIN32}'libavwrapper.dll'{$ENDIF};

    59 procedure AVWrapper_Close; cdecl; external {$IFDEF WIN32}'libavwrapper.dll'{$ENDIF};

    60 procedure AVWrapper_WriteFrame( pY, pCb, pCr: PByte ); cdecl; external {$IFDEF WIN32}'libavwrapper.dll'{$ENDIF};

    61 

    62 type TFrame = record

    63                   realTicks: LongWord;

    64                   gameTicks: LongWord;

    65                   CamX, CamY: LongInt;

    66                   zoom: single;

    67               end;

    68 

    69 var YCbCr_Planes: array[0..2] of PByte;

    70     RGB_Buffer: PByte;

    71     cameraFile: File of TFrame;

    72     audioFile: File;

    73     numPixels: LongWord;

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

    75     soundFilePath: shortstring;

    76     thumbnailSaved : Boolean;

    77 

    78 function BeginVideoRecording: Boolean;

    79 var filename, desc: shortstring;

    80 begin

    81     AddFileLog('BeginVideoRecording');

    82 

    83 {$IOCHECKS OFF}

    84     // open file with prerecorded camera positions

    85     filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.txtin';

    86     Assign(cameraFile, filename);

    87     Reset(cameraFile);

    88     maxProgress:= FileSize(cameraFile);

    89     if IOResult <> 0 then

    90     begin

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

    92         exit(false);

    93     end;

    94 {$IOCHECKS ON}

    95 

    96     // store some description in output file

    97     desc:= '';

    98     if UserNick <> '' then

    99         desc+= 'Player: ' + UserNick + #10;

   100     if recordFileName <> '' then

   101         desc+= 'Record: ' + recordFileName + #10;

   102     if cMapName <> '' then

   103         desc+= 'Map: ' + cMapName + #10;

   104     if Theme <> '' then

   105         desc+= 'Theme: ' + Theme + #10;

   106     desc+= 'prefix[' + RecPrefix + ']prefix';

   107     desc+= #0;

   108 

   109     filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix + #0;

   110     soundFilePath:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.sw' + #0;

   111     cAVFormat+= #0;

   112     cAudioCodec+= #0;

   113     cVideoCodec+= #0;

   114     AVWrapper_Init(@AddFileLogRaw, @filename[1], @desc[1], @soundFilePath[1], @cAVFormat[1], @cVideoCodec[1], @cAudioCodec[1],

   115                    cScreenWidth, cScreenHeight, cVideoFramerateNum, cVideoFramerateDen, cVideoQuality);

   116 

   117     numPixels:= cScreenWidth*cScreenHeight;

   118     YCbCr_Planes[0]:= GetMem(numPixels);

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

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

   121 

   122     if (YCbCr_Planes[0] = nil) or (YCbCr_Planes[1] = nil) or (YCbCr_Planes[2] = nil) then

   123     begin

   124         AddFileLog('Error: Could not allocate memory for video recording (YCbCr buffer).');

   125         exit(false);

   126     end;

   127 

   128     RGB_Buffer:= GetMem(4*numPixels);

   129     if RGB_Buffer = nil then

   130     begin

   131         AddFileLog('Error: Could not allocate memory for video recording (RGB buffer).');

   132         exit(false);

   133     end;

   134 

   135     curTime:= 0;

   136     numFrames:= 0;

   137     progress:= 0;

   138     BeginVideoRecording:= true;

   139 end;

   140 

   141 procedure StopVideoRecording;

   142 begin

   143     AddFileLog('StopVideoRecording');

   144     FreeMem(YCbCr_Planes[0], numPixels);

   145     FreeMem(YCbCr_Planes[1], numPixels div 4);

   146     FreeMem(YCbCr_Planes[2], numPixels div 4);

   147     FreeMem(RGB_Buffer, 4*numPixels);

   148     Close(cameraFile);

   149     AVWrapper_Close();

   150     Erase(cameraFile);

   151     DeleteFile(soundFilePath);

   152     SendIPC(_S'v'); // inform frontend that we finished

   153 end;

   154 

   155 function pixel(x, y, color: LongInt): LongInt;

   156 begin

   157     pixel:= RGB_Buffer[(cScreenHeight-y-1)*cScreenWidth*4 + x*4 + color];

   158 end;

   159 

   160 procedure EncodeFrame;

   161 var x, y, r, g, b: LongInt;

   162     s: shortstring;

   163 begin

   164     // read pixels from OpenGL

   165     glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_RGBA, GL_UNSIGNED_BYTE, RGB_Buffer);

   166 

   167     // convert to YCbCr 4:2:0 format

   168     // Y

   169     for y := 0 to cScreenHeight-1 do

   170         for x := 0 to cScreenWidth-1 do

   171             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));

   172 

   173     // Cb and Cr

   174     for y := 0 to cScreenHeight div 2 - 1 do

   175         for x := 0 to cScreenWidth div 2 - 1 do

   176         begin

   177             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);

   178             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);

   179             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);

   180             YCbCr_Planes[1][y*(cScreenWidth div 2) + x]:= Byte(128 + ((-2428*r - 4768*g + 7196*b) shr 16));

   181             YCbCr_Planes[2][y*(cScreenWidth div 2) + x]:= Byte(128 + (( 7196*r - 6026*g - 1170*b) shr 16));

   182         end;

   183 

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

   185 

   186     // inform frontend that we have encoded new frame

   187     s[0]:= #3;

   188     s[1]:= 'p'; // p for progress

   189     SDLNet_Write16(progress*10000 div maxProgress, @s[2]);

   190     SendIPC(s);

   191     inc(numFrames);

   192 end;

   193 

   194 function LoadNextCameraPosition(out newRealTicks, newGameTicks: LongInt): Boolean;

   195 var frame: TFrame;

   196 begin

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

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

   199     begin

   200     {$IOCHECKS OFF}

   201         if eof(cameraFile) then

   202             exit(false);

   203         BlockRead(cameraFile, frame, 1);

   204     {$IOCHECKS ON}

   205         curTime:= frame.realTicks;

   206         WorldDx:= frame.CamX;

   207         WorldDy:= frame.CamY + cScreenHeight div 2;

   208         zoom:= frame.zoom*cScreenWidth;

   209         ZoomValue:= zoom;

   210         inc(progress);

   211         newRealTicks:= frame.realTicks;

   212         newGameTicks:= frame.gameTicks;

   213     end;

   214     LoadNextCameraPosition:= true;

   215 end;

   216 

   217 // Callback which records sound.

   218 // This procedure may be called from different thread.

   219 procedure RecordPostMix(udata: pointer; stream: PByte; len: LongInt); cdecl;

   220 begin

   221     udata:= udata; // avoid warning

   222 {$IOCHECKS OFF}

   223     BlockWrite(audioFile, stream^, len);

   224 {$IOCHECKS ON}

   225 end;

   226 

   227 procedure SaveThumbnail;

   228 var thumbpath: shortstring;

   229     k: LongInt;

   230 begin

   231     thumbpath:= '/VideoTemp/' + RecPrefix;

   232     AddFileLog('Saving thumbnail ' + thumbpath);

   233     k:= max(max(cScreenWidth, cScreenHeight) div 400, 1); // here 400 is minimum size of thumbnail

   234     MakeScreenshot(thumbpath, k);

   235     thumbnailSaved:= true;

   236 end;

   237 

   238 // copy file (free pascal doesn't have copy file function)

   239 procedure CopyFile(src, dest: shortstring);

   240 var inF, outF: file;

   241     buffer: array[0..1023] of byte;

   242     result: LongInt;

   243 begin

   244 {$IOCHECKS OFF}

   245     result:= 0; // avoid compiler hint

   246 

   247     Assign(inF, src);

   248     Reset(inF, 1);

   249     if IOResult <> 0 then

   250     begin

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

   252         exit;

   253     end;

   254 

   255     Assign(outF, dest);

   256     Rewrite(outF, 1);

   257     if IOResult <> 0 then

   258     begin

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

   260         exit;

   261     end;

   262 

   263     repeat

   264         BlockRead(inF, buffer, 1024, result);

   265         BlockWrite(outF, buffer, result);

   266     until result < 1024;

   267 {$IOCHECKS ON}

   268 end;

   269 

   270 procedure BeginPreRecording;

   271 var format: word;

   272     filename: shortstring;

   273     frequency, channels: LongInt;

   274 begin

   275     AddFileLog('BeginPreRecording');

   276 

   277     thumbnailSaved:= false;

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

   279 

   280     // If this video is recorded from demo executed directly (without frontend)

   281     // then we need to copy demo so that frontend will be able to find it later.

   282     if recordFileName <> '' then

   283     begin

   284         if GameType <> gmtDemo then // this is save and game demo is not recording, abort

   285             exit;

   286         CopyFile(recordFileName, UserPathPrefix + '/VideoTemp/' + RecPrefix + '.hwd');

   287     end;

   288 

   289     Mix_QuerySpec(@frequency, @format, @channels);

   290     AddFileLog('sound: frequency = ' + IntToStr(frequency) + ', format = ' + IntToStr(format) + ', channels = ' + IntToStr(channels));

   291     if format <> $8010 then

   292     begin

   293         // TODO: support any audio format

   294         AddFileLog('Error: Unexpected audio format ' + IntToStr(format));

   295         exit;

   296     end;

   297 

   298 {$IOCHECKS OFF}

   299     // create sound file

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

   301     Assign(audioFile, filename);

   302     Rewrite(audioFile, 1);

   303     if IOResult <> 0 then

   304     begin

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

   306         exit;

   307     end;

   308 

   309     // create file with camera positions

   310     filename:= UserPathPrefix + '/VideoTemp/' + RecPrefix + '.txtout';

   311     Assign(cameraFile, filename);

   312     Rewrite(cameraFile);

   313     if IOResult <> 0 then

   314     begin

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

   316         exit;

   317     end;

   318 

   319     // save audio parameters in sound file

   320     BlockWrite(audioFile, frequency, 4);

   321     BlockWrite(audioFile, channels, 4);

   322 {$IOCHECKS ON}

   323 

   324     // register callback for actual audio recording

   325     Mix_SetPostMix(@RecordPostMix, nil);

   326 

   327     startTime:= SDL_GetTicks();

   328     flagPrerecording:= true;

   329 end;

   330 

   331 procedure StopPreRecording;

   332 begin

   333     AddFileLog('StopPreRecording');

   334     flagPrerecording:= false;

   335 

   336     // call SDL_LockAudio because RecordPostMix may be executing right now

   337     SDL_LockAudio();

   338     Close(audioFile);

   339     Close(cameraFile);

   340     Mix_SetPostMix(nil, nil);

   341     SDL_UnlockAudio();

   342 

   343     if not thumbnailSaved then

   344         SaveThumbnail();

   345 end;

   346 

   347 procedure SaveCameraPosition;

   348 var frame: TFrame;

   349 begin

   350     if (not thumbnailSaved) and (ScreenFade = sfNone) then

   351         SaveThumbnail();

   352 

   353     frame.realTicks:= SDL_GetTicks() - startTime;

   354     frame.gameTicks:= GameTicks;

   355     frame.CamX:= WorldDx;

   356     frame.CamY:= WorldDy - cScreenHeight div 2;

   357     frame.zoom:= zoom/cScreenWidth;

   358     BlockWrite(cameraFile, frame, 1);

   359 end;

   360 

   361 procedure freeModule;

   362 begin

   363     if flagPrerecording then

   364         StopPreRecording();

   365 end;

   366 

   367 end.

   368 

   369 {$ENDIF} // USE_VIDEO_RECORDING