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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.299 by root, Sun Jul 8 14:56:05 2007 UTC vs.
Revision 1.311 by root, Fri Jul 20 16:11:10 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
…		…
865	";	872	";
866	die if $@;	873	die if $@;
867	}	874	}
868		875
869	our $override;	876	our $override;
870	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?
871		878
872	sub override {	879	sub override {
873	$override = 1;	880	$override = 1;
874	@invoke_results = ();	881	@INVOKE_RESULTS = (@_);
875	}	882	}
876		883
877	sub do_invoke {	884	sub do_invoke {
878	my $event = shift;	885	my $event = shift;
879	my $callbacks = shift;	886	my $callbacks = shift;
880		887
881	@invoke_results = ();	888	@INVOKE_RESULTS = ();
882		889
883	local $override;	890	local $override;
884		891
885	for (@$callbacks) {	892	for (@$callbacks) {
886	eval { &{$_->[1]} };	893	eval { &{$_->[1]} };
…		…
903		910
904	Generate an object-specific event with the given arguments.	911	Generate an object-specific event with the given arguments.
905		912
906	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
907	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
908	results (if you must, access C<@cf::invoke_results> directly).	915	results (if you must, access C<@cf::INVOKE_RESULTS> directly).
909		916
910	=back	917	=back
911		918
912	=cut	919	=cut
913		920
…		…
1488	my ($path) = @_;	1495	my ($path) = @_;
1489		1496
1490	my ($match, $specificity);	1497	my ($match, $specificity);
1491		1498
1492	for my $region (list) {	1499	for my $region (list) {
1493	if ($region->match && $path =~ $region->match) {	1500	if ($region->{match} && $path =~ $region->{match}) {
1494	($match, $specificity) = ($region, $region->specificity)	1501	($match, $specificity) = ($region, $region->specificity)
1495	if $region->specificity > $specificity;	1502	if $region->specificity > $specificity;
1496	}	1503	}
1497	}	1504	}
1498		1505
…		…
1618	$self->init; # pass $1 etc.	1625	$self->init; # pass $1 etc.
1619	return $self;	1626	return $self;
1620	}	1627	}
1621	}	1628	}
1622		1629
1623	Carp::carp "unable to resolve path '$path' (base '$base').";	1630	Carp::cluck "unable to resolve path '$path' (base '$base').";
1624	()	1631	()
1625	}	1632	}
1626		1633
1627	sub init {	1634	sub init {
1628	my ($self) = @_;	1635	my ($self) = @_;
…		…
1906		1913
1907	undef $MAP_PREFETCH{$path};	1914	undef $MAP_PREFETCH{$path};
1908	$MAP_PREFETCHER \|\|= cf::async {	1915	$MAP_PREFETCHER \|\|= cf::async {
1909	while (%MAP_PREFETCH) {	1916	while (%MAP_PREFETCH) {
1910	for my $path (keys %MAP_PREFETCH) {	1917	for my $path (keys %MAP_PREFETCH) {
1911	my $map = find $path	1918	if (my $map = find $path) {
1912	or next;
1913	$map->load;	1919	$map->load;
		1920	}
1914		1921
1915	delete $MAP_PREFETCH{$path};	1922	delete $MAP_PREFETCH{$path};
1916	}	1923	}
1917	}	1924	}
1918	undef $MAP_PREFETCHER;	1925	undef $MAP_PREFETCHER;
…		…
2255		2262
2256	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext	2263	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2257	$self->enter_map ($map, $x, $y);	2264	$self->enter_map ($map, $x, $y);
2258	}	2265	}
2259		2266
2260	=item $player_object->goto ($path, $x, $y[, $check->($map)])	2267	=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2261		2268
2262	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
2263	her, loading and preparing them map, calling the provided $check callback	2270	her, loading and preparing them map, calling the provided $check callback
2264	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
2265	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.
2266		2274
2267	=cut	2275	=cut
2268		2276
2269	our $GOTOGEN;	2277	our $GOTOGEN;
2270		2278
2271	sub cf::object::player::goto {	2279	sub cf::object::player::goto {
2272	my ($self, $path, $x, $y, $check) = @_;	2280	my ($self, $path, $x, $y, $check, $done) = @_;
2273		2281
2274	# 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
2275	my $gen = $self->{_goto_generation} = ++$GOTOGEN;	2283	my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2276		2284
2277	$self->enter_link;	2285	$self->enter_link;
…		…
2297		2305
2298	if ($gen == $self->{_goto_generation}) {	2306	if ($gen == $self->{_goto_generation}) {
2299	delete $self->{_goto_generation};	2307	delete $self->{_goto_generation};
2300	$self->leave_link ($map, $x, $y);	2308	$self->leave_link ($map, $x, $y);
2301	}	2309	}
		2310
		2311	$done->() if $done;
2302	})->prio (1);	2312	})->prio (1);
2303	}	2313	}
2304		2314
2305	=item $player_object->enter_exit ($exit_object)	2315	=item $player_object->enter_exit ($exit_object)
2306		2316
…		…
2415		2425
2416	utf8::encode $text;	2426	utf8::encode $text;
2417	$self->send_packet (sprintf "drawinfo %d %s", $flags \|\| cf::NDI_BLACK, $text);	2427	$self->send_packet (sprintf "drawinfo %d %s", $flags \|\| cf::NDI_BLACK, $text);
2418	}	2428	}
2419		2429
2420	=item $client->send_msg ($color, $type, $msg, [extra...])	2430	=item $client->send_msg ($channel, $msg, $color, [extra...])
2421		2431
2422	Send a drawinfo or msg packet to the client, formatting the msg for the	2432	Send a drawinfo or msg packet to the client, formatting the msg for the
2423	client if neccessary. C<$type> should be a string identifying the type of	2433	client if neccessary. C<$type> should be a string identifying the type of
2424	the message, with C<log> being the default. If C<$color> is negative, suppress	2434	the message, with C<log> being the default. If C<$color> is negative, suppress
2425	the message unless the client supports the msg packet.	2435	the message unless the client supports the msg packet.
2426		2436
2427	=cut	2437	=cut
2428		2438
2429	sub cf::client::send_msg {	2439	sub cf::client::send_msg {
2430	my ($self, $color, $type, $msg, @extra) = @_;	2440	my ($self, $channel, $msg, $color, @extra) = @_;
2431		2441
2432	$msg = $self->pl->expand_cfpod ($msg);	2442	$msg = $self->pl->expand_cfpod ($msg);
2433		2443
2434	return unless @extra \|\| length $msg;	2444	return unless @extra \|\| length $msg;
2435		2445
		2446	$color &= ~cf::NDI_UNIQUE; # just in case...
		2447
		2448	if (ref $channel) {
		2449	# send meta info to client, if not yet sent
		2450	unless (exists $self->{channel}{$channel->{id}}) {
		2451	$self->{channel}{$channel->{id}} = $channel;
		2452	$self->ext_event (channel_info => %$channel);
		2453	}
		2454
		2455	$channel = $channel->{id};
		2456	}
		2457
2436	if ($self->can_msg) {	2458	if ($self->can_msg) {
2437	$self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra]));	2459	$self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $channel, $msg, @extra]));
2438	} else {	2460	} else {
2439	# replace some tags by gcfclient-compatible ones	2461	# replace some tags by gcfclient-compatible ones
2440	for ($msg) {	2462	for ($msg) {
2441	1 while	2463	1 while
2442	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/	2464	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
…		…
2463		2485
2464	=cut	2486	=cut
2465		2487
2466	sub cf::client::ext_event($$%) {	2488	sub cf::client::ext_event($$%) {
2467	my ($self, $type, %msg) = @_;	2489	my ($self, $type, %msg) = @_;
		2490
		2491	return unless $self->extcmd;
2468		2492
2469	$msg{msgtype} = "event_$type";	2493	$msg{msgtype} = "event_$type";
2470	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));	2494	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
2471	}	2495	}
2472		2496
…		…
2719	{	2743	{
2720	my $faces = $facedata->{faceinfo};	2744	my $faces = $facedata->{faceinfo};
2721		2745
2722	while (my ($face, $info) = each %$faces) {	2746	while (my ($face, $info) = each %$faces) {
2723	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;	2747	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;
2724	cf::face::set $idx, $info->{visibility}, $info->{magicmap};	2748	cf::face::set_visibility $idx, $info->{visibility};
		2749	cf::face::set_magicmap $idx, $info->{magicmap};
2725	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};	2750	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};
2726	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};	2751	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};
2727	Coro::cede;	2752
		2753	cf::cede_to_tick;
2728	}	2754	}
2729		2755
2730	while (my ($face, $info) = each %$faces) {	2756	while (my ($face, $info) = each %$faces) {
2731	next unless $info->{smooth};	2757	next unless $info->{smooth};
2732	my $idx = cf::face::find $face	2758	my $idx = cf::face::find $face
2733	or next;	2759	or next;
2734	if (my $smooth = cf::face::find $info->{smooth}) {	2760	if (my $smooth = cf::face::find $info->{smooth}) {
		2761	cf::face::set_smooth $idx, $smooth;
2735	cf::face::set_smooth $idx, $smooth, $info->{smoothlevel};	2762	cf::face::set_smoothlevel $idx, $info->{smoothlevel};
2736	} else {	2763	} else {
2737	warn "smooth face '$info->{smooth}' not found for face '$face'";	2764	warn "smooth face '$info->{smooth}' not found for face '$face'";
2738	}	2765	}
2739	Coro::cede;	2766
		2767	cf::cede_to_tick;
2740	}	2768	}
2741	}	2769	}
2742		2770
2743	{	2771	{
2744	my $anims = $facedata->{animinfo};	2772	my $anims = $facedata->{animinfo};
2745		2773
2746	while (my ($anim, $info) = each %$anims) {	2774	while (my ($anim, $info) = each %$anims) {
2747	cf::anim::set $anim, $info->{frames}, $info->{facings};	2775	cf::anim::set $anim, $info->{frames}, $info->{facings};
2748	Coro::cede;	2776	cf::cede_to_tick;
2749	}	2777	}
2750		2778
2751	cf::anim::invalidate_all; # d'oh	2779	cf::anim::invalidate_all; # d'oh
		2780	}
		2781
		2782	{
		2783	# TODO: for gcfclient pleasure, we should give resources
		2784	# that gcfclient doesn't grok a >10000 face index.
		2785	my $res = $facedata->{resource};
		2786	my $enc = JSON::XS->new->utf8->canonical;
		2787
		2788	while (my ($name, $info) = each %$res) {
		2789	my $meta = $enc->encode ({
		2790	name => $name,
		2791	type => $info->{type},
		2792	copyright => $info->{copyright}, #TODO#
		2793	});
		2794
		2795	my $idx = (cf::face::find $name) \|\| cf::face::alloc $name;
		2796
		2797	if ($name =~ /\.jpg$/) {
		2798	cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};#d# temp hack
		2799	cf::face::set_data $idx, 1, $info->{data}, $info->{chksum};#d# temp hack
		2800	} else {
		2801	my $data = pack "(w/a)", $meta, $info->{data};
		2802	my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
		2803
		2804	cf::face::set_type $idx, 1;
		2805	cf::face::set_data $idx, 0, $data, $chk;
		2806	}
		2807
		2808	cf::cede_to_tick;
		2809	}
2752	}	2810	}
2753		2811
2754	1	2812	1
2755	}	2813	}
2756		2814
2757	sub reload_regions {	2815	sub reload_regions {
2758	load_resource_file "$MAPDIR/regions"	2816	load_resource_file "$MAPDIR/regions"
2759	or die "unable to load regions file\n";	2817	or die "unable to load regions file\n";
		2818
		2819	for (cf::region::list) {
		2820	$_->{match} = qr/$_->{match}/
		2821	if exists $_->{match};
		2822	}
2760	}	2823	}
2761		2824
2762	sub reload_facedata {	2825	sub reload_facedata {
2763	load_facedata "$DATADIR/facedata"	2826	load_facedata "$DATADIR/facedata"
2764	or die "unable to load facedata\n";	2827	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.299 by root, Sun Jul 8 14:56:05 2007 UTC vs. Revision 1.311 by root, Fri Jul 20 16:11:10 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.299 by root, Sun Jul 8 14:56:05 2007 UTC vs.
Revision 1.311 by root, Fri Jul 20 16:11:10 2007 UTC