g_cmds.pas

雷神之锤2(Quake2)Delphi源码

unit g_cmds;

(*
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.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

*)

{******************************************************************************
Initial Conversion Author   :    Scott Price
Initially Conversion Created:    01-July-2002
Language                    :    Object Pascal
Compiler Version            :    Delphi 3.02, 4.03, 5.01, 6.02 (UK)

VERSION  AUTHOR                DATE/TIME
===============================================================================
0.01     sprice                11-July-2002
         Initial conversion completed.  See notes and todo sections below.
===============================================================================
NOTES:
 - With the lack of my archive of emails being available I can not remember if
   the original C/C++ functions for things like String Length were being
   directly replace with the delphi equivalents, or left as-is and a Delphi
   named version being created for use.  As such I have left those lines as-is
   presently, awaiting what-ever decision is made.
===============================================================================
TODO:
 - replace/leave current 'strlen' type functions.
 - Add required units.
 - Complete the conversion.
******************************************************************************}



interface


{ TODO:  Add the Uses Clause }

// TODO:  #include "g_local.h"
// TODO:  #include "m_player.h"


function ClientTeam(ent: Pedict_t): PChar;
function OnSameTeam(ent1, ent2: Pedict_t): qboolean;
procedure SelectNextItem(ent: Pedict_t; itflags: Inetger);
procedure SelectPrevItem(ent: edict_t; itflags: Integer);
procedure ValidateSelectedItem(ent: Pedict_t);
procedure Cmd_Give_f(ent: Pedict_t);
procedure Cmd_God_f(ent: Pedict_t);
procedure Cmd_Notarget_f(ent: Pedict_t);
procedure Cmd_Noclip_f(ent: Pedict_t);
procedure Cmd_Use_f(ent: Pedict_t);
procedure Cmd_Drop_f(ent: Pedict_t);
procedure Cmd_Inven_f(ent: Pedict_t);
procedure Cmd_InvUse_f(ent: Pedict_t);
procedure Cmd_WeapPrev_f(ent: Pedict_t);
procedure Cmd_WeapNext_f(ent: Pedict_t);
procedure Cmd_WeapLast_f(ent: Pedict_t);
procedure Cmd_InvDrop_f(ent: Pedict_t);
procedure Cmd_Kill_f(ent: Pedict_t);
procedure Cmd_PutAway_f(ent: Pedict_t);
function PlayerSort(const a, b: Pointer): Integer;  { ???  Not sure about this one at all... }
procedure Cmd_Players_f(ent: Pedict_t);
procedure Cmd_Wave_f(ent: Pedict_t);
procedure Cmd_Say_f(ent: Pedict_t; team, arg0: qboolean);
procedure ClientCommand(ent: Pedict_t);



implementation



function ClientTeam(ent: Pedict_t): PChar;
{ TODO:  Open Compiler Options to Allow Assignable Constants in D6+ }
const
  value: array[0..512-1] of Char;
{ TODO:  Close Compiler Options to Allow Assignable Constants in D6+ }
var
  p: PChar;  { TODO:  Here do they mean Byte? }
begin
  Result := '';

  value[0] := 0;

  if (ent^.client = Nil) then
  begin
    Result := value{[0]}
    Exit;
  end;

  strcpy(value, Info_ValueForKey(ent^.client^.pers.userinfo, 'skin'));
  p := strchr(value, '/');
  if (p = Nil) then
  begin
    Result := value{[0]};
    Exit;
  end;

  if ((Integer(dmflags^.value) AND DF_MODELTEAMS) <> 0) then
  begin
    p^ := 0;
    Result := value{[0]};
  end;

  { NOTE:  The following line was already commented out }
  // if ((int)(dmflags->value) & DF_SKINTEAMS)

  { return ++p; }
  Inc(p);
  Result := p;
end;

function OnSameTeam(ent1, ent2: Pedict_t): qboolean;
var
  ent1Team: array[0..512-1] of Char;
  ent2Team: array[0..512-1] of Char;
begin
  if ((Integer(dmflags^.value) AND (DF_MODELTEAMS OR DF_SKINTEAMS)) = 0) then
  begin
    Result := False;
    Exit;
  end;

  strcpy(ent1Team, ClientTeam(ent1));
  strcpy(ent2Team, ClientTeam(ent2));

  if (strcmp(ent1Team, ent2Team) = 0) then
  begin
    Result := True;
    Exit;
  end;

  Result := False;
end;

procedure SelectNextItem(ent: Pedict_t; itflags: Inetger);
var
  cl: Pgclient_t;
  i, index: Integer;
  it: Pgitem_t;
