author  unc0rr 
Fri, 17 Apr 2009 17:02:24 +0000  
changeset 2000  f9f47e681aad 
parent 1916  9c3d0e3df6bb 
child 2008  fc2fb5c938c3 
permissions  rwrr 
4  1 
(* 
1066  2 
* Hedgewars, a free turn based strategy game 
883  3 
* Copyright (c) 20042008 Andrey Korotaev <unC0Rr@gmail.com> 
4  4 
* 
183  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 

4  8 
* 
183  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. 

4  13 
* 
183  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 021111307, USA 

4  17 
*) 
18 

19 
unit uMisc; 

20 
interface 

1906  21 
uses uConsts, SDLh, 
22 
{$IFDEF IPHONE} 

23 
gles11, 

24 
{$ELSE} 

25 
GL, 

26 
{$ENDIF} 

27 
uFloat; 

4  28 
{$INCLUDE options.inc} 
1054  29 
var 
30 
isCursorVisible : boolean = false; 

31 
isTerminated : boolean = false; 

32 
isInLag : boolean = false; 

33 
isPaused : boolean = false; 

34 
isSoundEnabled : boolean = true; 

1128  35 
isMusicEnabled : boolean = false; 
1054  36 
isSEBackup : boolean = true; 
37 
isInMultiShoot : boolean = false; 

38 
isSpeed : boolean = false; 

4  39 

1560
e140bc57ff68
Quick replay round to spectators until current move
unc0rr
parents:
1530
diff
changeset

40 
fastUntilLag : boolean = false; 
e140bc57ff68
Quick replay round to spectators until current move
unc0rr
parents:
1530
diff
changeset

41 

1054  42 
GameState : TGameState = Low(TGameState); 
43 
GameType : TGameType = gmtLocal; 

44 
GameFlags : Longword = 0; 

45 
TurnTimeLeft : Longword = 0; 

1784  46 
cSuddenDTurns : LongInt = 15; 
1895  47 
cDamagePercent : LongInt = 100; 
1797  48 
cTemplateFilter : LongInt = 0; 
1888
e76274ce7365
Add an ability to run engine without IPC connection.
unc0rr
parents:
1861
diff
changeset

49 

1054  50 
cHedgehogTurnTime: Longword = 45000; 
51 
cMaxAIThinkTime : Longword = 9000; 

4  52 

1054  53 
cCloudsNumber : LongInt = 9; 
54 
cScreenWidth : LongInt = 1024; 

55 
cScreenHeight : LongInt = 768; 

1121
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1080
diff
changeset

56 
cInitWidth : LongInt = 1024; 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1080
diff
changeset

57 
cInitHeight : LongInt = 768; 
1054  58 
cBits : LongInt = 16; 
59 
cBitsStr : string[2] = '16'; 

60 
cTagsMask : byte = 7; 

74  61 

1760  62 
cWaterLine : LongInt = LAND_HEIGHT; 
1054  63 
cVisibleWater : LongInt = 128; 
64 
cGearScrEdgesDist: LongInt = 240; 

1530  65 
cCursorEdgesDist : LongInt = 100; 
1054  66 
cTeamHealthWidth : LongInt = 128; 
67 
cAltDamage : boolean = true; 

4  68 

1054  69 
GameTicks : LongWord = 0; 
70 

71 
cSkyColor : Longword = 0; 

72 
cWhiteColor : Longword = $FFFFFFFF; 

73 
cColorNearBlack : Longword = $FF000010; 

74 
cExplosionBorderColor : LongWord = $808080; 

4  75 

1054  76 
cShowFPS : boolean = true; 
1298  77 
cCaseFactor : Longword = 5; {0..9} 
1054  78 
cLandAdditions: Longword = 4; 
1888
e76274ce7365
Add an ability to run engine without IPC connection.
unc0rr
parents:
1861
diff
changeset

