1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../../../shared/a_modes.inc}
20 uses r_textures
, g_player
, g_phys
;
24 BP_LEFTUP
, BP_UP
, BP_RIGHTUP
,
25 BP_LEFT
, BP_CENTER
, BP_RIGHT
,
26 BP_LEFTDOWN
, BP_DOWN
, BP_RIGHTDOWN
39 function r_Common_LoadThis (const name
: AnsiString; var here
: THereTexture
): Boolean;
40 procedure r_Common_FreeThis (var here
: THereTexture
);
42 procedure r_Common_CalcAspect (ow
, oh
, nw
, nh
: LongInt; horizontal
: Boolean; out ww
, hh
: LongInt);
44 procedure r_Common_GetBasePoint (x
, y
, w
, h
: Integer; p
: TBasePoint
; out xx
, yy
: Integer);
45 procedure r_Common_DrawText (const text: AnsiString; x
, y
: Integer; r
, g
, b
, a
: Byte; f
: TGLFont
; p
: TBasePoint
);
46 procedure r_Common_DrawTexture (img
: TGLTexture
; x
, y
, w
, h
: Integer; p
: TBasePoint
);
47 procedure r_Common_GetFormatTextSize (const text: AnsiString; f
: TGLFont
; out w
, h
: Integer);
48 procedure r_Common_DrawFormatText (const text: AnsiString; x
, y
: Integer; a
: Byte; f
: TGLFont
; p
: TBasePoint
);
50 function r_Common_TimeToStr (t
: LongWord): AnsiString;
52 procedure r_Common_GetObjectPos (const obj
: TObj
; out x
, y
: Integer);
53 procedure r_Common_GetPlayerPos (const p
: TPlayer
; out x
, y
: Integer);
54 procedure r_Common_GetCameraPos (const p
: TPlayer
; center
: Boolean; out x
, y
: Integer);
55 function r_Common_GetPosByUID (uid
: WORD; out obj
: TObj
; out x
, y
: Integer): Boolean;
57 procedure r_Common_Load
;
58 procedure r_Common_Free
;
65 g_base
, g_basic
, g_options
, g_game
, g_map
,
66 {$IFDEF ENABLE_CORPSES}
72 procedure r_Common_GetObjectPos (const obj
: TObj
; out x
, y
: Integer);
75 obj
.Lerp(gLerpFactor
, fx
, fy
);
77 y
:= fy
+ obj
.slopeUpLeft
;
80 procedure r_Common_GetPlayerPos (const p
: TPlayer
; out x
, y
: Integer);
81 var fx
, fy
, fSlope
: Integer;
84 p
.obj
.Lerp(gLerpFactor
, fx
, fy
);
85 fSlope
:= nlerp(p
.SlopeOld
, p
.obj
.slopeUpLeft
, gLerpFactor
);
90 {$IFDEF ENABLE_CORPSES}
91 function r_Common_GetPlayerCorpse (const p
: TPlayer
): TCorpse
;
94 if (p
<> nil) and (p
.Alive
= false) and (p
.Spectator
= false) and (p
.Corpse
>= 0) then
95 if (gCorpses
<> nil) and (gCorpses
[p
.Corpse
] <> nil) and (gCorpses
[p
.Corpse
].PlayerUID
= p
.UID
) then
96 result
:= gCorpses
[p
.Corpse
];
100 procedure r_Common_GetCameraPos (const p
: TPlayer
; center
: Boolean; out x
, y
: Integer);
101 {$IFDEF ENABLE_CORPSES}
105 {$IFDEF ENABLE_CORPSES}
106 corpse
:= r_Common_GetPlayerCorpse(p
);
107 if corpse
<> nil then
109 r_Common_GetObjectPos(corpse
.obj
, x
, y
);
112 x
:= x
+ corpse
.obj
.rect
.width
div 2;
113 y
:= y
+ corpse
.obj
.rect
.height
div 2;
120 r_Common_GetPlayerPos(p
, x
, y
);
123 x
:= x
+ p
.obj
.rect
.width
div 2;
124 y
:= y
+ p
.obj
.rect
.height
div 2;
133 x
:= x
+ gMapInfo
.Width
div 2;
134 y
:= y
+ gMapInfo
.Height
div 2;
139 function r_Common_GetPosByUID (uid
: WORD; out obj
: TObj
; out x
, y
: Integer): Boolean;
140 var p
: TPlayer
; found
: Boolean;
143 if g_GetUIDType(uid
) = UID_PLAYER
then
145 p
:= g_Player_Get(uid
);
149 r_Common_GetPlayerPos(p
, x
, y
);
153 else if GetPos(uid
, @obj
) then
156 r_Common_GetObjectPos(obj
, x
, y
);
161 procedure r_Common_GetBasePoint (x
, y
, w
, h
: Integer; p
: TBasePoint
; out xx
, yy
: Integer);
164 TBasePoint
.BP_LEFTUP
, TBasePoint
.BP_LEFT
, TBasePoint
.BP_LEFTDOWN
: xx
:= x
;
165 TBasePoint
.BP_UP
, TBasePoint
.BP_CENTER
, TBasePoint
.BP_DOWN
: xx
:= x
- w
div 2;
166 TBasePoint
.BP_RIGHTUP
, TBasePoint
.BP_RIGHT
, TBasePoint
.BP_RIGHTDOWN
: xx
:= x
- w
;
169 TBasePoint
.BP_LEFTUP
, TBasePoint
.BP_UP
, TBasePoint
.BP_RIGHTUP
: yy
:= y
;
170 TBasePoint
.BP_LEFT
, TBasePoint
.BP_CENTER
, TBasePoint
.BP_RIGHT
: yy
:= y
- h
div 2;
171 TBasePoint
.BP_LEFTDOWN
, TBasePoint
.BP_DOWN
, TBasePoint
.BP_RIGHTDOWN
: yy
:= y
- h
;
175 procedure r_Common_DrawText (const text: AnsiString; x
, y
: Integer; r
, g
, b
, a
: Byte; f
: TGLFont
; p
: TBasePoint
);
176 var xx
, yy
, w
, h
: Integer;
179 if p
<> TBasePoint
.BP_LEFTUP
then
181 r_Draw_GetTextSize(text, f
, w
, h
);
182 r_Common_GetBasePoint(x
, y
, w
, h
, p
, xx
, yy
);
184 r_Draw_Text(text, xx
, yy
, r
, g
, b
, a
, f
);
187 procedure r_Common_DrawTexture (img
: TGLTexture
; x
, y
, w
, h
: Integer; p
: TBasePoint
);
189 r_Common_GetBasePoint(x
, y
, w
, h
, p
, x
, y
);
190 r_Draw_TextureRepeat(img
, x
, y
, w
, h
, false, 255, 255, 255, 255, false);
193 procedure r_Common_GetFormatTextSize (const text: AnsiString; f
: TGLFont
; out w
, h
: Integer);
194 var i
, cw
, ch
, cln
, curw
, curh
, maxw
, maxh
: Integer;
196 curw
:= 0; curh
:= 0; maxw
:= 0; maxh
:= 0;
197 r_Draw_GetTextSize('W', f
, cw
, cln
);
198 for i
:= 1 to Length(text) do
203 maxw
:= MAX(maxw
, curw
);
207 #1, #2, #3, #4, #18, #19, #20, #21:
209 // skip color modifiers
213 r_Draw_GetTextSize(text[i
], f
, cw
, ch
);
214 maxh
:= MAX(maxh
, curh
+ ch
);
219 w
:= MAX(maxw
, curw
);
220 h
:= MAX(maxh
, curh
);
223 procedure r_Common_DrawFormatText (const text: AnsiString; x
, y
: Integer; a
: Byte; f
: TGLFont
; p
: TBasePoint
);
225 colors
: array [boolean, 0..5] of TRGB
= (
226 ((R
:$00; G
:$00; B
:$00), (R
:$FF; G
:$00; B
:$00), (R
:$00; G
:$FF; B
:$00), (R
:$FF; G
:$FF; B
:$00), (R
:$00; G
:$00; B
:$FF), (R
:$FF; G
:$FF; B
:$FF)),
227 ((R
:$00; G
:$00; B
:$00), (R
:$7F; G
:$00; B
:$00), (R
:$00; G
:$7F; B
:$00), (R
:$FF; G
:$7F; B
:$00), (R
:$00; G
:$00; B
:$7F), (R
:$7F; G
:$7F; B
:$7F))
230 i
, xx
, yy
, cx
, cy
, w
, h
, cw
, ch
, cln
, color
: Integer; dark
: Boolean;
233 if p
<> TBasePoint
.BP_LEFTUP
then
235 r_Common_GetFormatTextSize(text, f
, w
, h
);
236 r_Common_GetBasePoint(x
, y
, w
, h
, p
, xx
, yy
);
238 cx
:= xx
; cy
:= yy
; color
:= 5; dark
:= false;
239 r_Draw_GetTextSize('W', f
, cw
, cln
);
240 for i
:= 1 to Length(text) do
258 r_Draw_GetTextSize(text[i
], f
, cw
, ch
);
259 r_Draw_Text(text[i
], cx
, cy
, colors
[dark
, color
].R
, colors
[dark
, color
].G
, colors
[dark
, color
].B
, a
, f
);
266 function r_Common_TimeToStr (t
: LongWord): AnsiString;
267 var h
, m
, s
: Integer;
269 h
:= t
div 1000 div 3600;
270 m
:= t
div 1000 div 60 mod 60;
271 s
:= t
div 1000 mod 60;
272 result
:= Format('%d:%.2d:%.2d', [h
, m
, s
]);
275 (* --------- --------- *)
277 procedure r_Common_FreeThis (var here
: THereTexture
);
280 if here
.id
<> nil then
285 function r_Common_LoadThis (const name
: AnsiString; var here
: THereTexture
): Boolean;
287 if name
<> here
.name
then
288 r_Common_FreeThis(here
);
289 if (name
<> '') and (here
.name
<> name
) then
290 here
.id
:= r_Textures_LoadFromFile(name
);
292 result
:= here
.id
<> nil;
298 procedure r_Common_CalcAspect (ow
, oh
, nw
, nh
: LongInt; horizontal
: Boolean; out ww
, hh
: LongInt);
303 hh
:= nw
* oh
div ow
;
307 ww
:= nh
* ow
div oh
;
312 function r_Common_LoadFont (const name
: AnsiString): TGLFont
;
313 var info
: TFontInfo
; skiphack
: Integer;
316 if name
= 'STD' then skiphack
:= 144 else skiphack
:= 0;
317 if r_Font_LoadInfoFromFile(GameWad
+ ':FONTS/' + name
+ 'TXT', info
) then
318 result
:= r_Textures_LoadFontFromFile(GameWad
+ ':FONTS/' + name
+ 'FONT', info
, skiphack
, true);
320 e_logwritefln('failed to load font %s', [name
]);
323 procedure r_Common_Load
;
325 stdfont
:= r_Common_LoadFont('STD');
326 smallfont
:= r_Common_LoadFont('SMALL');
327 menufont
:= r_Common_LoadFont('MENU');
330 procedure r_Common_Free
;