console.pas

雷神之锤2(Quake2)Delphi源码

unit Console;
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): Console.h,Console.c - Console                                     }
{                                                                            }
{                                                                            }
{ Initial conversion by : ggs ([e-mail])                           }
{ Initial conversion on : -Jan-2002                                          }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 25-jul-2002                                                   }
{ Updated by : burnin ([e-mail])                                }
{ - Removed IFDEF TODO directives around menu calls                          }
{ - Added declarations of routines needed by menu.pas to interface section   }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ 1) CVar       (0 modifications to compile)                                 }
{ 2) Keys       (0 modifications to compile)                                 }
{ 3) q_shared   (0 modifications to compile)                                 }
{ 3) client.pas (many modifications to compile)                              }
{ 3) common.c   (not translated)                                             }
{ 4) ref.h      (not translated)                                             }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1) Find all the dependances                                                }
{ 2) fixups to allow the entire project to compile                           }
{----------------------------------------------------------------------------}
interface
uses
  Client,
  cl_scrn,
  q_shared;


//
// console
//
const
  NUM_CON_TIMES  = 4;
  CON_TEXTSIZE = 32768;
type
  console_t = record
    initialized : qboolean;
    text : array[0..CON_TEXTSIZE-1] of char;
    current : integer; // line where next message will be printed
    x : integer; // offset in current line for next print
    display : integer;  // bottom of console displays this line
    ormask : integer; // high bit mask for colored characters
    linewidth : integer; // characters across screen
    totallines : integer;  // total lines in console scrollback
    cursorspeed : single;
    vislines : integer;
    Times : array [0..NUM_CON_TIMES-1] of single; // cls.realtime time the line was generated
    // for transparent notify lines
  end; {console_t}

var
  con : console_t;
{ TODO -cTranslation : Isnt implemented in original version! }
// Procedure Con_DrawCharacter(cx,line,num : integer);

Procedure Con_CheckResize;
Procedure Con_Init;
Procedure Con_DrawConsole(frac : single);
Procedure Con_Print(txt : pchar);
Procedure Con_CenteredPrint(text : pchar);
Procedure Con_Clear_f; cdecl;
Procedure Con_DrawNotify;
Procedure Con_ClearNotify;
Procedure Con_ToggleConsole_f; cdecl;
Procedure Key_ClearTyping;

Procedure DrawString (x,y : integer; s : pchar);
Procedure DrawAltString (x,y : integer; s : pchar);

implementation

uses
  Sysutils,
  Common,
  CVar,
  CPas,
  Cmd,
  menu,
  cl_main,
  Keys,
  vid_dll,
  files;

var
  con_notifytime : cvar_p;

Procedure DrawString (x,y : integer; s : pchar);
begin
  while s[0] <> #0 do begin
    re.DrawChar(x,y, byte(s[0]));
    x := x + 8;
    inc(s);
  end;
end; {DrawString}

Procedure DrawAltString (x,y : integer; s : pchar);
begin
  while s[0] <> #0 do
  begin
    re.DrawChar(x,y, byte(Ord(s[0]) Xor $80));
    Inc(x,8);
    inc(s);
  end;
end; {DrawAltString}

Procedure Key_ClearTyping;
Begin
  key_lines[edit_line][1] := #0;	// clear any typing
  key_linepos := 1;
End; {Key_ClearTyping}