79 
cFullScreen : boolean = false; 
1812  80 
cReducedQuality : boolean = false; 
1054  81 
cLocaleFName : shortstring = 'en.txt'; 
82 
cSeed : shortstring = ''; 

83 
cInitVolume : LongInt = 128; 

84 
cVolumeDelta : LongInt = 0; 

85 
cTimerInterval : Longword = 5; 

86 
cHasFocus : boolean = true; 

1057  87 
cInactDelay : Longword = 1250; 
4  88 

1054  89 
bBetweenTurns: boolean = false; 
1055
9af540b23409
Water rises after 25 mins of round, health is decreased after 20 mins
unc0rr
parents:
1054
diff
changeset

90 
cHealthDecrease: LongWord = 0; 
9af540b23409
Water rises after 25 mins of round, health is decreased after 20 mins
unc0rr
parents:
1054
diff
changeset

91 
bWaterRising : Boolean = false; 
4  92 

614  93 
{$WARNINGS OFF} 
1124  94 
cAirPlaneSpeed: hwFloat = (isNegative: false; QWordValue: 3006477107); // 1.4 
1054  95 
cBombsSpeed : hwFloat = (isNegative: false; QWordValue: 429496729); 
614  96 
{$WARNINGS ON} 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
539
diff
changeset

97 

4  98 
var 
1054  99 
cSendEmptyPacketTime : LongWord = 2000; 
100 
cSendCursorPosTime : LongWord = 50; 

101 
ShowCrosshair : boolean; 

102 
cDrownSpeed, 

103 
cMaxWindSpeed, 

104 
cWindSpeed, 

105 
cGravity: hwFloat; 

1849  106 
cDamageModifier: hwFloat; 
1854  107 
cLaserSighting: boolean; 
4  108 

1054  109 
flagMakeCapture: boolean = false; 
4  110 

1054  111 
InitStepsFlags: Longword = 0; 
55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
53
diff
changeset

112 

1054  113 
RealTicks: Longword = 0; 
836  114 

1054  115 
AttackBar: LongInt = 0; // 0  none, 1  just bar at the rightdown corner, 2  like in WWP 
4  116 

1911  117 
type HwColor3f = record 
118 
r, g, b: byte 

119 
end; 

120 

121 
var WaterColorArray: array[0..3] of HwColor3f; 

122 

371  123 
function hwSign(r: hwFloat): LongInt; 
802
ed5450a89b96
Start implementing 'visual gears'  gears, that don't need to be synchronized (clouds and flakes)
unc0rr
parents:
788
diff
changeset

124 
function Min(a, b: LongInt): LongInt; 
371  125 
function Max(a, b: LongInt): LongInt; 
351  126 
procedure OutError(Msg: String; isFatalError: boolean); 
4  127 
procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean); 
128 
procedure SDLTry(Assert: boolean; isFatal: boolean); 

316  129 
function IntToStr(n: LongInt): shortstring; 
351  130 
function FloatToStr(n: hwFloat): shortstring; 
775  131 
function DxDy2Angle(const _dY, _dX: hwFloat): GLfloat; 
371  132 
function DxDy2Angle32(const _dY, _dX: hwFloat): LongInt; 
133 
function DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt; 

4  134 
procedure AdjustColor(var Color: Longword); 
135 
{$IFDEF DEBUGFILE} 

136 
procedure AddFileLog(s: shortstring); 

24  137 
function RectToStr(Rect: TSDL_Rect): shortstring; 
4  138 
{$ENDIF} 
208  139 
procedure SetKB(n: Longword); 
140 
procedure SendKB; 

351  141 
procedure SetLittle(var r: hwFloat); 
306  142 
procedure SendStat(sit: TStatInfoType; s: shortstring); 
753  143 
function Str2PChar(const s: shortstring): PChar; 
1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

144 
function NewTexture(width, height: Longword; buf: Pointer): PTexture; 
755  145 
function Surface2Tex(surf: PSDL_Surface): PTexture; 
759  146 
procedure FreeTexture(tex: PTexture); 
945
4ead9cde4e14
 Start chat implementation: chat strings are on the screen
