sv_ccmds.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): sv_ccmds                                                          }
{                                                                            }
{ Initial conversion by : Soo Xiangdong ([e-mail])                     }
{                                                                            }
{ 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 : 10-Jun-2002                                                   }
{ Updated by : Juha Hartikainen ([e-mail])                        }
{ - Finished conversion (10%->100%)                                          }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{----------------------------------------------------------------------------}
// 25.07.2002 Juha: Proof-readed this unit

unit sv_ccmds;

interface


procedure SV_ReadLevelFile;
Procedure SV_InitOperatorCommands ();


implementation

uses
  DateUtils,
  SysUtils,
  Server,
  CVar,
  CPas,
  Cmd,
  Common,
  CModel,
  Files,
  net_wins,
  net_chan,
  sv_main,
  sv_game,
  sv_init,
  sv_user,
  sv_send,
  q_shwin,
  q_shared,
  g_local;

(*==================================================*)
(*                                                  *)
(*OPERATOR CONSOLE ONLY COMMANDS                    *)
(*                                                  *)
(*These commands can only be entered from stdin or  *)
(*by a remote operator datagram                     *)
(*==================================================*)

(*==================================================*)
(*SV_SetMaster_f                                    *)
(*                                                  *)
(*Specify a list of master servers                  *)
(*==================================================*)
procedure SV_SetMaster_f (); cdecl;
var
  i, slot : Integer;
