g_cmds.pas

雷神之锤2(Quake2)Delphi源码

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): g_cmds.h                                                          }
{                                                                            }
{ Initial conversion by : Burnin (Leonel Togniolli) - [e-mail]  }
{ Initial conversion on : 26-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.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ p_hud.pas                                                                  }
{ g_items.pas                                                                }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ Fix the calls to gi.cprintf where its formatted (I was not sure on what to }
{ do.                                                                        }
{----------------------------------------------------------------------------}

// Remove DOT before $DEFINE in next line to allow non-dependable compilation //
{$DEFINE NODEPEND}
// non-dependable compilation will use STUBS for some external symbols
unit g_cmds;

interface

uses g_local,
     m_player,
     GameUnit;

procedure ClientCommand(ent : pedict_t);

// qsort
type
  QSortCB = function (const arg1, arg2: Pointer): Integer;
  Size_t = Cardinal;

implementation

uses sysutils,
     g_chase,
{$IFNDEF NODEPEND}
     p_hud,
     g_items,
{$ENDIF}
     g_utils,
     q_shared;

{$IFDEF NODEPEND}
// from g_items
function Add_Ammo(ent : pedict_t;item : pgitem_t;Count : Integer):qboolean; begin Result := True; end;
function FindItem(pickup_name : pchar):pgitem_t; begin Result := nil; end;
function ITEM_INDEX(it:pgitem_t): Integer; begin Result := 0; end;
procedure SpawnItem (ent : pedict_t; item : pgitem_t); begin end;
procedure Touch_Item(ent : pedict_t;other : pedict_t; plane : pcplane_t;surf : pcsurface_t); begin end;
procedure player_die(Self : pedict_t;inflictor : pedict_t;attacker : pedict_t;damage : Integer;point :vec3_t); begin end;
// from p_hud
procedure Cmd_Score_f(ent : pedict_t); begin end;
procedure Cmd_Help_f (ent : pedict_t); begin end;
{$ENDIF}


function ClientTeam(ent : pedict_t): PChar;
var   p : PChar;
      Value : array[0..512-1] of char;
begin
  Value := '';

  if not Assigned(ent.client) then
  begin
    Result := Value;
    Exit;
  end;

  strpcopy(Value,Info_ValueForKey(ent.client.pers.userinfo,'skin'));

  p := StrPos(Value,Value);
  if p = nil then
  begin
    Result := Value;
    Exit;
  end;

  //delphi-note : round?
  if round(dmflags.Value) and DF_MODELTEAMS <> 0 then
  begin
    p^ := #0;
    Result := Value;
    Exit;
  end;

  //if round(dmflags.Value) and DF_SKINTEAMS <> 0 then {Originally commented}
  Inc(p);
  Result := p;
end;


function OnSameTeam (ent1 : pedict_t;ent2 : pedict_t): qboolean;
var ent1Team,
    ent2Team  : array[0..512-1] of char;
begin
  if round(dmflags.Value) and (DF_MODELTEAMS or DF_SKINTEAMS) = 0 then
  begin
    Result := False;
    Exit;
  end;

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

  Result := strcomp(ent1Team,ent2Team) = 0;
end;

procedure SelectNextItem(ent : pedict_t;itflags : Integer);
var cl : pgclient_t;
    i,Index : Integer;
    it : pgitem_t;
begin
  cl := ent.client;
  if assigned(cl.chase_target) then
  begin
    ChaseNext(ent);
    Exit;
  end;
  // scan  for the next valid one
  for i := 1 to MAX_ITEMS do
  begin
    Index := (cl.pers.selected_item + i) mod MAX_ITEMS;
    if cl.pers.inventory[Index] = 0 then
      continue;
    it := @itemlist[Index];
    if not assigned(it.use) 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 : pedict_t;itflags : Integer);
var cl : pgclient_t;
    i,Index : integer;
    it : pgitem_t;
begin
  cl := ent.client;
  if Assigned(cl.chase_target) then
  begin
    ChasePrev(ent);
    Exit;
  end;
  // scan  for the next valid one
  for i := 1 to MAX_ITEMS do
  begin
    Index := (cl.pers.selected_item - i) mod MAX_ITEMS;
    if cl.pers.inventory[Index] = 0 then
      continue;
    it := @itemlist[Index];
    if not assigned(it.use) 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;

//=================================================================================

{
==================
Cmd_Give_f

Give items to a client
==================
}

procedure Cmd_Give_f(ent : pedict_t);
var Name     : PChar;
    it       : pgitem_t;
    Index    : Integer;
    i        : Integer;
    give_all : qboolean;
    it_ent   : pedict_t;
    info     : pgitem_armor_t;