unc0rr
parents:
916
diff
changeset

147 
function toPowerOf2(i: Longword): Longword; 
949  148 
function DecodeBase64(s: shortstring): shortstring; 
1080  149 
procedure MakeScreenshot(s: shortstring); 
1861  150 
function modifyDamage(dmg: Longword): Longword; 
4  151 

152 
var CursorPoint: TPoint; 

153 
TargetPoint: TPoint = (X: NoPointX; Y: 0); 

154 

155 
implementation 

1896  156 
uses uConsole, uStore, uIO, Math, uRandom; 
208  157 
var KBnum: Longword = 0; 
4  158 
{$IFDEF DEBUGFILE} 
159 
var f: textfile; 

160 
{$ENDIF} 

161 

371  162 
function hwSign(r: hwFloat): LongInt; 
4  163 
begin 
351  164 
if r.isNegative then hwSign:= 1 else hwSign:= 1 
4  165 
end; 
166 

371  167 
function Min(a, b: LongInt): LongInt; 
4  168 
begin 
351  169 
if a < b then Min:= a else Min:= b 
4  170 
end; 
171 

371  172 
function Max(a, b: LongInt): LongInt; 
4  173 
begin 
351  174 
if a > b then Max:= a else Max:= b 
4  175 
end; 
176 

351  177 
procedure OutError(Msg: String; isFatalError: boolean); 
4  178 
begin 
179 
{$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF} 

53  180 
WriteLnToConsole(Msg); 
4  181 
if isFatalError then 
182 
begin 

53  183 
SendIPC('E' + GetLastConsoleLine); 
4  184 
SDL_Quit; 
185 
halt(1) 

53  186 
end 
4  187 
end; 
188 

189 
procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean); 

190 
begin 

70  191 
if not Assert then OutError(Msg, isFatal) 
4  192 
end; 
193 

194 
procedure SDLTry(Assert: boolean; isFatal: boolean); 

195 
begin 

196 
if not Assert then OutError(SDL_GetError, isFatal) 

197 
end; 

198 

188  199 
procedure AdjustColor(var Color: Longword); 
4  200 
begin 
201 
Color:= SDL_MapRGB(PixelFormat, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF) 

202 
end; 

203 

316  204 
function IntToStr(n: LongInt): shortstring; 
4  205 
begin 
351  206 
str(n, IntToStr) 
4  207 
end; 
208 

351  209 
function FloatToStr(n: hwFloat): shortstring; 
4  210 
begin 
1346  211 
FloatToStr:= cstr(n) + '_' + inttostr(Lo(n.QWordValue)) 
4  212 
end; 
213 

775  214 
function DxDy2Angle(const _dY, _dX: hwFloat): GLfloat; 
215 
var dY, dX: Extended; 

216 
begin 

217 
dY:= _dY.QWordValue / $100000000; 

218 
if _dY.isNegative then dY:=  dY; 

219 
dX:= _dX.QWordValue / $100000000; 

220 
if _dX.isNegative then dX:=  dX; 

221 
DxDy2Angle:= arctan2(dY, dX) * 180 / pi 

222 
end; 

223 

371  224 
function DxDy2Angle32(const _dY, _dX: hwFloat): LongInt; 
100  225 
const _16divPI: Extended = 16/pi; 
370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

226 
var dY, dX: Extended; 
100  227 
begin 
370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

228 
dY:= _dY.QWordValue / $100000000; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

229 
if _dY.isNegative then dY:=  dY; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

230 
dX:= _dX.QWordValue / $100000000; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

231 
if _dX.isNegative then dX:=  dX; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

232 
DxDy2Angle32:= trunc(arctan2(dY, dX) * _16divPI) and $1f 
4  233 
end; 
234 

