hedgewars/uMisc.pas
author koda
Wed, 23 Mar 2011 16:27:24 +0100
changeset 5043 2df62e1a6c02
parent 5004 2efa6a414518
child 5046 fc6639d56799
permissions -rw-r--r--
glswapbuffer consistency and create the window in the center (still, it doesn't work past sdl r5296)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
     1
(*
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     2
* Hedgewars, a free turn based strategy game
4976
088d40d8aba2 Happy 2011 :)
koda
parents: 4812
diff changeset
     3
* Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com>
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     4
*
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     5
* This program is free software; you can redistribute it and/or modify
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     6
* it under the terms of the GNU General Public License as published by
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     7
* the Free Software Foundation; version 2 of the License
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     8
*
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     9
* This program is distributed in the hope that it will be useful,
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    10
* but WITHOUT ANY WARRANTY; without even the implied warranty of
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    11
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    12
* GNU General Public License for more details.
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    13
*
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    14
* You should have received a copy of the GNU General Public License
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    15
* along with this program; if not, write to the Free Software
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    16
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
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
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
    26
procedure movecursor(dx, dy: LongInt);
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
    27
function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    28
procedure MakeScreenshot(filename: shortstring);
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
    29
function  GetTeamStatString(p: PTeam): shortstring;
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2622
diff changeset
    30
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    31
procedure initModule;
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    32
procedure freeModule;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    33
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    34
implementation
4377
43945842da0c Haven't found a better place than uIO for OutError
unC0Rr
parents: 4376
diff changeset
    35
uses typinfo, sysutils, uVariables;
3756
d42571e2e6c9 lua function SetEffect to set and remove THogEffects
burp
parents: 3709
diff changeset
    36
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
    37
procedure movecursor(dx, dy: LongInt);
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    38
var x, y: LongInt;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    39
begin
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    40
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
    41
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    42
SDL_GetMouseState(@x, @y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    43
Inc(x, dx);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    44
Inc(y, dy);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    45
SDL_WarpMouse(x, y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    46
end;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    47
949
866729775535 Use nick from frontend to prepend chat messages
unc0rr
parents: 945
diff changeset
    48
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    49
procedure MakeScreenshot(filename: shortstring);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    50
var p: Pointer;
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    51
    size: Longword;
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    52
    f: file;
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    53
    // Windows Bitmap Header
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    54
    head: array[0..53] of Byte = (
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    55
    $42, $4D, // identifier ("BM")
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    56
    0, 0, 0, 0, // file size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    57
    0, 0, 0, 0, // reserved
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    58
    54, 0, 0, 0, // starting offset
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    59
    40, 0, 0, 0, // header size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    60
    0, 0, 0, 0, // width
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    61
    0, 0, 0, 0, // height
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    62
    1, 0, // color planes
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    63
    24, 0, // bit depth
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    64
    0, 0, 0, 0, // compression method (uncompressed)
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    65
    0, 0, 0, 0, // image size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    66
    96, 0, 0, 0, // horizontal resolution
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    67
    96, 0, 0, 0, // vertical resolution
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    68
    0, 0, 0, 0, // number of colors (all)
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    69
    0, 0, 0, 0 // number of important colors
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    70
    );
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    71
begin
3107
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    72
// flash
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    73
ScreenFade:= sfFromWhite;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    74
ScreenFadeValue:= sfMax;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    75
ScreenFadeSpeed:= 5;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    76
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    77
size:= cScreenWidth * cScreenHeight * 3;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    78
p:= GetMem(size);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    79
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    80
// update header information and file name
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    81
3350
5cd02aafc612 Engine:
smxx
parents: 3337
diff changeset
    82
filename:= ParamStr(1) + '/Screenshots/' + filename + '.bmp';
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    83
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    84
head[$02]:= (size + 54) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    85
head[$03]:= ((size + 54) shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    86
head[$04]:= ((size + 54) shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    87
head[$05]:= ((size + 54) shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    88
head[$12]:= cScreenWidth and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    89
head[$13]:= (cScreenWidth shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    90
head[$14]:= (cScreenWidth shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    91
head[$15]:= (cScreenWidth shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    92
head[$16]:= cScreenHeight and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    93
head[$17]:= (cScreenHeight shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    94
head[$18]:= (cScreenHeight shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    95
head[$19]:= (cScreenHeight shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    96
head[$22]:= size and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    97
head[$23]:= (size shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    98
head[$24]:= (size shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    99
head[$25]:= (size shr 24) and $ff;
2163
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   100
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   101
//remember that opengles operates on a single surface, so GL_FRONT *should* be implied
3663
8c28abf427f5 reduce the number of keywords used and switch to BMP format for screenshots
koda
parents: 3650
diff changeset
   102
//glReadBuffer(GL_FRONT);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   103
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   104
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   105
{$I-}
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   106
Assign(f, filename);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   107
Rewrite(f, 1);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   108
if IOResult = 0 then
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   109
    begin
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   110
    BlockWrite(f, head, sizeof(head));
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   111
    BlockWrite(f, p^, size);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   112
    Close(f);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   113
    end;
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   114
{$I+}
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   115
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   116
FreeMem(p)
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   117
end;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   118
5004
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   119
// http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   120
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
   121
const conversionFormat: TSDL_PixelFormat = (
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   122
{$IFDEF SDL13}format: 0;{$ENDIF}
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   123
        palette: nil; BitsPerPixel: 32; BytesPerPixel: 4;
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   124
        Rloss: 0; Gloss: 0; Bloss: 0; Aloss: 0;
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   125
{$IFDEF ENDIAN_LITTLE}Rshift: 0; Gshift: 8; Bshift: 16; Ashift: 24;
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   126
{$ELSE} Rshift: 24; Gshift: 16; Bshift: 8; Ashift: 0;{$ENDIF}
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   127
        RMask: RMask; GMask: GMask; BMask: BMask; AMask: AMask;
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   128
{$IFDEF SDL13}refcount: 0; next: nil;
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   129
{$ELSE} colorkey: 0; alpha: 255{$ENDIF});
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   130
var convertedSurf: PSDL_Surface;
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   131
begin
5004
2efa6a414518 update some sdl-1.3 bindings (working up to rev 5296)
koda
parents: 4976
diff changeset
   132
    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
   133
       (tmpsurf^.format^.bitsperpixel = 24) then
4578
f3cf226fad16 Snowball weapon
nemo
parents: 4413
diff changeset
   134
        begin
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   135
        convertedSurf:= SDL_ConvertSurface(tmpsurf, @conversionFormat, SDL_SWSURFACE);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   136
        SDL_FreeSurface(tmpsurf);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   137
        exit(convertedSurf);
4578
f3cf226fad16 Snowball weapon
nemo
parents: 4413
diff changeset
   138
        end;
2705
2b5625c4ec16 fix a nasty 196 bytes memory leak in engine, plus other stuff for iphone frontend
koda
parents: 2699
diff changeset
   139
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   140
    exit(tmpsurf);
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   141
end;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   142
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   143
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   144
function GetTeamStatString(p: PTeam): shortstring;
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   145
var s: ansistring;
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
   146
begin
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   147
    s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':';
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   148
    GetTeamStatString:= s;
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
   149
end;
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2622
diff changeset
   150
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   151
procedure initModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   152
begin
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   153
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   154
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   155
procedure freeModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   156
begin
3626
19f78afa0188 fix the multitouch shooting and moving
koda
parents: 3613
diff changeset
   157
    recordFileName:= '';
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   158
end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   159
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   160
end.