author | koda |
Wed, 02 Mar 2011 00:27:20 +0100 | |
changeset 4976 | 088d40d8aba2 |
parent 4812 | f924be23ffb4 |
child 5004 | 2efa6a414518 |
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 |
|
4374 | 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; |
2735 | 28 |
procedure MakeScreenshot(filename: shortstring); |
4413 | 29 |
function GetTeamStatString(p: PTeam): shortstring; |
2630 | 30 |
|
3038 | 31 |
procedure initModule; |
32 |
procedure freeModule; |
|
4 | 33 |
|
34 |
implementation |
|
4377 | 35 |
uses typinfo, sysutils, uVariables; |
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 |
||
949 | 48 |
|
2735 | 49 |
procedure MakeScreenshot(filename: shortstring); |
1080 | 50 |
var p: Pointer; |
2947 | 51 |
size: Longword; |
52 |
f: file; |
|
53 |
// Windows Bitmap Header |
|
54 |
head: array[0..53] of Byte = ( |
|
55 |
$42, $4D, // identifier ("BM") |
|
56 |
0, 0, 0, 0, // file size |
|
57 |
0, 0, 0, 0, // reserved |
|
58 |
54, 0, 0, 0, // starting offset |
|
59 |
40, 0, 0, 0, // header size |
|
60 |
0, 0, 0, 0, // width |
|
61 |
0, 0, 0, 0, // height |
|
62 |
1, 0, // color planes |
|
63 |
24, 0, // bit depth |
|
64 |
0, 0, 0, 0, // compression method (uncompressed) |
|
65 |
0, 0, 0, 0, // image size |
|
66 |
96, 0, 0, 0, // horizontal resolution |
|
67 |
96, 0, 0, 0, // vertical resolution |
|
68 |
0, 0, 0, 0, // number of colors (all) |
|
69 |
0, 0, 0, 0 // number of important colors |
|
70 |
); |
|
1080 | 71 |
begin |
3107 | 72 |
// flash |
73 |
ScreenFade:= sfFromWhite; |
|
74 |
ScreenFadeValue:= sfMax; |
|
75 |
ScreenFadeSpeed:= 5; |
|
76 |
||
1080 | 77 |
size:= cScreenWidth * cScreenHeight * 3; |
78 |
p:= GetMem(size); |
|
79 |
||
2735 | 80 |
// update header information and file name |
81 |
||
3350 | 82 |
filename:= ParamStr(1) + '/Screenshots/' + filename + '.bmp'; |
2735 | 83 |
|
84 |
head[$02]:= (size + 54) and $ff; |
|
85 |
head[$03]:= ((size + 54) shr 8) and $ff; |
|
86 |
head[$04]:= ((size + 54) shr 16) and $ff; |
|
87 |
head[$05]:= ((size + 54) shr 24) and $ff; |
|
88 |
head[$12]:= cScreenWidth and $ff; |
|
89 |
head[$13]:= (cScreenWidth shr 8) and $ff; |
|
90 |
head[$14]:= (cScreenWidth shr 16) and $ff; |
|
91 |
head[$15]:= (cScreenWidth shr 24) and $ff; |
|
92 |
head[$16]:= cScreenHeight and $ff; |
|
93 |
head[$17]:= (cScreenHeight shr 8) and $ff; |
|
94 |
head[$18]:= (cScreenHeight shr 16) and $ff; |
|
95 |
head[$19]:= (cScreenHeight shr 24) and $ff; |
|
96 |
head[$22]:= size and $ff; |
|
97 |
head[$23]:= (size shr 8) and $ff; |
|
98 |
head[$24]:= (size shr 16) and $ff; |
|
99 |
head[$25]:= (size shr 24) and $ff; |
|
2163
12730f5e79b9
koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents:
2162
diff
changeset
|
100 |
|
12730f5e79b9
koda's patch fixing some iphone port troubles (color, mouse)
unc0rr
parents:
2162
diff
changeset
|
101 |
//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
|
102 |
//glReadBuffer(GL_FRONT); |
1080 | 103 |
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p); |
104 |
||
105 |
{$I-} |
|
2735 | 106 |
Assign(f, filename); |
1080 | 107 |
Rewrite(f, 1); |
108 |
if IOResult = 0 then |
|
2947 | 109 |
begin |
110 |
BlockWrite(f, head, sizeof(head)); |
|
111 |
BlockWrite(f, p^, size); |
|
112 |
Close(f); |
|
113 |
end; |
|
1080 | 114 |
{$I+} |
115 |
||
116 |
FreeMem(p) |
|
117 |
end; |
|
118 |
||
2619 | 119 |
function doSurfaceConversion(tmpsurf: PSDL_Surface): PSDL_Surface; |
120 |
{* for more information http://www.idevgames.com/forum/showpost.php?p=85864&postcount=7 *} |
|
121 |
var convertedSurf: PSDL_Surface = nil; |
|
122 |
begin |
|
2947 | 123 |
if (tmpsurf^.format^.bitsperpixel = 24) or ((tmpsurf^.format^.bitsperpixel = 32) and (tmpsurf^.format^.rshift > tmpsurf^.format^.bshift)) then |
4578 | 124 |
begin |
2947 | 125 |
convertedSurf:= SDL_ConvertSurface(tmpsurf, @conversionFormat, SDL_SWSURFACE); |
126 |
SDL_FreeSurface(tmpsurf); |
|
127 |
exit(convertedSurf); |
|
4578 | 128 |
end; |
2705
2b5625c4ec16
fix a nasty 196 bytes memory leak in engine, plus other stuff for iphone frontend
koda
parents:
2699
diff
changeset
|
129 |
|
2947 | 130 |
exit(tmpsurf); |
2619 | 131 |
end; |
132 |
||
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
133 |
|
4413 | 134 |
function GetTeamStatString(p: PTeam): shortstring; |
135 |
var s: ansistring; |
|
2670 | 136 |
begin |
4413 | 137 |
s:= p^.TeamName + ':' + IntToStr(p^.TeamHealth) + ':'; |
138 |
GetTeamStatString:= s; |
|
2670 | 139 |
end; |
2630 | 140 |
|
3038 | 141 |
procedure initModule; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
142 |
begin |
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
143 |
end; |
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
144 |
|
3038 | 145 |
procedure freeModule; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
146 |
begin |
3626 | 147 |
recordFileName:= ''; |
2699
249adefa9c1c
replace initialization/finalization statements with custom init functions
koda
parents:
2698
diff
changeset
|
148 |
end; |
4 | 149 |
|
150 |
end. |