99f46d1468c3ef3e5a2d39897178b750b9e2c48c
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
);
121 y
:= y
- nlerp(p
.IncCamOld
, p
.IncCam
, gLerpFactor
);
124 x
:= x
+ p
.obj
.rect
.width
div 2;
125 y
:= y
+ p
.obj
.rect
.height
div 2;
134 x
:= x
+ gMapInfo
.Width
div 2;
135 y
:= y
+ gMapInfo
.Height
div 2;
140 function r_Common_GetPosByUID (uid
: WORD; out obj
: TObj
; out x
, y
: Integer): Boolean;
141 var p
: TPlayer
; found
: Boolean;
144 if g_GetUIDType(uid
) = UID_PLAYER
then
146 p
:= g_Player_Get(uid
);
150 r_Common_GetPlayerPos(p
, x
, y
);
154 else if GetPos(uid
, @obj
) then
157 r_Common_GetObjectPos(obj
, x
, y
);
162 procedure r_Common_GetBasePoint (x
, y
, w
, h
: Integer; p
: TBasePoint
; out xx
, yy
: Integer);
165 TBasePoint
.BP_LEFTUP
, TBasePoint
.BP_LEFT
, TBasePoint
.BP_LEFTDOWN
: xx
:= x
;
166 TBasePoint
.BP_UP
, TBasePoint
.BP_CENTER
, TBasePoint
.BP_DOWN
: xx
:= x
- w
div 2;
167 TBasePoint
.BP_RIGHTUP
, TBasePoint
.BP_RIGHT
, TBasePoint
.BP_RIGHTDOWN
: xx
:= x
- w
;
170 TBasePoint
.BP_LEFTUP
, TBasePoint
.BP_UP
, TBasePoint
.BP_RIGHTUP
: yy
:= y
;
171 TBasePoint
.BP_LEFT
, TBasePoint
.BP_CENTER
, TBasePoint
.BP_RIGHT
: yy
:= y
- h
div 2;
172 TBasePoint
.BP_LEFTDOWN
, TBasePoint
.BP_DOWN
, TBasePoint
.BP_RIGHTDOWN
: yy
:= y
- h
;
176 procedure r_Common_DrawText (const text: AnsiString; x
, y
: Integer; r
, g
, b
, a
: Byte; f
: TGLFont
; p
: TBasePoint
);
177 var xx
, yy
, w
, h
: Integer;
180 if p
<> TBasePoint
.BP_LEFTUP
then
182 r_Draw_GetTextSize(text, f
, w
, h
);
183 r_Common_GetBasePoint(x
, y
, w
, h
, p
, xx
, yy
);
185 r_Draw_Text(text, xx
, yy
, r
, g
, b
, a
, f
);
188 procedure r_Common_DrawTexture (img
: TGLTexture
; x
, y
, w
, h
: Integer; p
: TBasePoint
);
190 r_Common_GetBasePoint(x
, y
, w
, h
, p
, x
, y
);
191 r_Draw_TextureRepeat(img
, x
, y
, w
, h
, false, 255, 255, 255, 255, false);
194 procedure r_Common_GetFormatTextSize (const text: AnsiString; f
: TGLFont
; out w
, h
: Integer);
195 var i
, cw
, ch
, cln
, curw
, curh
, maxw
, maxh
: Integer;
197 curw
:= 0; curh
:= 0; maxw
:= 0; maxh
:= 0;
198 r_Draw_GetTextSize('W', f
, cw
, cln
);
199 for i
:= 1 to Length(text) do
204 maxw
:= MAX(maxw
, curw
);
208 #1, #2, #3, #4, #18, #19, #20, #21:
210 // skip color modifiers
214 r_Draw_GetTextSize(text[i
], f
, cw
, ch
);
215 maxh
:= MAX(maxh
, curh
+ ch
);
220 w
:= MAX(maxw
, curw
);
221 h
:= MAX(maxh
, curh
);
224 procedure r_Common_DrawFormatText (const text: AnsiString; x
, y
: Integer; a
: Byte; f
: TGLFont
; p
: TBasePoint
);
226 colors
: array [boolean, 0..5] of TRGB
= (
227 ((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)),
228 ((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))
231 i
, xx
, yy
, cx
, cy
, w
, h
, cw
, ch
, cln
, color
: Integer; dark
: Boolean;
234 if p
<> TBasePoint
.BP_LEFTUP
then
236 r_Common_GetFormatTextSize(text, f
, w
, h
);
237 r_Common_GetBasePoint(x
, y
, w
, h
, p
, xx
, yy
);
239 cx
:= xx
; cy
:= yy
; color
:= 5; dark
:= false;
240 r_Draw_GetTextSize('W', f
, cw
, cln
);
241 for i
:= 1 to Length(text) do
259 r_Draw_GetTextSize(text[i
], f
, cw
, ch
);
260 r_Draw_Text(text[i
], cx
, cy
, colors
[dark
, color
].R
, colors
[dark
, color
].G
, colors
[dark
, color
].B
, a
, f
);
267 function r_Common_TimeToStr (t
: LongWord): AnsiString;
268 var h
, m
, s
: Integer;
270 h
:= t
div 1000 div 3600;
271 m
:= t
div 1000 div 60 mod 60;
272 s
:= t
div 1000 mod 60;
273 result
:= Format('%d:%.2d:%.2d', [h
, m
, s
]);
276 (* --------- --------- *)
278 procedure r_Common_FreeThis (var here
: THereTexture
);
281 if here
.id
<> nil then
286 function r_Common_LoadThis (const name
: AnsiString; var here
: THereTexture
): Boolean;
288 if name
<> here
.name
then
289 r_Common_FreeThis(here
);
290 if (name
<> '') and (here
.name
<> name
) then
291 here
.id
:= r_Textures_LoadFromFile(name
);
293 result
:= here
.id
<> nil;
299 procedure r_Common_CalcAspect (ow
, oh
, nw
, nh
: LongInt; horizontal
: Boolean; out ww
, hh
: LongInt);
304 hh
:= nw
* oh
div ow
;
308 ww
:= nh
* ow
div oh
;
313 function r_Common_LoadFont (const name
: AnsiString): TGLFont
;
314 var info
: TFontInfo
; skiphack
: Integer;
317 if name
= 'STD' then skiphack
:= 144 else skiphack
:= 0;
318 if r_Font_LoadInfoFromFile(GameWad
+ ':FONTS/' + name
+ 'TXT', info
) then
319 result
:= r_Textures_LoadFontFromFile(GameWad
+ ':FONTS/' + name
+ 'FONT', info
, skiphack
, true);
321 e_logwritefln('failed to load font %s', [name
]);
324 procedure r_Common_Load
;
326 stdfont
:= r_Common_LoadFont('STD');
327 smallfont
:= r_Common_LoadFont('SMALL');
328 menufont
:= r_Common_LoadFont('MENU');
331 procedure r_Common_Free
;