{
================
Con_ToggleConsole_f
================
}
Procedure Con_ToggleConsole_f; cdecl;
begin
  SCR_EndLoadingPlaque (); // get rid of loading plaque

  if cl.attractloop then begin
    Cbuf_AddText ('killserver'#10);
    exit;
  end;

  if cls.state = ca_disconnected then begin // start the demo loop again
    Cbuf_AddText ('d1'#10);
    exit;
  end;

  Key_ClearTyping;
  Con_ClearNotify;

  if (cls.key_dest = Client.key_console) then begin
    M_ForceMenuOff;
    Cvar_Set ('paused', '0');
  end
  else
  begin
    M_ForceMenuOff;
    cls.key_dest := Client.key_console;
    if (Cvar_VariableValue ('maxclients') = 1) and (Com_ServerState<>0) then
      Cvar_Set ('paused', '1');
  end;
end; {Con_ToggleConsole_f}

{
================
Con_ToggleChat_f
================
}

Procedure Con_ToggleChat_f; cdecl;
begin
  Key_ClearTyping;
  if cls.key_dest = Client.key_console then
  begin
    if cls.state = ca_active then
    begin
      M_ForceMenuOff;
      cls.key_dest := Client.key_game;
    end;
  end
  else
    cls.key_dest := Client.key_console;

  Con_ClearNotify;
end; {Con_ToggleChat_f}

{
================
Con_Clear_f
================
}
Procedure Con_Clear_f; cdecl;
begin
  FillChar(con.text[0], CON_TEXTSIZE, Ord(' '));
end; {Con_Clear_f}

{
================
Con_Dump_f

Save the console contents out to a file
================
}
Procedure Con_Dump_f; cdecl;
var
  index,index2,x : integer;
  line : pchar;
  f : Integer;
  Buffer : array[0..1024-1] of char;
  name : array[0..MAX_OSPATH-1] of char;
  NEWLINE: char;
begin
  NEWLINE := #10;
  if Cmd_Argc <> 2 then
  begin
    Com_Printf ('usage: condump <filename>'#10,[]);
    exit;
  end;

  Com_sprintf (name, sizeof(name), '%s/%s.txt', [FS_Gamedir(), Cmd_Argv(1)]);
  Com_Printf ('Dumped console text to %s.'#10, [name]);
  FS_CreatePath (name);

  f := FileOpen(name, fmOpenReadWrite);
  if (f = -1) then
    f := FileCreate(name);
  if f = -1 then
  begin
    Com_Printf ('ERROR: couldn''t open.'#10,[]);
    exit;
  end;
  index2 := con.current;
  // skip empty lines
  For Index := con.current - con.totallines + 1 to con.current do
  begin
    index2 := Index;
    { TODO -cTranslation : How do THIS translate! (lots items rely on this)}
    //  line = con.text + (Index % con.totallines)*con.linewidth;
    line := con.text + (Index mod con.totallines) * con.linewidth;
    For x := 0 to con.linewidth -1 do
      if Line[x] <> ' ' then
        break;
    if x <> Con.linewidth then
      break;
  end;

  // write the remaining lines
  buffer[con.linewidth] := #0;
  For Index := index2 to con.current do
  begin
    line := con.text + (Index mod con.totallines) * con.linewidth;
    StrLCopy (buffer, line, con.linewidth);
    For X := con.linewidth-1 downto 0 do
    begin
      if (buffer[x] = ' ') then
        buffer[x] := #0
      else
        break;
    end;
    X := 0;
    while buffer[x] <> #0 do
    begin
      buffer[x] := Char(Ord(buffer[x]) and $7F);
      inc(x);
    end;

    FileWrite(f, buffer, x);
    FileWrite(f, NEWLINE, 1);
  end;
  FileClose(f);
end; {Con_Dump_f}

{
================
Con_ClearNotify
================
}
Procedure Con_ClearNotify;
var
  Index : integer;
begin
  For Index := 0 to NUM_CON_TIMES-1 do
  begin
    con.times[Index] := 0;
  end;
end; {Con_ClearNotify}

{
================
Con_MessageMode_f
================
}
Procedure Con_MessageMode_f; cdecl;
begin
  chat_team := false;
  cls.key_dest := Client.key_message;
end; {Con_MessageMode_f}

{
================
Con_MessageMode2_f
================
}
Procedure Con_MessageMode2_f; cdecl;
Begin
  chat_team := true;
  cls.key_dest := Client.key_message;
end; {Con_MessageMode2_f}


{
================
Con_CheckResize

If the line width has changed, reformat the buffer.
================
}
Procedure Con_CheckResize;
var
 i,j,width,oldwidth,oldtotallines, numlines, numchars : integer;
 tbuf : array [0..CON_TEXTSIZE-1]of char;
begin
  width := (viddef.width shr 3) - 2;

  if width = con.linewidth then
    exit;

  if (width < 1) then // video hasn't been initialized yet
  begin
    width := 38;
    con.linewidth := width;
    con.totallines := CON_TEXTSIZE div con.linewidth;
    FillChar(con.text[0],CON_TEXTSIZE,Ord(' '));
  end
  else
  begin
    oldwidth := con.linewidth;
    con.linewidth := width;
    oldtotallines := con.totallines;
    con.totallines := CON_TEXTSIZE div con.linewidth;
    numlines := oldtotallines;

    if con.totallines < numlines then
      numlines := con.totallines;

    numchars := oldwidth;

    if con.linewidth < numchars then
      numchars := con.linewidth;

    memcpy (@tbuf, @con.text, CON_TEXTSIZE);
    FillChar(con.text[0],CON_TEXTSIZE,Ord(' '));

    for i := 0 to numlines -1 do
      begin
      for j := 0 to numchars -1 do
        begin
        con.text[(con.totallines - 1 - i) * con.linewidth + j] :=
                 tbuf[((con.current - i + oldtotallines) mod oldtotallines) * oldwidth + j];
        end;
      end;

    Con_ClearNotify;
  end;

  con.current := con.totallines - 1;
  con.display := con.current;
end; {Con_CheckResize}

{
================
Con_Init
================
}