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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.300 by root, Tue Jul 10 06:44:29 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
…		…
1435	s/\s+\n/\n/g; # ws line-ends	1442	s/\s+\n/\n/g; # ws line-ends
1436	s/\n\n+/\n/g; # double lines	1443	s/\n\n+/\n/g; # double lines
1437	s/^\n+//; # beginning lines	1444	s/^\n+//; # beginning lines
1438	s/\n+$//; # ending lines	1445	s/\n+$//; # ending lines
1439		1446
1440	warn $_;#d#
1441	$_	1447	$_
1442	}	1448	}
1443		1449
1444	sub hintmode {	1450	sub hintmode {
1445	$_[0]{hintmode} = $_[1] if @_ > 1;	1451	$_[0]{hintmode} = $_[1] if @_ > 1;
…		…
1489	my ($path) = @_;	1495	my ($path) = @_;
1490		1496
1491	my ($match, $specificity);	1497	my ($match, $specificity);
1492		1498
1493	for my $region (list) {	1499	for my $region (list) {
1494	if ($region->match && $path =~ $region->match) {	1500	if ($region->{match} && $path =~ $region->{match}) {
1495	($match, $specificity) = ($region, $region->specificity)	1501	($match, $specificity) = ($region, $region->specificity)
1496	if $region->specificity > $specificity;	1502	if $region->specificity > $specificity;
1497	}	1503	}
1498	}	1504	}
1499		1505
…		…
1619	$self->init; # pass $1 etc.	1625	$self->init; # pass $1 etc.
1620	return $self;	1626	return $self;
1621	}	1627	}
1622	}	1628	}
1623		1629
1624	Carp::carp "unable to resolve path '$path' (base '$base').";	1630	Carp::cluck "unable to resolve path '$path' (base '$base').";
1625	()	1631	()
1626	}	1632	}
1627		1633
1628	sub init {	1634	sub init {
1629	my ($self) = @_;	1635	my ($self) = @_;
…		…
1907		1913
1908	undef $MAP_PREFETCH{$path};	1914	undef $MAP_PREFETCH{$path};
1909	$MAP_PREFETCHER \|\|= cf::async {	1915	$MAP_PREFETCHER \|\|= cf::async {
1910	while (%MAP_PREFETCH) {	1916	while (%MAP_PREFETCH) {
1911	for my $path (keys %MAP_PREFETCH) {	1917	for my $path (keys %MAP_PREFETCH) {
1912	my $map = find $path	1918	if (my $map = find $path) {
1913	or next;
1914	$map->load;	1919	$map->load;
		1920	}
1915		1921
1916	delete $MAP_PREFETCH{$path};	1922	delete $MAP_PREFETCH{$path};
1917	}	1923	}
1918	}	1924	}
1919	undef $MAP_PREFETCHER;	1925	undef $MAP_PREFETCHER;
…		…
2256		2262
2257	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext	2263	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2258	$self->enter_map ($map, $x, $y);	2264	$self->enter_map ($map, $x, $y);
2259	}	2265	}
2260		2266
2261	=item $player_object->goto ($path, $x, $y[, $check->($map)])	2267	=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2262		2268
2263	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
2264	her, loading and preparing them map, calling the provided $check callback	2270	her, loading and preparing them map, calling the provided $check callback
2265	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
2266	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.
2267		2274
2268	=cut	2275	=cut
2269		2276
2270	our $GOTOGEN;	2277	our $GOTOGEN;
2271		2278
2272	sub cf::object::player::goto {	2279	sub cf::object::player::goto {
2273	my ($self, $path, $x, $y, $check) = @_;	2280	my ($self, $path, $x, $y, $check, $done) = @_;
2274		2281
2275	# 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
2276	my $gen = $self->{_goto_generation} = ++$GOTOGEN;	2283	my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2277		2284
2278	$self->enter_link;	2285	$self->enter_link;
…		…
2298		2305
2299	if ($gen == $self->{_goto_generation}) {	2306	if ($gen == $self->{_goto_generation}) {
2300	delete $self->{_goto_generation};	2307	delete $self->{_goto_generation};
2301	$self->leave_link ($map, $x, $y);	2308	$self->leave_link ($map, $x, $y);
2302	}	2309	}
		2310
		2311	$done->() if $done;
2303	})->prio (1);	2312	})->prio (1);
2304	}	2313	}
2305		2314
2306	=item $player_object->enter_exit ($exit_object)	2315	=item $player_object->enter_exit ($exit_object)
2307		2316
…		…
2416		2425
2417	utf8::encode $text;	2426	utf8::encode $text;
2418	$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);
2419	}	2428	}
2420		2429
2421	=item $client->send_msg ($color, $type, $msg, [extra...])	2430	=item $client->send_msg ($channel, $msg, $color, [extra...])
2422		2431
2423	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
2424	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
2425	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
2426	the message unless the client supports the msg packet.	2435	the message unless the client supports the msg packet.
2427		2436
2428	=cut	2437	=cut
2429		2438
2430	sub cf::client::send_msg {	2439	sub cf::client::send_msg {
2431	my ($self, $color, $type, $msg, @extra) = @_;	2440	my ($self, $channel, $msg, $color, @extra) = @_;
2432		2441
2433	$msg = $self->pl->expand_cfpod ($msg);	2442	$msg = $self->pl->expand_cfpod ($msg);
2434		2443
2435	return unless @extra \|\| length $msg;	2444	return unless @extra \|\| length $msg;
2436		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
2437	if ($self->can_msg) {	2458	if ($self->can_msg) {
2438	$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]));
2439	} else {	2460	} else {
2440	# replace some tags by gcfclient-compatible ones	2461	# replace some tags by gcfclient-compatible ones
2441	for ($msg) {	2462	for ($msg) {
2442	1 while	2463	1 while
2443	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/	2464	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
…		…
2464		2485
2465	=cut	2486	=cut
2466		2487
2467	sub cf::client::ext_event($$%) {	2488	sub cf::client::ext_event($$%) {
2468	my ($self, $type, %msg) = @_;	2489	my ($self, $type, %msg) = @_;
		2490
		2491	return unless $self->extcmd;
2469		2492
2470	$msg{msgtype} = "event_$type";	2493	$msg{msgtype} = "event_$type";
2471	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));	2494	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
2472	}	2495	}
2473		2496
…		…
2720	{	2743	{
2721	my $faces = $facedata->{faceinfo};	2744	my $faces = $facedata->{faceinfo};
2722		2745
2723	while (my ($face, $info) = each %$faces) {	2746	while (my ($face, $info) = each %$faces) {
2724	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;	2747	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;
2725	cf::face::set $idx, $info->{visibility}, $info->{magicmap};	2748	cf::face::set_visibility $idx, $info->{visibility};
		2749	cf::face::set_magicmap $idx, $info->{magicmap};
2726	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};	2750	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};
2727	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};	2751	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};
2728	Coro::cede;	2752
		2753	cf::cede_to_tick;
2729	}	2754	}
2730		2755
2731	while (my ($face, $info) = each %$faces) {	2756	while (my ($face, $info) = each %$faces) {
2732	next unless $info->{smooth};	2757	next unless $info->{smooth};
2733	my $idx = cf::face::find $face	2758	my $idx = cf::face::find $face
2734	or next;	2759	or next;
2735	if (my $smooth = cf::face::find $info->{smooth}) {	2760	if (my $smooth = cf::face::find $info->{smooth}) {
		2761	cf::face::set_smooth $idx, $smooth;
2736	cf::face::set_smooth $idx, $smooth, $info->{smoothlevel};	2762	cf::face::set_smoothlevel $idx, $info->{smoothlevel};
2737	} else {	2763	} else {
2738	warn "smooth face '$info->{smooth}' not found for face '$face'";	2764	warn "smooth face '$info->{smooth}' not found for face '$face'";
2739	}	2765	}
2740	Coro::cede;	2766
		2767	cf::cede_to_tick;
2741	}	2768	}
2742	}	2769	}
2743		2770
2744	{	2771	{
2745	my $anims = $facedata->{animinfo};	2772	my $anims = $facedata->{animinfo};
2746		2773
2747	while (my ($anim, $info) = each %$anims) {	2774	while (my ($anim, $info) = each %$anims) {
2748	cf::anim::set $anim, $info->{frames}, $info->{facings};	2775	cf::anim::set $anim, $info->{frames}, $info->{facings};
2749	Coro::cede;	2776	cf::cede_to_tick;
2750	}	2777	}
2751		2778
2752	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	}
2753	}	2810	}
2754		2811
2755	1	2812	1
2756	}	2813	}
2757		2814
2758	sub reload_regions {	2815	sub reload_regions {
2759	load_resource_file "$MAPDIR/regions"	2816	load_resource_file "$MAPDIR/regions"
2760	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	}
2761	}	2823	}
2762		2824
2763	sub reload_facedata {	2825	sub reload_facedata {
2764	load_facedata "$DATADIR/facedata"	2826	load_facedata "$DATADIR/facedata"
2765	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.300 by root, Tue Jul 10 06:44:29 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.300 by root, Tue Jul 10 06:44:29 2007 UTC vs.
Revision 1.311 by root, Fri Jul 20 16:11:10 2007 UTC