// $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;