[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.297 by root, Thu Jul 5 08:10:30 2007 UTC vs.
Revision 1.310 by elmex, Mon Jul 16 15:43:49 2007 UTC

…		…
29	use Fcntl;	29	use Fcntl;
30	use YAML::Syck ();	30	use YAML::Syck ();
31	use IO::AIO 2.32 ();	31	use IO::AIO 2.32 ();
32	use Time::HiRes;	32	use Time::HiRes;
33	use Compress::LZF;	33	use Compress::LZF;
		34	use Digest::MD5 ();
34		35
35	# configure various modules to our taste	36	# configure various modules to our taste
36	#	37	#
37	$Storable::canonical = 1; # reduce rsync transfers	38	$Storable::canonical = 1; # reduce rsync transfers
38	Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator	39	Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
…		…
165	=item cf::wait_for_tick, cf::wait_for_tick_begin	166	=item cf::wait_for_tick, cf::wait_for_tick_begin
166		167
167	These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only	168	These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only
168	returns directly I<after> the tick processing (and consequently, can only wake one process	169	returns directly I<after> the tick processing (and consequently, can only wake one process
169	per tick), while cf::wait_for_tick wakes up all waiters after tick processing.	170	per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
		171
		172	=item @cf::INVOKE_RESULTS
		173
		174	This array contains the results of the last C<invoke ()> call. When
		175	C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
		176	that call.
170		177
171	=back	178	=back
172		179
173	=cut	180	=cut
174		181
…		…
409	Coro::Storable. May, of course, block. Note that the executed sub may	416	Coro::Storable. May, of course, block. Note that the executed sub may
410	never block itself or use any form of Event handling.	417	never block itself or use any form of Event handling.
411		418
412	=cut	419	=cut
413		420
		421	sub _store_scalar {
		422	open my $fh, ">", \my $buf
		423	or die "fork_call: cannot open fh-to-buf in child : $!";
		424	Storable::store_fd $_[0], $fh;
		425	close $fh;
		426
		427	$buf
		428	}
		429
414	sub fork_call(&@) {	430	sub fork_call(&@) {
415	my ($cb, @args) = @_;	431	my ($cb, @args) = @_;
416		432
417	# socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC	433	# socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
418	# or die "socketpair: $!";	434	# or die "socketpair: $!";
…		…
421		437
422	if (my $pid = fork) {	438	if (my $pid = fork) {
423	close $fh2;	439	close $fh2;
424		440
425	my $res = (Coro::Handle::unblock $fh1)->readline (undef);	441	my $res = (Coro::Handle::unblock $fh1)->readline (undef);
		442	warn "pst<$res>" unless $res =~ /^pst/;
426	$res = Coro::Storable::thaw $res;	443	$res = Coro::Storable::thaw $res;
427		444
428	waitpid $pid, 0; # should not block anymore, we expect the child to simply behave	445	waitpid $pid, 0; # should not block anymore, we expect the child to simply behave
429		446
430	die $$res unless "ARRAY" eq ref $res;	447	Carp::confess $$res unless "ARRAY" eq ref $res;
431		448
432	return wantarray ? @$res : $res->[-1];	449	return wantarray ? @$res : $res->[-1];
433	} else {	450	} else {
434	reset_signals;	451	reset_signals;
435	local $SIG{__WARN__};	452	local $SIG{__WARN__};
436	local $SIG{__DIE__};	453	local $SIG{__DIE__};
		454	# just in case, this hack effectively disables event
		455	# in the child. cleaner and slower would be canceling all watchers,
		456	# but this works for the time being.
		457	local $Coro::idle;
		458	$Coro::current->prio (Coro::PRIO_MAX);
		459
437	eval {	460	eval {
438	close $fh1;	461	close $fh1;
439		462
440	my @res = eval { $cb->(@args) };	463	my @res = eval { $cb->(@args) };
		464
441	syswrite $fh2, Coro::Storable::freeze +($@ ? \"$@" : \@res);	465	syswrite $fh2, _store_scalar $@ ? \"$@" : \@res;
		466	close $fh2;
442	};	467	};
443		468
444	warn $@ if $@;	469	warn $@ if $@;
445	_exit 0;	470	_exit 0;
446	}	471	}
…		…
847	";	872	";
848	die if $@;	873	die if $@;
849	}	874	}
850		875
851	our $override;	876	our $override;
852	our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals?	877	our @INVOKE_RESULTS = (); # referenced from .xs code. TODO: play tricks with reify and mortals?
853		878
854	sub override {	879	sub override {
855	$override = 1;	880	$override = 1;
856	@invoke_results = ();	881	@INVOKE_RESULTS = (@_);
857	}	882	}
858		883
859	sub do_invoke {	884	sub do_invoke {
860	my $event = shift;	885	my $event = shift;
861	my $callbacks = shift;	886	my $callbacks = shift;
862		887
863	@invoke_results = ();	888	@INVOKE_RESULTS = ();
864		889
865	local $override;	890	local $override;
866		891
867	for (@$callbacks) {	892	for (@$callbacks) {
868	eval { &{$_->[1]} };	893	eval { &{$_->[1]} };
…		…
885		910
886	Generate an object-specific event with the given arguments.	911	Generate an object-specific event with the given arguments.
887		912
888	This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be	913	This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be
889	removed in future versions), and there is no public API to access override	914	removed in future versions), and there is no public API to access override
890	results (if you must, access C<@cf::invoke_results> directly).	915	results (if you must, access C<@cf::INVOKE_RESULTS> directly).
891		916
892	=back	917	=back
893		918
894	=cut	919	=cut
895		920
…		…
1470	my ($path) = @_;	1495	my ($path) = @_;
1471		1496
1472	my ($match, $specificity);	1497	my ($match, $specificity);
1473		1498
1474	for my $region (list) {	1499	for my $region (list) {
1475	if ($region->match && $path =~ $region->match) {	1500	if ($region->{match} && $path =~ $region->{match}) {
1476	($match, $specificity) = ($region, $region->specificity)	1501	($match, $specificity) = ($region, $region->specificity)
1477	if $region->specificity > $specificity;	1502	if $region->specificity > $specificity;
1478	}	1503	}
1479	}	1504	}
1480		1505
…		…
1600	$self->init; # pass $1 etc.	1625	$self->init; # pass $1 etc.
1601	return $self;	1626	return $self;
1602	}	1627	}
1603	}	1628	}
1604		1629
1605	Carp::carp "unable to resolve path '$path' (base '$base').";	1630	Carp::cluck "unable to resolve path '$path' (base '$base').";
1606	()	1631	()
1607	}	1632	}
1608		1633
1609	sub init {	1634	sub init {
1610	my ($self) = @_;	1635	my ($self) = @_;
…		…
1888		1913
1889	undef $MAP_PREFETCH{$path};	1914	undef $MAP_PREFETCH{$path};
1890	$MAP_PREFETCHER \|\|= cf::async {	1915	$MAP_PREFETCHER \|\|= cf::async {
1891	while (%MAP_PREFETCH) {	1916	while (%MAP_PREFETCH) {
1892	for my $path (keys %MAP_PREFETCH) {	1917	for my $path (keys %MAP_PREFETCH) {
1893	my $map = find $path	1918	if (my $map = find $path) {
1894	or next;
1895	$map->load;	1919	$map->load;
		1920	}
1896		1921
1897	delete $MAP_PREFETCH{$path};	1922	delete $MAP_PREFETCH{$path};
1898	}	1923	}
1899	}	1924	}
1900	undef $MAP_PREFETCHER;	1925	undef $MAP_PREFETCHER;
…		…
2237		2262
2238	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext	2263	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2239	$self->enter_map ($map, $x, $y);	2264	$self->enter_map ($map, $x, $y);
2240	}	2265	}
2241		2266
2242	=item $player_object->goto ($path, $x, $y[, $check->($map)])	2267	=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2243		2268
2244	Moves the player to the given map-path and coordinates by first freezing	2269	Moves the player to the given map-path and coordinates by first freezing
2245	her, loading and preparing them map, calling the provided $check callback	2270	her, loading and preparing them map, calling the provided $check callback
2246	that has to return the map if sucecssful, and then unfreezes the player on	2271	that has to return the map if sucecssful, and then unfreezes the player on
2247	the new (success) or old (failed) map position.	2272	the new (success) or old (failed) map position. In either case, $done will
		2273	be called at the end of this process.
2248		2274
2249	=cut	2275	=cut
2250		2276
2251	our $GOTOGEN;	2277	our $GOTOGEN;
2252		2278
2253	sub cf::object::player::goto {	2279	sub cf::object::player::goto {
2254	my ($self, $path, $x, $y, $check) = @_;	2280	my ($self, $path, $x, $y, $check, $done) = @_;
2255		2281
2256	# do generation counting so two concurrent goto's will be executed in-order	2282	# do generation counting so two concurrent goto's will be executed in-order
2257	my $gen = $self->{_goto_generation} = ++$GOTOGEN;	2283	my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2258		2284
2259	$self->enter_link;	2285	$self->enter_link;
…		…
2279		2305
2280	if ($gen == $self->{_goto_generation}) {	2306	if ($gen == $self->{_goto_generation}) {
2281	delete $self->{_goto_generation};	2307	delete $self->{_goto_generation};
2282	$self->leave_link ($map, $x, $y);	2308	$self->leave_link ($map, $x, $y);
2283	}	2309	}
		2310
		2311	$done->() if $done;
2284	})->prio (1);	2312	})->prio (1);
2285	}	2313	}
2286		2314
2287	=item $player_object->enter_exit ($exit_object)	2315	=item $player_object->enter_exit ($exit_object)
2288		2316
…		…
2446	=cut	2474	=cut
2447		2475
2448	sub cf::client::ext_event($$%) {	2476	sub cf::client::ext_event($$%) {
2449	my ($self, $type, %msg) = @_;	2477	my ($self, $type, %msg) = @_;
2450		2478
		2479	return unless $self->extcmd;
		2480
2451	$msg{msgtype} = "event_$type";	2481	$msg{msgtype} = "event_$type";
2452	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));	2482	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
2453	}	2483	}
2454		2484
2455	=item $success = $client->query ($flags, "text", \&cb)	2485	=item $success = $client->query ($flags, "text", \&cb)
…		…
2701	{	2731	{
2702	my $faces = $facedata->{faceinfo};	2732	my $faces = $facedata->{faceinfo};
2703		2733
2704	while (my ($face, $info) = each %$faces) {	2734	while (my ($face, $info) = each %$faces) {
2705	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;	2735	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;
2706	cf::face::set $idx, $info->{visibility}, $info->{magicmap};	2736	cf::face::set_visibility $idx, $info->{visibility};
		2737	cf::face::set_magicmap $idx, $info->{magicmap};
2707	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};	2738	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};
2708	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};	2739	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};
2709	Coro::cede;	2740
		2741	cf::cede_to_tick;
