--- deliantra/server/lib/cf.pm	2006/12/21 23:02:54	1.94
+++ deliantra/server/lib/cf.pm	2006/12/22 06:02:29	1.96
@@ -1,5 +1,8 @@
 package cf;
 
+use utf8;
+use strict;
+
 use Symbol;
 use List::Util;
 use Storable;
@@ -7,16 +10,22 @@
 use Safe;
 use Safe::Hole;
 
-use IO::AIO ();
+use Coro;
+use Coro::Event;
+use Coro::Timer;
+use Coro::Signal;
+use Coro::Semaphore;
+
+use IO::AIO;
 use YAML::Syck ();
 use Time::HiRes;
-use Event;
-$Event::Eval = 1; # no idea why this is required, but it is
+
+use Event; $Event::Eval = 1; # no idea why this is required, but it is
 
 # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
 $YAML::Syck::ImplicitUnicode = 1;
 
-use strict;
+$Coro::main->prio (Coro::PRIO_MIN);
 
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
 
@@ -251,6 +260,14 @@
       }
    }
 
+=item $attachable->valid
+
+Just because you have a perl object does not mean that the corresponding
+C-level object still exists. If you try to access an object that has no
+valid C counterpart anymore you get an exception at runtime. This method
+can be used to test for existence of the C object part without causing an
+exception.
+
 =cut
 
 # the following variables are defined in .xs and must not be re-created
@@ -415,19 +432,13 @@
    0
 }
 
-=item $bool = cf::invoke EVENT_GLOBAL_XXX, ...
-
-=item $bool = $object->invoke (EVENT_OBJECT_XXX, ...)
-
-=item $bool = $player->invoke (EVENT_PLAYER_XXX, ...)
-
-=item $bool = $client->invoke (EVENT_CLIENT_XXX, ...)
+=item $bool = cf::global::invoke (EVENT_CLASS_XXX, ...)
 
-=item $bool = $map->invoke (EVENT_MAP_XXX, ...)
+=item $bool = $attachable->invoke (EVENT_CLASS_XXX, ...)
 
-Generate a global/object/player/map-specific event with the given arguments.
+Generate an object-specific event with the given arguments.
 
-This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be
+This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be
 removed in future versions), and there is no public API to access override
 results (if you must, access C<@cf::invoke_results> directly).
 
@@ -436,26 +447,6 @@
 =cut
 
 #############################################################################
-
-=head2 METHODS VALID FOR ALL ATTACHABLE OBJECTS
-
-Attachable objects includes objects, players, clients and maps.
-
-=over 4
-
-=item $object->valid
-
-Just because you have a perl object does not mean that the corresponding
-C-level object still exists. If you try to access an object that has no
-valid C counterpart anymore you get an exception at runtime. This method
-can be used to test for existence of the C object part without causing an
-exception.
-
-=back
-
-=cut
-
-#############################################################################
 # object support
 
 sub instantiate {
@@ -760,6 +751,8 @@
 
 Functions and methods that extend core crossfire objects.
 
+=head3 cf::player
+
 =over 4
 
 =item cf::player::exists $login
@@ -773,6 +766,26 @@
       or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
 }
 
+=item $player->ext_reply ($msgid, $msgtype, %msg)
+
+Sends an ext reply to the player.
+
+=cut
+
+sub cf::player::ext_reply($$$%) {
+   my ($self, $id, %msg) = @_;
+
+   $msg{msgid} = $id;
+
+   $self->send ("ext " . to_json \%msg);
+}
+
+=back
+
+=head3 cf::object::player
+
+=over 4
+
 =item $player_object->reply ($npc, $msg[, $flags])
 
 Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
@@ -783,6 +796,7 @@
 
 # rough implementation of a future "reply" method that works
 # with dialog boxes.
+#TODO: the first argument must go, split into a $npc->reply_to ( method
 sub cf::object::player::reply($$$;$) {
    my ($self, $npc, $msg, $flags) = @_;
 
@@ -796,20 +810,6 @@
    }
 }
 
-=item $player->ext_reply ($msgid, $msgtype, %msg)
-
-Sends an ext reply to the player.
-
-=cut
-
-sub cf::player::ext_reply($$$%) {
-   my ($self, $id, %msg) = @_;
-
-   $msg{msgid} = $id;
-
-   $self->send ("ext " . to_json \%msg);
-}
-
 =item $player_object->may ("access")
 
 Returns wether the given player is authorized to access resource "access"
@@ -826,9 +826,108 @@
          : $cf::CFG{"may_$access"})
 }
 
+=head3 cf::client
+
+=over 4
+
+=item $client->send_drawinfo ($text, $flags)
+
+Sends a drawinfo packet to the client. Circumvents output buffering so
+should not be used under normal circumstances.
+
+=cut
+
+sub cf::client::send_drawinfo {
+   my ($self, $text, $flags) = @_;
+
+   utf8::encode $text;
+   $self->send_packet (sprintf "drawinfo %d %s", $flags, $text);
+}
+
+
+=item $success = $client->query ($flags, "text", \&cb)
+
+Queues a query to the client, calling the given callback with
+the reply text on a reply. flags can be C<cf::CS_QUERY_YESNO>,
+C<cf::CS_QUERY_SINGLECHAR> or C<cf::CS_QUERY_HIDEINPUT> or C<0>.
+
+Queries can fail, so check the return code. Or don't, as queries will become
+reliable at some point in the future.
+
 =cut
 
-#############################################################################
+sub cf::client::query {
+   my ($self, $flags, $text, $cb) = @_;
+
+   return unless $self->state == ST_PLAYING
+              || $self->state == ST_SETUP
+              || $self->state == ST_CUSTOM;
+
+   $self->state (ST_CUSTOM);
+
+   utf8::encode $text;
+   push @{ $self->{query_queue} }, [(sprintf "query %d %s", $flags, $text), $cb];
+
+   $self->send_packet ($self->{query_queue}[0][0])
+      if @{ $self->{query_queue} } == 1;
+}
+
+cf::client->attach (
+   on_reply => sub {
+      my ($ns, $msg) = @_;
+
+      # this weird shuffling is so that direct followup queries
+      # get handled first
+      my $queue = delete $ns->{query_queue};
+
+      (shift @$queue)->[1]->($msg);
+
+      push @{ $ns->{query_queue} }, @$queue;
+
+      if (@{ $ns->{query_queue} } == @$queue) {
+         if (@$queue) {
+            $ns->send_packet ($ns->{query_queue}[0][0]);
+         } else {
+            $ns->state (ST_PLAYING);
+         }
+      }
+   },
+);
+
+=item $client->coro (\&cb)
+
+Create a new coroutine, running the specified callback. The coroutine will
+be automatically cancelled when the client gets destroyed (e.g. on logout,
+or loss of connection).
+
+=cut
+
+sub cf::client::coro {
+   my ($self, $cb) = @_;
+
+   my $coro; $coro = async {
+      eval {
+         $cb->();
+      };
+      warn $@ if $@;
+      warn "cancel myself\n";#d#
+      delete $self->{_coro}{$coro+0};
+   };
+
+   $self->{_coro}{$coro+0} = $coro;
+}
+
+cf::client->attach (
+   on_destroy => sub {
+      my ($ns) = @_;
+
+      warn "cancel $_" for values %{ $ns->{_coro} || {} };#d#
+      $_->cancel for values %{ $ns->{_coro} || {} };
+   },
+);
+
+=back
+
 
 =head2 SAFE SCRIPTING