hedgewars/uMisc.pas
author unC0Rr
Thu, 18 Nov 2010 11:50:02 +0300
changeset 4376 9654205a9424
parent 4375 ae5507ddb989
child 4377 43945842da0c
permissions -rw-r--r--
Move SendStats to uIO
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;
4374
bcefeeabaa33 Move some stuff from uMisc to uUtils
unC0Rr
parents: 4371
diff changeset
    29
procedure OutError(Msg: shortstring; isFatalError: boolean);
bcefeeabaa33 Move some stuff from uMisc to uUtils
unC0Rr
parents: 4371
diff changeset
    30
procedure TryDo(Assert: boolean; Msg: shortstring; isFatal: boolean); inline;
bcefeeabaa33 Move some stuff from uMisc to uUtils
unC0Rr
parents: 4371
diff changeset
    31
procedure SDLTry(Assert: boolean; isFatal: boolean);
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    32
procedure MakeScreenshot(filename: shortstring);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    33
4359
83ef50815535 Move variables from uMisc to uVariables
unC0Rr
parents: 4357
diff changeset
    34
procedure initModule;
83ef50815535 Move variables from uMisc to uVariables
unC0Rr
parents: 4357
diff changeset
    35
procedure freeModule;
83ef50815535 Move variables from uMisc to uVariables
unC0Rr
parents: 4357
diff changeset
    36
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    37
implementation
4376
9654205a9424 Move SendStats to uIO
unC0Rr
parents: 4375
diff changeset
    38
uses uConsole, uIO, typinfo, sysutils, uVariables;
3756
d42571e2e6c9 lua function SetEffect to set and remove THogEffects
burp
parents: 3709
diff changeset
    39
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
    40
procedure movecursor(dx, dy: LongInt);
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    41
var x, y: LongInt;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    42
begin
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    43
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
    44