2710	}	2742	}
2711		2743
2712	while (my ($face, $info) = each %$faces) {	2744	while (my ($face, $info) = each %$faces) {
2713	next unless $info->{smooth};	2745	next unless $info->{smooth};
2714	my $idx = cf::face::find $face	2746	my $idx = cf::face::find $face
2715	or next;	2747	or next;
2716	if (my $smooth = cf::face::find $info->{smooth}) {	2748	if (my $smooth = cf::face::find $info->{smooth}) {
		2749	cf::face::set_smooth $idx, $smooth;
2717	cf::face::set_smooth $idx, $smooth, $info->{smoothlevel};	2750	cf::face::set_smoothlevel $idx, $info->{smoothlevel};
2718	} else {	2751	} else {
2719	warn "smooth face '$info->{smooth}' not found for face '$face'";	2752	warn "smooth face '$info->{smooth}' not found for face '$face'";
2720	}	2753	}
2721	Coro::cede;	2754
		2755	cf::cede_to_tick;
2722	}	2756	}
2723	}	2757	}
2724		2758
2725	{	2759	{
2726	my $anims = $facedata->{animinfo};	2760	my $anims = $facedata->{animinfo};
2727		2761
2728	while (my ($anim, $info) = each %$anims) {	2762	while (my ($anim, $info) = each %$anims) {
2729	cf::anim::set $anim, $info->{frames}, $info->{facings};	2763	cf::anim::set $anim, $info->{frames}, $info->{facings};
2730	Coro::cede;	2764	cf::cede_to_tick;
2731	}	2765	}
2732		2766
2733	cf::anim::invalidate_all; # d'oh	2767	cf::anim::invalidate_all; # d'oh
		2768	}
		2769
		2770	{
		2771	# TODO: for gcfclient pleasure, we should give resources
		2772	# that gcfclient doesn't grok a >10000 face index.
		2773	my $res = $facedata->{resource};
		2774	my $enc = JSON::XS->new->utf8->canonical;
		2775
		2776	while (my ($name, $info) = each %$res) {
		2777	my $meta = $enc->encode ({
		2778	name => $name,
		2779	type => $info->{type},
		2780	copyright => $info->{copyright}, #TODO#
		2781	});
		2782
		2783	my $idx = (cf::face::find $name) \|\| cf::face::alloc $name;
		2784
		2785	if ($name =~ /\.jpg$/) {
		2786	cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};#d# temp hack
		2787	cf::face::set_data $idx, 1, $info->{data}, $info->{chksum};#d# temp hack
		2788	} else {
		2789	my $data = pack "(w/a)", $meta, $info->{data};
		2790	my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
		2791
		2792	cf::face::set_type $idx, 1;
		2793	cf::face::set_data $idx, 0, $data, $chk;
		2794	}
		2795
		2796	cf::cede_to_tick;
		2797	}
2734	}	2798	}
2735		2799
2736	1	2800	1
2737	}	2801	}
2738		2802
2739	sub reload_regions {	2803	sub reload_regions {
2740	load_resource_file "$MAPDIR/regions"	2804	load_resource_file "$MAPDIR/regions"
2741	or die "unable to load regions file\n";	2805	or die "unable to load regions file\n";
		2806
		2807	for (cf::region::list) {
		2808	$_->{match} = qr/$_->{match}/
		2809	if exists $_->{match};
		2810	}
2742	}	2811	}
2743		2812
2744	sub reload_facedata {	2813	sub reload_facedata {
2745	load_facedata "$DATADIR/facedata"	2814	load_facedata "$DATADIR/facedata"
2746	or die "unable to load facedata\n";	2815	or die "unable to load facedata\n";

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.297 by root, Thu Jul 5 08:10:30 2007 UTC vs. Revision 1.310 by elmex, Mon Jul 16 15:43:49 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.297 by root, Thu Jul 5 08:10:30 2007 UTC vs.
Revision 1.310 by elmex, Mon Jul 16 15:43:49 2007 UTC