371  235 
function DxDy2AttackAngle(const _dY, _dX: hwFloat): LongInt; 
100  236 
const MaxAngleDivPI: Extended = cMaxAngle/pi; 
370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

237 
var dY, dX: Extended; 
100  238 
begin 
370
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

239 
dY:= _dY.QWordValue / $100000000; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

240 
if _dY.isNegative then dY:=  dY; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

241 
dX:= _dX.QWordValue / $100000000; 
c75410fe3133
 Repair bots: they can walk and use bazooka, possible cannot jump (why?)
unc0rr
parents:
351
diff
changeset

242 
if _dX.isNegative then dX:=  dX; 
438  243 
DxDy2AttackAngle:= trunc(arctan2(dY, dX) * MaxAngleDivPI) 
100  244 
end; 
4  245 

208  246 
procedure SetKB(n: Longword); 
247 
begin 

248 
KBnum:= n 

249 
end; 

250 

251 
procedure SendKB; 

252 
var s: shortstring; 

253 
begin 

254 
if KBnum <> 0 then 

255 
begin 

256 
s:= 'K' + inttostr(KBnum); 

257 
SendIPCRaw(@s, Length(s) + 1) 

258 
end 

259 
end; 

260 

351  261 
procedure SetLittle(var r: hwFloat); 
300  262 
begin 
553
5478386d935f
 Switch to bazooka (or whatever) after use of some weapon (fixes problem with bots)
unc0rr
parents:
543
diff
changeset

263 
r:= SignAs(cLittle, r) 
300  264 
end; 
265 

337  266 
procedure SendStat(sit: TStatInfoType; s: shortstring); 
1625  267 
const stc: array [TStatInfoType] of char = 'rDkKH'; 
337  268 
begin 
269 
SendIPC('i' + stc[sit] + s) 

270 
end; 

271 

534  272 
function Str2PChar(const s: shortstring): PChar; 
351  273 
const CharArray: array[byte] of Char = ''; 
274 
begin 

275 
CharArray:= s; 

276 
CharArray[Length(s)]:= #0; 

277 
Str2PChar:= @CharArray 

278 
end; 

279 

771  280 
function isPowerOf2(i: Longword): boolean; 
281 
begin 

282 
if i = 0 then exit(true); 

283 
while (i and 1) = 0 do i:= i shr 1; 

284 
isPowerOf2:= (i = 1) 

285 
end; 

286 

287 
function toPowerOf2(i: Longword): Longword; 

288 
begin 

289 
toPowerOf2:= 1; 

290 
while (toPowerOf2 < i) do toPowerOf2:= toPowerOf2 shl 1 

291 
end; 

292 

1912
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

293 
procedure ResetVertexArrays(texture: PTexture); 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

294 
begin 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

295 
with texture^ do 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

296 
begin 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

297 
vb[0].X:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

298 
vb[0].Y:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

299 
vb[1].X:= w; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

300 
vb[1].Y:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

301 
vb[2].X:= w; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

302 
vb[2].Y:= h; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

303 
vb[3].X:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

304 
vb[3].Y:= h; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

305 

c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

306 
tb[0].X:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

307 
tb[0].Y:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

308 
tb[1].X:= rx; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

309 
tb[1].Y:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

310 
tb[2].X:= rx; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

311 
tb[2].Y:= ry; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

312 
tb[3].X:= 0; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

313 
tb[3].Y:= ry 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

314 
end; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

315 
end; 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

316 

1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

317 
function NewTexture(width, height: Longword; buf: Pointer): PTexture; 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

318 
begin 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

319 
new(NewTexture); 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

320 
NewTexture^.w:= width; 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

321 
NewTexture^.h:= height; 
1896  322 
NewTexture^.rx:= 1.0; 
323 
NewTexture^.ry:= 1.0; 

1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

324 

1912
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

325 
ResetVertexArrays(NewTexture); 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

326 

1180
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

327 
glGenTextures(1, @NewTexture^.id); 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

