hedgewars/uMisc.pas
author unc0rr
Sun, 19 Dec 2010 20:33:33 +0300
changeset 4565 8a1476a5629e
parent 4413 46caab3a8f84
child 4578 f3cf226fad16
permissions -rw-r--r--
Most probably it's fix to a crash
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
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
     3
* Copyright (c) 2004-2008 Andrey Korotaev <unC0Rr@gmail.com>
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
4374
bcefeeabaa33 Move some stuff from uMisc to uUtils
unC0Rr
parents: 4371
diff changeset
    24
uses    SDLh, uConsts, GLunit, uTypes;
2697
75880595a9f1 code cleanup and opengles optimizations
koda
parents: 2693
diff changeset
    25
3611
ed00aa2b339e interpret parameters before initializing everything
koda
parents: 3599
diff changeset
    26
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
    27
procedure movecursor(dx, dy: LongInt);
2670
1b327b7515ed regression, powerpc colors working again
koda
parents: 2666
diff changeset
    28
function  doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    29
procedure MakeScreenshot(filename: shortstring);
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
    30
function  GetTeamStatString(p: PTeam): shortstring;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    31
4359
83ef50815535 Move variables from uMisc to uVariables
unC0Rr
parents: 4357
diff changeset
    32
procedure initModule;
83ef50815535 Move variables from uMisc to uVariables
unC0Rr
parents: 4357
diff changeset
    33
procedure freeModule;
83ef50815535 Move variables from uMisc to uVariables
unC0Rr
parents: 4357
diff changeset
    34
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    35
implementation
4377
43945842da0c Haven't found a better place than uIO for OutError
unC0Rr
parents: 4376
diff changeset
    36
uses typinfo, sysutils, uVariables;
3756
d42571e2e6c9 lua function SetEffect to set and remove THogEffects
burp
parents: 3709
diff changeset
    37
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
    38
procedure movecursor(dx, dy: LongInt);
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    39
var x, y: LongInt;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    40
begin
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    41
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
    42
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    43
SDL_GetMouseState(@x, @y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    44
Inc(x, dx);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    45
Inc(y, dy);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    46
SDL_WarpMouse(x, y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    47
end;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    48
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    49
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    50
procedure MakeScreenshot(filename: shortstring);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    51
var p: Pointer;
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    52
    size: Longword;
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    53
    f: file;
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    54
    // Windows Bitmap Header
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    55
    head: array[0..53] of Byte = (
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    56
    $42, $4D, // identifier ("BM")
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    57
    0, 0, 0, 0, // file size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    58
    0, 0, 0, 0, // reserved
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    59
    54, 0, 0, 0, // starting offset
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    60
    40, 0, 0, 0, // header size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    61
    0, 0, 0, 0, // width
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    62
    0, 0, 0, 0, // height
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    63
    1, 0, // color planes
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    64
    24, 0, // bit depth
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    65
    0, 0, 0, 0, // compression method (uncompressed)
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    66
    0, 0, 0, 0, // image size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    67
    96, 0, 0, 0, // horizontal resolution
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    68
    96, 0, 0, 0, // vertical resolution
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    69
    0, 0, 0, 0, // number of colors (all)
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    70
    0, 0, 0, 0 // number of important colors
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    71
    );
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    72
begin
3107
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    73
// flash
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    74
ScreenFade:= sfFromWhite;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    75
ScreenFadeValue:= sfMax;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    76
ScreenFadeSpeed:= 5;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    77
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    78
size:= cScreenWidth * cScreenHeight * 3;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    79
p:= GetMem(size);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    80
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    81
// update header information and file name
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    82
3350
5cd02aafc612 Engine:
smxx
parents: 3337
diff changeset
    83
filename:= ParamStr(1) + '/Screenshots/' + filename + '.bmp';
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    84
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    85
head[$02]:= (size + 54) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    86
head[$03]:= ((size + 54) shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    87
head[$04]:= ((size + 54) shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    88
head[$05]:= ((size + 54) shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    89
head[$12]:= cScreenWidth and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    90
head[$13]:= (cScreenWidth shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    91
head[$14]:= (cScreenWidth shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    92
head[$15]:= (cScreenWidth shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    93
head[$16]:= cScreenHeight and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    94
head[$17]:= (cScreenHeight shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    95
head[$18]:= (cScreenHeight shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    96
head[$19]:= (cScreenHeight shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    97
head[$22]:= size and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    98
head[$23]:= (size shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    99
head[$24]:= (size shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   100
head[$25]:= (size shr 24) and $ff;
2163
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   101
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   102
//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
   103
//glReadBuffer(GL_FRONT);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   104
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   105
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   106
{$I-}
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   107
Assign(f, filename);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   108
Rewrite(f, 1);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   109
if IOResult = 0 then
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   110
    begin
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   111
    BlockWrite(f, head, sizeof(head));
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   112
    BlockWrite(f, p^, size);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   113
    Close(f);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   114
    end;
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   115
{$I+}
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   116
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   117
FreeMem(p)
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   118
end;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   119
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   120
function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   121
{* for more information http://www.idevgames.com/forum/showpost.php?p=85864&postcount=7 *}
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   122
var convertedSurf: PSDL_Surface = nil;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   123
begin
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   124
    if (tmpsurf^.format^.bitsperpixel = 24) or ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) then
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   125
    begin
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   126
        convertedSurf:= SDL_ConvertSurface(tmpsurf, @conversionFormat, SDL_SWSURFACE);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   127
        SDL_FreeSurface(tmpsurf);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   128
        exit(convertedSurf);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   129
    end;
2705
2b5625c4ec16 fix a nasty 196 bytes memory leak in engine, plus other stuff for iphone frontend
koda
parents: 2699
diff changeset
   130
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   131
    exit(tmpsurf);
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   132
end;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   133
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   134
4413
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   135
function GetTeamStatString(p: PTeam): shortstring;
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   136
var s: ansistring;
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   137
begin
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   138
    s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':';
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   139
    GetTeamStatString:= s;
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   140
end;
46caab3a8f84 uCommandHandlers
unc0rr
parents: 4377
diff changeset
   141
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   142
procedure initModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   143
begin
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   144
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   145
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   146
procedure freeModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   147
begin
3626
19f78afa0188 fix the multitouch shooting and moving
koda
parents: 3613
diff changeset
   148
    recordFileName:= '';
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   149
end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   150
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   151
end.