DEADSOFTWARE

gl: implement camera look up/down
[d2df-sdl.git] / src / game / renders / opengl / r_common.pas
index 61d03439a5423d5c00c2ee77e15a37d984d86183..99f46d1468c3ef3e5a2d39897178b750b9e2c48c 100644 (file)
@@ -17,9 +17,15 @@ unit r_common;
 
 interface
 
-  uses r_textures;
+  uses r_textures, g_player, g_phys;
 
   type
+    TBasePoint = (
+      BP_LEFTUP,   BP_UP,     BP_RIGHTUP,
+      BP_LEFT,     BP_CENTER, BP_RIGHT,
+      BP_LEFTDOWN, BP_DOWN,   BP_RIGHTDOWN
+    );
+
     THereTexture = record
       name: AnsiString;
       id: TGLTexture;
@@ -35,12 +41,239 @@ interface
 
   procedure r_Common_CalcAspect (ow, oh, nw, nh: LongInt; horizontal: Boolean; out ww, hh: LongInt);
 
+  procedure r_Common_GetBasePoint (x, y, w, h: Integer; p: TBasePoint; out xx, yy: Integer);
+  procedure r_Common_DrawText (const text: AnsiString; x, y: Integer; r, g, b, a: Byte; f: TGLFont; p: TBasePoint);
+  procedure r_Common_DrawTexture (img: TGLTexture; x, y, w, h: Integer; p: TBasePoint);
+  procedure r_Common_GetFormatTextSize (const text: AnsiString; f: TGLFont; out w, h: Integer);
+  procedure r_Common_DrawFormatText (const text: AnsiString; x, y: Integer; a: Byte; f: TGLFont; p: TBasePoint);
+
+  function r_Common_TimeToStr (t: LongWord): AnsiString;
+
+  procedure r_Common_GetObjectPos (const obj: TObj; out x, y: Integer);
+  procedure r_Common_GetPlayerPos (const p: TPlayer; out x, y: Integer);
+  procedure r_Common_GetCameraPos (const p: TPlayer; center: Boolean; out x, y: Integer);
+  function  r_Common_GetPosByUID (uid: WORD; out obj: TObj; out x, y: Integer): Boolean;
+
   procedure r_Common_Load;
   procedure r_Common_Free;
 
 implementation
 
