hedgewars/uMisc.pas
author unc0rr
Wed, 02 May 2012 22:12:58 +0400
changeset 7001 89488f5b99ca
parent 6992 b8f3d8991e92
child 7043 7c080e5ac8d0
permissions -rw-r--r--
GetRandom -> GetRandomf
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
     1
(*
6952
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     2
 * Hedgewars, a free turn based strategy game
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     3
 * Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com>
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     4
 *
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     8
 *
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    12
 * GNU General Public License for more details.
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    13
 *
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    14
 * You should have received a copy of the GNU General Public License
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    15
 * along with this program; if not, write to the Free Software
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
7f70f37bbf08 license header year range adjustments
sheepluva
parents: 6884
diff changeset
    17
 *)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    18
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2622
diff changeset
    19
{$INCLUDE "options.inc"}
079ef82eac75 revamped file access and debug display
koda
parents: 2622
diff changeset
    20
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    21
unit uMisc;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    22
interface
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2622
diff changeset
    23
5004
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
    24
uses SDLh, uConsts, GLunit, uTypes;
1054
80225c6af656 - Prepare for sudden death implementation
unc0rr
parents: 988
diff changeset
    25
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    26
procedure initModule;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    27
procedure freeModule;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    28
3169
c8c6ac44f51b prophylactic removal of some Integer references, raise a few of the template islands up a bit so they work inverted without triggering border
nemo
parents: 3165
diff changeset
    29
procedure movecursor(dx, dy: LongInt);
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
    30
function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
5912
d31eba29e706 screenshots: display a msg on failure and log causative error
sheepluva
parents: 5911
diff changeset
    31
function  MakeScreenshot(filename: shortstring): boolean;
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
    32
function  GetTeamStatString(p: PTeam): shortstring;
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
    33
{$IFDEF SDL13}
6992
b8f3d8991e92 marked a couple of functions as inline
koda
parents: 6990
diff changeset
    34
function  SDL_RectMake(x, y, width, height: LongInt): TSDL_Rect; inline;
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
    35
{$ELSE}
6992
b8f3d8991e92 marked a couple of functions as inline
koda
parents: 6990
diff changeset
    36
function  SDL_RectMake(x, y: SmallInt; width, height: Word): TSDL_Rect; inline;
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
    37
{$ENDIF}
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    38
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    39
implementation
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    40
uses typinfo, sysutils, uVariables, uUtils
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    41
     {$IFDEF PNG_SCREENSHOTS}, PNGh, png {$ENDIF}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    42
     {$IFNDEF USE_SDLTHREADS} {$IFDEF UNIX}, cthreads{$ENDIF} {$ENDIF};
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    43
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    44
type PScreenshot = ^TScreenshot;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    45
     TScreenshot = record
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    46
         buffer: PByte;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    47
         filename: shortstring;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    48
         width, height: LongInt;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    49
         size: QWord;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    50
         end;
3756
d42571e2e6c9 lua function SetEffect to set and remove THogEffects
burp
parents: 3709
diff changeset
    51
3169
c8c6ac44f51b prophylactic removal of some Integer references, raise a few of the template islands up a bit so they work inverted without triggering border
nemo
parents: 3165
diff changeset
    52
