g_cmds.pas

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.                       }
{                                                                            }
{----------------------------------------------------------------------------}

unit g_cmds;

interface

uses
  CPas,
  g_local,
  q_shared;

procedure ClientCommand(ent : edict_p); cdecl;
function OnSameTeam (ent1 : edict_p;ent2 : edict_p): qboolean; // added by FAB
procedure ValidateSelectedItem(ent : edict_p);


implementation

uses
  sysutils,
  g_chase,
  p_hud,
  g_items,
  g_utils,
  m_player,
  gameUnit,
  g_main,
  p_client,
  g_local_add;



function ClientTeam(ent : edict_p): 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,'/');
  if p = nil then
  begin
    Result := Value;
    Exit;
  end;

  if trunc(dmflags.Value) and DF_MODELTEAMS <> 0 then
  begin
    p^ := #0;
    Result := Value;
    Exit;
  end;

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


function OnSameTeam (ent1 : edict_p;ent2 : edict_p): qboolean;
var ent1Team,
    ent2Team  : array[0..512-1] of char;
begin
  if trunc(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 : edict_p;itflags : Integer);
var cl : gclient_p;
    i,Index : Integer;
    it : gitem_p;
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 : edict_p;itflags : Integer);
var cl : gclient_p;
    i,Index : integer;
    it : gitem_p;
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 + MAX_ITEMS - 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 : edict_p);
var cl : gclient_p;
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 : edict_p);
var Name     : PChar;
    it       : gitem_p;
    Index    : Integer;
    i        : Integer;
    give_all : qboolean;
    it_ent   : edict_p;
    info     : gitem_armor_p;

begin
  if (trunc(deathmatch.Value) <> 0) and (trunc(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 := 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 := gitem_armor_p(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'+#10);
      Exit;
    end;
  end;

  if not Assigned(it.pickup) 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] := 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 : edict_p);
var Msg : PChar;
begin
  if (trunc(deathmatch.Value) <> 0) and (trunc(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 : edict_p);
var Msg : PChar;
begin
  if (trunc(deathmatch.Value) <> 0) and (trunc(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 : edict_p);
var Msg : PChar;
begin
  if (trunc(deathmatch.Value) <> 0) and (trunc(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 : edict_p);
var Index : Integer;
    it    : gitem_p;
    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 = nil 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 : edict_p);
var Index : Integer;
    it    : gitem_p;
    s     : PChar;
begin
  S := gi.args;
  it := FindItem(s);
  if not Assigned(It) then
  begin
    gi.cprintf(ent,PRINT_HIGH,'unknown item : %s'+#10,s);
    Exit;
  end;
  if not Assigned(it.drop) 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 : edict_p);
var i : Integer;
    cl : gclient_p;
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]);