grendel-1.0.0a7/backup/
grendel-1.0.0a7/bin/
grendel-1.0.0a7/boards/
grendel-1.0.0a7/clans/
grendel-1.0.0a7/documentation/todo/
grendel-1.0.0a7/help/
grendel-1.0.0a7/logs/
grendel-1.0.0a7/players/
grendel-1.0.0a7/progs/
grendel-1.0.0a7/races/
grendel-1.0.0a7/src/contrib/
grendel-1.0.0a7/src/modules/speller/
grendel-1.0.0a7/src/modules/status/
grendel-1.0.0a7/src/tests/
grendel-1.0.0a7/src/tests/dunit/
// $Id: cmd_comm.inc,v 1.4 2004/03/30 20:58:42 hemko Exp $

procedure do_say(ch:GCharacter;param:string);
begin
  if (length(param)=0) then
    begin
    ch.sendBuffer('Say what?'#13#10);
    exit;
    end;
  case param[length(param)] of
    '!':begin
        act(AT_SAY,'You exclaim, ''' + param + '''',false,ch,nil,nil,TO_CHAR);
        act(AT_SAY,'$n exclaims, ''' + param + '''',false,ch,nil,nil,TO_ROOM);
        end;
    '?':begin
        act(AT_SAY,'You ask, ''' + param + '''',false,ch,nil,nil,TO_CHAR);
        act(AT_SAY,'$n asks, ''' + param + '''',false,ch,nil,nil,TO_ROOM);
        end;
    ')':if (param[length(param)-1]=':') or (param[length(param)-2]=':') then
          begin
          act(AT_SAY,'You grin, ''' + param + '''',false,ch,nil,nil,TO_CHAR);
          act(AT_SAY,'$n grins, ''' + param + '''',false,ch,nil,nil,TO_ROOM);
          end
        else
        if (param[length(param)-2]=';') or (param[length(param)-2]='3') then
          begin
          act(AT_SAY,'You whink, ''' + param + '''',false,ch,nil,nil,TO_CHAR);
          act(AT_SAY,'$n whink, ''' + param + '''',false,ch,nil,nil,TO_ROOM);
          end
        else
          begin
          act(AT_SAY,'You say, ''' + param + '''',false,ch,nil,nil,TO_CHAR);
          act(AT_SAY,'$n says, ''' + param + '''',false,ch,nil,nil,TO_ROOM);
          end;
     else
       begin
       act(AT_SAY,'You say, ''' + param + '''',false,ch,nil,nil,TO_CHAR);
       act(AT_SAY,'$n says, ''' + param + '''',false,ch,nil,nil,TO_ROOM);
       end;
  end;
end;

procedure do_tell(ch:GCharacter;param:string);
var 
	vict : GPlayer;
	sub : string;
begin
  if (length(param)=0) then
    begin
    ch.sendBuffer('Talk what to whom?'#13#10);
    exit;
    end;

  param := one_argument(param, sub);
  vict := GPlayer(findPlayerWorld(ch,sub));

  if (vict = nil) then
    begin
    ch.sendBuffer('They are not here.'#13#10);
    exit;
    end;

  if (vict = ch) then
    begin
    ch.sendBuffer('You talk to yourself and are surprised that you receive no answer.'#13#10);
    exit;
    end;

  if (vict.afk) then
    begin
    ch.sendBuffer('That player is away from the keyboard right now.'#13#10);
    exit;
    end;

  vict.reply := GPlayer(ch);
  act(AT_TELL,'You tell $N, ''' + param + '''',false,ch,nil,vict,TO_CHAR);
  act(AT_TELL,'>> $n tells you, ''' + param + '''',false,ch,nil,vict,TO_VICT);
end;

procedure do_reply(ch : GCharacter;param:string);
begin
  if (ch.IS_NPC) or (length(param)=0) then
    begin
    ch.sendBuffer('Reply what?'#13#10);
    exit;
    end;

  if (GPlayer(ch).reply.CHAR_DIED) then
    begin
    GPlayer(ch).reply := nil;
    ch.sendBuffer('They are not here.'#13#10);
    exit;
    end;

  if (GPlayer(ch).reply.afk) then
    begin
    ch.sendBuffer('That player is away from the keyboard right now.'#13#10);
    exit;
    end;

  GPlayer(ch).reply.reply := GPlayer(ch);

  act(AT_TELL,'You tell $N, ''' + param + '''',false,ch,nil,GPlayer(ch).reply,TO_CHAR);
  act(AT_TELL,'>> $n tells you, ''' + param + '''',false,ch,nil,GPlayer(ch).reply,TO_VICT);
end;

procedure do_suggest(ch:GCharacter;param:string);
var 
  f : textfile;
  he : GHistoryElement;
  iterator : GIterator; 
begin
  if (length(param) = 0) then
    begin
    if (ch.IS_IMMORT()) then
      begin
      iterator := suggestHistory.iterator();
      
      while (iterator.hasNext()) do
        begin
        he := GHistoryElement(iterator.next());
       
        ch.sendBuffer(he.contents^ + #13#10);
        end;
      end
    else
      begin
      ch.sendBuffer('Suggest what?'#13#10);
      exit;
      end;
    end;
    
  act(AT_SUGGEST,'You suggest, '''+param+'''.',false,ch,nil,nil,TO_CHAR);
  writeConsole(ch.name+' suggested '''+param+'''');

  assignfile(f, 'system\suggest.dat');
  append(f);
  writeln(f, DateTimeToStr(Now),'> ', 'Suggestion by ',ch.name,': ',param);
  closefile(f);

  he := GHistoryElement.Create(ch.name+' suggested '''+param+'''');
  
  suggestHistory.insertLast(he);

  if (suggestHistory.size() > CHANNEL_HISTORY_MAX) then
    suggestHistory.remove(suggestHistory.head);
end;

procedure do_pray(ch:GCharacter;param:string);
var
  he : GHistoryElement;
  iterator : GIterator;
begin
  if (length(param) = 0) then
    begin
    if (ch.IS_IMMORT()) then
      begin
      iterator := prayHistory.iterator();
      
      while (iterator.hasNext()) do
        begin
        he := GHistoryElement(iterator.next());
       
        ch.sendBuffer(he.contents^ + #13#10);
        end;
      end
    else
      begin
      ch.sendBuffer('Pray what?'#13#10);
      exit;
      end;
    end;
    
  act(AT_PRAY, 'You =PRAY= '''+param+'''.',false,ch,nil,nil,TO_CHAR);
  writeConsole(ch.name + ' prays ''' + param + '''');
  
  he := GHistoryElement.Create(ch.name + ' prays ''' + param + '''');
  
  prayHistory.insertLast(he);

  if (prayHistory.size() > CHANNEL_HISTORY_MAX) then
    prayHistory.remove(prayHistory.head);
end;

procedure do_clanadd(ch:GCharacter;param:string);
var vict : GPlayer;
    obj : GObject;
    index : GObject;
begin
  if (ch.IS_NPC) then
    exit;

  if (not GPlayer(ch).clanleader) then
    ch.sendBuffer('You are not a clanleader!'#13#10)
  else
  if (length(param) = 0) then
    ch.sendBuffer('Add who to the clan?'#13#10)
  else
    begin
    vict := GPlayer(findPlayerWorld(ch,param));

    if (vict=nil) or (vict.IS_NPC) then
      ch.sendBuffer('That character does not exist.'#13#10)
    else
    if vict=ch then
      ch.sendBuffer('You''re clanleader, you don''t want to be member!'#13#10)
    else
    if vict.clan=ch.clan then
      ch.sendBuffer('That character is already member of this clan!'#13#10)
    else
    if vict.clan<>nil then
      ch.sendBuffer('That character is already member of a clan.'#13#10)
    else
      begin
      vict.clan := ch.clan;
      GPlayer(vict).clanleader := false;

      to_channel(ch, '*CLAN NOTIFY*: ' + vict.name+' is now a member of the clan!',CHANNEL_CLAN,AT_WHITE);

			index := GObject(objectIndices[ch.clan.clanobj]);

			if (index <> nil) then
        begin
        obj := index.clone();
        obj.toChar(vict);
        act(AT_REPORT,'You have received $p.',false,vict,obj,nil,TO_CHAR);
				end;
      end;
    end;
end;

procedure do_clanremove(ch:GCharacter;param:string);
var vict : GPlayer;
begin
  if (ch.IS_NPC) then
    exit;

  if (not GPlayer(ch).clanleader) then
    ch.sendBuffer('You are not a clanleader!'#13#10)
  else
  if (length(param)=0) then
    ch.sendBuffer('Remove who from the clan?'#13#10)
  else
    begin
    vict := GPlayer(findPlayerWorld(ch,param));

    if (vict=nil) or (vict.IS_NPC) then
      ch.sendBuffer('That character is not online.'#13#10)
    else
    if vict=ch then
      ch.sendBuffer('You''re clanleader, you don''t want to remove yourself!'#13#10)
    else
    if vict.clan<>ch.clan then
      ch.sendBuffer('That character is not a member of this clan!'#13#10)
    else
      begin
      to_channel(ch, '*CLAN NOTIFY*: ' + vict.name+' is no longer a member of the clan!',CHANNEL_CLAN,AT_WHITE);
      vict.clan:=nil;
      vict.clanleader:=false;
      end;
    end;
end;

procedure do_clan(ch:GCharacter;param:string);
var
  str : string;
  obj : GObject;
begin
  if (ch.clan=nil) then
    ch.sendBuffer('But you aren''t in a clan!'#13#10)
  else
    with ch.clan do
      begin
      obj := GObject(objectIndices[clanobj]);
      
      str := obj.short;

      act(AT_REPORT,#13#10'$B$3'+name,false,ch,nil,nil,TO_CHAR);
      act(AT_REPORT,#13#10'$B$1[$7Leader$1]$A$7:        $B$2'+leader,false,ch,nil,nil,TO_CHAR);
      act(AT_REPORT,'$B$1[$7Clanbase VNum$1]$A$7: $B$2' + inttostr(clanvnum),false,ch,nil,nil,TO_CHAR);
      act(AT_REPORT,'$B$1[$7Clan object$1]$A$7:   $B$2' + str,false,ch,nil,nil,TO_CHAR);
      act(AT_REPORT,'$B$1[$7Minimum level$1]$A$7: $B$2' + inttostr(minlevel),false,ch,nil,nil,TO_CHAR);
      end;
end;

procedure do_emote(ch:GCharacter;param:string);
begin
  if (length(param)=0) then
    begin
    ch.sendBuffer('EMOTE <string>'#13#10);
    exit;
    end;

  if not (param[length(param)] in ['.','!','?']) then
    param := param + '.';

  act(AT_REPORT,ch.name+' '+param,false,ch,nil,nil,TO_CHAR);
  act(AT_REPORT,ch.name+' '+param,false,ch,nil,nil,TO_ROOM);
end;

procedure do_auction(ch:GCharacter;param:string);
var price:integer;
    obj : GObject;
    buf : string;
    auc : GAuction;
begin
  if (ch.IS_EVIL) then
    auc := auction_evil
  else
    auc := auction_good;

  if (param = 'halt') then
    begin
    if (auc.item = nil) then
      ch.sendBuffer('No auction is currently going on.'#13#10)
    else
    if (auc.seller <> ch) then
      ch.sendBuffer('But that is not your auction!'#13#10)
    else
      begin
      GObject(auc.item).toChar(ch);

      buf := '$B$2<Auction> $1[$7' + ch.name + '$1] Auction of $7' + GObject(auc.item).name + '$1 has been halted.';
      to_channel(ch,buf,CHANNEL_AUCTION,AT_REPORT);
      auc.item:=nil;
      auc.seller:=nil;
      end;
    exit;
    end;

  if (length(param)=0) then
    begin
    ch.sendBuffer('Auction what at what price?'#13#10);
    exit;
    end;

  if (auc.item<>nil) then
    begin
    ch.sendBuffer('Another auction is already going on.'#13#10);
    exit;
    end;

  param := one_argument(param,buf);
  obj := ch.findInventory(buf);

  if obj=nil then
    begin
    ch.sendBuffer('That object is not in your inventory.'#13#10);
    exit;
    end;

  one_argument(param,buf);

  try
    price:=strtoint(buf);
  except
    ch.sendBuffer('The price is invalid.'#13#10);
    exit;
  end;

  if (price < 100) then
    begin
    ch.sendBuffer('Why auction it at such a low price anyway?'#13#10);
    exit;
    end;

  act(AT_REPORT,'Auctioned $p at the price of '+inttostr(price)+'.',false,ch,obj,nil,TO_CHAR);

  obj.seperate;
  obj.fromChar;

  auc.pulse := CPULSE_AUCTION;
  auc.item:=obj;
  auc.start:=price;
  auc.bid:=0;
  auc.seller:=ch;
  auc.going:=0;

  buf := '$B$2<Auction> $1[$7' + ch.name + '$1] $7' + cap(GObject(auc.item).name) + '$1, minimum bid ' + inttostr(auc.start) + ' coins.';

  to_channel(ch,buf,CHANNEL_AUCTION,AT_REPORT);
end;

procedure do_bid(ch:GCharacter;param:string);
var bid:integer;
    buf:string;
    auc : GAuction;
begin
  if (ch.IS_NPC) then
    begin
    ch.sendBuffer('NPCs cannot bid.'#13#10);
    exit;
    end;

  if (ch.IS_EVIL) then
    auc := auction_evil
  else
    auc := auction_good;

  if (auc.item=nil) then
    begin
    ch.sendBuffer('Nothing is currently up for auction.'#13#10);
    exit;
    end;

  if (length(param)=0) then
    begin
    buf := 'Currently up for auction: ' + cap(GObject(auc.item).name) + ' by ' + GCharacter(auc.seller).name + '.'#13#10;
    ch.sendBuffer(buf);

    buf := 'Startprice: ' + inttostr(auc.start);

    if (auc.bid=0) then
      buf := buf + '   No bids made yet.'#13#10
    else
      buf := buf + '  Current bid: ' + inttostr(auc.bid) + ' (' + GCharacter(auc.buyer).name + ')'#13#10;

    ch.sendBuffer(buf);
    exit;
    end;

  if (auc.seller=ch) then
    begin
    ch.sendBuffer('You cannot bid on your own auction.'#13#10);
    exit;
    end;

  if (auc.buyer=ch) then
    begin
    ch.sendBuffer('The last bid on this item is already yours.'#13#10);
    exit;
    end;

  try
    bid:=strtoint(param);
  except
    ch.sendBuffer('The bid is invalid.'#13#10);
    exit;
  end;

  if (bid > GPlayer(ch).bankgold) then
    begin
    ch.sendBuffer('You do not have enough money in the bank.'#13#10);
    exit;
    end;

  if (bid < auc.start) then
    begin
    act(AT_REPORT,'Minimum bid is '+inttostr(auc.start)+'.',false,ch,nil,nil,TO_CHAR);

    exit;
    end;

  if (bid < auc.bid+20) then
    begin
    ch.sendBuffer('Minimum bid increase is 20 coins.'#13#10);
    exit;
    end;

  auc.buyer:=ch;
  auc.bid:=bid;
  auc.going:=0;

  buf := '$B$2<Auction> $1[$7' + GCharacter(auc.seller).name + '$1] $7' + GCharacter(auc.buyer).name + '$1 bids ' + inttostr(auc.bid) + ' coins.';

  to_channel(ch,buf,CHANNEL_AUCTION,AT_REPORT);
end;

procedure do_battle(ch:GCharacter;param:string);
begin
  if (ch.IS_NPC) then
    begin
    ch.sendBuffer('NPCs cannot battle.'#13#10);
    exit;
    end;

  if (GPlayer(ch).bg_status=BG_PARTICIPATE) then
    begin
    ch.sendBuffer('You are already participating in a battleground!'#13#10);
    exit;
    end;

  if (GPlayer(ch).bg_status=BG_NOJOIN) then
    begin
    GPlayer(ch).bg_status:=BG_JOIN;
    ch.sendBuffer('You will join a battleground when it starts.'#13#10);
    exit;
    end;
    
  if (GPlayer(ch).bg_status=BG_JOIN) then
    begin
    GPlayer(ch).bg_status:=BG_NOJOIN;
    ch.sendBuffer('You will no longer join a battleground when it starts.'#13#10);
    exit;
    end;
end;

// Enable/Disable MCCP compression
procedure do_compress(ch : GCharacter; param : string);
begin
	if (ch.IS_NPC) then
		begin
		ch.sendBuffer('NPCs don''t use MCCP.'#13#10);
		exit;
		end;

	if (prep(param) = 'ON') then
 		begin
 		if (GPlayer(ch).conn.useCompress) then
 			begin
 			ch.sendBuffer('MCCP is already enabled.'#13#10);
 			exit;
 			end;
 		
	  ch.sendBuffer('Enabling MCCP (will only work on supporting clients).'#13#10);
		GPlayer(ch).conn.negotiateCompression();
	  ch.sendBuffer('Ok.'#13#10);
 		end
	else
	if (prep(param) = 'OFF') then
 		begin
 		if (not GPlayer(ch).conn.useCompress) then
 			begin
 			ch.sendBuffer('MCCP is already disabled.'#13#10);
 			exit;
 			end;
 			
  	ch.sendBuffer('Disabling MCCP.'#13#10);
 		GPlayer(ch).conn.disableCompression();
  	ch.sendBuffer('Ok.'#13#10);
 		end
	else
		begin
		ch.sendBuffer('Usage: COMPRESS <on/off>'#13#10);
		exit;
		end;
end;