begin
  if (round(deathmatch.Value) and not(round(sv_cheats.Value))) <> 0 then
  begin
    gi.cprintf(ent,PRINT_HIGH,'You must run the server with ''+set cheats 1'' to enable this command.\n');
    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 := StrToInt(gi.argv(2))
    else
      ent.health := ent.max_health;
    if not give_all 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 not Assigned(it.pickup) then
        continue;
      if (it.flags and IT_WEAPON) <> 0 then
        continue;
      ent.client.pers.inventory[i] := ent.client.pers.inventory[i] + 1;
    end;
    if not give_all 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 not Assigned(it.pickup) then
        continue;
      if (it.flags and IT_AMMO) <> 0 then
        continue;
      Add_Ammo(ent,it,1000);
    end;
    if not give_all 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 not give_all 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 not give_all then
      Exit;
  end;

  if give_all then
  begin
    for i := 0 to game.num_items - 1 do
    begin
      it := @itemlist[i];
      if not Assigned(it.pickup) then
        continue;
      if (it.flags and (IT_AMMO or IT_WEAPON or IT_AMMO)) <> 0 then
        continue;
      ent.client.pers.inventory[i] := 1;
    end;
    Exit;
  end;

  it := FindItem(Name);
  if not Assigned(it) then
  begin
    Name := gi.argv(1);
    it := FindItem(Name);
    if not Assigned(it) then
    begin
      gi.cprintf(ent,PRINT_HIGH,'unknown item\n');
      Exit;
    end;
  end;

  if not Assigned(it.pickup) then
  begin
    gi.cprintf(ent,PRINT_HIGH,'non-pickup item\n');
    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] := StrToInt(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 (round(deathmatch.Value) and not(round(sv_cheats.Value))) <> 0 then
  begin
    gi.cprintf(ent,PRINT_HIGH,'You must run the server with ''+set cheats 1'' to enable this command.\n');
    Exit;
  end;
  ent.flags := ent.flags or FL_GODMODE;
  if (ent.flags and FL_GODMODE) = 0 then
    Msg := 'godmode OFF\n'
  else
    Msg := 'godmode ON\n';

  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 (round(deathmatch.Value) and not(round(sv_cheats.Value))) <> 0 then
  begin
    gi.cprintf(ent,PRINT_HIGH,'You must run the server with ''+set cheats 1'' to enable this command.\n');
    Exit;
  end;
  ent.flags := ent.flags or FL_NOTARGET;
  if (ent.flags and FL_NOTARGET) = 0 then
    Msg := 'notarget OFF\n'
  else
    Msg := 'notarget ON\n';

  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 (round(deathmatch.Value) and not(round(sv_cheats.Value))) <> 0 then
  begin
    gi.cprintf(ent,PRINT_HIGH,'You must run the server with ''+set cheats 1'' to enable this command.\n');
    Exit;
  end;
  if ent.movetype = MOVETYPE_NOCLIP then
  begin
    ent.movetype := MOVETYPE_WALK;
    Msg := 'noclip OFF\n';
  end else
  begin
    ent.movetype := MOVETYPE_NOCLIP;
    Msg := 'noclip ON\n';
  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 not Assigned(s) then
  begin
    gi.cprintf(ent,PRINT_HIGH,'unknown item : %s\n'{,s});
    Exit;
  end;
  if not Assigned(it.use) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Item is not usable.\n');
    Exit;
  end;
  Index := ITEM_INDEX(it);
  if ent.client.pers.inventory[Index] = 0 then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Out of item: %s\n'{, 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 not Assigned(It) then
  begin
    gi.cprintf(ent,PRINT_HIGH,'unknown item : %s\n'{,s});
    Exit;
  end;
  if not Assigned(it.drop) then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Item is not dropable.\n');
    Exit;
  end;
  Index := ITEM_INDEX(it);
  if ent.client.pers.inventory[Index] = 0 then
  begin
    gi.cprintf(ent, PRINT_HIGH, 'Out of item: %s\n'{, 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
  cl := ent.client;

  cl.showscores := False;
  cl.showhelp := False;
  if cl.showinventory then
  begin
    cl.showinventory := False;
    Exit;
  end;

  cl.showinventory :=  True;
  gi.WriteByte(svc_inventory);

  for i := 0 to MAX_ITEMS - 1 do
  begin
    gi.WriteShort(cl.pers.inventory[i]);
  end;
  gi.unicast(ent,True);
end;

{
=================
Cmd_InvUse_f
=================