author | koda |
Fri, 17 Feb 2012 12:08:01 +0100 | |
changeset 6695 | 32de8965c62c |
parent 6267 | be5d40bb1e86 |
child 6700 | e04da46ee43c |
permissions | -rw-r--r-- |
4 | 1 |
(* |
2947 | 2 |
* Hedgewars, a free turn based strategy game |
4976 | 3 |
* Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com> |
2947 | 4 |
* |
5 |
* This program is free software; you can redistribute it and/or modify |
|
6 |
* it under the terms of the GNU General Public License as published by |
|
7 |
* the Free Software Foundation; version 2 of the License |
|
8 |
* |
|
9 |
* This program is distributed in the hope that it will be useful, |
|
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
12 |
* GNU General Public License for more details. |
|
13 |
* |
|
14 |
* You should have received a copy of the GNU General Public License |
|
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 |
|
17 |
*) |
|
4 | 18 |
|
2630 | 19 |
{$INCLUDE "options.inc"} |
20 |
||
4 | 21 |
unit uMisc; |
22 |
interface |
|
2630 | 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 | 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 | 27 |
function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface; |
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
28 |
function MakeScreenshot(filename: shortstring): boolean; |
4413 | 29 |
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
|
30 |
{$IFDEF SDL13} |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
31 |
function SDL_RectMake(x, y, width, height: LongInt): TSDL_Rect; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
32 |
{$ELSE} |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
33 |
function SDL_RectMake(x, y: SmallInt; width, height: Word): TSDL_Rect; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
34 |
{$ENDIF} |
3038 | 35 |
procedure initModule; |
36 |
procedure freeModule; |
|
4 | 37 |
|
38 |
implementation |
|
5911
4a28d0ae9624
based on the fact that the crash never seemed to have happened with default screen resolutions and also inspired by the only other getmem usage in the code I came up with this simple solution which seems to work just fine.
sheepluva
parents:
5910
diff
changeset
|
39 |
uses typinfo, sysutils, uVariables, uUtils; |
3756 | 40 |
|
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
|
41 |
procedure movecursor(dx, dy: LongInt); |
2428 | 42 |
var x, y: LongInt; |
43 |
begin |
|
44 |
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
|
45 |
|
2428 | 46 |
SDL_GetMouseState(@x, @y); |
47 |
Inc(x, dx); |
|
48 |
Inc(y, dy); |
|
49 |
SDL_WarpMouse(x, y); |
|
50 |
end; |
|
51 |
||
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
52 |
// captures and saves the screen. returns true on success. |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
53 |
function MakeScreenshot(filename: shortstring): Boolean; |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
54 |
var success: boolean; |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
55 |
p: Pointer; |
5910 | 56 |
size: QWord; |
2947 | 57 |
f: file; |
58 |
// Windows Bitmap Header |
|
59 |
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
|
60 |
$42, $4D, // identifier ("BM") |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
61 |
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
|
62 |
0, 0, 0, 0, // reserved |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
63 |
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
|
64 |
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
|
65 |
0, 0, 0, 0, // width |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
66 |
0, 0, 0, 0, // height |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
67 |
1, 0, // color planes |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
68 |
32, 0, // bit depth |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
69 |
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
|
70 |
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
|
71 |
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
|
72 |
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
|
73 |
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
|
74 |
0, 0, 0, 0 // number of important colors |
2947 | 75 |
); |
1080 | 76 |
begin |
3107 | 77 |
// flash |
78 |
ScreenFade:= sfFromWhite; |
|
79 |
ScreenFadeValue:= sfMax; |
|
80 |
ScreenFadeSpeed:= 5; |
|
81 |
||
6267
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
82 |
size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 4; |
1080 | 83 |
p:= GetMem(size); |
84 |
||
5910 | 85 |
// memory could not be allocated |
86 |
if p = nil then |
|
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
87 |
begin |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
88 |
AddFileLog('Error: Could not allocate memory for screenshot.'); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
89 |
exit(false); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
90 |
end; |
5910 | 91 |
|
2735 | 92 |
// update header information and file name |
5239 | 93 |
filename:= UserPathPrefix + '/Screenshots/' + filename + '.bmp'; |
2735 | 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; |
|
2163
12730f5e79b9
koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents:
2162
diff
changeset
|
111 |
|
6267
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
112 |
// read pixel from the front buffer |
be5d40bb1e86
make screenshots with 32bits of depths, so that they are more opengles friendly
koda
parents:
5912
diff
changeset
|
113 |
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGRA, GL_UNSIGNED_BYTE, p); |
1080 | 114 |
|
5910 | 115 |
{$IOCHECKS OFF} |
2735 | 116 |
Assign(f, filename); |
1080 | 117 |
Rewrite(f, 1); |
118 |
if IOResult = 0 then |
|
2947 | 119 |
begin |
120 |
BlockWrite(f, head, sizeof(head)); |
|
121 |
BlockWrite(f, p^, size); |
|
122 |
Close(f); |
|
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
123 |
success:= true; |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
124 |
end |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
125 |
else |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
126 |
begin |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
127 |
AddFileLog('Error: Could not write to ' + filename); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
128 |
success:= false; |
2947 | 129 |
end; |
5910 | 130 |
{$IOCHECKS ON} |
1080 | 131 |
|
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
132 |
FreeMem(p, size); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
133 |
MakeScreenshot:= success; |
1080 | 134 |
end; |
135 |
||
5004
2efa6a414518
update some sdl-1.3 bindings (working up to rev 5296)
koda
parents:
4976
diff
changeset
|
136 |
// http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860 |
2619 | 137 |
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
|
138 |
var convertedSurf: PSDL_Surface; |
2619 | 139 |
begin |
5004
2efa6a414518
update some sdl-1.3 bindings (working up to rev 5296)
koda
parents:
4976
diff
changeset
|
140 |
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
|
141 |
(tmpsurf^.format^.bitsperpixel = 24) then |
4578 | 142 |
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
|
143 |
convertedSurf:= SDL_ConvertSurface(tmpsurf, conversionFormat, SDL_SWSURFACE); |
2947 | 144 |
SDL_FreeSurface(tmpsurf); |
145 |
exit(convertedSurf); |
|
4578 | 146 |
end; |
2705
2b5625c4ec16
fix a nasty 196 bytes memory leak in engine, plus other stuff for iphone frontend
koda
parents:
2699
diff
changeset
|
147 |
|
2947 | 148 |
exit(tmpsurf); |
2619 | 149 |
end; |
150 |
||
6695
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
151 |
{$IFDEF SDL13} |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
152 |
function SDL_RectMake(x, y, width, height: LongInt): TSDL_Rect; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
153 |
{$ELSE} |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
154 |
function SDL_RectMake(x, y: SmallInt; width, height: Word): TSDL_Rect; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
155 |
{$ENDIF} |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
156 |
var rect: TSDL_Rect; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
157 |
begin |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
158 |
rect.x:= x; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
159 |
rect.y:= y; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
160 |
rect.w:= width; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
161 |
rect.h:= height; |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
162 |
exit(rect); |
32de8965c62c
refactored a few types involved in the touch interface and corrected a few invisible mistakes
koda
parents:
6267
diff
changeset
|
163 |
end; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
164 |
|
4413 | 165 |
function GetTeamStatString(p: PTeam): shortstring; |
166 |
var s: ansistring; |
|
2670 | 167 |
begin |
4413 | 168 |
s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':'; |
169 |
GetTeamStatString:= s; |
|
2670 | 170 |
end; |
2630 | 171 |
|
3038 | 172 |
procedure initModule; |
5052 | 173 |
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
|
174 |
begin |
5052 | 175 |
conversionFormat:= SDL_AllocFormat(SDL_PIXELFORMAT_ABGR8888); |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
176 |
end; |
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
177 |
|
3038 | 178 |
procedure freeModule; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
179 |
begin |
3626 | 180 |
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
|
181 |
SDL_FreeFormat(conversionFormat); |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
182 |
end; |
4 | 183 |
|
184 |
end. |