hedgewars/uMisc.pas
changeset 6881 ee01eeaa1281
parent 6857 b34288c8fafa
child 6884 85e810230372
equal deleted inserted replaced
6880:34d3bc7bd8b1 6881:ee01eeaa1281
    15 * along with this program; if not, write to the Free Software
    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
    16 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
    17 *)
    17 *)
    18 
    18 
    19 {$INCLUDE "options.inc"}
    19 {$INCLUDE "options.inc"}
       
    20 {$DEFINE PNG_SCREENSHOTS}
    20 
    21 
    21 unit uMisc;
    22 unit uMisc;
    22 interface
    23 interface
    23 
    24 
    24 uses SDLh, uConsts, GLunit, uTypes;
    25 uses SDLh, uConsts, GLunit, uTypes;
    34 {$ENDIF}
    35 {$ENDIF}
    35 procedure initModule;
    36 procedure initModule;
    36 procedure freeModule;
    37 procedure freeModule;
    37 
    38 
    38 implementation
    39 implementation
    39 uses typinfo, sysutils, uVariables, uUtils;
    40 uses typinfo, sysutils, uVariables, uUtils
       
    41      {$IFDEF PNG_SCREENSHOTS}, PNGh, png {$ENDIF}
       
    42      {$IFNDEF USE_SDLTHREADS} {$IFDEF UNIX}, cthreads{$ENDIF} {$ENDIF};
       
    43 
       
    44 type PScreenshot = ^TScreenshot;
       
    45      TScreenshot = record
       
    46          buffer: PByte;
       
    47          filename: shortstring;
       
    48          width, height: LongInt;
       
    49          size: QWord;
       
    50          end;
    40 
    51 
    41 procedure movecursor(dx, dy: LongInt);
    52 procedure movecursor(dx, dy: LongInt);
    42 var x, y: LongInt;
    53 var x, y: LongInt;
    43 begin
    54 begin
    44 if (dx = 0) and (dy = 0) then exit;
    55 if (dx = 0) and (dy = 0) then exit;
    47 Inc(x, dx);
    58 Inc(x, dx);
    48 Inc(y, dy);
    59 Inc(y, dy);
    49 SDL_WarpMouse(x, y);
    60 SDL_WarpMouse(x, y);
    50 end;
    61 end;
    51 
    62 
    52 // captures and saves the screen. returns true on success.
    63 {$IFDEF PNG_SCREENSHOTS}
    53 function MakeScreenshot(filename: shortstring): Boolean;
    64 // this funtion will be executed in separate thread
    54 var success: boolean;
    65 function SaveScreenshot(screenshot: pointer): PtrInt;
    55     p: Pointer;
    66 var i: LongInt;
    56     size: QWord;
    67     png_ptr: ^png_struct;
       
    68     info_ptr: ^png_info;
    57     f: file;
    69     f: file;
       
    70     image: PScreenshot;
       
    71 begin
       
    72 image:= PScreenshot(screenshot);
       
    73 
       
    74 png_ptr := png_create_write_struct(png_get_libpng_ver(nil), nil, nil, nil);
       
    75 if png_ptr = nil then
       
    76 begin
       
    77     // AddFileLog('Error: Could not create png write struct.');
       
    78     exit(0);
       
    79 end;
       
    80 
       
    81 info_ptr := png_create_info_struct(png_ptr);
       
    82 if info_ptr = nil then
       
    83 begin
       
    84     png_destroy_write_struct(@png_ptr, nil);
       
    85     // AddFileLog('Error: Could not create png info struct.');
       
    86     exit(0);
       
    87 end;
       
    88 
       
    89 {$IOCHECKS OFF}
       
    90 Assign(f, image^.filename);
       
    91 Rewrite(f, 1);
       
    92 if IOResult = 0 then
       
    93     begin
       
    94     png_init_pascal_io(png_ptr,@f);
       
    95     png_set_IHDR(png_ptr, info_ptr, image^.width, image^.height,
       
    96                  8, // bit depth
       
    97                  PNG_COLOR_TYPE_RGBA, PNG_INTERLACE_NONE,
       
    98                  PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
       
    99     png_write_info(png_ptr, info_ptr);
       
   100     // glReadPixels and libpng number rows in different order
       
   101     for i:= image^.height-1 downto 0 do
       
   102         png_write_row(png_ptr, image^.buffer + i*4*image^.width);
       
   103     png_write_end(png_ptr, info_ptr);
       
   104     Close(f);
       
   105     end;
       
   106 {$IOCHECKS ON}
       
   107 
       
   108 // free everything
       
   109 png_destroy_write_struct(@png_ptr, @info_ptr);
       
   110 FreeMem(image^.buffer, image^.size);
       
   111 Dispose(image);
       
   112 SaveScreenshot:= 0;
       
   113 end;
       
   114 
       
   115 {$ELSE} // no PNG_SCREENSHOTS
       
   116 
       
   117 // this funtion will be executed in separate thread
       
   118 function SaveScreenshot(screenshot: pointer): PtrInt;
       
   119 var f: file;
    58     // Windows Bitmap Header
   120     // Windows Bitmap Header
    59     head: array[0..53] of Byte = (
   121     head: array[0..53] of Byte = (
    60     $42, $4D,       // identifier ("BM")
   122     $42, $4D,       // identifier ("BM")
    61     0, 0, 0, 0,     // file size
   123     0, 0, 0, 0,     // file size
    62     0, 0, 0, 0,     // reserved
   124     0, 0, 0, 0,     // reserved
    71     96, 0, 0, 0,    // horizontal resolution
   133     96, 0, 0, 0,    // horizontal resolution
    72     96, 0, 0, 0,    // vertical resolution
   134     96, 0, 0, 0,    // vertical resolution
    73     0, 0, 0, 0,     // number of colors (all)
   135     0, 0, 0, 0,     // number of colors (all)
    74     0, 0, 0, 0      // number of important colors
   136     0, 0, 0, 0      // number of important colors
    75     );
   137     );
       
   138     image: PScreenshot;
       
   139     size: QWord;
       
   140 begin
       
   141 image:= PScreenshot(screenshot);
       
   142 
       
   143 size:= image^.Width*image^.Height*4;
       
   144 
       
   145 head[$02]:= (size + 54) and $ff;
       
   146 head[$03]:= ((size + 54) shr 8) and $ff;
       
   147 head[$04]:= ((size + 54) shr 16) and $ff;
       
   148 head[$05]:= ((size + 54) shr 24) and $ff;
       
   149 head[$12]:= image^.Width and $ff;
       
   150 head[$13]:= (image^.Width shr 8) and $ff;
       
   151 head[$14]:= (image^.Width shr 16) and $ff;
       
   152 head[$15]:= (image^.Width shr 24) and $ff;
       
   153 head[$16]:= image^.Height and $ff;
       
   154 head[$17]:= (image^.Height shr 8) and $ff;
       
   155 head[$18]:= (image^.Height shr 16) and $ff;
       
   156 head[$19]:= (image^.Height shr 24) and $ff;
       
   157 head[$22]:= size and $ff;
       
   158 head[$23]:= (size shr 8) and $ff;
       
   159 head[$24]:= (size shr 16) and $ff;
       
   160 head[$25]:= (size shr 24) and $ff;
       
   161 
       
   162 {$IOCHECKS OFF}
       
   163 Assign(f, image^.filename);
       
   164 Rewrite(f, 1);
       
   165 if IOResult = 0 then
       
   166     begin
       
   167     BlockWrite(f, head, sizeof(head));
       
   168     BlockWrite(f, image^.buffer^, size);
       
   169     Close(f);
       
   170     end
       
   171 else
       
   172     begin
       
   173     //AddFileLog('Error: Could not write to ' + filename);
       
   174     end;
       
   175 {$IOCHECKS ON}
       
   176 
       
   177 // free everything
       
   178 FreeMem(image^.buffer, image^.size);
       
   179 Dispose(image);
       
   180 SaveScreenshot:= 0;
       
   181 end;
       
   182 
       
   183 {$ENDIF} // no PNG_SCREENSHOTS
       
   184 
       
   185 // captures and saves the screen. returns true on success.
       
   186 function MakeScreenshot(filename: shortstring): Boolean;
       
   187 var p: Pointer;
       
   188     size: QWord;
       
   189     image: PScreenshot;
       
   190     format: GLenum;
       
   191     ext: string[4];
    76 begin
   192 begin
    77 // flash
   193 // flash
    78 ScreenFade:= sfFromWhite;
   194 ScreenFade:= sfFromWhite;
    79 ScreenFadeValue:= sfMax;
   195 ScreenFadeValue:= sfMax;
    80 ScreenFadeSpeed:= 5;
   196 ScreenFadeSpeed:= 5;
    81 
   197 
       
   198 {$IFDEF PNG_SCREENSHOTS}
       
   199 format:= GL_RGBA;
       
   200 ext:= '.png';
       
   201 {$ELSE}
       
   202 format:= GL_BGRA;
       
   203 ext:= '.bmp';
       
   204 {$ENDIF}
       
   205 
    82 size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 4;
   206 size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 4;
    83 p:= GetMem(size);
   207 p:= GetMem(size); // will be freed in SaveScreenshot()
    84 
   208 
    85 // memory could not be allocated
   209 // memory could not be allocated
    86 if p = nil then
   210 if p = nil then
    87 begin
   211 begin
    88     AddFileLog('Error: Could not allocate memory for screenshot.');
   212     AddFileLog('Error: Could not allocate memory for screenshot.');
    89     exit(false);
   213     exit(false);
    90 end;
   214 end;
    91 
   215 
    92 // update header information and file name
       
    93 filename:= UserPathPrefix + '/Screenshots/' + filename + '.bmp';
       
    94 
       
    95 head[$02]:= (size + 54) and $ff;
       
    96 head[$03]:= ((size + 54) shr 8) and $ff;
       
    97 head[$04]:= ((size + 54) shr 16) and $ff;
       
    98 head[$05]:= ((size + 54) shr 24) and $ff;
       
    99 head[$12]:= cScreenWidth and $ff;
       
   100 head[$13]:= (cScreenWidth shr 8) and $ff;
       
   101 head[$14]:= (cScreenWidth shr 16) and $ff;
       
   102 head[$15]:= (cScreenWidth shr 24) and $ff;
       
   103 head[$16]:= cScreenHeight and $ff;
       
   104 head[$17]:= (cScreenHeight shr 8) and $ff;
       
   105 head[$18]:= (cScreenHeight shr 16) and $ff;
       
   106 head[$19]:= (cScreenHeight shr 24) and $ff;
       
   107 head[$22]:= size and $ff;
       
   108 head[$23]:= (size shr 8) and $ff;
       
   109 head[$24]:= (size shr 16) and $ff;
       
   110 head[$25]:= (size shr 24) and $ff;
       
   111 
       
   112 // read pixel from the front buffer
   216 // read pixel from the front buffer
   113 glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGRA, GL_UNSIGNED_BYTE, p);
   217 glReadPixels(0, 0, cScreenWidth, cScreenHeight, format, GL_UNSIGNED_BYTE, p);
   114 
   218 
   115 {$IOCHECKS OFF}
   219 // allocate and fill structure that will be passed to new thread
   116 Assign(f, filename);
   220 New(image); // will be disposed in SaveScreenshot()
   117 Rewrite(f, 1);
   221 image^.filename:= UserPathPrefix + '/Screenshots/' + filename + ext;
   118 if IOResult = 0 then
   222 image^.width:= cScreenWidth;
   119     begin
   223 image^.height:= cScreenHeight;
   120     BlockWrite(f, head, sizeof(head));
   224 image^.size:= size;
   121     BlockWrite(f, p^, size);
   225 image^.buffer:= p;
   122     Close(f);
   226 
   123     success:= true;
   227 {$IFDEF USE_SDLTHREADS}
   124     end
   228 SDL_CreateThread(@SaveScreenshot{$IFDEF SDL13}, nil{$ENDIF}, image);
   125 else
   229 {$ELSE}
   126     begin
   230 BeginThread(@SaveScreenshot, image);
   127     AddFileLog('Error: Could not write to ' + filename);
   231 {$ENDIF}
   128     success:= false;
   232 MakeScreenshot:= true; // possibly it is not true but we will not wait for thread to terminate
   129     end;
       
   130 {$IOCHECKS ON}
       
   131 
       
   132 FreeMem(p, size);
       
   133 MakeScreenshot:= success;
       
   134 end;
   233 end;
   135 
   234 
   136 // http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
   235 // http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
   137 function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
   236 function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
   138 var convertedSurf: PSDL_Surface;
   237 var convertedSurf: PSDL_Surface;