328 

e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

329 
glBindTexture(GL_TEXTURE_2D, NewTexture^.id); 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

330 

e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

331 
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, width, height, 0, GL_RGBA, GL_UNSIGNED_BYTE, buf); 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

332 

e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

333 
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

334 
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR) 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

335 
end; 
e56317fdf78d
Start implementing support for 32bit sprites concerned in map generation process.
unc0rr
parents:
1128
diff
changeset

336 

755  337 
function Surface2Tex(surf: PSDL_Surface): PTexture; 
753  338 
var mode: LongInt; 
1896  339 
tw, th, x, y: Longword; 
340 
tmpp: pointer; 

341 
fromP4, toP4: PLongWordArray; 

342 
fromP1, toP1: PByteArray; 

753  343 
begin 
755  344 
new(Surface2Tex); 
345 
Surface2Tex^.w:= surf^.w; 

346 
Surface2Tex^.h:= surf^.h; 

347 

753  348 
if (surf^.format^.BytesPerPixel = 3) then mode:= GL_RGB else 
349 
if (surf^.format^.BytesPerPixel = 4) then mode:= GL_RGBA else 

350 
begin 

869  351 
TryDo(false, 'Surface2Tex: BytesPerPixel not in [3, 4]', true); 
755  352 
Surface2Tex^.id:= 0; 
753  353 
exit 
354 
end; 

355 

755  356 
glGenTextures(1, @Surface2Tex^.id); 
753  357 

755  358 
glBindTexture(GL_TEXTURE_2D, Surface2Tex^.id); 
753  359 

771  360 
if SDL_MustLock(surf) then 
361 
SDLTry(SDL_LockSurface(surf) >= 0, true); 

362 

363 
if not (isPowerOf2(Surf^.w) and isPowerOf2(Surf^.h)) then 

1896  364 
begin 
365 
tw:= toPowerOf2(Surf^.w); 

366 
th:= toPowerOf2(Surf^.h); 

367 

368 
Surface2Tex^.rx:= Surf^.w / tw; 

369 
Surface2Tex^.ry:= Surf^.h / th; 

370 

371 
GetMem(tmpp, tw * th * surf^.format^.BytesPerPixel); 

372 

373 
if surf^.format^.BytesPerPixel = 4 then 

374 
begin 

375 
fromP4:= Surf^.pixels; 

376 
toP4:= tmpp; 

771  377 

1896  378 
for y:= 0 to Pred(Surf^.h) do 
379 
begin 

380 
for x:= 0 to Pred(Surf^.w) do 

381 
toP4^[x]:= fromP4^[x]; 

382 
for x:= Surf^.w to Pred(tw) do 

383 
toP4^[x]:= 0; 

384 
toP4:= @(toP4^[tw]); 

385 
fromP4:= @(fromP4^[Surf^.w]); 

386 
end; 

387 

388 
for y:= Surf^.h to Pred(th) do 

389 
begin 

390 
for x:= 0 to Pred(tw) do 

391 
toP4^[x]:= 0; 

392 
toP4:= @(toP4^[tw]); 

393 
end; 

394 
end 

395 
else 

396 
begin 

397 
fromP1:= Surf^.pixels; 

398 
toP1:= tmpp; 

771  399 

1896  400 
for y:= 0 to Pred(Surf^.h) do 
401 
begin 

402 
for x:= 0 to Pred(Surf^.w) do 

403 
begin 

404 
toP1^[x * 3]:= fromP1^[x * 3]; 

405 
toP1^[x * 3 + 1]:= fromP1^[x * 3 + 1]; 

406 
toP1^[x * 3 + 2]:= fromP1^[x * 3 + 2]; 

407 
end; 

408 
for x:= Surf^.w to Pred(tw) do 

409 
begin 

410 
toP1^[x * 3]:= 0; 

411 
toP1^[x * 3 + 1]:= 0; 