-  uses e_log, r_fonts, g_options;
+  uses
+    Math, SysUtils,
+    e_log, utils,
+    g_base, g_basic, g_options, g_game, g_map,
+    {$IFDEF ENABLE_CORPSES}
+      g_corpses,
+    {$ENDIF}
+    r_draw, r_fonts
+  ;
+
+  procedure r_Common_GetObjectPos (const obj: TObj; out x, y: Integer);
+    var fx, fy: Integer;
+  begin
+    obj.Lerp(gLerpFactor, fx, fy);
+    x := fx;
+    y := fy + obj.slopeUpLeft;
+  end;
+
+  procedure r_Common_GetPlayerPos (const p: TPlayer; out x, y: Integer);
+    var fx, fy, fSlope: Integer;
+  begin
+    ASSERT(p <> nil);
+    p.obj.Lerp(gLerpFactor, fx, fy);
+    fSlope := nlerp(p.SlopeOld, p.obj.slopeUpLeft, gLerpFactor);
+    x := fx;
+    y := fy + fSlope;
+  end;
+
+{$IFDEF ENABLE_CORPSES}
+  function r_Common_GetPlayerCorpse (const p: TPlayer): TCorpse;
+  begin
+    result := nil;
+    if (p <> nil) and (p.Alive = false) and (p.Spectator = false) and (p.Corpse >= 0) then
+      if (gCorpses <> nil) and (gCorpses[p.Corpse] <> nil) and (gCorpses[p.Corpse].PlayerUID = p.UID) then
+        result := gCorpses[p.Corpse];
+  end;
+{$ENDIF}
+
+  procedure r_Common_GetCameraPos (const p: TPlayer; center: Boolean; out x, y: Integer);
+    {$IFDEF ENABLE_CORPSES}
+      var corpse: TCorpse;
+    {$ENDIF}
+  begin
+{$IFDEF ENABLE_CORPSES}
+    corpse := r_Common_GetPlayerCorpse(p);
+    if corpse <> nil then
+    begin
+      r_Common_GetObjectPos(corpse.obj, x, y);
+      if center then
+      begin
+        x := x + corpse.obj.rect.width div 2;
+        y := y + corpse.obj.rect.height div 2;
+      end;
+    end
+    else
+{$ENDIF}
+    if p <> nil then
+    begin
+      r_Common_GetPlayerPos(p, x, y);
+      y := y - nlerp(p.IncCamOld, p.IncCam, gLerpFactor);
+      if center then
+      begin
+        x := x + p.obj.rect.width div 2;
+        y := y + p.obj.rect.height div 2;
+      end;
+    end
+    else
+    begin
+      x := 0;
+      y := 0;
+      if center then
+      begin
+        x := x + gMapInfo.Width div 2;
+        y := y + gMapInfo.Height div 2;
+      end;
+    end;
+  end;
+
+  function r_Common_GetPosByUID (uid: WORD; out obj: TObj; out x, y: Integer): Boolean;
+    var p: TPlayer; found: Boolean;
+  begin
+    found := false;
+    if g_GetUIDType(uid) = UID_PLAYER then
+    begin
+      p := g_Player_Get(uid);
+      found := p <> nil;
+      if found then
+      begin
+        r_Common_GetPlayerPos(p, x, y);
+        obj := p.obj;
+      end;
+    end
+    else if GetPos(uid, @obj) then
+    begin
+      found := true;
+      r_Common_GetObjectPos(obj, x, y);
+    end;
+    result := found;
+  end;
+
+  procedure r_Common_GetBasePoint (x, y, w, h: Integer; p: TBasePoint; out xx, yy: Integer);
+  begin
+    case p of
+      TBasePoint.BP_LEFTUP,  TBasePoint.BP_LEFT,   TBasePoint.BP_LEFTDOWN:  xx := x;
+      TBasePoint.BP_UP,      TBasePoint.BP_CENTER, TBasePoint.BP_DOWN:      xx := x - w div 2;
+      TBasePoint.BP_RIGHTUP, TBasePoint.BP_RIGHT,  TBasePoint.BP_RIGHTDOWN: xx := x - w;
+    end;
+    case p of
+      TBasePoint.BP_LEFTUP,   TBasePoint.BP_UP,     TBasePoint.BP_RIGHTUP:   yy := y;
+      TBasePoint.BP_LEFT,     TBasePoint.BP_CENTER, TBasePoint.BP_RIGHT:     yy := y - h div 2;
+      TBasePoint.BP_LEFTDOWN, TBasePoint.BP_DOWN,   TBasePoint.BP_RIGHTDOWN: yy := y - h;
+    end;
+  end;
+
+  procedure r_Common_DrawText (const text: AnsiString; x, y: Integer; r, g, b, a: Byte; f: TGLFont; p: TBasePoint);
+    var xx, yy, w, h: Integer;
+  begin
+    xx := x; yy := y;
+    if p <> TBasePoint.BP_LEFTUP then
+    begin
+      r_Draw_GetTextSize(text, f, w, h);
+      r_Common_GetBasePoint(x, y, w, h, p, xx, yy);
+    end;
+    r_Draw_Text(text, xx, yy, r, g, b, a, f);
+  end;
+
+  procedure r_Common_DrawTexture (img: TGLTexture; x, y, w, h: Integer; p: TBasePoint);
+  begin
+    r_Common_GetBasePoint(x, y, w, h, p, x, y);
+    r_Draw_TextureRepeat(img, x, y, w, h, false, 255, 255, 255, 255, false);
+  end;
+
+  procedure r_Common_GetFormatTextSize (const text: AnsiString; f: TGLFont; out w, h: Integer);
+    var i, cw, ch, cln, curw, curh, maxw, maxh: Integer;
+  begin
+    curw := 0; curh := 0; maxw := 0; maxh := 0;
+    r_Draw_GetTextSize('W', f, cw, cln);
+    for i := 1 to Length(text) do
+    begin
+      case text[i] of
+        #10:
+        begin
+          maxw := MAX(maxw, curw);
+          curh := curh + cln;
+          curw := 0;
+        end;
+        #1, #2, #3, #4, #18, #19, #20, #21:
+        begin
+          // skip color modifiers
+        end;
+        otherwise
+        begin
+          r_Draw_GetTextSize(text[i], f, cw, ch);
+          maxh := MAX(maxh, curh + ch);
+          curw := curw + cw;
+        end;
+      end;
+    end;
+    w := MAX(maxw, curw);
+    h := MAX(maxh, curh);
+  end;
+
+  procedure r_Common_DrawFormatText (const text: AnsiString; x, y: Integer; a: Byte; f: TGLFont; p: TBasePoint);
+    const
+      colors: array [boolean, 0..5] of TRGB = (
+        ((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)),
+        ((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))
+      );
+    var
+      i, xx, yy, cx, cy, w, h, cw, ch, cln, color: Integer; dark: Boolean;
+  begin
+    xx := x; yy := y;
+    if p <> TBasePoint.BP_LEFTUP then
+    begin
+      r_Common_GetFormatTextSize(text, f, w, h);
+      r_Common_GetBasePoint(x, y, w, h, p, xx, yy);
+    end;
+    cx := xx; cy := yy; color := 5; dark := false;
+    r_Draw_GetTextSize('W', f, cw, cln);
+    for i := 1 to Length(text) do
+    begin
+      case text[i] of
+        #10:
+        begin
+          cx := xx;
+          INC(cy, cln);
+        end;
+        #1: color := 0;
+        #2: color := 5;
+        #3: dark := true;
+        #4: dark := false;
+        #18: color := 1;
+        #19: color := 2;
+        #20: color := 4;
+        #21: color := 3;
+        otherwise
+        begin
+          r_Draw_GetTextSize(text[i], f, cw, ch);
+          r_Draw_Text(text[i], cx, cy, colors[dark, color].R, colors[dark, color].G, colors[dark, color].B, a, f);
+          INC(cx, cw);
+        end;
+      end;
+    end;
+  end;
+
+  function r_Common_TimeToStr (t: LongWord): AnsiString;
+    var h, m, s: Integer;
+  begin
+    h := t div 1000 div 3600;
+    m := t div 1000 div 60 mod 60;
+    s := t div 1000 mod 60;
+    result := Format('%d:%.2d:%.2d', [h, m, s]);
+  end;
+
+  (* ---------  --------- *)
 
   procedure r_Common_FreeThis (var here: THereTexture);
   begin