procedure movecursor(dx, dy: LongInt);
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    53
var x, y: LongInt;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    54
begin
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    55
if (dx = 0) and (dy = 0) then exit;
2671
7e0f88013fe8 smaller patches, one missing Sky-lowres, IMG_Init and Mix_Init (might require newer libraries), updates to SDL bindings, code cleanup, new compile flags
koda
parents: 2670
diff changeset
    56
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    57
SDL_GetMouseState(@x, @y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    58
Inc(x, dx);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    59
Inc(y, dy);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    60
SDL_WarpMouse(x, y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    61
end;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    62
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    63
{$IFDEF PNG_SCREENSHOTS}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    64
// this funtion will be executed in separate thread
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    65
function SaveScreenshot(screenshot: pointer): PtrInt;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    66
var i: LongInt;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    67
    png_ptr: ^png_struct;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    68
    info_ptr: ^png_info;
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    69
    f: file;
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    70
    image: PScreenshot;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    71
begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    72
image:= PScreenshot(screenshot);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    73
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    74
png_ptr := png_create_write_struct(png_get_libpng_ver(nil), nil, nil, nil);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    75
if png_ptr = nil then
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    76
begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    77
    // AddFileLog('Error: Could not create png write struct.');
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    78
    SaveScreenshot:= 0;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    79
    exit;
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    80
end;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    81
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    82
info_ptr := png_create_info_struct(png_ptr);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    83
if info_ptr = nil then
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    84
begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    85
    png_destroy_write_struct(@png_ptr, nil);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    86
    // AddFileLog('Error: Could not create png info struct.');
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    87
    SaveScreenshot:= 0;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
    88
    exit;
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    89
end;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    90
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    91
{$IOCHECKS OFF}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    92
Assign(f, image^.filename);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    93
Rewrite(f, 1);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    94
if IOResult = 0 then
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    95
    begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    96
    png_init_pascal_io(png_ptr,@f);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    97
    png_set_IHDR(png_ptr, info_ptr, image^.width, image^.height,
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    98
                 8, // bit depth
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
    99
                 PNG_COLOR_TYPE_RGBA, PNG_INTERLACE_NONE,
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   100
                 PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   101
    png_write_info(png_ptr, info_ptr);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   102
    // glReadPixels and libpng number rows in different order
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   103
    for i:= image^.height-1 downto 0 do
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   104
        png_write_row(png_ptr, image^.buffer + i*4*image^.width);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   105
    png_write_end(png_ptr, info_ptr);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   106
    Close(f);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   107
    end;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   108
{$IOCHECKS ON}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   109
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   110
// free everything
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   111
png_destroy_write_struct(@png_ptr, @info_ptr);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   112
FreeMem(image^.buffer, image^.size);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   113
Dispose(image);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   114
SaveScreenshot:= 0;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   115
end;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   116
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   117
{$ELSE} // no PNG_SCREENSHOTS
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   118
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   119
// this funtion will be executed in separate thread
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   120
function SaveScreenshot(screenshot: pointer): PtrInt;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   121
var f: file;
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   122
    // Windows Bitmap Header
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   123
    head: array[0..53] of Byte = (
6267
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   124
    $42, $4D,       // identifier ("BM")
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   125
    0, 0, 0, 0,     // file size
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   126
    0, 0, 0, 0,     // reserved
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   127
    54, 0, 0, 0,    // starting offset
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   128
    40, 0, 0, 0,    // header size
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   129
    0, 0, 0, 0,     // width
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   130
    0, 0, 0, 0,     // height
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   131
    1, 0,           // color planes
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   132
    32, 0,          // bit depth
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   133
    0, 0, 0, 0,     // compression method (uncompressed)
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   134
    0, 0, 0, 0,     // image size
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   135
    96, 0, 0, 0,    // horizontal resolution
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   136
    96, 0, 0, 0,    // vertical resolution
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   137
    0, 0, 0, 0,     // number of colors (all)
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   138
    0, 0, 0, 0      // number of important colors
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   139
    );
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   140
    image: PScreenshot;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   141
    size: QWord;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   142
begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   143
image:= PScreenshot(screenshot);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   144
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   145
size:= image^.Width*image^.Height*4;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   146
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   147
head[$02]:= (size + 54) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   148
head[$03]:= ((size + 54) shr 8) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   149
head[$04]:= ((size + 54) shr 16) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   150
head[$05]:= ((size + 54) shr 24) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   151
head[$12]:= image^.Width and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   152
head[$13]:= (image^.Width shr 8) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   153
head[$14]:= (image^.Width shr 16) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   154
head[$15]:= (image^.Width shr 24) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   155
head[$16]:= image^.Height and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   156
head[$17]:= (image^.Height shr 8) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   157
head[$18]:= (image^.Height shr 16) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   158
head[$19]:= (image^.Height shr 24) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   159
head[$22]:= size and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   160
head[$23]:= (size shr 8) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   161
head[$24]:= (size shr 16) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   162
head[$25]:= (size shr 24) and $ff;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   163
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   164
{$IOCHECKS OFF}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   165
Assign(f, image^.filename);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   166
Rewrite(f, 1);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   167
if IOResult = 0 then
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   168
    begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   169
    BlockWrite(f, head, sizeof(head));
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   170
    BlockWrite(f, image^.buffer^, size);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   171
    Close(f);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   172
    end
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   173
else
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   174
    begin
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   175
    //AddFileLog('Error: Could not write to ' + filename);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   176
    end;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   177
{$IOCHECKS ON}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   178
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   179
// free everything
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   180
FreeMem(image^.buffer, image^.size);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   181
Dispose(image);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   182
SaveScreenshot:= 0;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   183
end;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   184
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   185
{$ENDIF} // no PNG_SCREENSHOTS
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   186
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   187
// captures and saves the screen. returns true on success.
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   188
function MakeScreenshot(filename: shortstring): Boolean;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   189
var p: Pointer;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   190
    size: QWord;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   191
    image: PScreenshot;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   192
    format: GLenum;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   193
    ext: string[4];
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   194
begin
3107
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   195
// flash
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   196
ScreenFade:= sfFromWhite;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   197
ScreenFadeValue:= sfMax;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   198
ScreenFadeSpeed:= 5;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   199
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   200
{$IFDEF PNG_SCREENSHOTS}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   201
format:= GL_RGBA;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   202
ext:= '.png';
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   203
{$ELSE}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   204
format:= GL_BGRA;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   205
ext:= '.bmp';
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   206
{$ENDIF}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   207
6267
be5d40bb1e86 make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents: 5912
diff changeset
   208
size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 4;
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   209
p:= GetMem(size); // will be freed in SaveScreenshot()
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   210
5910
c9a4de51b5a0 cleaned up the screenshot procedure a little.
sheepluva
parents: 5239
diff changeset
   211
// memory could not be allocated
c9a4de51b5a0 cleaned up the screenshot procedure a little.
sheepluva
parents: 5239
diff changeset
   212
if p = nil then
5912
d31eba29e706 screenshots: display a msg on failure and log causative error
sheepluva
parents: 5911
diff changeset
   213
begin
d31eba29e706 screenshots: display a msg on failure and log causative error
sheepluva
parents: 5911
diff changeset
   214
    AddFileLog('Error: Could not allocate memory for screenshot.');
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
   215
    MakeScreenshot:= false;
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
   216
    exit;
5912
d31eba29e706 screenshots: display a msg on failure and log causative error
sheepluva
parents: 5911
diff changeset
   217
end;
5910
c9a4de51b5a0 cleaned up the screenshot procedure a little.
sheepluva
parents: 5239
diff changeset
   218
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   219
// read pixel from the front buffer
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   220
glReadPixels(0, 0, cScreenWidth, cScreenHeight, format, GL_UNSIGNED_BYTE, p);
2163
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   221
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   222
// allocate and fill structure that will be passed to new thread
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   223
New(image); // will be disposed in SaveScreenshot()
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   224
image^.filename:= UserPathPrefix + '/Screenshots/' + filename + ext;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   225
image^.width:= cScreenWidth;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   226
image^.height:= cScreenHeight;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   227
image^.size:= size;
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   228
image^.buffer:= p;
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   229
6881
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   230
{$IFDEF USE_SDLTHREADS}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   231
SDL_CreateThread(@SaveScreenshot{$IFDEF SDL13}, nil{$ENDIF}, image);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   232
{$ELSE}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   233
BeginThread(@SaveScreenshot, image);
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   234
{$ENDIF}
ee01eeaa1281 png screenshots
Stepan777
parents: 6857
diff changeset
   235
MakeScreenshot:= true; // possibly it is not true but we will not wait for thread to terminate
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   236
end;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   237
5004
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   238
// http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   239
function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
5004
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   240
var convertedSurf: PSDL_Surface;
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   241
begin
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
   242
    doSurfaceConversion:= tmpsurf;
5004
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   243
    if ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) or
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   244
       (tmpsurf^.format^.bitsperpixel = 24) then
4578
f3cf226fad16 Snowball weapon
nemo
parents: 4413
diff changeset
   245
        begin
5046
fc6639d56799 this brings compatibility up with SDL HEAD (5504), but maybe breaks compatibility with sdl 1.2 so please test! still has problems with keyboard input and rendered ttf textures
koda
parents: 5004
diff changeset
   246
        convertedSurf:= SDL_ConvertSurface(tmpsurf, conversionFormat, SDL_SWSURFACE);
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   247
        SDL_FreeSurface(tmpsurf);
6990
40e5af28d026 change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents: 6952
diff changeset
   248
        doSurfaceConversion:= convertedSurf;
4578
f3cf226fad16 Snowball weapon
nemo
parents: 4413
diff changeset
   249
        end;
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   250
end;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   251
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
   252
{$IFDEF SDL13}
6992
b8f3d8991e92 marked a couple of functions as inline
koda
parents: 6990
diff changeset
   253
function SDL_RectMake(x, y, width, height: LongInt): TSDL_Rect; inline;
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
   254
{$ELSE}
6992
b8f3d8991e92 marked a couple of functions as inline
koda
parents: 6990
diff changeset
   255
function SDL_RectMake(x, y: SmallInt; width, height: Word): TSDL_Rect; inline;
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
   256
{$ENDIF}
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
   257
begin
6857
b34288c8fafa Make function more pascal-ish
unc0rr
parents: 6843
diff changeset
   258
    SDL_RectMake.x:= x;
b34288c8fafa Make function more pascal-ish
unc0rr
parents: 6843
diff changeset
   259
    SDL_RectMake.y:= y;
b34288c8fafa Make function more pascal-ish
unc0rr
parents: 6843
diff changeset
   260
    SDL_RectMake.w:= width;
b34288c8fafa Make function more pascal-ish
unc0rr
parents: 6843
diff changeset
   261
    SDL_RectMake.h:= height;
6695
32de8965c62c refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents: 6267
diff changeset
   262
end;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   263
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   264
function GetTeamStatString(p: PTeam): shortstring;
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   265
var s: ansistring;
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
   266
begin
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   267
    s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':';
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   268
    GetTeamStatString:= s;
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
   269
end;
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2622
diff changeset
   270
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   271
procedure initModule;
6843
59da15acb2f2 Finally fix the bug with pointer declarations polluting namespace with bad records
unc0rr
parents: 6700
diff changeset
   272
const SDL_PIXELFORMAT_ABGR8888 = (1 shl 31) or (6 shl 24) or (7 shl 20) or (6 shl 16) or (32 shl 8) or 4;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   273
begin
5052
74a81c276d67 fix a couple of loose ends
koda
parents: 5050
diff changeset
   274
    conversionFormat:= SDL_AllocFormat(SDL_PIXELFORMAT_ABGR8888);
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   275
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   276
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   277
procedure freeModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   278
begin
3626
19f78afa0188 fix the multitouch shooting and moving
koda
parents: 3613
diff changeset
   279
    recordFileName:= '';
5046
fc6639d56799 this brings compatibility up with SDL HEAD (5504), but maybe breaks compatibility with sdl 1.2 so please test! still has problems with keyboard input and rendered ttf textures
koda
parents: 5004
diff changeset
   280
    SDL_FreeFormat(conversionFormat);
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   281
end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   282
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   283
end.