begin
  cl := ent^.client;

  if (cl^.chase_target) then
  begin
    ChaseNext(ent);
    Exit;
  end;

  // scan  for the next valid one
  for i := 1 to (MAX_ITEMS - 1) do
  begin
    index := (cl^.pers.selected_item + i) mod MAX_ITEMS;
    if (cl^.pers.inventory[index] = 0) then
      Continue;

    it := @itemlist[index];
    if (it^.use = Nil) then
      Continue;

    if ((it^.flags AND itflags) = 0) then
      Continue;

    cl^.pers.selected_item := index;
    Exit;
  end;

  cl^.pers.selected_item := -1;
end;

procedure SelectPrevItem(ent: edict_t; itflags: Integer);
var
  cl: Pgclient_t;
  i, index: Integer;
  it: Pgitem_t;
begin
  cl := ent^.client;

  if (cl^.chase_target <> Nil) then
  begin
    ChasePrev(ent);
    Exit;
  end;

  // scan  for the next valid one
  for i := 1 to (MAX_ITEMS - 1) do
  begin
    index := (cl^.pers.selected_item + MAX_ITEMS - i) mod MAX_ITEMS;
    if (cl^.pers.inventory[index] = 0) then
      Continue;

    it := @itemlist[index];
    if (it^.use = Nil) then
      Continue;

    if ((it^.flags AND itflags) = 0) then
      Continue;

    cl^.pers.selected_item := index;
    Exit;
  end;

  cl^.pers.selected_item := -1;
end;

procedure ValidateSelectedItem(ent: Pedict_t);
var
  cl: Pgclient_t;
begin
  cl := ent^.client;

  if (cl^.pers.inventory[cl^.pers.selected_item] <> 0) then
    Exit;  // valid

  SelectNextItem(ent, -1);
end;

{ TODO:  A LOT of these procedures use the same string time and again, we should
         create a list of PChar Constants in this Implemenation that use these
         constants instead of the same thing time and time again. Easier to
         change then!  (Scott Price) } 

(* ==================
Cmd_Give_f

Give items to a client
================== *)
procedure Cmd_Give_f(ent: Pedict_t);
var
  name: PChar;
  it: Pgitem_t;
  index, i: Integer;
  give_all: qboolean;
  it_ent: Pedict_t;
  info: Pgitem_armor_t;