412 
toP1^[x * 3 + 2]:= 0; 

413 
end; 

414 
toP1:= @(toP1^[tw * 3]); 

415 
fromP1:= @(fromP1^[Surf^.pitch]); 

416 
end; 

771  417 

1896  418 
for y:= Surf^.h to Pred(th) do 
419 
begin 

420 
for x:= 0 to Pred(tw) do 

421 
begin 

422 
toP1^[x * 3]:= 0; 

423 
toP1^[x * 3 + 1]:= 0; 

424 
toP1^[x * 3 + 2]:= 0; 

425 
end; 

426 
toP1:= @(toP1^[tw * 3]); 

427 
end; 

428 
end; 

771  429 

1896  430 
// gluScaleImage(mode, Surf^.w, Surf^.h, GL_UNSIGNED_BYTE, 
431 
// Surf^.pixels, tw, th, GL_UNSIGNED_BYTE, 

432 
// tmpp); 

433 

434 
glTexImage2D(GL_TEXTURE_2D, 0, mode, tw, th, 0, mode, GL_UNSIGNED_BYTE, tmpp); 

435 

436 
FreeMem(tmpp, tw * th * surf^.format^.BytesPerPixel) 

437 
end else 

438 
begin 

439 
Surface2Tex^.rx:= 1.0; 

440 
Surface2Tex^.ry:= 1.0; 

441 
glTexImage2D(GL_TEXTURE_2D, 0, mode, surf^.w, surf^.h, 0, mode, GL_UNSIGNED_BYTE, surf^.pixels); 

442 
end; 

753  443 

1912
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

444 
ResetVertexArrays(Surface2Tex); 
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

445 

754  446 
if SDL_MustLock(surf) then 
1912
c3d31fb59f0e
Save much CPU time by initializing vertex arrays in texture creation function
unc0rr
parents:
1911
diff
changeset

447 
SDL_UnlockSurface(surf); 
754  448 

788
00720357601f
 Get rid of PageSimpleGame, now pressing 'quick game' just starts round
unc0rr
parents:
785
diff
changeset

449 
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); 
00720357601f
 Get rid of PageSimpleGame, now pressing 'quick game' just starts round
unc0rr
parents:
785
diff
changeset

450 
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR) 
753  451 
end; 
452 

759  453 
procedure FreeTexture(tex: PTexture); 
454 
begin 

2000
f9f47e681aad
Don't crash engine after round in reduced quality mode
unc0rr
parents:
1916
diff
changeset

455 
if tex <> nil then 
f9f47e681aad
Don't crash engine after round in reduced quality mode
unc0rr
parents:
1916
diff
changeset

456 
begin 
f9f47e681aad
Don't crash engine after round in reduced quality mode
unc0rr
parents:
1916
diff
changeset

457 
glDeleteTextures(1, @tex^.id); 
f9f47e681aad
Don't crash engine after round in reduced quality mode
unc0rr
parents:
1916
diff
changeset

458 
dispose(tex) 
f9f47e681aad
Don't crash engine after round in reduced quality mode
unc0rr
parents:
1916
diff
changeset

459 
end 
759  460 
end; 
337  461 

949  462 
function DecodeBase64(s: shortstring): shortstring; 
463 
const table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; 

464 
var i, t, c: Longword; 

465 
begin 

466 
c:= 0; 

467 
for i:= 1 to Length(s) do 

468 
begin 

469 
t:= Pos(s[i], table); 

470 
if s[i] = '=' then inc(c); 

471 
if t > 0 then byte(s[i]):= t  1 else byte(s[i]):= 0 

472 
end; 

473 

474 
i:= 1; 

475 
t:= 1; 

476 
while i <= length(s) do 

477 
begin 

478 
DecodeBase64[t ]:= char((byte(s[i ]) shl 2) or (byte(s[i + 1]) shr 4)); 

479 
DecodeBase64[t + 1]:= char((byte(s[i + 1]) shl 4) or (byte(s[i + 2]) shr 2)); 

