author | Wuzzy <Wuzzy2@mail.ru> |
Sun, 29 Sep 2019 21:42:46 +0200 | |
changeset 15434 | 4ed8b0301e1e |
parent 12215 | 2cbc57db82e1 |
permissions | -rw-r--r-- |
4976 | 1 |
(* |
2 |
* Hedgewars, a free turn based strategy game |
|
11046 | 3 |
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
4976 | 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 |
|
10108
c68cf030eded
update FSF address. note: two sdl include files (by Sam Lantinga) still have the old FSF address in their copyright - but I ain't gonna touch their copyright headers
sheepluva
parents:
10105
diff
changeset
|
16 |
* Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |
4976 | 17 |
*) |
10015 | 18 |
|
5303
e06bf3954a83
this should fix captions on iOS (and android), though I can't check
Henek
parents:
4976
diff
changeset
|
19 |
{$INCLUDE "options.inc"} |
4976 | 20 |
|
4393 | 21 |
unit uCaptions; |
22 |
||
23 |
interface |
|
24 |
uses uTypes; |
|
25 |
||
10124
aabd1b75d5a3
Even more explicit type conversions and other stuff to help pas2c use ansistrings
unc0rr
parents:
10116
diff
changeset
|
26 |
procedure AddCaption(s: ansistring; Color: Longword; Group: TCapGroup); |
4393 | 27 |
procedure DrawCaptions; |
6394
f0a9042e7387
yay, finally osx (and likely windows) fullscreen switch works like on linux! ALL textures had to be destroyed and recreated only after the new window got created. In other news, the new window must be cleaned with glClear to skip a first frame of garbage and AddProgress is only called the first time.
koda
parents:
6383
diff
changeset
|
28 |
procedure ReloadCaptions(unload: boolean); |
4393 | 29 |
|
30 |
procedure initModule; |
|
31 |
procedure freeModule; |
|
32 |
||
33 |
implementation |
|
4850 | 34 |
uses uTextures, uRenderUtils, uVariables, uRender; |
4393 | 35 |
|
36 |
type TCaptionStr = record |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6415
diff
changeset
|
37 |
Tex: PTexture; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6415
diff
changeset
|
38 |
EndTime: LongWord; |
10124
aabd1b75d5a3
Even more explicit type conversions and other stuff to help pas2c use ansistrings
unc0rr
parents:
10116
diff
changeset
|
39 |
Text: ansistring; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6415
diff
changeset
|
40 |
Color: Longword |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6415
diff
changeset
|
41 |
end; |
4393 | 42 |
var |
43 |
Captions: array[TCapGroup] of TCaptionStr; |
|
44 |
||
10124
aabd1b75d5a3
Even more explicit type conversions and other stuff to help pas2c use ansistrings
unc0rr
parents:
10116
diff
changeset
|
45 |
procedure AddCaption(s: ansistring; Color: Longword; Group: TCapGroup); |
4393 | 46 |
begin |
8027
e5ba3dd12531
make stats-only mode work headless. also skip a few things to save time/memory.
nemo
parents:
6999
diff
changeset
|
47 |
if cOnlyStats then exit; |
8026
4a4f21070479
merge xymeng's gsoc engine with a few updates (and further checks on symbol definitions)
koda
parents:
6999
diff
changeset
|
48 |
if Length(s) = 0 then |
4a4f21070479
merge xymeng's gsoc engine with a few updates (and further checks on symbol definitions)
koda
parents:
6999
diff
changeset
|
49 |
exit; |
12215
2cbc57db82e1
Fix caption not updating if adding caption with same text but different color
Wuzzy <almikes@aol.com>
parents:
11046
diff
changeset
|
50 |
if (Captions[Group].Text <> s) or (Captions[Group].Color <> Color) then |
10634
35d059bd0932
Use FreeAndNil across the board. Even if we are immediately assigning after, probably avoids accidental mistakes. Also free neglected owner tex on shutdown, and delete hog gears using the normal deletion procedure if for any reason they still exist (EndGame call?).
nemo
parents:
10124
diff
changeset
|
51 |
FreeAndNilTexture(Captions[Group].Tex); |
10015 | 52 |
|
6374 | 53 |
if Captions[Group].Tex = nil then |
6371
c6f73d8e87e2
Skip rerendering the caption if the text is unchanged. Scripts make heavy use of caption, often onGameTick
nemo
parents:
5303
diff
changeset
|
54 |
begin |
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
55 |
Captions[Group].Color:= Color; |
6371
c6f73d8e87e2
Skip rerendering the caption if the text is unchanged. Scripts make heavy use of caption, often onGameTick
nemo
parents:
5303
diff
changeset
|
56 |
Captions[Group].Text:= s; |
c6f73d8e87e2
Skip rerendering the caption if the text is unchanged. Scripts make heavy use of caption, often onGameTick
nemo
parents:
5303
diff
changeset
|
57 |
Captions[Group].Tex:= RenderStringTex(s, Color, fntBig) |
c6f73d8e87e2
Skip rerendering the caption if the text is unchanged. Scripts make heavy use of caption, often onGameTick
nemo
parents:
5303
diff
changeset
|
58 |
end; |
4393 | 59 |
|
60 |
case Group of |
|
61 |
capgrpGameState: Captions[Group].EndTime:= RealTicks + 2200 |
|
62 |
else |
|
63 |
Captions[Group].EndTime:= RealTicks + 1400 + LongWord(Captions[Group].Tex^.w) * 3; |
|
64 |
end; |
|
65 |
end; |
|
6382
0e76c5cd4250
move the order of reloading texture to workaround buggy drivers
koda
parents:
6379
diff
changeset
|
66 |
|
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
67 |
// For uStore texture recreation |
6394
f0a9042e7387
yay, finally osx (and likely windows) fullscreen switch works like on linux! ALL textures had to be destroyed and recreated only after the new window got created. In other news, the new window must be cleaned with glClear to skip a first frame of garbage and AddProgress is only called the first time.
koda
parents:
6383
diff
changeset
|
68 |
procedure ReloadCaptions(unload: boolean); |
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
69 |
var Group: TCapGroup; |
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
70 |
begin |
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
71 |
for Group:= Low(TCapGroup) to High(TCapGroup) do |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6415
diff
changeset
|
72 |
if unload then |
10634
35d059bd0932
Use FreeAndNil across the board. Even if we are immediately assigning after, probably avoids accidental mistakes. Also free neglected owner tex on shutdown, and delete hog gears using the normal deletion procedure if for any reason they still exist (EndGame call?).
nemo
parents:
10124
diff
changeset
|
73 |
FreeAndNilTexture(Captions[Group].Tex) |
10124
aabd1b75d5a3
Even more explicit type conversions and other stuff to help pas2c use ansistrings
unc0rr
parents:
10116
diff
changeset
|
74 |
else if length(Captions[Group].Text) > 0 then |
6383
c34a8b98d78c
increase land tex size to 512, which is the current minimum required just to load a hat. On my system max fps rose from 840 to 890 - about 6% change.
nemo
parents:
6382
diff
changeset
|
75 |
Captions[Group].Tex:= RenderStringTex(Captions[Group].Text, Captions[Group].Color, fntBig) |
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
76 |
end; |
4393 | 77 |
|
78 |
procedure DrawCaptions; |
|
79 |
var |
|
80 |
grp: TCapGroup; |
|
81 |
offset: LongInt; |
|
82 |
begin |
|
6685
ef706fccfb0a
moved other widgets under the USE_TOUCH_INTERFACE, added pause button (at least, graphically...)
koda
parents:
6580
diff
changeset
|
83 |
{$IFDEF USE_TOUCH_INTERFACE} |
5303
e06bf3954a83
this should fix captions on iOS (and android), though I can't check
Henek
parents:
4976
diff
changeset
|
84 |
offset:= 48; |
4808 | 85 |
{$ELSE} |
86 |
offset:= 8; |
|
87 |
{$ENDIF} |
|
4393 | 88 |
|
89 |
for grp:= Low(TCapGroup) to High(TCapGroup) do |
|
90 |
with Captions[grp] do |
|
91 |
if Tex <> nil then |
|
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
92 |
begin |
6999 | 93 |
DrawTextureCentered(0, offset, Tex); |
4393 | 94 |
inc(offset, Tex^.h + 2); |
95 |
if EndTime <= RealTicks then |
|
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
96 |
begin |
10634
35d059bd0932
Use FreeAndNil across the board. Even if we are immediately assigning after, probably avoids accidental mistakes. Also free neglected owner tex on shutdown, and delete hog gears using the normal deletion procedure if for any reason they still exist (EndGame call?).
nemo
parents:
10124
diff
changeset
|
97 |
FreeAndNilTexture(Tex); |
10124
aabd1b75d5a3
Even more explicit type conversions and other stuff to help pas2c use ansistrings
unc0rr
parents:
10116
diff
changeset
|
98 |
Text:= ansistring(''); |
4393 | 99 |
EndTime:= 0 |
6377
3ce19204b14b
Since I'm storing the text string anyway, might as well recreate captions on resize as well
nemo
parents:
6374
diff
changeset
|
100 |
end; |
4393 | 101 |
end; |
102 |
end; |
|
103 |
||
104 |
procedure initModule; |
|
105 |
begin |
|
106 |
FillChar(Captions, sizeof(Captions), 0) |
|
107 |
end; |
|
108 |
||
109 |
procedure freeModule; |
|
6383
c34a8b98d78c
increase land tex size to 512, which is the current minimum required just to load a hat. On my system max fps rose from 840 to 890 - about 6% change.
nemo
parents:
6382
diff
changeset
|
110 |
var group: TCapGroup; |
4393 | 111 |
begin |
4901 | 112 |
for group:= Low(TCapGroup) to High(TCapGroup) do |
10634
35d059bd0932
Use FreeAndNil across the board. Even if we are immediately assigning after, probably avoids accidental mistakes. Also free neglected owner tex on shutdown, and delete hog gears using the normal deletion procedure if for any reason they still exist (EndGame call?).
nemo
parents:
10124
diff
changeset
|
113 |
FreeAndNilTexture(Captions[group].Tex); |
4393 | 114 |
end; |
115 |
||
116 |
end. |