begin
  // only dedicated servers send heartbeats
  if not (dedicated.value<>0) then
  begin
    Com_Printf ('Only dedicated servers use masters.'#10, []);
    exit;
  end;

  // make sure the server is listed public
  Cvar_Set ('public', '1');

  for i := 1 to MAX_MASTERS-1 do
    FillChar (master_adr[i], sizeof(master_adr[i]), 0);

  slot := 1;    // slot 0 will always contain the id master
  for i := 1 to Cmd_Argc()-1 do
  begin
    if (slot = MAX_MASTERS) then
      break;
    if (not NET_StringToAdr (Cmd_Argv(i), master_adr[i])) then
    begin
      Com_Printf ('Bad address: %s'#10, [Cmd_Argv(i)]);
      continue;
    end;
    if (master_adr[slot].port = 0) then
      master_adr[slot].port := BigShort(PORT_MASTER);

    Com_Printf ('Master server at %s'#10, [NET_AdrToString (master_adr[slot])]);
    Com_Printf ('Sending a ping.'#10, []);
    Netchan_OutOfBandPrint (NS_SERVER, master_adr[slot], 'ping', []);
    Inc(slot);
  End;
  svs.last_heartbeat := -9999999;
End;



(*
==================================================
SV_SetPlayer

Sets sv_client and sv_player to the player with idnum Cmd_Argv(1)
==================================================
*)
function SV_SetPlayer (): qboolean;
var
  cl: client_p;
  i: integer;
  idnum: integer;
  s: PChar;
Begin
  if (Cmd_Argc() < 2) then begin
    Result := False;
    exit;
  end;

  s := Cmd_Argv(1);

  // numeric values are just slot numbers
  if (s[0] >= '0') and (s[0] <= '9') then
  begin
    idnum := StrToInt(Cmd_Argv(1));
    if (idnum < 0) or (idnum >= maxclients.value) then
    begin
      Com_Printf ('Bad client slot: %i'#10, [idnum]);
      Result := false;
      exit;
    end;

    sv_client := @svs.clients^[idnum];
    sv_player := sv_client.edict;
    if (Integer(sv_client.state) = 0) then
    begin
      Com_Printf ('Client %i is not active'#10, [idnum]);
      Result := false;
      exit;
    end;
    Result := true;
    exit;
  end;

  // check for a name match
  for i := 0 to Round(maxclients.value)-1 do
  begin
    cl := @svs.clients[i];
    if (Integer(cl.state) = 0) then
      continue;
    if (strcmp(cl.name, s) = 0) then
    begin
      sv_client := cl;
      sv_player := sv_client.edict;
      Result := true;
      exit;
    end;
  end;
  Com_Printf ('Userid %s is not on the server'#10, [s]);
  Result := false;
end;

(*==================================================

SAVEGAME FILES

==================================================*)

(*==================================================
SV_WipeSavegame
Delete save/<XXX>/
==================================================*)
procedure SV_WipeSavegame (savename: pchar);
var
  name: array[0..MAX_OSPATH-1] of char;
  s: pchar;
Begin
  Com_DPrintf('SV_WipeSaveGame(%s)'#10, [savename]);
  Com_sprintf (name, sizeof(name), '%s/save/%s/server.ssv', [FS_Gamedir(), savename]);
  DeleteFile (name);
  Com_sprintf (name, sizeof(name), '%s/save/%s/game.ssv', [FS_Gamedir(), savename]);
  DeleteFile (name);

  Com_sprintf (name, sizeof(name), '%s/save/%s/*.sav', [FS_Gamedir(), savename]);
  s := Sys_FindFirst( name, 0, 0 );
  while (s <> nil) do
  Begin
    DeleteFile (s);
    s := Sys_FindNext( 0, 0 );
  End;
  Sys_FindClose ();
  Com_sprintf (name, sizeof(name), '%s/save/%s/*.sv2', [FS_Gamedir (), savename]);
  s := Sys_FindFirst(name, 0, 0 );
  while (s <> nil) do
  Begin
    DeleteFile (s);
    s := Sys_FindNext( 0, 0 );
  End;
  Sys_FindClose ();
End;


(*==================================================
CopyFile
==================================================*)
Procedure CopyFile (src, dst: pchar);
var
  f1, f2: integer;
  l: integer;
  buffer: array[0..65536-1] of char;
begin
  Com_DPrintf ('CopyFile (%s, %s)'#10, [src, dst]);
  f1 := FileOpen(src, fmOpenRead);
  if f1 = -1 then exit;
  f2 := FileOpen(dst, fmOpenReadWrite);
  if f2 = -1 then begin
    FileClose(f1);
    exit;
  end;

  while (true) do
  Begin
    l := FileRead(f1, buffer, sizeof(buffer));
    if (l = 0) then
      break;
    FileWrite(f2, buffer, l);
  End;

  FileClose (f1);
  FileClose (f2);
End;


(*==================================================
SV_CopySaveGame
==================================================*)
Procedure SV_CopySaveGame (src, dst: pchar);
var
  name, name2: array[0..MAX_OSPATH-1] of char;
  l, len: integer;
  found: pchar;
begin
  Com_DPrintf('SV_CopySaveGame(%s, %s)'#10, [src, dst]);

  SV_WipeSavegame (dst);

  // copy the savegame over
  Com_sprintf (name, sizeof(name), '%s/save/%s/server.ssv', [FS_Gamedir(), src]);
  Com_sprintf (name2, sizeof(name2), '%s/save/%s/server.ssv', [FS_Gamedir(), dst]);
  FS_CreatePath (name2);
  CopyFile (name, name2);

  Com_sprintf (name, sizeof(name), '%s/save/%s/game.ssv', [FS_Gamedir(), src]);
  Com_sprintf (name2, sizeof(name2), '%s/save/%s/game.ssv', [FS_Gamedir(), dst]);
  CopyFile (name, name2);

  Com_sprintf (name, sizeof(name), '%s/save/%s/', [FS_Gamedir(), src]);
  len := strlen(name);
  Com_sprintf (name, sizeof(name), '%s/save/%s/*.sav', [FS_Gamedir(), src]);
  found := Sys_FindFirst(name, 0, 0 );
  while (found <> nil) do
  Begin
    strcpy (name+len, found+len);

    Com_sprintf (name2, sizeof(name2), '%s/save/%s/%s', [FS_Gamedir(), dst, found+len]);
    CopyFile (name, name2);

    // change sav to sv2
    l := strlen(name);
    strcpy (name+l-3, 'sv2');
    l := strlen(name2);
    strcpy (name2+l-3, 'sv2');
    CopyFile (name, name2);

    found := Sys_FindNext( 0, 0 );
  End;
  Sys_FindClose ();
End;


(*==================================================
SV_WriteLevelFile
==================================================*)
Procedure SV_WriteLevelFile ();
Var
  name: array[0..MAX_OSPATH-1] of char;
  f: integer;
Begin
  Com_DPrintf('SV_WriteLevelFile()'#10, []);
  Com_sprintf (name, sizeof(name), '%s/save/current/%s.sv2', [FS_Gamedir(), sv.name]);

  f := FileOpen(name, fmOpenReadWrite);
  if f = -1 then begin
   Com_Printf ('Failed to open %s'#10, [name]);
   exit;
  end;

  FileWrite (f, sv.configstrings, sizeof(sv.configstrings));
  CM_WritePortalState (f);
  FileClose (f);

  Com_sprintf (name, sizeof(name), '%s/save/current/%s.sav', [FS_Gamedir(), sv.name]);
  ge.WriteLevel (name);
End;

(*==================================================
SV_ReadLevelFile

==================================================*)
procedure SV_ReadLevelFile;
var
  name: array[0..MAX_OSPATH-1] of char;
  f: integer;
begin
  Com_DPrintf('SV_ReadLevelFile()'#10, []);

  Com_sprintf (name, sizeof(name), '%s/save/current/%s.sv2', [FS_Gamedir(), sv.name]);
  f := FileOpen(name, fmOpenRead);
  if (f = -1) then
  begin
    Com_Printf ('Failed to open %s'#10, [name]);
    exit;
  end;
  FS_Read (@sv.configstrings, sizeof(sv.configstrings), f);
  CM_ReadPortalState (f);
  FileClose (f);

  Com_sprintf (name, sizeof(name), '%s/save/current/%s.sav', [FS_Gamedir(), sv.name]);
  ge.ReadLevel (name);
end;

(*==================================================
SV_WriteServerFile

==================================================*)
procedure SV_WriteServerFile (autosave: qboolean);
var
  f: integer;
  var_: cvar_p;
  name: array[0..MAX_OSPATH-1] of char;
  string_: array[0..128-1] of char;
  comment: array[0..32-1] of char;
  tmp: String;
  year, month, day, hour, minute, second, ms: Word;
label
  continue_;
begin
  If autosave then
    tmp := 'true'
  else
    tmp := 'false';
  Com_DPrintf('SV_WriteServerFile(%s)'#10, [tmp]);

  Com_sprintf (name, sizeof(name), '%s/save/current/server.ssv', [FS_Gamedir()]);
  f := FileOpen (name, fmOpenReadWrite);

  if (f = -1) then
    f := FileCreate(name);

  if (f = -1) then
  begin
    Com_Printf ('Couldn''t write %s'#10, [name]);
    exit;
  end;
  // write the comment field
  FillChar (comment, sizeof(comment), 0);

  if (not autosave) then
  begin
    DecodeDateTime(Now, Year, Month, Day, Hour, Minute, Second, Ms);
    Com_sprintf (comment,sizeof(comment), '%2i:%i%i %2i/%2i  ', [Hour
      , Minute/10, Minute  mod 10,
      Month+1, Day]);
    strncat (comment, sv.configstrings[CS_NAME], sizeof(comment)-1-strlen(comment) );
  end
  else
  begin  // autosaved
    Com_sprintf (comment, sizeof(comment), 'ENTERING %s', [sv.configstrings[CS_NAME]]);
  end;

  FileWrite (f, comment, sizeof(comment));

  // write the mapcmd
  FileWrite (f, svs.mapcmd, sizeof(svs.mapcmd));

  // write all CVAR_LATCH cvars
  // these will be things like coop, skill, deathmatch, etc
  var_ := cvar_vars;
  while (var_ <> nil) do
  begin
    if (not (var_.flags and CVAR_LATCH<>0)) then
      goto continue_;
    if (strlen(var_.name) >= sizeof(name)-1)
      or (strlen(var_.string_) >= sizeof(string_)-1) then
    begin
      Com_Printf ('Cvar too long: %s := %s'#10, [var_.name, var_.string_]);
      goto continue_;
    end;
    FillChar(name, sizeof(name), 0);
    FillChar(string_, sizeof(string_), 0);
    strcpy (name, var_.name);
    strcpy (string_, var_.string_);
    FileWrite (f, name,  sizeof(name));
    FileWrite (f, string_, sizeof(string_));
  continue_:
    var_ := var_.next;
  end;

  FileClose (f);

  // write game state
  Com_sprintf (name, sizeof(name), '%s/save/current/game.ssv', [FS_Gamedir()]);
  ge.WriteGame (name, autosave);
end;

(*==================================================
SV_ReadServerFile
==================================================*)
procedure SV_ReadServerFile ();
var
  f: integer;
  name: array[0..MAX_OSPATH-1] of char;
  string_: array[0..128-1] of char;
  comment: array[0..32-1] of char;
  mapcmd: array[0..MAX_TOKEN_CHARS-1] of char;
begin
  Com_DPrintf('SV_ReadServerFile()'#10, []);

  Com_sprintf (name, sizeof(name), '%s/save/current/server.ssv', [FS_Gamedir()]);
  f := FileOpen (name, fmOpenRead);
  if (f = -1) then
  begin
    Com_Printf ('Couldn''t read %s'#10, [name]);
    exit;
  end;
  // read the comment field
  FS_Read (@comment, sizeof(comment), f);

  // read the mapcmd
  FS_Read (@mapcmd, sizeof(mapcmd), f);

  // read all CVAR_LATCH cvars
  // these will be things like coop, skill, deathmatch, etc
  while (true) do
  begin
    if (FileRead (f, name, sizeof(name)) = 0) then
      break;
    FS_Read (@string_, sizeof(string_), f);
    Com_DPrintf ('Set %s := %s'#10, [name, string_]);
    Cvar_ForceSet (name, string_);
  end;

  FileClose (f);

  // start a new game fresh with new cvars
  SV_InitGame ();

  strcpy (@svs.mapcmd, mapcmd);

  // read game state
  Com_sprintf (name, sizeof(name), '%s/save/current/game.ssv', [FS_Gamedir()]);
  ge.ReadGame (name);
End;


(*
==================================================
SV_DemoMap_f

Puts the server in demo mode on a specific map/cinematic
==================================================
*)
Procedure SV_DemoMap_f (); cdecl;
Begin
  SV_Map (true, Cmd_Argv(1), false );
End;

(*
==================================================
SV_GameMap_f

Saves the state of the map just being exited and goes to a new map.

If the initial character of the map string is '*', the next map is
in a new unit, so the current savegame directory is cleared of
map files.

Example:

*inter.cin+jail

Clears the archived maps, plays the inter.cin cinematic, then
goes to map jail.bsp.
==================================================
*)
Procedure SV_GameMap_f (); cdecl;
type
  TQBoolArr = array[0..0] of qboolean;
  PQBoolArr = ^TQBoolArr;
var
  map: PChar;
  i: integer;
  cl: client_p;
  savedInuse: PQBoolArr;
begin
  if (Cmd_Argc() <> 2) then
  begin
    Com_Printf ('USAGE: gamemap <map>'#10, []);
    exit;
  end;

  Com_DPrintf('SV_GameMap(%s)'#10, [Cmd_Argv(1)]);

  FS_CreatePath (va('%s/save/current/', [FS_Gamedir()]));

  // check for clearing the current savegame
  map := Cmd_Argv(1);
  if (map[0] = '*') then
  begin
    // wipe all the *.sav files
    SV_WipeSavegame ('current');
  end
  else
  begin  // save the map just exited
    if (sv.state = ss_game) then
    begin
      // clear all the client inuse flags before saving so that
      // when the level is re-entered, the clients will spawn
      // at spawn points instead of occupying body shells
      savedInuse := malloc(Round(maxclients.value) * sizeof(qboolean));
      cl := client_p(svs.clients);
      i := 0;