author | unc0rr |
Thu, 03 May 2012 12:21:16 +0400 | |
changeset 7013 | 54db061b5710 |
parent 6992 | b8f3d8991e92 |
child 7043 | 7c080e5ac8d0 |
permissions | -rw-r--r-- |
4 | 1 |
(* |
6952 | 2 |
* Hedgewars, a free turn based strategy game |
3 |
* Copyright (c) 2004-2012 Andrey Korotaev <unC0Rr@gmail.com> |
|
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 |
|
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 | 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 | 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 | 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 | 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 | 38 |
|
39 |
implementation |
|
6881 | 40 |
uses typinfo, sysutils, uVariables, uUtils |
41 |
{$IFDEF PNG_SCREENSHOTS}, PNGh, png {$ENDIF} |
|
42 |
{$IFNDEF USE_SDLTHREADS} {$IFDEF UNIX}, cthreads{$ENDIF} {$ENDIF}; |
|
43 |
||
44 |
type PScreenshot = ^TScreenshot; |
|
45 |
TScreenshot = record |
|
46 |
buffer: PByte; |
|
47 |
filename: shortstring; |
|
48 |
width, height: LongInt; |
|
49 |
size: QWord; |
|
50 |
end; |
|
3756 | 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 | 53 |
var x, y: LongInt; |
54 |
begin |
|
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 | 57 |
SDL_GetMouseState(@x, @y); |
58 |
Inc(x, dx); |
|
59 |
Inc(y, dy); |
|
60 |
SDL_WarpMouse(x, y); |
|
61 |
end; |
|
62 |
||
6881 | 63 |
{$IFDEF PNG_SCREENSHOTS} |
64 |
// this funtion will be executed in separate thread |
|
65 |
function SaveScreenshot(screenshot: pointer): PtrInt; |
|
66 |
var i: LongInt; |
|
67 |
png_ptr: ^png_struct; |
|
68 |
info_ptr: ^png_info; |
|
2947 | 69 |
f: file; |
6881 | 70 |
image: PScreenshot; |
71 |
begin |
|
72 |
image:= PScreenshot(screenshot); |
|
73 |
||
74 |
png_ptr := png_create_write_struct(png_get_libpng_ver(nil), nil, nil, nil); |
|
75 |
if png_ptr = nil then |
|
76 |
begin |
|
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 | 80 |
end; |
81 |
||
82 |
info_ptr := png_create_info_struct(png_ptr); |
|
83 |
if info_ptr = nil then |
|
84 |
begin |
|
85 |
png_destroy_write_struct(@png_ptr, nil); |
|
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 | 89 |
end; |
90 |
||
91 |
{$IOCHECKS OFF} |
|
92 |
Assign(f, image^.filename); |
|
93 |
Rewrite(f, 1); |
|
94 |
if IOResult = 0 then |
|
95 |
begin |
|
96 |
png_init_pascal_io(png_ptr,@f); |
|
97 |
png_set_IHDR(png_ptr, info_ptr, image^.width, image^.height, |
|
98 |
8, // bit depth |
|
99 |
PNG_COLOR_TYPE_RGBA, PNG_INTERLACE_NONE, |
|
100 |
PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT); |
|
101 |
png_write_info(png_ptr, info_ptr); |
|
102 |
// glReadPixels and libpng number rows in different order |
|
103 |
for i:= image^.height-1 downto 0 do |
|
104 |
png_write_row(png_ptr, image^.buffer + i*4*image^.width); |
|
105 |
png_write_end(png_ptr, info_ptr); |
|
106 |
Close(f); |
|
107 |
end; |
|
108 |
{$IOCHECKS ON} |
|
109 |
||
110 |
// free everything |
|
111 |
png_destroy_write_struct(@png_ptr, @info_ptr); |
|
112 |
FreeMem(image^.buffer, image^.size); |
|
113 |
Dispose(image); |
|
114 |
SaveScreenshot:= 0; |
|
115 |
end; |
|
116 |
||
117 |
{$ELSE} // no PNG_SCREENSHOTS |
|
118 |
||
119 |
// this funtion will be executed in separate thread |
|
120 |
function SaveScreenshot(screenshot: pointer): PtrInt; |
|
121 |
var f: file; |
|
2947 | 122 |
// Windows Bitmap Header |
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 | 139 |
); |
6881 | 140 |
image: PScreenshot; |
141 |
size: QWord; |
|
142 |
begin |
|
143 |
image:= PScreenshot(screenshot); |
|
144 |
||
145 |
size:= image^.Width*image^.Height*4; |
|
146 |
||
147 |
head[$02]:= (size + 54) and $ff; |
|
148 |
head[$03]:= ((size + 54) shr 8) and $ff; |
|
149 |
head[$04]:= ((size + 54) shr 16) and $ff; |
|
150 |
head[$05]:= ((size + 54) shr 24) and $ff; |
|
151 |
head[$12]:= image^.Width and $ff; |
|
152 |
head[$13]:= (image^.Width shr 8) and $ff; |
|
153 |
head[$14]:= (image^.Width shr 16) and $ff; |
|
154 |
head[$15]:= (image^.Width shr 24) and $ff; |
|
155 |
head[$16]:= image^.Height and $ff; |
|
156 |
head[$17]:= (image^.Height shr 8) and $ff; |
|
157 |
head[$18]:= (image^.Height shr 16) and $ff; |
|
158 |
head[$19]:= (image^.Height shr 24) and $ff; |
|
159 |
head[$22]:= size and $ff; |
|
160 |
head[$23]:= (size shr 8) and $ff; |
|
161 |
head[$24]:= (size shr 16) and $ff; |
|
162 |
head[$25]:= (size shr 24) and $ff; |
|
163 |
||
164 |
{$IOCHECKS OFF} |
|
165 |
Assign(f, image^.filename); |
|
166 |
Rewrite(f, 1); |
|
167 |
if IOResult = 0 then |
|
168 |
begin |
|
169 |
BlockWrite(f, head, sizeof(head)); |
|
170 |
BlockWrite(f, image^.buffer^, size); |
|
171 |
Close(f); |
|
172 |
end |
|
173 |
else |
|
174 |
begin |
|
175 |
//AddFileLog('Error: Could not write to ' + filename); |
|
176 |
end; |
|
177 |
{$IOCHECKS ON} |
|
178 |
||
179 |
// free everything |
|
180 |
FreeMem(image^.buffer, image^.size); |
|
181 |
Dispose(image); |
|
182 |
SaveScreenshot:= 0; |
|
183 |
end; |
|
184 |
||
185 |
{$ENDIF} // no PNG_SCREENSHOTS |
|
186 |
||
187 |
// captures and saves the screen. returns true on success. |
|
188 |
function MakeScreenshot(filename: shortstring): Boolean; |
|
189 |
var p: Pointer; |
|
190 |
size: QWord; |
|
191 |
image: PScreenshot; |
|
192 |
format: GLenum; |
|
193 |
ext: string[4]; |
|
1080 | 194 |
begin |
3107 | 195 |
// flash |
196 |
ScreenFade:= sfFromWhite; |
|
197 |
ScreenFadeValue:= sfMax; |
|
198 |
ScreenFadeSpeed:= 5; |
|
199 |
||
6881 | 200 |
{$IFDEF PNG_SCREENSHOTS} |
201 |
format:= GL_RGBA; |
|
202 |
ext:= '.png'; |
|
203 |
{$ELSE} |
|
204 |
format:= GL_BGRA; |
|
205 |
ext:= '.bmp'; |
|
206 |
{$ENDIF} |
|
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 | 209 |
p:= GetMem(size); // will be freed in SaveScreenshot() |
1080 | 210 |
|
5910 | 211 |
// memory could not be allocated |
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 | 218 |
|
6881 | 219 |
// read pixel from the front buffer |
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 | 222 |
// allocate and fill structure that will be passed to new thread |
223 |
New(image); // will be disposed in SaveScreenshot() |
|
224 |
image^.filename:= UserPathPrefix + '/Screenshots/' + filename + ext; |
|
225 |
image^.width:= cScreenWidth; |
|
226 |
image^.height:= cScreenHeight; |
|
227 |
image^.size:= size; |
|
228 |
image^.buffer:= p; |
|
1080 | 229 |
|
6881 | 230 |
{$IFDEF USE_SDLTHREADS} |
231 |
SDL_CreateThread(@SaveScreenshot{$IFDEF SDL13}, nil{$ENDIF}, image); |
|
232 |
{$ELSE} |
|
233 |
BeginThread(@SaveScreenshot, image); |
|
234 |
{$ENDIF} |
|
235 |
MakeScreenshot:= true; // possibly it is not true but we will not wait for thread to terminate |
|
1080 | 236 |
end; |
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 | 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 | 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 | 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 | 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 | 249 |
end; |
2619 | 250 |
end; |
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 | 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 | 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 | 258 |
SDL_RectMake.x:= x; |
259 |
SDL_RectMake.y:= y; |
|
260 |
SDL_RectMake.w:= width; |
|
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 | 264 |
function GetTeamStatString(p: PTeam): shortstring; |
265 |
var s: ansistring; |
|
2670 | 266 |
begin |
4413 | 267 |
s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':'; |
268 |
GetTeamStatString:= s; |
|
2670 | 269 |
end; |
2630 | 270 |
|
3038 | 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 | 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 | 277 |
procedure freeModule; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
278 |
begin |
3626 | 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 | 282 |
|
283 |
end. |