src/game/opengl/r_console.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   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.
   6  *
   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.
  11  *
  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/>.
  14  *)
  15 {$INCLUDE ../../shared/a_modes.inc}
  16 unit r_console;
  17
  18 interface
  19
  20   procedure r_Console_Init;
  21   procedure r_Console_Update;
  22   procedure r_Console_Draw (MessagesOnly: Boolean = False);
  23
  24 implementation
  25
  26   uses
  27     SysUtils, Classes, Math,
  28     e_log, r_graphics,
  29     conbuf,
  30     g_base, g_main, g_console, g_game, g_menu, g_textures
  31   ;
  32
  33 (* ====== Console ====== *)
  34
  35 const
  36   DEBUG_STRING = 'DEBUG MODE';
  37
  38 var
  39   ID: DWORD;
  40   ConsoleTrans: Single;
  41   ChatTop: BOOLEAN;
  42
  43   Cons_Y: SmallInt;
  44   ConsoleHeight: Single;
  45   ConsoleStep: Single;
  46   Cons_Shown: Boolean; // draw console
  47
  48 procedure drawConsoleText ();
  49 var
  50   CWidth, CHeight: Byte;
  51   ty: Integer;
  52   sp, ep: LongWord;
  53   skip: Integer;
  54
  55   procedure putLine (sp, ep: LongWord);
  56   var
  57     p: LongWord;
  58     wdt, cw: Integer;
  59   begin
  60     p := sp;
  61     wdt := 0;
  62     while p <> ep do
  63     begin
  64       cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
  65       if wdt+cw > gScreenWidth-8 then break;
  66       //e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
  67       Inc(wdt, cw);
  68       cbufNext(p);
  69     end;
  70     if p <> ep then putLine(p, ep); // do rest of the line first
  71     // now print our part
  72     if skip = 0 then
  73     begin
  74       ep := p;
  75       p := sp;
  76       wdt := 2;
  77       while p <> ep do
  78       begin
  79         cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
  80         e_TextureFontPrintCharEx(wdt, ty, cbufAt(p), gStdFont);
  81         Inc(wdt, cw);
  82         cbufNext(p);
  83       end;
  84       Dec(ty, CHeight);
  85     end
  86     else
  87     begin
  88       Dec(skip);
  89     end;
  90   end;
  91
  92 begin
  93   e_TextureFontGetSize(gStdFont, CWidth, CHeight);
  94   ty := Floor(gScreenHeight * ConsoleHeight) - 4 - 2 * CHeight - Abs(Cons_Y);
  95   skip := conSkipLines;
  96   cbufLastLine(sp, ep);
  97   repeat
  98     putLine(sp, ep);
  99     if ty+CHeight <= 0 then break;
 100   until not cbufLineUp(sp, ep);
 101 end;
 102
 103 procedure r_Console_Draw (MessagesOnly: Boolean = False);
 104 var
 105   CWidth, CHeight: Byte;
 106   mfW, mfH: Word;
 107   a, b, offset_y: Integer;
 108 begin
 109   e_TextureFontGetSize(gStdFont, CWidth, CHeight);
 110
 111   if ChatTop and gChatShow then
 112     offset_y := CHeight
 113   else
 114     offset_y := 0;
 115
 116   for a := 0 to High(MsgArray) do
 117     if MsgArray[a].Time > 0 then
 118       e_TextureFontPrintFmt(0, offset_y + CHeight * a, MsgArray[a].Msg, gStdFont, True);
 119
 120   if MessagesOnly then Exit;
 121
 122   if gChatShow then
 123   begin
 124     if ChatTop then
 125       offset_y := 0
 126     else
 127       offset_y := gScreenHeight - CHeight - 1;
 128     if gChatTeam then
 129     begin
 130       e_TextureFontPrintEx(0, offset_y, 'say team> ' + Line, gStdFont, 255, 255, 255, 1, True);
 131       e_TextureFontPrintEx((CPos + 9) * CWidth, offset_y, '_', gStdFont, 255, 255, 255, 1, True);
 132     end
 133     else
 134     begin
 135       e_TextureFontPrintEx(0, offset_y, 'say> ' + Line, gStdFont, 255, 255, 255, 1, True);
 136       e_TextureFontPrintEx((CPos + 4) * CWidth, offset_y, '_', gStdFont, 255, 255, 255, 1, True);
 137     end
 138   end;
 139
 140   if not Cons_Shown then
 141     Exit;
 142
 143   if gDebugMode then
 144   begin
 145     e_CharFont_GetSize(gMenuFont, DEBUG_STRING, mfW, mfH);
 146     a := (gScreenWidth - 2*mfW) div 2;
 147     b := Cons_Y + (Floor(gScreenHeight * ConsoleHeight) - 2 * mfH) div 2;
 148     e_CharFont_PrintEx(gMenuFont, a div 2, b div 2, DEBUG_STRING,
 149                        _RGB(128, 0, 0), 2.0);
 150   end;
 151
 152   e_DrawSize(ID, 0, Cons_Y, Round(ConsoleTrans * 255), False, False, gScreenWidth, Floor(gScreenHeight * ConsoleHeight));
 153   e_TextureFontPrint(0, Cons_Y + Floor(gScreenHeight * ConsoleHeight) - CHeight - 4, '> ' + Line, gStdFont);
 154
 155   drawConsoleText();
 156   (*
 157   if ConsoleHistory <> nil then
 158   begin
 159     b := 0;
 160     if CHeight > 0 then
 161       if Length(ConsoleHistory) > (Floor(gScreenHeight * ConsoleHeight) div CHeight) - 1 then
 162         b := Length(ConsoleHistory) - (Floor(gScreenHeight * ConsoleHeight) div CHeight) + 1;
 163
 164     b := Max(b-Offset, 0);
 165     d := Max(High(ConsoleHistory)-Offset, 0);
 166
 167     c := 2;
 168     for a := d downto b do
 169     begin
 170       e_TextureFontPrintFmt(0, Floor(gScreenHeight * ConsoleHeight) - 4 - c * CHeight - Abs(Cons_Y), ConsoleHistory[a], gStdFont, True);
 171       c := c + 1;
 172     end;
 173   end;
 174   *)
 175
 176   e_TextureFontPrint((CPos + 1) * CWidth, Cons_Y + Floor(gScreenHeight * ConsoleHeight) - 21, '_', gStdFont);
 177 end;
 178
 179   procedure r_Console_Update;
 180     var step, miny: Integer;
 181   begin
 182     step := Max(1, Round(Floor(gScreenHeight * ConsoleHeight) * ConsoleStep));
 183     miny := Round(-Floor(gScreenHeight * ConsoleHeight));
 184     if gConsoleShow then
 185       Cons_Y := Cons_Y + step
 186     else
 187       Cons_Y := Cons_Y - step;
 188     Cons_Y := Min(Max(Cons_Y, miny), 0);
 189     Cons_Shown := Cons_Y > miny;
 190   end;
 191
 192   procedure r_Console_Init;
 193     var miny: Integer;
 194   begin
 195     g_Texture_CreateWAD(ID, GameWAD + ':TEXTURES\CONSOLE');
 196     miny := Round(-Floor(gScreenHeight * ConsoleHeight));
 197     Cons_Y := miny;
 198   end;
 199
 200 initialization
 201   conRegVar('chat_at_top', @ChatTop, 'draw chat at top border', 'draw chat at top border');
 202   conRegVar('console_height', @ConsoleHeight, 0.0, 1.0, 'set console size', 'set console size');
 203   conRegVar('console_step', @ConsoleStep, 0.0, 1.0, 'set console animation speed', 'set console animation speed');
 204   conRegVar('console_trans', @ConsoleTrans, 0.0, 1.0, 'set console transparency', 'set console transparency');
 205 {$IFDEF ANDROID}
 206   ChatTop := True;
 207   ConsoleHeight := 0.35;
 208 {$ELSE}
 209   ChatTop := False;
 210   ConsoleHeight := 0.5;
 211 {$ENDIF}
 212   ConsoleStep := 0.07;
 213   ConsoleTrans := 0.1;
 214 end.