1 (*
2 * Hedgewars, a free turn based strategy game
3 * Copyright (c) 2004-2015 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
17 *)
18
19 {$INCLUDE "options.inc"}
20 {$IF GLunit = GL}{$DEFINE GLunit:=GL,GLext}{$ENDIF}
21
22 unit uStore;
23 interface
24 uses SysUtils, uConsts, SDLh, GLunit, uTypes, uLandTexture, uCaptions, uChat;
25
26 procedure initModule;
27 procedure freeModule;
28
29 procedure LoadFonts();
30 procedure StoreLoad(reload: boolean);
31 procedure StoreRelease(reload: boolean);
32 procedure RenderHealth(var Hedgehog: THedgehog);
makeHealthBarTexturenull33 function makeHealthBarTexture(w, h, Color: Longword): PTexture;
34 procedure AddProgress;
35 procedure FinishProgress;
LoadImagenull36 function LoadImage(const filename: shortstring; imageFlags: LongInt): PSDL_Surface;
37
38 // loads an image from the games data files
LoadDataImagenull39 function LoadDataImage(const path: TPathType; const filename: shortstring; imageFlags: LongInt): PSDL_Surface;
40 // like LoadDataImage but uses altPath as fallback-path if file not found/loadable in path
LoadDataImageAltPathnull41 function LoadDataImageAltPath(const path, altPath: TPathType; const filename: shortstring; imageFlags: LongInt): PSDL_Surface;
42 // like LoadDataImage but uses altFile as fallback-filename if file cannot be loaded
LoadDataImageAltFilenull43 function LoadDataImageAltFile(const path: TPathType; const filename, altFile: shortstring; imageFlags: LongInt): PSDL_Surface;
44
45 procedure LoadHedgehogHat(var HH: THedgehog; newHat: shortstring);
46 procedure LoadHedgehogHat2(var HH: THedgehog; newHat: shortstring; allowSurfReuse: boolean);
47
48 procedure LoadDefaultClanColors(s: shortstring);
49
50 procedure InitZoom(zoom: real);
51
52 procedure SetupOpenGL;
RenderHelpWindownull53 function RenderHelpWindow(caption, subcaption, description, extra: ansistring; extracolor: LongInt; iconsurf: PSDL_Surface; iconrect: PSDL_Rect): PTexture;
54 procedure RenderWeaponTooltip(atype: TAmmoType);
55 procedure ShowWeaponTooltip(x, y: LongInt);
56 procedure MakeCrossHairs;
57 {$IFDEF USE_VIDEO_RECORDING}
58 procedure InitOffscreenOpenGL;
59 {$ENDIF}
60
61 procedure WarpMouse(x, y: Word); inline;
62 procedure SwapBuffers; {$IFDEF USE_VIDEO_RECORDING}cdecl{$ELSE}inline{$ENDIF};
63 procedure SetSkyColor(r, g, b: real);
64
65 implementation
66 uses uMisc, uConsole, uVariables, uUtils, uTextures, uRender, uRenderUtils,
67 uCommands, uPhysFSLayer, uDebug, uLocale, uInputHandler, adler32
68 {$IFDEF USE_CONTEXT_RESTORE}, uWorld{$ENDIF};
69
70 //type TGPUVendor = (gvUnknown, gvNVIDIA, gvATI, gvIntel, gvApple);
71
72 var
73 squaresize : LongInt;
74 numsquares : LongInt;
75 ProgrTex: PTexture;
76 LoadingText: PTexture;
77
78 prevHat: shortstring;
79 tmpHatSurf: PSDL_Surface;
80
81 const
82 cHHFileName = 'Hedgehog';
83 cCHFileName = 'Crosshair';
84
85 procedure freeTmpHatSurf();
86 begin
87 if tmpHatSurf = nil then exit;
88 SDL_FreeSurface(tmpHatSurf);
89 tmpHatSurf:= nil;
90 prevHat:= 'NoHat';
91 end;
92
93 procedure InitZoom(zoom: real);
94 begin
95 SetScale(zoom);
96 // make sure view limits are updated
97 // because SetScale() doesn't do it, if zoom=cScaleFactor
98 updateViewLimits();
99 end;
100
101 function WriteInRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: PChar): TSDL_Rect;
102 var w, h: LongInt;
103 tmpsurf: PSDL_Surface;
104 clr: TSDL_Color;
105 finalRect: TSDL_Rect;
106 begin
107 w:= 0; h:= 0; // avoid compiler hints
108 TTF_SizeUTF8(Fontz[Font].Handle, s, @w, @h);
109 finalRect.x:= X + cFontBorder + 2;
110 finalRect.y:= Y + cFontBorder;
111 finalRect.w:= w + cFontBorder * 2 + 4;
112 finalRect.h:= h + cFontBorder * 2;
113 clr.r:= Color shr 16;
114 clr.g:= (Color shr 8) and $FF;
115 clr.b:= Color and $FF;
116 clr.a:= $FF;
117 tmpsurf:= TTF_RenderUTF8_Blended(Fontz[Font].Handle, s, clr);
118 if tmpsurf = nil then exit;
119 tmpsurf:= doSurfaceConversion(tmpsurf);
120
121 if tmpsurf <> nil then
122 begin
123 SDL_UpperBlit(tmpsurf, nil, Surface, @finalRect);
124 SDL_FreeSurface(tmpsurf);
125 finalRect.x:= X;
126 finalRect.y:= Y;
127 finalRect.w:= w + cFontBorder * 2 + 4;
128 finalRect.h:= h + cFontBorder * 2;
129 end;
130
131 WriteInRect:= finalRect
132 end;
133
134 procedure MakeCrossHairs;
135 var tmpsurf: PSDL_Surface;
136 begin
137 tmpsurf:= LoadDataImage(ptGraphics, cCHFileName, ifAlpha or ifCritical);
138
139 CrosshairTexture:= Surface2Tex(tmpsurf, false);
140
141 SDL_FreeSurface(tmpsurf)
142 end;
143
144 function makeHealthBarTexture(w, h, Color: Longword): PTexture;
145 var
146 rr: TSDL_Rect;
147 texsurf: PSDL_Surface;
148 begin
149 rr.x:= 0;
150 rr.y:= 0;
151 rr.w:= w;
152 rr.h:= h;
153
154 texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, w, h, 32, RMask, GMask, BMask, AMask);
155 if not checkFails(texsurf <> nil, errmsgCreateSurface, true) then
156 checkFails(SDL_SetColorKey(texsurf, SDL_TRUE, 0) = 0, errmsgTransparentSet, true);
157
158 if not allOK then exit(nil);
159
160 DrawRoundRect(@rr, cWhiteColor, cNearBlackColor, texsurf, true);
161
162 rr.x:= 2;
163 rr.y:= 2;
164 rr.w:= w - 4;
165 rr.h:= h - 4;
166
167 DrawRoundRect(@rr, Color, Color, texsurf, false);
168 makeHealthBarTexture:= Surface2Tex(texsurf, false);
169 SDL_FreeSurface(texsurf);
170 end;
171
172 procedure WriteNames(Font: THWFont);
173 var t: LongInt;
174 i, maxLevel: LongInt;
175 r: TSDL_Rect;
176 drY: LongInt;
177 texsurf, flagsurf, iconsurf: PSDL_Surface;
178 foundBot: boolean;
179 year, month, md : word;
180 begin
181 if cOnlyStats then exit;
182 r.x:= 0;
183 r.y:= 0;
184 drY:= - 4;
185 {$IFNDEF PAS2C}
186 DecodeDate(Date, year, month, md);
187 {$ELSE}
188 year:= 0;
189 month:= 0;
190 md:= 0;
191 {$ENDIF}
192 for t:= 0 to Pred(TeamsCount) do
193 with TeamsArray[t]^ do
194 begin
195 if ExtDriven then
196 NameTagTex:= RenderStringTexLim(ansistring(TeamName), Clan^.Color, Font, cTeamHealthWidth)
197 else NameTagTex:= RenderStringTex(ansistring(TeamName), Clan^.Color, Font);
198 if length(Owner) > 0 then
199 if ExtDriven then
200 OwnerTex:= RenderStringTexLim(ansistring(Owner), Clan^.Color, Font, cTeamHealthWidth)
201 else OwnerTex:= RenderStringTex(ansistring(Owner), Clan^.Color, Font);
202
203 r.x:= 0;
204 r.y:= 0;
205 r.w:= 32;
206 r.h:= 32;
207 texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, r.w, r.h, 32, RMask, GMask, BMask, AMask);
208 if not checkFails(texsurf <> nil, errmsgCreateSurface, true) then
209 checkFails(SDL_SetColorKey(texsurf, SDL_TRUE, 0) = 0, errmsgTransparentSet, true);
210 if not allOK then exit;
211
212 r.w:= 26;
213 r.h:= 19;
214
215 DrawRoundRect(@r, cWhiteColor, cNearBlackColor, texsurf, true);
216
217 // overwrite flag for cpu teams and keep players from using it
218 foundBot:= false;
219 maxLevel:= -1;
220 for i:= 0 to cMaxHHIndex do
221 with Hedgehogs[i] do
222 if (Gear <> nil) and (BotLevel > 0) then
223 begin
224 foundBot:= true;
225 // initially was going to do the highest botlevel of the team, but for now, just apply if entire team has same bot level
226 if maxLevel = -1 then maxLevel:= BotLevel
227 else if (maxLevel > 0) and (maxLevel <> BotLevel) then maxLevel:= 0;
228 //if (maxLevel > 0) and (BotLevel < maxLevel) then maxLevel:= BotLevel
229 end
230 else if Gear <> nil then maxLevel:= 0;
231
232 if foundBot then
233 begin
234 // disabled the plain flag - I think it looks ok even w/ full bars obscuring CPU
235 //if (maxLevel > 0) and (maxLevel < 3) then Flag:= 'cpu_plain' else
236 Flag:= 'cpu'
237 end
238 else if (Flag = 'cpu') or (Flag = 'cpu_plain') then
239 Flag:= 'hedgewars';
240
241 flagsurf:= LoadDataImageAltFile(ptFlags, Flag, 'hedgewars', ifNone);
242 if not checkFails(flagsurf <> nil, 'Failed to load flag "' + Flag + '" as well as the default flag', true) then
243 begin
244 case maxLevel of
245 1: copyToXY(SpritesData[sprBotlevels].Surface, flagsurf, 0, 0);
246 2: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 5, 2, 17, 13, 5, 2);
247 3: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 9, 5, 13, 10, 9, 5);
248 4: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 13, 9, 9, 6, 13, 9);
249 5: copyToXYFromRect(SpritesData[sprBotlevels].Surface, flagsurf, 17, 11, 5, 4, 17, 11)
250 end;
251
252 copyToXY(flagsurf, texsurf, 2, 2);
253 SDL_FreeSurface(flagsurf);
254 flagsurf:= nil;
255 end;
256
257 // restore black border pixels inside the flag
258 PLongwordArray(texsurf^.pixels)^[32 * 2 + 2]:= cNearBlackColor;
259 PLongwordArray(texsurf^.pixels)^[32 * 2 + 23]:= cNearBlackColor;
260 PLongwordArray(texsurf^.pixels)^[32 * 16 + 2]:= cNearBlackColor;
261 PLongwordArray(texsurf^.pixels)^[32 * 16 + 23]:= cNearBlackColor;
262
263
264 FlagTex:= Surface2Tex(texsurf, false);
265 SDL_FreeSurface(texsurf);
266 texsurf:= nil;
267
268 if not allOK then exit;
269
270 AIKillsTex := RenderStringTex(ansistring(inttostr(stats.AIKills)), Clan^.Color, fnt16);
271 LuaTeamValueTex := RenderStringTex(LuaTeamValue, Clan^.Color, fnt16);
272
273 dec(drY, r.h + 2);
274 DrawHealthY:= drY;
275 for i:= 0 to cMaxHHIndex do
276 with Hedgehogs[i] do
277 if Gear <> nil then
278 begin
279 if ExtDriven then
280 NameTagTex:= RenderStringTexLim(ansistring(Name), Clan^.Color, fnt16, cTeamHealthWidth)
281 else NameTagTex:= RenderStringTex(ansistring(Name), Clan^.Color, fnt16);
282 if cHolidaySilliness then
283 begin
284 // Special hats on special days
285 if Hat = 'NoHat' then
286 begin
287 if (month = 4) and (md = 20) then
288 Hat := 'eastertop' // Easter
289 else if (month = 12) and ((md = 24) or (md = 25) or (md = 26)) then
290 Hat := 'Santa' // Christmas Eve/Christmas/Boxing Day
291 else if (month = 10) and (md = 31) then
292 Hat := 'fr_pumpkin'; // Halloween/Hedgewars' birthday
293 end;
294 if (month = 4) and (md = 1) then
295 begin
296 AprilOne:= true;
297 Hat := 'fr_tomato'; // avoid promoting violence to hedgehogs. see https://hedgewars.org/node/5818
298 end;
299 end;
300
301 if Hat <> 'NoHat' then
302 begin
303 if (Length(Hat) > 39) and (Copy(Hat,1,8) = 'Reserved') and (Copy(Hat,9,32) = PlayerHash) then
304 LoadHedgehogHat2(Hedgehogs[i], 'Reserved/' + Copy(Hat,9,Length(Hat)-8), true)
305 else
306 LoadHedgehogHat2(Hedgehogs[i], Hat, true);
307 end
308 end;
309 end;
310
311 freeTmpHatSurf();
312
313 MissionIcons:= LoadDataImage(ptGraphics, 'missions', ifCritical);
314 iconsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, 28, 28, 32, RMask, GMask, BMask, AMask);
315 if iconsurf <> nil then
316 begin
317 r.x:= 0;
318 r.y:= 0;
319 r.w:= 28;
320 r.h:= 28;
321 DrawRoundRect(@r, cWhiteColor, cNearBlackColor, iconsurf, true);
322 ropeIconTex:= Surface2Tex(iconsurf, false);
323 SDL_FreeSurface(iconsurf);
324 iconsurf:= nil;
325 end;
326
327
328 for t:= 0 to Pred(ClansCount) do
329 with ClansArray[t]^ do
330 HealthTex:= makeHealthBarTexture(cTeamHealthWidth + 5, 19 * HDPIScaleFactor, Color);
331
332 GenericHealthTexture:= makeHealthBarTexture(cTeamHealthWidth + 5, 19 * HDPIScaleFactor, cWhiteColor)
333 end;
334
335
336 procedure InitHealth;
337 var i, t: LongInt;
338 begin
339 for t:= 0 to Pred(TeamsCount) do
340 if TeamsArray[t] <> nil then
341 with TeamsArray[t]^ do
342 begin
343 for i:= 0 to cMaxHHIndex do
344 if Hedgehogs[i].Gear <> nil then
345 RenderHealth(Hedgehogs[i]);
346 end
347 end;
348
349 procedure LoadGraves;
350 var t: LongInt;
351 texsurf: PSDL_Surface;
352 begin
353 for t:= 0 to Pred(TeamsCount) do
354 if TeamsArray[t] <> nil then
355 with TeamsArray[t]^ do
356 begin
357 if GraveName = '' then
358 GraveName:= 'Statue';
359 texsurf:= LoadDataImageAltFile(ptGraves, GraveName, 'Statue', ifCritical or ifColorKey);
360 GraveTex:= Surface2Tex(texsurf, false);
361 SDL_FreeSurface(texsurf)
362 end
363 end;
364
365 procedure LoadFonts();
366 var s: shortstring;
367 fi: THWFont;
368 begin
369 AddFileLog('LoadFonts();');
370
371 if (not cOnlyStats) then
372 for fi:= Low(THWFont) to High(THWFont) do
373 with Fontz[fi] do
374 begin
375 s:= cPathz[ptFonts] + '/' + Name;
376 WriteToConsole(msgLoading + s + ' (' + inttostr(Height) + 'pt)... ');
377 Handle:= TTF_OpenFontRW(rwopsOpenRead(s), true, Height);
378 if SDLCheck(Handle <> nil, 'TTF_OpenFontRW', true) then exit;
379 TTF_SetFontStyle(Handle, style);
380 WriteLnToConsole(msgOK)
381 end;
382 end;
383
384 procedure StoreLoad(reload: boolean);
385 var ii: TSprite;
386 ai: TAmmoType;
387 tmpsurf, tmpoverlay: PSDL_Surface;
388 i, imflags: LongInt;
389 keyConfirm, keyQuit: shortstring;
390 begin
391 AddFileLog('StoreLoad()');
392
393 if not cOnlyStats then
394 begin
395 MakeCrossHairs;
396 LoadGraves;
397 {$IFDEF IPHONEOS}
398 tmpHatSurf:= LoadDataImage(ptHats, 'chef', ifNone);
399 {$ELSE}
400 tmpHatSurf:= LoadDataImage(ptHats, 'Reserved/chef', ifNone);
401 {$ENDIF}
402 ChefHatTexture:= Surface2Tex(tmpHatSurf, true);
403 freeTmpHatSurf();
404 end;
405
406 if not reload then
407 AddProgress;
408
409 for ii:= Low(TSprite) to High(TSprite) do
410 with SpritesData[ii] do
411 // FIXME - add a sprite attribute to match on rq flags?
412 if (((cReducedQuality and (rqNoBackground or rqLowRes)) = 0) or // why rqLowRes?
413 (not (ii in [sprSky, sprSkyL, sprSkyR, sprHorizont, sprHorizontL, sprHorizontR])))
414 and (((cReducedQuality and rqPlainSplash) = 0) or ((not (ii in [sprSplash, sprDroplet, sprSDSplash, sprSDDroplet]))))
415 and (((cReducedQuality and rqKillFlakes) = 0) or cSnow or ((not (ii in [sprFlake, sprSDFlake]))))
416 and ((cCloudsNumber > 0) or (ii <> sprCloud))
417 and ((vobCount > 0) or (ii <> sprFlake))
418 and (savesurf or (not cOnlyStats)) // in stats-only only load those which are needed later
419 and allOK
420 then
421 begin
422 if reload then
423 tmpsurf:= Surface
424 else
425 begin
426 imflags := (ifAlpha or ifColorKey);
427
428 // these sprites are optional
429 if critical then
430 imflags := (imflags or ifCritical);
431
432 // load the image
433 if checkSum then
434 tmpsurf := LoadDataImageAltPath(Path, AltPath, FileName, imflags or ifDigestAlpha)
435 else
436 tmpsurf := LoadDataImageAltPath(Path, AltPath, FileName, imflags);
437 end;
438
439 if tmpsurf <> nil then
440 begin
441 if getImageDimensions then
442 begin
443 imageWidth:= tmpsurf^.w;
444 imageHeight:= tmpsurf^.h
445 end;
446 if getDimensions then
447 if Height = -1 then //BlueWater
448 begin
449 Width:= tmpsurf^.w;
450 Height:= tmpsurf^.h div watFrames;
451 end
452 else if Height = -2 then //SDWater
453 begin
454 Width:= tmpsurf^.w;
455 Height:= tmpsurf^.h div watSDFrames;
456 end
457 else
458 begin
459 Width:= tmpsurf^.w;
460 Height:= tmpsurf^.h
461 end;
462 if (ii in [sprAMAmmos, sprAMAmmosBW]) then
463 begin
464 tmpoverlay := LoadDataImage(Path, copy(FileName, 1, length(FileName)-5), (imflags and (not ifCritical)));
465 if tmpoverlay <> nil then
466 begin
467 copyToXY(tmpoverlay, tmpsurf, 0, 0);
468 SDL_FreeSurface(tmpoverlay)
469 end
470 end;
471 if (ii in [sprSky, sprSkyL, sprSkyR, sprHorizont, sprHorizontL, sprHorizontR]) then
472 begin
473 Texture:= Surface2Tex(tmpsurf, true);
474 Texture^.Scale:= 2
475 end
476 else
477 begin
478 Texture:= Surface2Tex(tmpsurf, false);
479 // HACK: We should include some sprite attribute to define the texture wrap directions
480 if ((ii = sprWater) or (ii = sprSDWater)) and ((cReducedQuality and (rq2DWater or rqClampLess)) = 0) then
481 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
482 end;
483 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, priority);
484 // This should maybe be flagged. It wastes quite a bit of memory.
485 if not reload then
486 begin
487 {$IFDEF USE_CONTEXT_RESTORE}
488 Surface:= tmpsurf
489 {$ELSE}
490 if saveSurf then
491 Surface:= tmpsurf
492 else
493 SDL_FreeSurface(tmpsurf)
494 {$ENDIF}
495 end
496 end
497 else
498 Surface:= nil
499 end;
500
501 if (not cOnlyStats) and allOK then
502 begin
503 WriteNames(fnt16);
504
505 if not reload then
506 AddProgress;
507
508 tmpsurf:= LoadDataImage(ptGraphics, cHHFileName, ifAlpha or ifCritical or ifColorKey);
509
510 HHTexture:= Surface2Tex(tmpsurf, false);
511 SDL_FreeSurface(tmpsurf);
512
513 InitHealth;
514
515 PauseTexture:= RenderStringTex(trmsg[sidPaused], cCentralMessageColor, fntBig);
516 AFKTexture:= RenderStringTex(trmsg[sidAFK], cCentralMessageColor, fntBig);
517 keyConfirm:= KeyBindToName('confirm');
518 keyQuit:= KeyBindToName('quit');
519 ConfirmTexture:= RenderStringTex(FormatA(trmsg[sidConfirm], ansistring(keyConfirm), ansistring(keyQuit)), cCentralMessageColor, fntBig);
520 SyncTexture:= RenderStringTex(trmsg[sidSync], cCentralMessageColor, fntBig);
521
522 if not reload then
523 AddProgress;
524
525 // name of weapons in ammo menu
526 for ai:= Low(TAmmoType) to High(TAmmoType) do
527 with Ammoz[ai] do
528 begin
529 if checkFails(length(trAmmo[NameId]) > 0,'No default text/translation found for ammo type #' + intToStr(ord(ai)) + '!',true) then exit;
530 tmpsurf:= TTF_RenderUTF8_Blended(Fontz[CheckCJKFont(trAmmo[NameId],fnt16)].Handle, PChar(trAmmo[NameId]), cWhiteColorChannels);
531 if checkFails(tmpsurf <> nil,'Name-texture creation for ammo type #' + intToStr(ord(ai)) + ' failed!',true) then exit;
532 tmpsurf:= doSurfaceConversion(tmpsurf);
533 FreeAndNilTexture(NameTex);
534 NameTex:= Surface2Tex(tmpsurf, false);
535 SDL_FreeSurface(tmpsurf)
536 end;
537
538 // number of weapons in ammo menu
539 for i:= Low(CountTexz) to High(CountTexz) do
540 begin
541 tmpsurf:= TTF_RenderUTF8_Blended(Fontz[CheckCJKFont(trmsg[sidAmmoCount],fnt16)].Handle, Str2PChar(Format(shortstring(trmsg[sidAmmoCount]), IntToStr(i))), cWhiteColorChannels);
542 if checkFails(tmpsurf <> nil,'Number texture creation for ammo type #' + intToStr(ord(ai)) + ' failed!',true) then exit;
543 tmpsurf:= doSurfaceConversion(tmpsurf);
544 FreeAndNilTexture(CountTexz[i]);
545 CountTexz[i]:= Surface2Tex(tmpsurf, false);
546 SDL_FreeSurface(tmpsurf)
547 end;
548
549 if not reload then
550 AddProgress;
551 end;
552
553 IMG_Quit();
554 end;
555
556 procedure StoreRelease(reload: boolean);
557 var ii: TSprite;
558 ai: TAmmoType;
559 i, t: LongInt;
560 begin
561 for ii:= Low(TSprite) to High(TSprite) do
562 begin
563 FreeAndNilTexture(SpritesData[ii].Texture);
564
565 if (SpritesData[ii].Surface <> nil) and (not reload) then
566 begin
567 SDL_FreeSurface(SpritesData[ii].Surface);
568 SpritesData[ii].Surface:= nil
569 end
570 end;
571 SDL_FreeSurface(MissionIcons);
572
573 // free the textures declared in uVariables
574 FreeAndNilTexture(ChefHatTexture);
575 FreeAndNilTexture(CrosshairTexture);
576 FreeAndNilTexture(WeaponTooltipTex);
577 FreeAndNilTexture(PauseTexture);
578 FreeAndNilTexture(AFKTexture);
579 FreeAndNilTexture(SyncTexture);
580 FreeAndNilTexture(ConfirmTexture);
581 FreeAndNilTexture(ropeIconTex);
582 FreeAndNilTexture(HHTexture);
583 FreeAndNilTexture(GenericHealthTexture);
584 // free all ammo name textures
585 for ai:= Low(TAmmoType) to High(TAmmoType) do
586 FreeAndNilTexture(Ammoz[ai].NameTex);
587
588 // free all count textures
589 for i:= Low(CountTexz) to High(CountTexz) do
590 begin
591 FreeAndNilTexture(CountTexz[i]);
592 CountTexz[i]:= nil
593 end;
594
595 for t:= 0 to Pred(ClansCount) do
596 begin
597 if ClansArray[t] <> nil then
598 FreeAndNilTexture(ClansArray[t]^.HealthTex);
599 end;
600
601 // free all team and hedgehog textures
602 for t:= 0 to Pred(TeamsCount) do
603 begin
604 if TeamsArray[t] <> nil then
605 begin
606 FreeAndNilTexture(TeamsArray[t]^.NameTagTex);
607 FreeAndNilTexture(TeamsArray[t]^.GraveTex);
608 FreeAndNilTexture(TeamsArray[t]^.AIKillsTex);
609 FreeAndNilTexture(TeamsArray[t]^.FlagTex);
610
611 for i:= 0 to cMaxHHIndex do
612 begin
613 FreeAndNilTexture(TeamsArray[t]^.Hedgehogs[i].NameTagTex);
614 FreeAndNilTexture(TeamsArray[t]^.Hedgehogs[i].HealthTagTex);
615 FreeAndNilTexture(TeamsArray[t]^.Hedgehogs[i].HatTex);
616 end;
617 end;
618 end;
619
620 RendererCleanup();
621 end;
622
623
624 procedure RenderHealth(var Hedgehog: THedgehog);
625 var s: shortstring;
626 begin
627 FreeAndNilTexture(Hedgehog.HealthTagTex);
628 if Hedgehog.Gear <> nil then
629 s:= IntToStr(Hedgehog.Gear^.Health)
630 else if Hedgehog.GearHidden <> nil then
631 s:= IntToStr(Hedgehog.GearHidden^.Health)
632 else
633 exit;
634 Hedgehog.HealthTagTex:= RenderStringTex(ansistring(s), Hedgehog.Team^.Clan^.Color, fnt16)
635 end;
636
LoadImagenull637 function LoadImage(const filename: shortstring; imageFlags: LongInt): PSDL_Surface;
638 var tmpsurf: PSDL_Surface;
639 s: shortstring;
640 logMsg, digestMsg: shortstring;
641 rwops: PSDL_RWops;
642 y, x: LongInt;
643 rowData: PByteArray;
644 begin
645 LoadImage:= nil;
646 digestMsg:= '';
647 logMsg:= msgLoading + filename + '.png [flags: ' + inttostr(imageFlags) + ']';
648
649 s:= filename + '.png';
650
651 rwops:= nil;
652 tmpsurf:= nil;
653
654 if pfsExists(s) then
655 begin
656 // get data source
657 rwops:= rwopsOpenRead(s);
658
659 // load image with SDL (with freesrc param set to true)
660 if rwops <> nil then
661 tmpsurf:= IMG_Load_RW(rwops, true);
662 end;
663
664 // loading failed
665 if tmpsurf = nil then
666 begin
667 // output sdl error if loading failed when data source was available
668 if rwops <> nil then
669 begin
670 // anounce that loading failed
671 OutError(logMsg + ' ' + msgFailed, false);
672
673 if SDLCheck(false, 'LoadImage: ' + logMsg + ' ' + msgFailed, (imageFlags and ifCritical) <> 0) then
674 exit;
675 // rwops was already freed by IMG_Load_RW
676 rwops:= nil;
677 end
678 else
679 OutError(logMsg + ' ' + msgFailed, (imageFlags and ifCritical) <> 0);
680 exit;
681 end;
682
683 if ((imageFlags and ifIgnoreCaps) = 0) and ((tmpsurf^.w > MaxTextureSize) or (tmpsurf^.h > MaxTextureSize)) then
684 begin
685 SDL_FreeSurface(tmpsurf);
686 OutError(logMsg + ' ' + msgFailedSize, ((not cOnlyStats) and ((imageFlags and ifCritical) <> 0)));
687 // dummy surface to replace non-critical textures that failed to load due to their size
688 LoadImage:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2, 2, 32, RMask, GMask, BMask, AMask);
689 exit;
690 end;
691
692 tmpsurf:= doSurfaceConversion(tmpsurf);
693
694 if (imageFlags and ifColorKey) <> 0 then
695 if checkFails(SDL_SetColorKey(tmpsurf, SDL_TRUE, 0) = 0, errmsgTransparentSet, true) then exit;
696
697 if ((imageFlags and (ifDigestAll or ifDigestAlpha)) <> 0)
698 and (tmpsurf^.format^.BytesPerPixel = 4)then
699 begin
700 if SDL_MustLock(tmpsurf) then
701 SDL_LockSurface(tmpsurf);
702
703 if (imageFlags and ifDigestAll) <> 0 then
704 begin
705 for y := 0 to tmpsurf^.h - 1 do
706 syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(tmpsurf^.pixels)^[y*tmpsurf^.pitch], tmpsurf^.w*4);
707 digestMsg := ' [CD: ' + inttostr(syncedPixelDigest) + ']'
708 end
709 else if (imageFlags and ifDigestAlpha) <> 0 then
710 begin
711 rowData := GetMem(tmpsurf^.w);
712 for y := 0 to tmpsurf^.h - 1 do
713 begin
714 for x := 0 to tmpsurf^.w - 1 do
715 rowData^[x] := PByteArray(tmpsurf^.pixels)^[y * tmpsurf^.pitch + x * 4 + AByteIndex];
716 syncedPixelDigest:= Adler32Update(syncedPixelDigest, rowData, tmpsurf^.w);
717 end;
718 FreeMem(rowData, tmpsurf^.w);
719 digestMsg := ' [AD: ' + inttostr(syncedPixelDigest) + ']'
720 end;
721
722 if SDL_MustLock(tmpsurf) then
723 SDL_UnlockSurface(tmpsurf);
724 end;
725
726 // log success
727 WriteLnToConsole(logMsg + ' ' + msgOK + ' (' + inttostr(tmpsurf^.w) + 'x' + inttostr(tmpsurf^.h) + ')' + digestMsg);
728
729 LoadImage:= tmpsurf //Result
730 end;
731
732
LoadDataImagenull733 function LoadDataImage(const path: TPathType; const filename: shortstring; imageFlags: LongInt): PSDL_Surface;
734 var tmpsurf: PSDL_Surface;
735 begin
736 // check for file in user dir (never critical)
737 tmpsurf:= LoadImage(cPathz[path] + '/' + filename, imageFlags);
738
739 LoadDataImage:= tmpsurf;
740 end;
741
742
LoadDataImageAltPathnull743 function LoadDataImageAltPath(const path, altPath: TPathType; const filename: shortstring; imageFlags: LongInt): PSDL_Surface;
744 var tmpsurf: PSDL_Surface;
745 begin
746 // if there is no alternative path, just forward and return result
747 if (altPath = ptNone) then
748 exit(LoadDataImage(path, filename, imageFlags));
749
750 // since we have a fallback path this search isn't critical yet
751 tmpsurf:= LoadDataImage(path, filename, imageFlags and (not ifCritical));
752
753 // if image still not found try alternative path
754 if (tmpsurf = nil) then
755 tmpsurf:= LoadDataImage(altPath, filename, imageFlags);
756
757 LoadDataImageAltPath:= tmpsurf;
758 end;
759
760 function LoadDataImageAltFile(const path: TPathType; const filename, altFile: shortstring; imageFlags: LongInt): PSDL_Surface;
761 var tmpsurf: PSDL_Surface;
762 begin
763 // if there is no alternative filename, just forward and return result
764 if (altFile = '') then
765 exit(LoadDataImage(path, filename, imageFlags));
766
767 // since we have a fallback filename this search isn't critical yet
768 tmpsurf:= LoadDataImage(path, filename, imageFlags and (not ifCritical));
769
770 // if image still not found try alternative filename
771 if (tmpsurf = nil) then
772 tmpsurf:= LoadDataImage(path, altFile, imageFlags);
773
774 LoadDataImageAltFile:= tmpsurf;
775 end;
776
777 procedure LoadHedgehogHat(var HH: THedgehog; newHat: shortstring);
778 begin
779 LoadHedgehogHat2(HH, newHat, false);
780 end;
781
782 procedure LoadHedgehogHat2(var HH: THedgehog; newHat: shortstring; allowSurfReuse: boolean);
783 begin
784 // free the mem of any previously assigned texture. This was previously only if the new one could be loaded, but, NoHat is usually a better choice
785 if HH.HatTex <> nil then
786 FreeAndNilTexture(HH.HatTex);
787
788 // load new hat surface if this hat is different than the one already loaded
789 if newHat <> prevHat then
790 begin
791 freeTmpHatSurf();
792 tmpHatSurf:= LoadDataImage(ptHats, newHat, ifNone);
793 end;
794
795 AddFileLog('Hat => '+newHat);
796 // only do something if the hat could be loaded
797 if tmpHatSurf <> nil then
798 begin
799 AddFileLog('Got Hat');
800
801 // assign new hat to hedgehog
802 HH.HatTex:= Surface2Tex(tmpHatSurf, true);
803
804 // remember that this hat was used last
805 if allowSurfReuse then
806 prevHat:= newHat
807 // cleanup: free temporary surface mem
808 else
809 freeTmpHatSurf();
810 end;
811 end;
812
813 // Load default clan colors from config fiile
814 procedure LoadDefaultClanColors(s: shortstring);
815 var i: LongInt;
816 f: PFSFile;
817 key, value, l, temp: shortstring;
818 color, tempColor: Longword;
819 clanID, tempClanID: byte;
820 begin
821 if cOnlyStats then exit;
822
823 WriteLnToConsole('Loading default clan colors from: ' + s);
824
825 l:= '';
826 if pfsExists(s) then
827 begin
828 f:= pfsOpenRead(s);
829 while (not pfsEOF(f)) and (l <> '[colors]') do
830 pfsReadLn(f, l);
831
832 while (not pfsEOF(f)) and (l <> '') do
833 begin
834 pfsReadLn(f, l);
835
836 key:= '';
837 i:= 1;
838 while (i <= length(l)) and (l[i] <> '=') do
839 begin
840 key:= key + l[i];
841 inc(i)
842 end;
843 temp:= copy(key, 1, 5);
844 if temp = 'color' then
845 begin
846 temp:= copy(key, 6, length(key) - 5);
847 tempClanID:= StrToInt(temp);
848 clanID:= tempClanID
849 end
850 else
851 continue;
852
853 if i < length(l) then
854 begin
855 value:= copy(l, i + 1, length(l) - i);
856 if (length(value) = 2) and (value[1] = '\') then
857 value:= value[1] + ''
858 else if (value[1] = '"') and (value[length(value)] = '"') then
859 value:= copy(value, 2, length(value) - 2);
860 if value[1] <> '#' then
861 continue;
862 temp:= copy(value, 2, length(value) - 1);
863 tempColor:= StrToInt('$'+temp);
864 color:= tempColor
865 end;
866
867 if clanID <= cClanColors then
868 ClanColorArray[clanID]:= color;
869
870 end;
871
872 pfsClose(f)
873 end
874 else
875 WriteLnToConsole('Settings file not found');
876 end;
877
878
879 procedure SetupOpenGLAttributes;
880 begin
881 {$IFDEF IPHONEOS}
882 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 0);
883 SDL_GL_SetAttribute(SDL_GL_RETAINED_BACKING, 1);
884
885 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 1);
886 SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1);
887 {$ELSE}
888 SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
889 {$ENDIF}
890 SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
891 SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 6);
892 SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
893 SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 0); // no depth buffer
894 SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 0); // no alpha channel
895 SDL_GL_SetAttribute(SDL_GL_BUFFER_SIZE, 16); // buffer should be 16
896 {$IFNDEF DARWIN}
897 SDL_GL_SetAttribute(SDL_GL_ACCELERATED_VISUAL, 1); // force hw rendering except on macOS
898 {$ENDIF}
899 end;
900
901 procedure SetupOpenGL;
902 begin
903 AddFileLog('Setting up OpenGL (using driver: ' + shortstring(SDL_GetCurrentVideoDriver()) + ')');
904
createsnull905 // TODO: this function creates an opengles1.1 context
906 // un-comment below and add proper logic to support opengles2.0
907 //SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2);
908 //SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 0);
909 if SDLGLcontext = nil then
910 SDLGLcontext:= SDL_GL_CreateContext(SDLwindow);
911 if SDLCheck(SDLGLcontext <> nil, 'SDLGLcontext', true) then exit;
912 SDL_GL_SetSwapInterval(1);
913
914 RendererSetup();
915
916 // gl2 init/matrix code was here, but removed
917 end;
918
919 ////////////////////////////////////////////////////////////////////////////////
920 procedure AddProgress;
921 var r: TSDL_Rect;
922 texsurf: PSDL_Surface;
923 begin
924 if cOnlyStats then exit;
925 if Step = 0 then
926 begin
927 WriteToConsole(msgLoading + 'progress sprite: ');
928 texsurf:= LoadDataImage(ptGraphics, 'Progress', ifCritical or ifColorKey);
929
930 ProgrTex:= Surface2Tex(texsurf, false);
931
932 LoadingText:= RenderStringTex(trmsg[sidLoading], $FFF39EE8, fntBig);
933
934 squaresize:= texsurf^.w shr 1;
935 numsquares:= texsurf^.h div squaresize;
936 SDL_FreeSurface(texsurf);
937
938 {$IFNDEF PAS2C}
939 with mobileRecord do
940 if GameLoading <> nil then
941 GameLoading();
942 {$ENDIF}
943 end;
944
945 if checkFails((ProgrTex <> nil) and (LoadingText <> nil), 'Error - Progress or Loading texture is nil!', true) then exit;
946
947 RenderClear();
948 if Step < numsquares then
949 r.x:= 0
950 else
951 r.x:= squaresize;
952
953 r.y:= (Step mod numsquares) * squaresize;
954 r.w:= squaresize;
955 r.h:= squaresize;
956
957 DrawTextureFromRect( -squaresize div 2, (cScreenHeight - squaresize) shr 1, @r, ProgrTex);
958 DrawTexture( -LoadingText^.w div 2, (cScreenHeight - LoadingText^.h) shr 1 - (squaresize div 2) - (LoadingText^.h div 2) - 8, LoadingText);
959
960 SwapBuffers;
961
962 inc(Step);
963 end;
964
965 procedure FinishProgress;
966 begin
967 {$IFNDEF PAS2C}
968 with mobileRecord do
969 if GameLoaded <> nil then
970 GameLoaded();
971 {$ENDIF}
972 WriteLnToConsole('Freeing progress textures... ');
973 FreeAndNilTexture(ProgrTex);
974 FreeAndNilTexture(LoadingText);
975 Step:= 0
976 end;
977
RenderHelpWindownull978 function RenderHelpWindow(caption, subcaption, description, extra: ansistring; extracolor: LongInt; iconsurf: PSDL_Surface; iconrect: PSDL_Rect): PTexture;
979 var tmpsurf: PSDL_SURFACE;
980 w, h, i, j: LongInt;
981 font: THWFont;
982 r, r2: TSDL_Rect;
983 wa, ha: LongInt;
984 tmpline, tmpline2, tmpline3, tmpdesc: ansistring;
985 begin
986 // make sure there is a caption as well as a sub caption - description is optional
987 if length(caption) = 0 then
988 caption:= ansistring('???');
989 if length(subcaption) = 0 then
990 subcaption:= ansistring(_S' ');
991
992 font:= CheckCJKFont(caption,fnt16);
993 font:= CheckCJKFont(subcaption,font);
994 font:= CheckCJKFont(description,font);
995 font:= CheckCJKFont(extra,font);
996
997 w:= 0;
998 h:= 0;
999 wa:= cFontBorder * 2 + 4;
1000 ha:= cFontBorder * 2;
1001
1002 i:= 0; j:= 0; // avoid compiler hints
1003
1004 // TODO: Recheck height/position calculation
1005
1006 // get caption's dimensions
1007 TTF_SizeUTF8(Fontz[font].Handle, PChar(caption), @i, @j);
1008 // width adds 36 px (image + space)
1009 w:= i + 36 + wa;
1010 h:= j + ha;
1011
1012 // get sub caption's dimensions
1013 TTF_SizeUTF8(Fontz[font].Handle, PChar(subcaption), @i, @j);
1014 // width adds 36 px (image + space)
1015 if w < (i + 36 + wa) then
1016 w:= i + 36 + wa;
1017 inc(h, j + ha);
1018
1019 // get description's dimensions
1020 tmpdesc:= description;
1021 while length(tmpdesc) > 0 do
1022 begin
1023 tmpline:= tmpdesc;
1024 EscapeCharA(tmpline, '|');
1025 SplitByCharA(tmpline, tmpdesc, '|');
1026 UnEscapeCharA(tmpline, '|');
1027 if length(tmpline) > 0 then
1028 begin
1029 TTF_SizeUTF8(Fontz[font].Handle, PChar(tmpline), @i, @j);
1030 if w < (i + wa) then
1031 w:= i + wa;
1032 inc(h, j + ha)
1033 end
1034 end;
1035
1036 if length(extra) > 0 then
1037 begin
1038 // get extra label's dimensions
1039 TTF_SizeUTF8(Fontz[font].Handle, PChar(extra), @i, @j);
1040 if w < (i + wa) then
1041 w:= i + wa;
1042 inc(h, j + ha);
1043 end;
1044
1045 // add borders space
1046 inc(w, wa);
1047 inc(h, ha + 8);
1048
1049 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, w, h, 32, RMask, GMask, BMask, AMask);
1050 if checkFails(tmpsurf <> nil, 'RenderHelpWindow: fail to create surface', true) then exit(nil);
1051
1052 // render border and background
1053 r.x:= 0;
1054 r.y:= 0;
1055 r.w:= w;
1056 r.h:= h;
1057 DrawRoundRect(@r, cWhiteColor, cNearBlackColor, tmpsurf, true);
1058
1059 // render caption
1060 r:= WriteInRect(tmpsurf, 36 + cFontBorder + 2, ha, $ffffffff, font, PChar(caption));
1061 // render sub caption
1062 r:= WriteInRect(tmpsurf, 36 + cFontBorder + 2, r.y + r.h, $ffc7c7c7, font, PChar(subcaption));
1063
1064 // render all description lines
1065 tmpdesc:= description;
1066 while length(tmpdesc) > 0 do
1067 begin
1068 tmpline:= tmpdesc;
1069 EscapeCharA(tmpline, '|');
1070 SplitByCharA(tmpline, tmpdesc, '|');
1071 UnEscapeCharA(tmpline, '|');
1072 r2:= r;
1073 if length(tmpline) > 0 then
1074 begin
1075
1076 // Render highlighted caption if there is a ':',
1077 // from the beginning of the line to (and including) the ':'.
1078 // With '::', the colons will be suppressed in the final text.
1079 EscapeCharA(tmpline, ':');
1080 tmpline2:= _S'';
1081 SplitByCharA(tmpline, tmpline2, ':');
1082 if length(tmpline2) > 0 then
1083 begin
1084 if (tmpline2[1] <> ':') then
1085 begin
1086 tmpline:= tmpline + ':';
1087 tmpline3:= tmpline + tmpline2;
1088 end
1089 else
1090 tmpline3:= tmpline + Copy(tmpline2, 2, Length(tmpline2)-1);
1091 UnEscapeCharA(tmpline3, ':');
1092 r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, PChar(tmpline3));
1093 WriteInRect(tmpsurf, cFontBorder + 2, r2.y + r2.h, $ffc7c7c7, font, PChar(tmpline));
1094 end
1095 else
1096 begin
1097 UnEscapeCharA(tmpline, ':');
1098 r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, PChar(tmpline));
1099 end
1100 end;
1101 end;
1102
1103 if length(extra) > 0 then
1104 r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, extracolor, font, PChar(extra));
1105
1106 r.x:= cFontBorder + 6;
1107 r.y:= cFontBorder + 4;
1108 r.w:= 32;
1109 r.h:= 32;
1110 SDL_FillRect(tmpsurf, @r, SDL_MapRGB(tmpsurf^.format, 0, 0, 0));
1111 SDL_UpperBlit(iconsurf, iconrect, tmpsurf, @r);
1112
1113 RenderHelpWindow:= Surface2Tex(tmpsurf, true);
1114 SDL_FreeSurface(tmpsurf)
1115 end;
1116
1117 procedure RenderWeaponTooltip(atype: TAmmoType);
1118 var r: TSDL_Rect;
1119 i: LongInt;
1120 ammoname: ansistring;
1121 ammocap: ansistring;
1122 ammodesc: ansistring;
1123 extra: ansistring;
1124 extracolor: LongInt;
1125 begin
1126 // don't do anything if the window shouldn't be shown
1127 if (cReducedQuality and rqTooltipsOff) <> 0 then
1128 begin
1129 WeaponTooltipTex:= nil;
1130 exit
1131 end;
1132
1133 // free old texture
1134 FreeAndNilTexture(WeaponTooltipTex);
1135
1136 // image region
1137 i:= LongInt(atype) - 1;
1138 r.x:= (i shr 4) * 32;
1139 r.y:= (i mod 16) * 32;
1140 r.w:= 32;
1141 r.h:= 32;
1142
1143 // default (no extra text)
1144 extra:= _S'';
1145 extracolor:= 0;
1146
1147 if (trluaammoe[Ammoz[atype].NameId] = true) then
1148 if (CurrentTeam <> nil) and (Ammoz[atype].SkipTurns >= CurrentTeam^.Clan^.TurnNumber) then // weapon or utility is not yet available
1149 begin
1150 if (atype = amTardis) and (SuddenDeathActive) then
1151 extra:= trmsg[sidNotAvailableInSD]
1152 else
1153 extra:= trmsg[sidNotYetAvailable];
1154 extracolor:= LongInt($ffc77070);
1155 end
1156 else if ((((GameFlags and gfInfAttack) <> 0) and ((Ammoz[atype].Ammo.Propz and ammoprop_ForceTurnEnd) = 0)) or ((Ammoz[atype].Ammo.Propz and ammoprop_NoRoundEnd) <> 0)) and (not (PlacingHogs and (atype = amTeleport))) then
1157 // weapon or utility will not end your turn
1158 begin
1159 extra:= trmsg[sidNoEndTurn];
1160 extracolor:= LongInt($ff70c770);
1161 end;
1162
1163 if length(trluaammo[Ammoz[atype].NameId]) > 0 then
1164 ammoname := trluaammo[Ammoz[atype].NameId]
1165 else
1166 ammoname := trammo[Ammoz[atype].NameId];
1167
1168 if length(trluaammoc[Ammoz[atype].NameId]) > 0 then
1169 ammocap := trluaammoc[Ammoz[atype].NameId]
1170 else
1171 ammocap := trammoc[Ammoz[atype].NameId];
1172
1173 if length(trluaammod[Ammoz[atype].NameId]) > 0 then
1174 ammodesc := trluaammod[Ammoz[atype].NameId]
1175 else
1176 ammodesc := trammod[Ammoz[atype].NameId];
1177
1178 if length(trluaammoa[Ammoz[atype].NameId]) > 0 then
1179 ammodesc := ammodesc + '|' + trluaammoa[Ammoz[atype].NameId];
1180
1181 // render window and return the texture
1182 WeaponTooltipTex:= RenderHelpWindow(ammoname, ammocap, ammodesc, extra, extracolor, SpritesData[sprAMAmmos].Surface, @r)
1183 end;
1184
1185 procedure ShowWeaponTooltip(x, y: LongInt);
1186 begin
1187 // draw the texture if it exists
1188 if WeaponTooltipTex <> nil then
1189 DrawTexture(x, y, WeaponTooltipTex)
1190 end;
1191
1192 {$IFDEF USE_VIDEO_RECORDING}
1193 procedure InitOffscreenOpenGL;
1194 begin
1195 // create hidden window
1196 SDLwindow:= SDL_CreateWindow(PChar('hedgewars video rendering (SDL2 hidden window)'),
1197 SDL_WINDOWPOS_CENTERED_MASK, SDL_WINDOWPOS_CENTERED_MASK,
1198 cScreenWidth, cScreenHeight,
1199 SDL_WINDOW_HIDDEN or SDL_WINDOW_OPENGL);
1200 if SDLCheck(SDLwindow <> nil, 'SDL_CreateWindow', true) then exit;
1201 SetupOpenGL();
1202 end;
1203 {$ENDIF} // USE_VIDEO_RECORDING
1204
1205 procedure chFullScr(var s: shortstring);
1206 var flags: Longword = 0;
1207 reinit: boolean = false;
1208 {$IFNDEF DARWIN}ico: PSDL_Surface;{$ENDIF}
1209 x, y: LongInt;
1210 begin
1211 if cOnlyStats then
1212 begin
1213 MaxTextureSize:= 1024;
1214 exit
1215 end;
1216 if Length(s) = 0 then
1217 cFullScreen:= (not cFullScreen)
1218 else cFullScreen:= s = '1';
1219
1220 if cFullScreen then
1221 begin
1222 cScreenWidth:= cFullscreenWidth;
1223 cScreenHeight:= cFullscreenHeight;
1224 end
1225 else
1226 begin
1227 cScreenWidth:= cWindowedWidth;
1228 cScreenHeight:= cWindowedHeight;
1229 end;
1230
1231 AddFileLog('Preparing to change video parameters...');
1232 if SDLwindow = nil then
1233 begin
1234 // set window title
1235 WriteToConsole('Init SDL_image... ');
1236 if SDLCheck(IMG_Init(IMG_INIT_PNG) <> 0, 'IMG_Init', true) then exit;
1237 WriteLnToConsole(msgOK);
1238 end
1239 else
1240 begin
1241 AmmoMenuInvalidated:= true;
1242 {$IFDEF IPHONEOS}
1243 // chFullScr is called when there is a rotation event and needs the SetScale and SetupOpenGL to set up the new resolution
1244 // this 6 gl functions are the relevant ones and are hacked together here for optimisation
1245 glMatrixMode(GL_MODELVIEW);
1246 glPopMatrix;
1247 glLoadIdentity();
1248 glScalef(2.0 / cScreenWidth, -2.0 / cScreenHeight, 1.0);
1249 glTranslatef(0, -cScreenHeight / 2, 0);
1250 glViewport(0, 0, cScreenWidth, cScreenHeight);
1251 exit;
1252 {$ELSE}
1253 SetScale(cDefaultZoomLevel);
1254 {$IFDEF USE_CONTEXT_RESTORE}
1255 reinit:= true;
1256 StoreRelease(true);
1257 ResetLand;
1258 ResetWorldTex;
1259 //uTextures.freeModule; //DEBUG ONLY
1260 {$ENDIF}
1261 AddFileLog('Freeing old primary surface...');
1262 {$ENDIF}
1263 end;
1264
1265 // these attributes must be set up before creating the sdl window
1266 {$IFNDEF WINDOWS}
1267 (* On a large number of testers machines, SDL default to software rendering
1268 when opengl attributes were set. These attributes were "set" after
1269 CreateWindow in .15, which probably did nothing.
1270 IMO we should rely on the gl_config defaults from SDL, and use
1271 SDL_GL_GetAttribute to possibly post warnings if any bad values are set.
1272 *)
1273 SetupOpenGLAttributes();
1274 {$ENDIF}
1275
1276 // these values in x and y make the window appear in the center
1277 x:= SDL_WINDOWPOS_CENTERED_MASK;
1278 y:= SDL_WINDOWPOS_CENTERED_MASK;
1279
1280 if SDLwindow = nil then
1281 begin
1282
1283 // SDL_WINDOW_RESIZABLE makes the window resizable and
1284 // respond to rotation events on mobile devices
1285 flags:= SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN or SDL_WINDOW_RESIZABLE;
1286
1287 {$IFDEF MOBILE}
1288 if isPhone() then
1289 SDL_SetHint('SDL_IOS_ORIENTATIONS','LandscapeLeft LandscapeRight');
1290 // no need for borders on mobile devices
1291 flags:= flags or SDL_WINDOW_BORDERLESS;
1292 {$ENDIF}
1293
1294 if cFullScreen then
1295 flags:= flags or SDL_WINDOW_FULLSCREEN;
1296
1297 SDLwindow:= SDL_CreateWindow(PChar('Hedgewars'), x, y, cScreenWidth, cScreenHeight, flags);
1298 end
1299 // we're toggling
1300 else if Length(s) = 0 then
1301 begin
1302 if cFullScreen then
1303 begin
1304 SDL_SetWindowSize(SDLwindow, cScreenWidth, cScreenHeight);
1305 SDL_SetWindowFullscreen(SDLwindow, SDL_WINDOW_FULLSCREEN);
1306 end
1307 else
1308 begin
1309 SDL_SetWindowFullscreen(SDLwindow, 0);
1310 SDL_SetWindowSize(SDLwindow, cScreenWidth, cScreenHeight);
1311 SDL_SetWindowPosition(SDLwindow, x, y);
1312 end;
1313 updateViewLimits();
1314 end;
1315
1316 if SDLCheck(SDLwindow <> nil, 'SDL_CreateWindow', true) then exit;
1317
1318 // load engine ico
1319 {$IFNDEF DARWIN}
1320 ico:= LoadDataImage(ptGraphics, 'hwengine', ifIgnoreCaps);
1321 if ico <> nil then
1322 begin
1323 SDL_SetWindowIcon(SDLwindow, ico);
1324 SDL_FreeSurface(ico);
1325 end;
1326 {$ENDIF}
1327 SetupOpenGL();
1328
1329 if reinit then
1330 begin
1331 // clean the window from any previous content
1332 RenderClear();
1333 if SuddenDeathDmg then
1334 SetSkyColor(SDSkyColor.r * (SDTint.r/255) / 255, SDSkyColor.g * (SDTint.g/255) / 255, SDSkyColor.b * (SDTint.b/255) / 255)
1335 else if ((cReducedQuality and rqNoBackground) = 0) then
1336 SetSkyColor(SkyColor.r / 255, SkyColor.g / 255, SkyColor.b / 255)
1337 else
1338 SetSkyColor(RQSkyColor.r / 255, RQSkyColor.g / 255, RQSkyColor.b / 255);
1339
1340 // reload everything we had before
1341 ReloadCaptions(false);
1342 ReloadLines;
1343 StoreLoad(true);
1344 // redraw all land
1345 UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT, false);
1346 end;
1347 end;
1348
1349 // for sdl1.2 we directly call SDL_WarpMouse()
1350 // for sdl2 we provide a SDL_WarpMouse() which just calls this function
1351 // this has the advantage of reducing 'uses' and 'ifdef' statements
1352 // (SDLwindow is a private member of this module)
1353 procedure WarpMouse(x, y: Word); inline;
1354 begin
1355 SDL_WarpMouseInWindow(SDLwindow, x, y);
1356 end;
1357
1358 procedure SwapBuffers; {$IFDEF USE_VIDEO_RECORDING}cdecl{$ELSE}inline{$ENDIF};
1359 begin
1360 if GameType = gmtRecord then
1361 exit;
1362 SDL_GL_SwapWindow(SDLwindow);
1363 end;
1364
1365 procedure SetSkyColor(r, g, b: real);
1366 begin
1367 RenderSetClearColor(r, g, b, 0.99)
1368 end;
1369
1370 procedure initModule;
1371 var ai: TAmmoType;
1372 i: LongInt;
1373 begin
1374 RegisterVariable('fullscr', @chFullScr, true);
1375
1376 cScaleFactor:= 2.0;
1377 updateViewLimits();
1378 Step:= 0;
1379 ProgrTex:= nil;
1380 SupportNPOTT:= false;
1381
1382 // init all ammo name texture pointers
1383 for ai:= Low(TAmmoType) to High(TAmmoType) do
1384 begin
1385 Ammoz[ai].NameTex := nil;
1386 end;
1387 // init all count texture pointers
1388 for i:= Low(CountTexz) to High(CountTexz) do
1389 CountTexz[i] := nil;
1390 SDLwindow:= nil;
1391 SDLGLcontext:= nil;
1392
1393 prevHat:= 'NoHat';
1394 tmpHatSurf:= nil;
1395 end;
1396
1397 procedure freeModule;
1398 var fi: THWFont;
1399 begin
1400 StoreRelease(false);
1401 // make sure fonts are cleaned up
1402 for fi:= Low(THWFont) to High(THWFont) do
1403 with Fontz[fi] do
1404 begin
1405 if Handle <> nil then
1406 begin
1407 TTF_CloseFont(Handle);
1408 Handle:= nil;
1409 end;
1410 end;
1411
1412 TTF_Quit();
1413 SDL_GL_DeleteContext(SDLGLcontext);
1414 SDL_DestroyWindow(SDLwindow);
1415 SDL_Quit();
1416 end;
1417 end.
1418