sv_ccmds.pas

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,
  {$IFDEF WIN32}
  net_wins,
  q_shwin,
  {$ELSE}
  net_udp,
  q_shlinux,
  {$ENDIF}
  net_chan,
  sv_main,
  sv_game,
  sv_init,
  sv_user,
  sv_send,
  q_shared;

(*==================================================*)
(*                                                  *)
(*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;
    {$IFDEF WIN32}
    if (not NET_StringToAdr(Cmd_Argv(i), master_adr[i])) then
    {$ELSE}
    if (not NET_StringToAdr(Cmd_Argv(i), @master_adr[i])) then
    {$ENDIF}
    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 := FileCreate(dst);
  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
    f := FileCreate(name);

  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 div 10, Minute mod 10,
        Month, 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