--- deliantra/server/ext/chat.ext 2007/03/02 00:29:08 1.12 +++ deliantra/server/ext/chat.ext 2007/07/20 16:11:10 1.21 @@ -1,4 +1,4 @@ -#! perl +#! perl # depends=irc #CONVERSION: PARTIAL # implement a replacement for the built-in say/chat/shout/tell/reply commands @@ -24,6 +24,16 @@ } } +# send_irc ($format, @args, $msg) +# make sure the last argument is the message! +sub send_irc { + my ($format, @args) = @_; + my $msg = pop @args; + for (split /\n/, $msg) { + ext::irc::do_notice (sprintf $format, @args, $_) + } +} + cf::player->attach ( prio => -1000, on_login => sub { @@ -38,10 +48,12 @@ my $player = cf::player::find_active $pl->name; if ($msg ne "") { + $msg = 10 if $msg > 10; + my $prev_listen = $player->listening; $player->listening ($msg); if ($prev_listen == $player->listening) { - $pl->message ("Your verbose level stayed $prev_listen.", cf::NDI_UNIQUE); + $pl->message ("Your verbose level stays at $prev_listen.", cf::NDI_UNIQUE); } else { $pl->message ("Your verbose level is now " . $player->listening . ". (previously: $prev_listen)", cf::NDI_UNIQUE); } @@ -54,24 +66,15 @@ my ($pl, $msg) = @_; my $name = $pl->name; + my $coin = int rand 2 ? "Heads" : "Tails"; - if (int rand 2) { - for my $other ( grep { $pl->on_same_map_as ($_->ob) } cf::player::list ) { - next - if $other->ob == $pl; - $other->ob->message ("$name flips a coin.... Heads!", cf::NDI_GREY | cf::NDI_UNIQUE); - } - - $pl->message ("You flip a coin.... Heads!", cf::NDI_GREY | cf::NDI_UNIQUE); - } else { - for my $other ( grep { $pl->on_same_map_as ($_->ob) } cf::player::list ) { - next - if $other->ob == $pl; - $other->ob->message ("$name flips a coin.... Tails!", cf::NDI_GREY | cf::NDI_UNIQUE); - } - - $pl->message ("You flip a coin.... Tails!", cf::NDI_GREY | cf::NDI_UNIQUE); + for my $other ( grep { $pl->on_same_map_as ($_->ob) } cf::player::list ) { + next + if $other->ob == $pl; + $other->ob->message ("$name flips a coin.... $coin!", cf::NDI_GREY | cf::NDI_UNIQUE); } + + $pl->message ("You flip a coin.... $coin!", cf::NDI_GREY | cf::NDI_UNIQUE); }; cf::register_command orcknuckle => sub { @@ -745,12 +748,19 @@ }; } +our $SAY_CHANNEL = { + id => "say", + title => "Map", + reply => "say ", + tooltip => "Things said to and replied from npcs near you and other players on the same map only.", +}; + cf::register_command me => sub { my ($pl, $msg) = @_; my $name = $pl->name; - $_->ob->message ("* $name $msg", cf::NDI_GREY | cf::NDI_UNIQUE) + $_->ns->send_msg ($SAY_CHANNEL => "* $name $msg", cf::NDI_GREY, $_ == $pl ? (reply => 1) : ()) for grep $pl->on_same_map_as ($_->ob), cf::player::list; }; @@ -763,15 +773,14 @@ if ($msg) { my $name = $pl->name; + my @plonmap = grep $pl->on_same_map_as ($_->ob), cf::player::list; - utf8::encode $msg; # ->message not yet utf8-ified - $_->ob->message ("$name says: $msg", cf::NDI_GREY | cf::NDI_UNIQUE) - for grep $pl->on_same_map_as ($_->ob), cf::player::list; - utf8::decode $msg; + $_->ns->send_msg ($SAY_CHANNEL => "$name says: $msg", cf::NDI_GREY, $_ == $pl ? (reply => 1) : ()) + for @plonmap; # npcs, magic_ears etc. - # first find all objects and theirt-level inventories - # within a 5x5 square # that have something resembling + # first find all objects and their first-level inventories + # within a 5x5 square that have something resembling # dialogue or support on_say. my ($map, $x, $y) = ($pl->map, $pl->x - 2, $pl->y - 2); @@ -785,35 +794,42 @@ # if some listener teleported us somewhere else, stop right here last unless $map->path == $pl->map->path; - my $dialog = new NPC_Dialogue ob => $pl, npc => $npc; + my $dialog = new NPC_Dialogue pl => $pl->contr, npc => $npc; my ($reply, @kw) = $dialog->tell ($msg); if (defined $reply) { if ($npc->type == cf::MAGIC_EAR) { if (length $reply) { - $_->ob->message ($reply, cf::NDI_BROWN | cf::NDI_UNIQUE) - for grep $pl->on_same_map_as ($_->ob), cf::player::list; + $_->contr->send_msg ($SAY_CHANNEL => $reply, cf::NDI_BROWN) + for @plonmap; } $npc->use_trigger; } else { if (length $reply) { - $_->ob->message ($npc->name . " says: $reply", cf::NDI_BROWN | cf::NDI_UNIQUE) - for grep $pl->on_same_map_as ($_->ob), cf::player::list; + $_->contr->send_msg ($SAY_CHANNEL => $npc->name . " says: $reply", cf::NDI_BROWN) + for @plonmap; } } } if (@kw) { - $_->ob->message ("[further topics: " . (join ", ", @kw) . "]", cf::NDI_BROWN | cf::NDI_UNIQUE) - for grep $pl->on_same_map_as ($_->ob), cf::player::list; + $_->contr->send_msg ($SAY_CHANNEL => "[further topics: " . (join ", ", @kw) . "]", cf::NDI_BROWN) + for @plonmap; } } } else { - $pl->message ("What do you want to say?", cf::NDI_UNIQUE); + $pl->contr->send_msg ($SAY_CHANNEL => "What do you want to say?", 0, reply => 1); } }; +our $CHAT_CHANNEL = { + id => "chat", + title => "Chat", + reply => "chat ", + tooltip => "Player chat and shouts, global to the server.", +}; + cf::register_command chat => sub { my ($pl, $msg) = @_; @@ -825,15 +841,14 @@ my $name = $pl->name; my $NOW = time; - utf8::encode $msg; # ->message not yet utf8-ified cf::LOG cf::llevDebug, sprintf "QBERT [%s] %s\n", $name, $msg; - ext::schmorp_irc::do_notice (sprintf "[%s] %s", $name, $msg); + send_irc ("[%s] %s", $name, $msg); - $_->ob->message ("$name chats: $msg", cf::NDI_BLUE) + $_->ns->send_msg ($CHAT_CHANNEL => "$name chats: $msg", cf::NDI_BLUE, $_ == $pl ? (reply => 1) : ()) for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 10 } cf::player::list; } else { - $pl->message ("Chat what?", cf::NDI_UNIQUE); + $pl->ns->send_msg ($CHAT_CHANNEL => "Chat what?"); } }; @@ -849,90 +864,66 @@ my $name = $pl->name; cf::LOG cf::llevDebug, sprintf "QBERT {%s} %s\n", $name, $msg; - ext::schmorp_irc::do_notice (sprintf "\007\0034{%s} %s\n", $name, $msg); + send_irc ("\007\0034{%s} %s\n", $name, $msg); - utf8::encode $msg; # ->message not yet utf8-ified - $_->ob->message ("$name shouts: $msg", cf::NDI_RED) + $_->ns->send_msg ($CHAT_CHANNEL => "$name shouts: $msg", cf::NDI_BLUE, $_ == $pl ? (reply => 1) : ()) for grep { $_->ob->{ext_ignore_shout}{$name} < $NOW && $_->listening >= 2 } cf::player::list; } else { - $pl->message ("Shout what?", cf::NDI_UNIQUE); + $pl->ns->send_msg ($CHAT_CHANNEL => "Shout what?"); } }; cf::register_command tell => sub { - my ($pl, $args) = @_; + my ($ob, $args) = @_; my ($target, $msg) = split /\s+/, $args, 2; utf8::decode $msg; - return if $pl->contr->invoke (cf::EVENT_PLAYER_TELL, $target, $msg); - - my $name = $pl->name; + my $pl = $ob->contr; + my $ns = $pl->ns + or return; + my $name = $ob->name; + + return if $pl->invoke (cf::EVENT_PLAYER_TELL, $target, $msg); + + my $pl_channel = { + id => "tell-$target", + title => "$target", + reply => "tell $target ", + tooltip => "Private messages from/to $target", + }; if ($target =~ /irc\//) { my (undef, $nick) = split /\//, $target, 2; - $pl->message ("You tell $target: $args"); - ext::schmorp_irc::do_notice (sprintf "(%s) %s: %s\n", $name, $nick, $msg); + $ns->send_msg ($pl_channel => "You tell $target: $args", reply => 1); + send_irc ("(%s) %s: %s\n", $name, $nick, $msg); } elsif (my $other = cf::player::find_active $target) { + my $other_channel = { + id => "tell-$name", + title => "$name", + reply => "tell $name ", + tooltip => "Private messages from/to $name", + }; if ($msg) { if ($target eq $name) { - $pl->message ("You are talking to yourself, you freak!", cf::NDI_UNIQUE); + $ns->send_msg ($pl_channel => "You are talking to yourself, you freak!", reply => 1); } elsif ($other->ob->{ext_ignore_tell}{$name} >= time) { - $pl->message ("$target ignores what you say. Give up on it.", cf::NDI_UNIQUE); + $ns->send_msg ($pl_channel => "$target ignores what you say. Give up on it.", reply => 1); } else { return if $other->invoke (cf::EVENT_PLAYER_TOLD, $pl->contr, $msg); - utf8::encode $msg; # ->message not yet utf8-ified cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $target, $msg; - $pl->message ("You tell $target: $msg"); - $other->ob->message ("$name tells you: $msg"); - $other->ob->{ext_last_tell} = $name; + $ns->send_msg ($pl_channel => "You tell $target: $msg", reply => 1); + $other->ns->send_msg ($other_channel => "$name tells you: $msg"); } } else { - $pl->message ("What do you want to tell $target?", cf::NDI_UNIQUE); + $ns->send_msg ($pl_channel => "What do you want to tell $target?"); } } else { - $pl->message ("No such player. Your message: $msg", cf::NDI_UNIQUE); - } -}; - -cf::register_command reply => sub { - my ($pl, $args) = @_; - my $name = $pl->name; - - utf8::decode $args; - - return if $pl->contr->invoke (cf::EVENT_PLAYER_TELL, $pl->{ext_last_tell}, $args); - - if ($pl->{ext_last_tell} =~ /irc\//) { - my (undef, $nick) = split /\//, $pl->{ext_last_tell}, 2; - $pl->message ("You tell " . $pl->{ext_last_tell} . ": $args"); - ext::schmorp_irc::do_notice (sprintf "(%s) %s: %s\n", $name, $nick, $args); - } elsif (my $other = cf::player::find_active $pl->{ext_last_tell}) { - - if ($args) { - $other->ob->{ext_ignore_tell}{$name} >= time - or delete $other->ob->{ext_ignore_tell}{$name}; - - if ($other->ob->{ext_ignore_tell}{$name} < time) { - utf8::encode $args; # ->message not yet utf8-ified - cf::LOG cf::llevDebug, sprintf "TELL [%s>%s] %s\n", $name, $other->ob->name, $args; - - $pl->message ("You tell " . $other->ob->name . ": $args"); - $other->ob->message ("$name tells you: $args"); - $pl->{ext_last_tell} = $other->ob->name; - } else { - $pl->message ($other->ob->name . " ignores what you say. Give up on it.", cf::NDI_UNIQUE); - } - } else { - $pl->message ("What do you want to tell ".$other->ob->name."?", cf::NDI_UNIQUE); - } - - } else { - $pl->message ("Can't reply, player left. Your message: $args".$pl->{ext_last_tell}, cf::NDI_UNIQUE); + $ns->send_msg ($pl_channel => "No such player. Your message: $msg"); } }; @@ -1019,26 +1010,3 @@ } }; -cf::register_command seen => sub { - my ($pl, $args) = @_; - - if (my ($login) = $args =~ /(\S+)/) { - if ($login eq $pl->name) { - $pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE); - } elsif (cf::player::find_active $login) { - $pl->message ("$login is right here on this server!", cf::NDI_UNIQUE); - } elsif (cf::player::exists $login - and stat sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($login) x 2) { - my $time = (stat _)[9]; - - $pl->message ("$login was last seen here " - . (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time) - . " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE); - } else { - $pl->message ("No player named $login is known to me.", cf::NDI_UNIQUE); - } - } else { - $pl->message ("Usage: seen ", cf::NDI_UNIQUE); - } -}; -