author | nemo |
Sat, 17 Sep 2011 10:11:56 -0400 | |
changeset 5950 | 7ce3946154f9 |
parent 5912 | d31eba29e706 |
child 6267 | be5d40bb1e86 |
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; |
2630 | 30 |
|
3038 | 31 |
procedure initModule; |
32 |
procedure freeModule; |
|
4 | 33 |
|
34 |
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
|
35 |
uses typinfo, sysutils, uVariables, uUtils; |
3756 | 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 | 38 |
var x, y: LongInt; |
39 |
begin |
|
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 | 42 |
SDL_GetMouseState(@x, @y); |
43 |
Inc(x, dx); |
|
44 |
Inc(y, dy); |
|
45 |
SDL_WarpMouse(x, y); |
|
46 |
end; |
|
47 |
||
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
48 |
// 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
|
49 |
function MakeScreenshot(filename: shortstring): Boolean; |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
50 |
var success: boolean; |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
51 |
p: Pointer; |
5910 | 52 |
size: QWord; |
2947 | 53 |
f: file; |
54 |
// Windows Bitmap Header |
|
55 |
head: array[0..53] of Byte = ( |
|
56 |
$42, $4D, // identifier ("BM") |
|
57 |
0, 0, 0, 0, // file size |
|
58 |
0, 0, 0, 0, // reserved |
|
59 |
54, 0, 0, 0, // starting offset |
|
60 |
40, 0, 0, 0, // header size |
|
61 |
0, 0, 0, 0, // width |
|
62 |
0, 0, 0, 0, // height |
|
63 |
1, 0, // color planes |
|
64 |
24, 0, // bit depth |
|
65 |
0, 0, 0, 0, // compression method (uncompressed) |
|
66 |
0, 0, 0, 0, // image size |
|
67 |
96, 0, 0, 0, // horizontal resolution |
|
68 |
96, 0, 0, 0, // vertical resolution |
|
69 |
0, 0, 0, 0, // number of colors (all) |
|
70 |
0, 0, 0, 0 // number of important colors |
|
71 |
); |
|
1080 | 72 |
begin |
3107 | 73 |
// flash |
74 |
ScreenFade:= sfFromWhite; |
|
75 |
ScreenFadeValue:= sfMax; |
|
76 |
ScreenFadeSpeed:= 5; |
|
77 |
||
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
|
78 |
size:= toPowerOf2(cScreenWidth) * toPowerOf2(cScreenHeight) * 3; |
1080 | 79 |
p:= GetMem(size); |
80 |
||
5910 | 81 |
// memory could not be allocated |
82 |
if p = nil then |
|
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
83 |
begin |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
84 |
AddFileLog('Error: Could not allocate memory for screenshot.'); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
85 |
exit(false); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
86 |
end; |
5910 | 87 |
|
2735 | 88 |
// update header information and file name |
89 |
||
5239 | 90 |
filename:= UserPathPrefix + '/Screenshots/' + filename + '.bmp'; |
2735 | 91 |
|
92 |
head[$02]:= (size + 54) and $ff; |
|
93 |
head[$03]:= ((size + 54) shr 8) and $ff; |
|
94 |
head[$04]:= ((size + 54) shr 16) and $ff; |
|
95 |
head[$05]:= ((size + 54) shr 24) and $ff; |
|
96 |
head[$12]:= cScreenWidth and $ff; |
|
97 |
head[$13]:= (cScreenWidth shr 8) and $ff; |
|
98 |
head[$14]:= (cScreenWidth shr 16) and $ff; |
|
99 |
head[$15]:= (cScreenWidth shr 24) and $ff; |
|
100 |
head[$16]:= cScreenHeight and $ff; |
|
101 |
head[$17]:= (cScreenHeight shr 8) and $ff; |
|
102 |
head[$18]:= (cScreenHeight shr 16) and $ff; |
|
103 |
head[$19]:= (cScreenHeight shr 24) and $ff; |
|
104 |
head[$22]:= size and $ff; |
|
105 |
head[$23]:= (size shr 8) and $ff; |
|
106 |
head[$24]:= (size shr 16) and $ff; |
|
107 |
head[$25]:= (size shr 24) and $ff; |
|
2163
12730f5e79b9
koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents:
2162
diff
changeset
|
108 |
|
12730f5e79b9
koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents:
2162
diff
changeset
|
109 |
//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
|
110 |
//glReadBuffer(GL_FRONT); |
1080 | 111 |
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p); |
112 |
||
5910 | 113 |
{$IOCHECKS OFF} |
2735 | 114 |
Assign(f, filename); |
1080 | 115 |
Rewrite(f, 1); |
116 |
if IOResult = 0 then |
|
2947 | 117 |
begin |
118 |
BlockWrite(f, head, sizeof(head)); |
|
119 |
BlockWrite(f, p^, size); |
|
120 |
Close(f); |
|
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
121 |
success:= true; |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
122 |
end |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
123 |
else |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
124 |
begin |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
125 |
AddFileLog('Error: Could not write to ' + filename); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
126 |
success:= false; |
2947 | 127 |
end; |
5910 | 128 |
{$IOCHECKS ON} |
1080 | 129 |
|
5912
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
130 |
FreeMem(p, size); |
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
131 |
|
d31eba29e706
screenshots: display a msg on failure and log causative error
sheepluva
parents:
5911
diff
changeset
|
132 |
MakeScreenshot:= success; |
1080 | 133 |
end; |
134 |
||
5004
2efa6a414518
update some sdl-1.3 bindings (working up to rev 5296)
koda
parents:
4976
diff
changeset
|
135 |
// http://www.idevgames.com/forums/thread-5602-post-21860.html#pid21860 |
2619 | 136 |
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
|
137 |
var convertedSurf: PSDL_Surface; |
2619 | 138 |
begin |
5004
2efa6a414518
update some sdl-1.3 bindings (working up to rev 5296)
koda
parents:
4976
diff
changeset
|
139 |
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
|
140 |
(tmpsurf^.format^.bitsperpixel = 24) then |
4578 | 141 |
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
|
142 |
convertedSurf:= SDL_ConvertSurface(tmpsurf, conversionFormat, SDL_SWSURFACE); |
2947 | 143 |
SDL_FreeSurface(tmpsurf); |
144 |
exit(convertedSurf); |
|
4578 | 145 |
end; |
2705
2b5625c4ec16
fix a nasty 196 bytes memory leak in engine, plus other stuff for iphone frontend
koda
parents:
2699
diff
changeset
|
146 |
|
2947 | 147 |
exit(tmpsurf); |
2619 | 148 |
end; |
149 |
||
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
150 |
|
4413 | 151 |
function GetTeamStatString(p: PTeam): shortstring; |
152 |
var s: ansistring; |
|
2670 | 153 |
begin |
4413 | 154 |
s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':'; |
155 |
GetTeamStatString:= s; |
|
2670 | 156 |
end; |
2630 | 157 |
|
3038 | 158 |
procedure initModule; |
5052 | 159 |
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
|
160 |
begin |
5052 | 161 |
conversionFormat:= SDL_AllocFormat(SDL_PIXELFORMAT_ABGR8888); |
2699
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 | 164 |
procedure freeModule; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
165 |
begin |
3626 | 166 |
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
|
167 |
SDL_FreeFormat(conversionFormat); |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
168 |
end; |
4 | 169 |
|
170 |
end. |