480 
DecodeBase64[t + 2]:= char((byte(s[i + 2]) shl 6) or (byte(s[i + 3]) )); 

481 
inc(t, 3); 

482 
inc(i, 4) 

483 
end; 

484 

485 
if c < 3 then t:= t  c; 

486 

487 
byte(DecodeBase64[0]):= t  1 

488 
end; 

489 

1906  490 
const GL_BGR = $80E0; // some opengl headers don't have that const (?)' 
1080  491 
procedure MakeScreenshot(s: shortstring); 
492 
const head: array[0..8] of Word = (0, 2, 0, 0, 0, 0, 0, 0, 24); 

493 
var p: Pointer; 

494 
size: Longword; 

495 
f: file; 

496 
begin 

497 
head[6]:= cScreenWidth; 

498 
head[7]:= cScreenHeight; 

499 

500 
size:= cScreenWidth * cScreenHeight * 3; 

501 
p:= GetMem(size); 

502 

1916  503 
{$IFDEF IPHONE} 
504 
//since opengl es operates on a single surface GL_FRONT is implied, but how to test that? 

505 
{$ELSE} 

1080  506 
glReadBuffer(GL_FRONT); 
1916  507 
{$ENDIF} 
1080  508 
glReadPixels(0, 0, cScreenWidth, cScreenHeight, GL_BGR, GL_UNSIGNED_BYTE, p); 
509 

510 
{$I} 

511 
Assign(f, s); 

512 
Rewrite(f, 1); 

513 
if IOResult = 0 then 

514 
begin 

515 
BlockWrite(f, head, sizeof(head)); 

516 
BlockWrite(f, p^, size); 

517 
Close(f); 

518 
end; 

519 
{$I+} 

520 

521 
FreeMem(p) 

522 
end; 

523 

1861  524 
function modifyDamage(dmg: Longword): Longword; 
525 
begin 

1895  526 
ModifyDamage:= hwRound(_0_01 * cDamageModifier * dmg * cDamagePercent) 
1861  527 
end; 
528 

949  529 
{$IFDEF DEBUGFILE} 
530 
procedure AddFileLog(s: shortstring); 

531 
begin 

532 
writeln(f, GameTicks: 6, ': ', s); 

533 
flush(f) 

534 
end; 

535 

536 
function RectToStr(Rect: TSDL_Rect): shortstring; 

537 
begin 

538 
RectToStr:= '(x: ' + inttostr(rect.x) + '; y: ' + inttostr(rect.y) + '; w: ' + inttostr(rect.w) + '; h: ' + inttostr(rect.h) + ')' 

539 
end; 

540 

371  541 
var i: LongInt; 
488  542 
{$ENDIF} 
306  543 

4  544 
initialization 
351  545 
cDrownSpeed.QWordValue:= 257698038;// 0.06 
488  546 
cMaxWindSpeed.QWordValue:= 2147484;// 0.0005 
547 
cWindSpeed.QWordValue:= 429496;// 0.0001 

351  548 
cGravity:= cMaxWindSpeed; 
1849  549 
cDamageModifier:= _1; 
1854  550 
cLaserSighting:= false; 
351  551 

488  552 
{$IFDEF DEBUGFILE} 
337  553 
{$I} 
497  554 
if ParamCount > 0 then 
555 
for i:= 0 to 7 do 

337  556 
begin 
497  557 
Assign(f, ParamStr(1) + '/debug' + inttostr(i) + '.txt'); 
337  558 
rewrite(f); 
559 
if IOResult = 0 then break 

560 
end; 

561 
{$I+} 

17  562 

4  563 
finalization 
916  564 
//uRandom.DumpBuffer; 
4  565 
writeln(f, '= halt at ',GameTicks,' ticks ='); 
566 
Flush(f); 

351  567 
close(f) 
4  568 
{$ENDIF} 
569 

570 
end. 