hedgewars/uVideoRec.pas
changeset 7180 53ffc8853008
child 7198 5debd5fe526e
equal deleted inserted replaced
7176:fb4b0c6dfdbd 7180:53ffc8853008
       
     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 {$INCLUDE "options.inc"}
       
    20 
       
    21 unit uVideoRec;
       
    22 
       
    23 {$IFDEF UNIX}
       
    24     {$LINKLIB avwrapper}
       
    25     {$LINKLIB avutil}
       
    26     {$LINKLIB avcodec}
       
    27     {$LINKLIB avformat}
       
    28 {$ENDIF}
       
    29 
       
    30 interface
       
    31 
       
    32 var flagPrerecording: boolean = false;
       
    33 
       
    34 function BeginVideoRecording: Boolean;
       
    35 function LoadNextCameraPosition: LongInt;
       
    36 procedure EncodeFrame;
       
    37 procedure StopVideoRecording;
       
    38 
       
    39 function BeginPreRecording(filePrefix: shortstring): Boolean;
       
    40 procedure StopPreRecording;
       
    41 procedure SaveCameraPosition;
       
    42 
       
    43 procedure freeModule;
       
    44 
       
    45 implementation
       
    46 
       
    47 uses uVariables, uUtils, GLunit, SDLh, SysUtils;
       
    48 
       
    49 {$IFDEF WIN32}
       
    50 const AVWrapperLibName = 'libavwrapper.dll';
       
    51 {$ENDIF}
       
    52 
       
    53 type TAddFileLogRaw = procedure (s: pchar); cdecl;
       
    54 
       
    55 {$IFDEF WIN32}
       
    56 procedure AVWrapper_Init(AddLog: TAddFileLogRaw; filename, soundFile: PChar; width, height, framerate, frequency, channels: LongInt); cdecl; external AVWrapperLibName;
       
    57 procedure AVWrapper_Close; cdecl; external AVWrapperLibName;
       
    58 procedure AVWrapper_WriteFrame( pY, pCb, pCr: PByte ); cdecl; external AVWrapperLibName;
       
    59 {$ELSE}
       
    60 procedure AVWrapper_Init(AddLog: TAddFileLogRaw; filename, soundFile: PChar; width, height, framerate, frequency, channels: LongInt); cdecl; external;
       
    61 procedure AVWrapper_Close; cdecl; external;
       
    62 procedure AVWrapper_WriteFrame( pY, pCb, pCr: PByte ); cdecl; external;
       
    63 {$ENDIF}
       
    64 
       
    65 var YCbCr_Planes: array[0..2] of PByte;
       
    66     RGB_Buffer: PByte;
       
    67 
       
    68     frequency, channels: LongInt;
       
    69 
       
    70     cameraFile: TextFile;
       
    71     audioFile: File;
       
    72     
       
    73     numPixels: LongInt;
       
    74 
       
    75     framerate: Int64 = 30;
       
    76     firstTick, nframes: Int64;
       
    77     
       
    78     cameraFilePath, soundFilePath: shortstring;
       
    79 
       
    80 function BeginVideoRecording: Boolean;
       
    81 var filename: shortstring;
       
    82 begin
       
    83     AddFileLog('BeginVideoRecording');
       
    84 
       
    85     numPixels:= cScreenWidth*cScreenHeight;
       
    86 
       
    87 {$IOCHECKS OFF}
       
    88     // open file with prerecorded camera positions
       
    89     cameraFilePath:= UserPathPrefix + '/Videos/' + cRecPrefix + '.txtin';
       
    90     Assign(cameraFile, cameraFilePath);
       
    91     Reset(cameraFile);
       
    92     if IOResult <> 0 then
       
    93     begin
       
    94         AddFileLog('Error: Could not read from ' + cameraFilePath);
       
    95         exit(false);
       
    96     end;
       
    97 
       
    98     ReadLn(cameraFile, frequency, channels);
       
    99 {$IOCHECKS ON}
       
   100 
       
   101     filename:= UserPathPrefix + '/Videos/' + cRecPrefix + '.mp4' + #0;
       
   102     soundFilePath:= UserPathPrefix + '/Videos/' + cRecPrefix + '.hwsound' + #0;
       
   103     AVWrapper_Init(@AddFileLogRaw, @filename[1], @soundFilePath[1], cScreenWidth, cScreenHeight, framerate, frequency, channels);
       
   104 
       
   105     YCbCr_Planes[0]:= GetMem(numPixels);
       
   106     YCbCr_Planes[1]:= GetMem(numPixels div 4);
       
   107     YCbCr_Planes[2]:= GetMem(numPixels div 4);
       
   108 
       
   109     if (YCbCr_Planes[0] = nil) or (YCbCr_Planes[1] = nil) or (YCbCr_Planes[2] = nil) then
       
   110     begin
       
   111         AddFileLog('Error: Could not allocate memory for video recording (YCbCr buffer).');
       
   112         exit(false);
       
   113     end;
       
   114 
       
   115     RGB_Buffer:= GetMem(4*numPixels);
       
   116     if RGB_Buffer = nil then
       
   117     begin
       
   118         AddFileLog('Error: Could not allocate memory for video recording (RGB buffer).');
       
   119         exit(false);
       
   120     end;
       
   121 
       
   122     BeginVideoRecording:= true;
       
   123 end;
       
   124 
       
   125 procedure StopVideoRecording;
       
   126 begin
       
   127     AddFileLog('StopVideoRecording');
       
   128     FreeMem(YCbCr_Planes[0], numPixels);
       
   129     FreeMem(YCbCr_Planes[1], numPixels div 4);
       
   130     FreeMem(YCbCr_Planes[2], numPixels div 4);
       
   131     FreeMem(RGB_Buffer, 4*numPixels);
       
   132     Close(cameraFile);
       
   133     AVWrapper_Close();
       
   134     DeleteFile(cameraFilePath);
       
   135     DeleteFile(soundFilePath);
       
   136 end;
       
   137 
       
   138 function pixel(x, y, color: LongInt): LongInt;
       
   139 begin
       
   140     pixel:= RGB_Buffer[(cScreenHeight-y-1)*cScreenWidth*4 + x*4 + color];
       
   141 end;
       
   142 
       
   143 procedure EncodeFrame;
       
   144 var x, y, r, g, b: LongInt;
       
   145 begin
       
   146     // read pixels from OpenGL
       
   147     glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_RGBA, GL_UNSIGNED_BYTE, RGB_Buffer);
       
   148 
       
   149     // convert to YCbCr 4:2:0 format
       
   150     // Y
       
   151     for y := 0 to cScreenHeight-1 do
       
   152         for x := 0 to cScreenWidth-1 do
       
   153             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));
       
   154 
       
   155     // Cb and Cr
       
   156     for y := 0 to cScreenHeight div 2 - 1 do
       
   157         for x := 0 to cScreenWidth div 2 - 1 do
       
   158         begin
       
   159             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);
       
   160             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);
       
   161             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);
       
   162             YCbCr_Planes[1][y*(cScreenWidth div 2) + x]:= Byte(128 + ((-2428*r - 4768*g + 7196*b) shr 16));
       
   163             YCbCr_Planes[2][y*(cScreenWidth div 2) + x]:= Byte(128 + (( 7196*r - 6026*g - 1170*b) shr 16));
       
   164         end;
       
   165 
       
   166     AVWrapper_WriteFrame(YCbCr_Planes[0], YCbCr_Planes[1], YCbCr_Planes[2]);
       
   167 end;
       
   168 
       
   169 function LoadNextCameraPosition: LongInt;
       
   170 var NextTime: LongInt;
       
   171     NextZoom: LongInt;
       
   172     NextWorldDx, NextWorldDy: LongInt;
       
   173 begin
       
   174 {$IOCHECKS OFF}
       
   175     if eof(cameraFile) then
       
   176         exit(-1);
       
   177     ReadLn(cameraFile, NextTime, NextWorldDx, NextWorldDy, NextZoom);
       
   178 {$IOCHECKS ON}
       
   179     if NextTime = 0 then
       
   180         exit(-1);
       
   181     WorldDx:= NextWorldDx;
       
   182     WorldDy:= NextWorldDy;
       
   183     zoom:= NextZoom/10000;
       
   184     ZoomValue:= NextZoom/10000;
       
   185     LoadNextCameraPosition:= NextTime;
       
   186 end;
       
   187 
       
   188 // this procedure may be called from different thread
       
   189 procedure RecordPostMix(udata: pointer; stream: PByte; len: LongInt); cdecl;
       
   190 begin
       
   191     udata:= udata;
       
   192 {$IOCHECKS OFF}
       
   193     BlockWrite(audioFile, stream^, len);
       
   194 {$IOCHECKS ON}
       
   195 end;
       
   196 
       
   197 function BeginPreRecording(filePrefix: shortstring): Boolean;
       
   198 var format: word;
       
   199     filename: shortstring;
       
   200 begin
       
   201     AddFileLog('BeginPreRecording');
       
   202 
       
   203     nframes:= 0;
       
   204     firstTick:= SDL_GetTicks();
       
   205 
       
   206     Mix_QuerySpec(@frequency, @format, @channels);
       
   207     if format <> $8010 then
       
   208     begin
       
   209         // TODO: support any audio format
       
   210         AddFileLog('Error: Unexpected audio format ' + IntToStr(format));
       
   211         exit(false);
       
   212     end;
       
   213 
       
   214 {$IOCHECKS OFF}
       
   215     filename:= UserPathPrefix + '/Videos/' + filePrefix + '.hwsound';
       
   216     Assign(audioFile, filename);
       
   217     Rewrite(audioFile, 1);
       
   218     if IOResult <> 0 then
       
   219     begin
       
   220         AddFileLog('Error: Could not write to ' + filename);
       
   221         exit(false);
       
   222     end;
       
   223 
       
   224     filename:= UserPathPrefix + '/Videos/' + filePrefix + '.txtout';
       
   225     Assign(cameraFile, filename);
       
   226     Rewrite(cameraFile);
       
   227     if IOResult <> 0 then
       
   228     begin
       
   229         AddFileLog('Error: Could not write to ' + filename);
       
   230         exit(false);
       
   231     end;
       
   232 {$IOCHECKS ON}
       
   233     WriteLn(cameraFile, inttostr(frequency) + ' ' + inttostr(channels));
       
   234 
       
   235     // register callback for actual audio recording
       
   236     Mix_SetPostMix(@RecordPostMix, nil);
       
   237 
       
   238     flagPrerecording:= true;
       
   239     BeginPreRecording:= true;
       
   240 end;
       
   241 
       
   242 procedure StopPreRecording;
       
   243 begin
       
   244     AddFileLog('StopPreRecording');
       
   245     flagPrerecording:= false;
       
   246 
       
   247     // call SDL_LockAudio because RecordPostMix may be executing right now
       
   248     SDL_LockAudio();
       
   249     Close(audioFile);
       
   250     Close(cameraFile);
       
   251     Mix_SetPostMix(nil, nil);
       
   252     SDL_UnlockAudio();
       
   253 end;
       
   254 
       
   255 procedure SaveCameraPosition;
       
   256 var Ticks: LongInt;
       
   257 begin
       
   258     Ticks:= SDL_GetTicks();
       
   259     while (Ticks - firstTick)*framerate > nframes*1000 do
       
   260     begin
       
   261         WriteLn(cameraFile, inttostr(GameTicks) + ' ' + inttostr(WorldDx) + ' ' + inttostr(WorldDy) + ' ' + inttostr(Round(zoom*10000)));
       
   262         inc(nframes);
       
   263     end;
       
   264 end;
       
   265 
       
   266 procedure freeModule;
       
   267 begin
       
   268     if flagPrerecording then
       
   269         StopPreRecording();
       
   270 end;
       
   271 
       
   272 end.