begin
  if (deathmatch^.value <> 0) AND (sv_cheats^.value = 0) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'You must run the server with ''+set cheats 1'' to enable this command.'#10);
    Exit;
  end;

  name := gi.args();

  if (Q_stricmp(name, 'all') = 0) then
    give_all := True
  else
    give_all := False;

  if give_all OR (Q_stricmp(gi.argv(1), 'health') = 0) then
  begin
    if (gi.argc() = 3) then
      ent^.health := atoi(gi.argv(2))
    else
      ent^.health := ent^.max_health;
    if (give_all = False) then
      Exit;
  end;

  if give_all OR (Q_stricmp(name, 'weapons') = 0) then
  begin
    for i := 0 to (game.num_items - 1) do
    begin
      it := itemlist + i;
      if (it^.pickup = 0) then
        Continue;

      if ((it^.flags AND IT_WEAPON) = 0)
        Continue;

      ent^.client^.pers.inventory[i] := ent^.client^.pers.inventory[i] + 1;
    end;
    if (give_all = False) then
      Exit;
  end;

  if give_all OR (Q_stricmp(name, 'ammo') = 0) then
  begin
    for i := 0 to (game.num_items - 1) do
    begin
      it := itemlist + i;
      if (it^.pickup = 0) then
        Continue;

      if ((it^.flags AND IT_AMMO) = 0) then
        Continue;
      Add_Ammo(ent, it, 1000);
    end;
    if (give_all = False) then
      Exit;
  end;

  if give_all OR (Q_stricmp(name, 'armor') = 0) then
  begin
    it := FindItem('Jacket Armor');
    ent^.client^.pers.inventory[ITEM_INDEX(it)] := 0;

    it := FindItem('Combat Armor');
    ent^.client^.pers.inventory[ITEM_INDEX(it)] := 0;

    it := FindItem('Body Armor');
    info := Pgitem_armor_t(it)^.info;
    ent^.client^.pers.inventory[ITEM_INDEX(it)] := info^.max_count;

    if (give_all = False) then
      Exit;
  end;

  if give_all OR (Q_stricmp(name, 'Power Shield') = 0) then
  begin
    it := FindItem('Power Shield');
    it_ent := G_Spawn();
    it_ent^.classname := it^.classname;
    SpawnItem(it_ent, it);
    Touch_Item(it_ent, ent, Nil, Nil);
    if (it_ent^.inuse) then
      G_FreeEdict(it_ent);

    if (give_all = False) then
      Exit;
  end;

  if give_all then
  begin
    for i := 0 to (game.num_items - 1) do
    begin
      it := itemlist + i;
      if (it^.pickup = 0) then
        Continue;

      if (it^.flags AND (IT_ARMOR OR IT_WEAPON OR IT_AMMO) <> 0) then
        Continue;
      ent^.client^.pers.inventory[i] := 1;
    end;

    Exit;
  end;

  it := FindItem(name);
  if (it = Nil) then
  begin
    name := gi.argv(1);
    it := FindItem(name);
    if (it = Nil) then
    begin
      gi.cprintf(ent, PRINT_HIGH, 'unknown item'#10);
      Exit;
    end;
  end;

  if (it^.pickup = Nil) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'non-pickup item'#10);
    Exit;
  end;

  index := ITEM_INDEX(it);

  if (it^.flags AND IT_AMMO) <> 0 then
  begin
    if (gi.argc() = 3) then
      ent^.client^.pers.inventory[index] := atoi(gi.argv(2))
    else
      ent^.client^.pers.inventory[index] := ent^.client^.pers.inventory[index] + it^.quantity;
  end
  else
  begin
    it_ent := G_Spawn();
    it_ent^.classname := it^.classname;
    SpawnItem(it_ent, it);
    Touch_Item(it_ent, ent, Nil, Nil);
    if (it_ent^.inuse) then
      G_FreeEdict(it_ent);
  end;
end;

(* ==================
Cmd_God_f

Sets client to godmode

argv(0) god
================== *)
procedure Cmd_God_f(ent: Pedict_t);
var
  msg: PChar;
begin
  if (deathmatch^.value AND (sv_cheats^.value = 0)) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'You must run the server with ''+set cheats 1'' to enable this command.'#10);
    Exit;
  end;

  ent^.flags := ent^.flags XOR FL_GODMODE;
  if ((ent^.flags AND FL_GODMODE) = 0) then
    msg := 'godmode OFF'#10
  else
    msg := 'godmode ON'#10;

  gi.cprintf(ent, PRINT_HIGH, msg);
end;

(* ==================
Cmd_Notarget_f

Sets client to notarget

argv(0) notarget
================== *)
procedure Cmd_Notarget_f(ent: Pedict_t);
var
  msg: PChar;
begin
  if (deathmatch^.value <> 0) AND (sv_cheats^.value = 0) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'You must run the server with ''+set cheats 1'' to enable this command.'#10);
    Exit;
  end;

  ent^.flags := ent^.flags XOR FL_NOTARGET;
  if ((ent^.flags AND FL_NOTARGET) = 0) then
    msg := 'notarget OFF'#10
  else
    msg := 'notarget ON'#10;

  gi.cprintf(ent, PRINT_HIGH, msg);
end;

(* ==================
Cmd_Noclip_f

argv(0) noclip
================== *)
procedure Cmd_Noclip_f(ent: Pedict_t);
var
  msg: PChar;
begin
  if (deathmatch^.value <> 0) AND (sv_cheats^.value = 0) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'You must run the server with ''+set cheats 1'' to enable this command.'#10);
    Exit;
  end;

  if (ent^.movetype = MOVETYPE_NOCLIP) then
  begin
    ent^.movetype := MOVETYPE_WALK;
    msg := 'noclip OFF'#10;
  end
  else
  begin
    ent^.movetype := MOVETYPE_NOCLIP;
    msg := 'noclip ON'#10;
  end;

  gi.cprintf(ent, PRINT_HIGH, msg);
end;

(* ==================
Cmd_Use_f

Use an inventory item
================== *)
procedure Cmd_Use_f(ent: Pedict_t);
var
  index: Integer;
  it: Pgitem_t;
  s: PChar;
begin
  s := gi.args();
  it := FindItem(s);
  if (it = Nil) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'unknown item: %s'#10, s);
    Exit;
  end;
  if (it^.use = 0) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Item is not usable.'#10);
    Exit;
  end;
  index := ITEM_INDEX(it);
  if (ent^.client^.pers.inventory[index] = 0) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Out of item: %s'#10, s);
    Exit;
  end;

  it^.use(ent, it);
end;

(* ==================
Cmd_Drop_f

Drop an inventory item
================== *)
procedure Cmd_Drop_f(ent: Pedict_t);
var
  index: Integer;
  it: Pgitem_t;
  s: PChar;
begin
  s := gi.args();
  it := FindItem(s);
  if (it = Nil) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'unknown item: %s'#10, s);
    Exit;
  end;
  if (it^.drop = 0) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Item is not dropable.'#10);
    Exit;
  end;
  index := ITEM_INDEX(it);
  if (ent^.client^.pers.inventory[index] = 0) then
  begin
    gi.cprintf (ent, PRINT_HIGH, 'Out of item: %s'#10, s);
    Exit;
  end;

  it^.drop(ent, it);
end;

(* =================
Cmd_Inven_f
================= *)
procedure Cmd_Inven_f(ent: Pedict_t);
var
  i: Integer;
  cl: Pgclient_t;
begin