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