2428
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    45
SDL_GetMouseState(@x, @y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    46
Inc(x, dx);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    47
Inc(y, dy);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    48
SDL_WarpMouse(x, y);
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    49
end;
6800f8aa0184 Huge Smaxx patch with some fixes by me:
unc0rr
parents: 2392
diff changeset
    50
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    51
2905
f3c79f7193a9 Engine:
smxx
parents: 2882
diff changeset
    52
procedure OutError(Msg: shortstring; isFatalError: boolean);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    53
begin
3407
dcc129c4352e Engine:
smxx
parents: 3381
diff changeset
    54
// obsolete? written in WriteLnToConsole() anyway
dcc129c4352e Engine:
smxx
parents: 3381
diff changeset
    55
// {$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF}
4046
cfdbddc4b385 making indentation consistent (noticed while debugging)
nemo
parents: 4003
diff changeset
    56
WriteLnToConsole(Msg);
cfdbddc4b385 making indentation consistent (noticed while debugging)
nemo
parents: 4003
diff changeset
    57
if isFatalError then
3407
dcc129c4352e Engine:
smxx
parents: 3381
diff changeset
    58
    begin
4046
cfdbddc4b385 making indentation consistent (noticed while debugging)
nemo
parents: 4003
diff changeset
    59
    SendIPC('E' + GetLastConsoleLine);
cfdbddc4b385 making indentation consistent (noticed while debugging)
nemo
parents: 4003
diff changeset
    60
    SDL_Quit;
cfdbddc4b385 making indentation consistent (noticed while debugging)
nemo
parents: 4003
diff changeset
    61
    halt(1)
3407
dcc129c4352e Engine:
smxx
parents: 3381
diff changeset
    62
    end
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    63
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    64
2905
f3c79f7193a9 Engine:
smxx
parents: 2882
diff changeset
    65
procedure TryDo(Assert: boolean; Msg: shortstring; isFatal: boolean);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    66
begin
70
82d93eeecebe - Many AI improvements
unc0rr
parents: 56
diff changeset
    67
if not Assert then OutError(Msg, isFatal)
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    68
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    69
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    70
procedure SDLTry(Assert: boolean; isFatal: boolean);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    71
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    72
if not Assert then OutError(SDL_GetError, isFatal)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    73
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
    74
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
    75
procedure MakeScreenshot(filename: shortstring);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    76
var p: Pointer;
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    77
    size: Longword;
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    78
    f: file;
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    79
    // Windows Bitmap Header
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    80
    head: array[0..53] of Byte = (
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    81
    $42, $4D, // identifier ("BM")
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    82
    0, 0, 0, 0, // file size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    83
    0, 0, 0, 0, // reserved
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    84
    54, 0, 0, 0, // starting offset
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    85
    40, 0, 0, 0, // header size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    86
    0, 0, 0, 0, // width
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    87
    0, 0, 0, 0, // height
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    88
    1, 0, // color planes
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    89
    24, 0, // bit depth
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    90
    0, 0, 0, 0, // compression method (uncompressed)
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    91
    0, 0, 0, 0, // image size
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    92
    96, 0, 0, 0, // horizontal resolution
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    93
    96, 0, 0, 0, // vertical resolution
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    94
    0, 0, 0, 0, // number of colors (all)
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    95
    0, 0, 0, 0 // number of important colors
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
    96
    );
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
    97
begin
3107
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    98
// flash
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
    99
ScreenFade:= sfFromWhite;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   100
ScreenFadeValue:= sfMax;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   101
ScreenFadeSpeed:= 5;
1fa539758c10 Engine:
smxx
parents: 3066
diff changeset
   102
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   103
size:= cScreenWidth * cScreenHeight * 3;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   104
p:= GetMem(size);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   105
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   106
// update header information and file name
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   107
3350
5cd02aafc612 Engine:
smxx
parents: 3337
diff changeset
   108
filename:= ParamStr(1) + '/Screenshots/' + filename + '.bmp';
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   109
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   110
head[$02]:= (size + 54) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   111
head[$03]:= ((size + 54) shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   112
head[$04]:= ((size + 54) shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   113
head[$05]:= ((size + 54) shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   114
head[$12]:= cScreenWidth and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   115
head[$13]:= (cScreenWidth shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   116
head[$14]:= (cScreenWidth shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   117
head[$15]:= (cScreenWidth shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   118
head[$16]:= cScreenHeight and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   119
head[$17]:= (cScreenHeight shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   120
head[$18]:= (cScreenHeight shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   121
head[$19]:= (cScreenHeight shr 24) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   122
head[$22]:= size and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   123
head[$23]:= (size shr 8) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   124
head[$24]:= (size shr 16) and $ff;
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   125
head[$25]:= (size shr 24) and $ff;
2163
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   126
12730f5e79b9 koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents: 2162
diff changeset
   127
//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
   128
//glReadBuffer(GL_FRONT);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   129
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   130
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   131
{$I-}
2735
f2008d0ce3f8 Engine:
smxx
parents: 2726
diff changeset
   132
Assign(f, filename);
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   133
Rewrite(f, 1);
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   134
if IOResult = 0 then
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   135
    begin
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   136
    BlockWrite(f, head, sizeof(head));
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   137
    BlockWrite(f, p^, size);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   138
    Close(f);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   139
    end;
1080
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   140
{$I+}
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   141
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   142
FreeMem(p)
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   143
end;
8735046fc698 Repair screenshots capture on 'C' key press
unc0rr
parents: 1066
diff changeset
   144
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   145
function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   146
{* 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
   147
var convertedSurf: PSDL_Surface = nil;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   148
begin
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   149
    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
   150
    begin
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   151
        convertedSurf:= SDL_ConvertSurface(tmpsurf, @conversionFormat, SDL_SWSURFACE);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   152
        SDL_FreeSurface(tmpsurf);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   153
        exit(convertedSurf);
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   154
    end;
2705
2b5625c4ec16 fix a nasty 196 bytes memory leak in engine, plus other stuff for iphone frontend
koda
parents: 2699
diff changeset
   155
2947
803b277e4894 hate Smaxx (tested)
unc0rr
parents: 2915
diff changeset
   156
    exit(tmpsurf);
2619
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   157
end;
bc2786a00fb8 fix wrong ttf blending in ppc
koda
parents: 2607
diff changeset
   158
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   159
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   160
procedure initModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   161
begin
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   162
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   163
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
   164
procedure freeModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   165
begin
3626
19f78afa0188 fix the multitouch shooting and moving
koda
parents: 3613
diff changeset
   166
    recordFileName:= '';
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2698
diff changeset
   167
end;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   168
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 2
diff changeset
   169
end.