console.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ 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.                       }
{                                                                            }
{----------------------------------------------------------------------------}
unit Console;

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,
  {$IFDEF WIN32}
  vid_dll,
  {$ELSE}
  vid_so,
  {$ENDIF}
  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
================
}