[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.323 by root, Sat Jul 28 12:02:58 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
…		…
315	};	322	};
316	$TICK_WATCHER->stop;	323	$TICK_WATCHER->stop;
317	$guard	324	$guard
318	}	325	}
319		326
		327	=item cf::get_slot $time[, $priority[, $name]]
		328
		329	Allocate $time seconds of blocking CPU time at priority C<$priority>:
		330	This call blocks and returns only when you have at least C<$time> seconds
		331	of cpu time till the next tick. The slot is only valid till the next cede.
		332
		333	The optional C<$name> can be used to identify the job to run. It might be
		334	used for statistical purposes and should identify the same time-class.
		335
		336	Useful for short background jobs.
		337
		338	=cut
		339
		340	our @SLOT_QUEUE;
		341	our $SLOT_QUEUE;
		342
		343	$SLOT_QUEUE->cancel if $SLOT_QUEUE;
		344	$SLOT_QUEUE = Coro::async {
		345	my $signal = new Coro::Signal;
		346
		347	while () {
		348	next_job:
		349	my $avail = cf::till_tick;
		350	if ($avail > 0.01) {
		351	for (0 .. $#SLOT_QUEUE) {
		352	if ($SLOT_QUEUE[$_][0] < $avail) {
		353	my $job = splice @SLOT_QUEUE, $_, 1, ();
		354	$job->[2]->send;
		355	Coro::cede;
		356	goto next_job;
		357	}
		358	}
		359	}
		360
		361	if (@SLOT_QUEUE) {
		362	# we do not use wait_For_tick() as it returns immediately when tick is inactive
		363	push @cf::WAIT_FOR_TICK, $signal;
		364	$signal->wait;
		365	} else {
		366	Coro::schedule;
		367	}
		368	}
		369	};
		370
		371	sub get_slot($;$$) {
		372	my ($time, $pri, $name) = @_;
		373
		374	$time = $TICK * .6 if $time > $TICK * .6;
		375	my $sig = new Coro::Signal;
		376
		377	push @SLOT_QUEUE, [$time, $pri, $sig, $name];
		378	@SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE;
		379	$SLOT_QUEUE->ready;
		380	$sig->wait;
		381	}
		382
320	=item cf::async { BLOCK }	383	=item cf::async { BLOCK }
321		384
322	Currently the same as Coro::async_pool, meaning you cannot use	385	Currently the same as Coro::async_pool, meaning you cannot use
323	C<on_destroy>, C<join> or other gimmicks on these coroutines. The only	386	C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
324	thing you are allowed to do is call C<prio> on it.	387	thing you are allowed to do is call C<prio> on it.
…		…
865	";	928	";
866	die if $@;	929	die if $@;
867	}	930	}
868		931
869	our $override;	932	our $override;
870	our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals?	933	our @INVOKE_RESULTS = (); # referenced from .xs code. TODO: play tricks with reify and mortals?
871		934
872	sub override {	935	sub override {
873	$override = 1;	936	$override = 1;
874	@invoke_results = ();	937	@INVOKE_RESULTS = (@_);
875	}	938	}
876		939
877	sub do_invoke {	940	sub do_invoke {
878	my $event = shift;	941	my $event = shift;
879	my $callbacks = shift;	942	my $callbacks = shift;
880		943
881	@invoke_results = ();	944	@INVOKE_RESULTS = ();
882		945
883	local $override;	946	local $override;
884		947
885	for (@$callbacks) {	948	for (@$callbacks) {
886	eval { &{$_->[1]} };	949	eval { &{$_->[1]} };
…		…
903		966
904	Generate an object-specific event with the given arguments.	967	Generate an object-specific event with the given arguments.
905		968
906	This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be	969	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	970	removed in future versions), and there is no public API to access override
908	results (if you must, access C<@cf::invoke_results> directly).	971	results (if you must, access C<@cf::INVOKE_RESULTS> directly).
909		972
910	=back	973	=back
911		974
912	=cut	975	=cut
913		976
914	#############################################################################	977	#############################################################################
915	# object support	978	# object support
		979	#
		980
		981	sub _can_merge {
		982	my ($ob1, $ob2) = @_;
		983
		984	local $Storable::canonical = 1;
		985	my $fob1 = Storable::freeze $ob1;
		986	my $fob2 = Storable::freeze $ob2;
		987
		988	$fob1 eq $fob2
		989	}
916		990
917	sub reattach {	991	sub reattach {
918	# basically do the same as instantiate, without calling instantiate	992	# basically do the same as instantiate, without calling instantiate
919	my ($obj) = @_;	993	my ($obj) = @_;
920		994
…		…
1107	my ($pl, $buf) = @_;	1181	my ($pl, $buf) = @_;
1108		1182
1109	my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };	1183	my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1110		1184
1111	if (ref $msg) {	1185	if (ref $msg) {
		1186	my ($type, $reply, @payload) =
		1187	"ARRAY" eq ref $msg
		1188	? @$msg
		1189	: ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
		1190
1112	if (my $cb = $EXTCMD{$msg->{msgtype}}) {	1191	if (my $cb = $EXTCMD{$type}) {
1113	if (my %reply = $cb->($pl, $msg)) {	1192	my @reply = $cb->($pl, @payload);
		1193
1114	$pl->ext_reply ($msg->{msgid}, %reply);	1194	$pl->ext_reply ($reply, @reply)
1115	}	1195	if $reply;
1116	}	1196	}
1117	} else {	1197	} else {
1118	warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";	1198	warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1119	}	1199	}
1120		1200
…		…
1443	sub hintmode {	1523	sub hintmode {
1444	$_[0]{hintmode} = $_[1] if @_ > 1;	1524	$_[0]{hintmode} = $_[1] if @_ > 1;
1445	$_[0]{hintmode}	1525	$_[0]{hintmode}
1446	}	1526	}
1447		1527
1448	=item $player->ext_reply ($msgid, %msg)	1528	=item $player->ext_reply ($msgid, @msg)
1449		1529
1450	Sends an ext reply to the player.	1530	Sends an ext reply to the player.
1451		1531
1452	=cut	1532	=cut
1453		1533
1454	sub ext_reply($$%) {	1534	sub ext_reply($$@) {
1455	my ($self, $id, %msg) = @_;	1535	my ($self, $id, @msg) = @_;
1456		1536
1457	$msg{msgid} = $id;	1537	if ($self->ns->extcmd == 2) {
		1538	$self->send ("ext " . $self->ns->{json_coder}->encode (["reply-$id", @msg]));
		1539	} elsif ($self->ns->extcmd == 1) {
		1540	#TODO: version 1, remove
		1541	unshift @msg, msgtype => "reply", msgid => $id;
1458	$self->send ("ext " . $self->ns->{json_coder}->encode (\%msg));	1542	$self->send ("ext " . $self->ns->{json_coder}->encode ({@msg}));
		1543	}
1459	}	1544	}
1460		1545
1461	=item $player->ext_event ($type, %msg)	1546	=item $player->ext_msg ($type, @msg)
1462		1547
1463	Sends an ext event to the client.	1548	Sends an ext event to the client.
1464		1549
1465	=cut	1550	=cut
1466		1551
1467	sub ext_event($$%) {	1552	sub ext_msg($$@) {
1468	my ($self, $type, %msg) = @_;	1553	my ($self, $type, @msg) = @_;
1469		1554
1470	$self->ns->ext_event ($type, %msg);	1555	$self->ns->ext_msg ($type, @msg);
1471	}	1556	}
1472		1557
1473	=head3 cf::region	1558	=head3 cf::region
1474		1559
1475	=over 4	1560	=over 4
…		…
1488	my ($path) = @_;	1573	my ($path) = @_;
1489		1574
1490	my ($match, $specificity);	1575	my ($match, $specificity);
1491		1576
1492	for my $region (list) {	1577	for my $region (list) {
1493	if ($region->match && $path =~ $region->match) {	1578	if ($region->{match} && $path =~ $region->{match}) {
1494	($match, $specificity) = ($region, $region->specificity)	1579	($match, $specificity) = ($region, $region->specificity)
1495	if $region->specificity > $specificity;	1580	if $region->specificity > $specificity;
1496	}	1581	}
1497	}	1582	}
1498		1583
…		…
1618	$self->init; # pass $1 etc.	1703	$self->init; # pass $1 etc.
1619	return $self;	1704	return $self;
1620	}	1705	}
1621	}	1706	}
1622		1707
1623	Carp::carp "unable to resolve path '$path' (base '$base').";	1708	Carp::cluck "unable to resolve path '$path' (base '$base').";
1624	()	1709	()
1625	}	1710	}
1626		1711
1627	sub init {	1712	sub init {
1628	my ($self) = @_;	1713	my ($self) = @_;
…		…
1906		1991
1907	undef $MAP_PREFETCH{$path};	1992	undef $MAP_PREFETCH{$path};
1908	$MAP_PREFETCHER \|\|= cf::async {	1993	$MAP_PREFETCHER \|\|= cf::async {
1909	while (%MAP_PREFETCH) {	1994	while (%MAP_PREFETCH) {
1910	for my $path (keys %MAP_PREFETCH) {	1995	for my $path (keys %MAP_PREFETCH) {
1911	my $map = find $path	1996	if (my $map = find $path) {
1912	or next;
1913	$map->load;	1997	$map->load;
		1998	}
1914		1999
1915	delete $MAP_PREFETCH{$path};	2000	delete $MAP_PREFETCH{$path};
1916	}	2001	}
1917	}	2002	}
1918	undef $MAP_PREFETCHER;	2003	undef $MAP_PREFETCHER;
…		…
2145		2230
2146	} else {	2231	} else {
2147	my $pl = $self->contr;	2232	my $pl = $self->contr;
2148		2233
2149	if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) {	2234	if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) {
2150	my $diag = $pl->{npc_dialog};	2235	my $dialog = $pl->{npc_dialog};
2151	$diag->{pl}->ext_reply (	2236	$dialog->{pl}->ext_msg ($dialog->{id}, update => msg => $dialog->{pl}->expand_cfpod ($msg));
2152	$diag->{id},
2153	msgtype => "reply",
2154	msg => $diag->{pl}->expand_cfpod ($msg),
2155	add_topics => []
2156	);
2157		2237
2158	} else {	2238	} else {
2159	$msg = $npc->name . " says: $msg" if $npc;	2239	$msg = $npc->name . " says: $msg" if $npc;
2160	$self->message ($msg, $flags);	2240	$self->message ($msg, $flags);
2161	}	2241	}
…		…
2255		2335
2256	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext	2336	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2257	$self->enter_map ($map, $x, $y);	2337	$self->enter_map ($map, $x, $y);
2258	}	2338	}
2259		2339
2260	=item $player_object->goto ($path, $x, $y[, $check->($map)])	2340	=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2261		2341
2262	Moves the player to the given map-path and coordinates by first freezing	2342	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	2343	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	2344	that has to return the map if sucecssful, and then unfreezes the player on
2265	the new (success) or old (failed) map position.	2345	the new (success) or old (failed) map position. In either case, $done will
		2346	be called at the end of this process.
2266		2347
2267	=cut	2348	=cut
2268		2349
2269	our $GOTOGEN;	2350	our $GOTOGEN;
2270		2351
2271	sub cf::object::player::goto {	2352	sub cf::object::player::goto {
2272	my ($self, $path, $x, $y, $check) = @_;	2353	my ($self, $path, $x, $y, $check, $done) = @_;
2273		2354
2274	# do generation counting so two concurrent goto's will be executed in-order	2355	# do generation counting so two concurrent goto's will be executed in-order
2275	my $gen = $self->{_goto_generation} = ++$GOTOGEN;	2356	my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2276		2357
2277	$self->enter_link;	2358	$self->enter_link;
…		…
2297		2378
2298	if ($gen == $self->{_goto_generation}) {	2379	if ($gen == $self->{_goto_generation}) {
2299	delete $self->{_goto_generation};	2380	delete $self->{_goto_generation};
2300	$self->leave_link ($map, $x, $y);	2381	$self->leave_link ($map, $x, $y);
2301	}	2382	}
		2383
		2384	$done->() if $done;
2302	})->prio (1);	2385	})->prio (1);
2303	}	2386	}
2304		2387
2305	=item $player_object->enter_exit ($exit_object)	2388	=item $player_object->enter_exit ($exit_object)
2306		2389
…		…
2415		2498
2416	utf8::encode $text;	2499	utf8::encode $text;
2417	$self->send_packet (sprintf "drawinfo %d %s", $flags \|\| cf::NDI_BLACK, $text);	2500	$self->send_packet (sprintf "drawinfo %d %s", $flags \|\| cf::NDI_BLACK, $text);
2418	}	2501	}
2419		2502
2420	=item $client->send_msg ($color, $type, $msg, [extra...])	2503	=item $client->send_msg ($channel, $msg, $color, [extra...])
2421		2504
2422	Send a drawinfo or msg packet to the client, formatting the msg for the	2505	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	2506	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	2507	the message, with C<log> being the default. If C<$color> is negative, suppress
2425	the message unless the client supports the msg packet.	2508	the message unless the client supports the msg packet.
2426		2509
2427	=cut	2510	=cut
2428		2511
2429	sub cf::client::send_msg {	2512	sub cf::client::send_msg {
2430	my ($self, $color, $type, $msg, @extra) = @_;	2513	my ($self, $channel, $msg, $color, @extra) = @_;
2431		2514
2432	$msg = $self->pl->expand_cfpod ($msg);	2515	$msg = $self->pl->expand_cfpod ($msg);
2433		2516
		2517	$color &= cf::NDI_CLIENT_MASK; # just in case...
		2518
		2519	if (ref $channel) {
		2520	# send meta info to client, if not yet sent
		2521	unless (exists $self->{channel}{$channel->{id}}) {
		2522	$self->{channel}{$channel->{id}} = $channel;
		2523	$self->ext_msg (channel_info => $channel);
		2524	}
		2525
		2526	$channel = $channel->{id};
		2527	}
		2528
2434	return unless @extra \|\| length $msg;	2529	return unless @extra \|\| length $msg;
2435		2530
2436	if ($self->can_msg) {	2531	if ($self->can_msg) {
		2532	# default colour, mask it out
		2533	$color &= ~(cf::NDI_COLOR_MASK \| cf::NDI_DEF)
		2534	if $color & cf::NDI_DEF;
		2535
2437	$self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra]));	2536	$self->send_packet ("msg " . $self->{json_coder}->encode (
		2537	[$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]));
2438	} else {	2538	} else {
2439	# replace some tags by gcfclient-compatible ones
2440	for ($msg) {
2441	1 while
2442	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2443	\|\| s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2444	\|\| s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2445	\|\| s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2446	\|\| s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2447	}
2448
2449	if ($color >= 0) {	2539	if ($color >= 0) {
		2540	# replace some tags by gcfclient-compatible ones
		2541	for ($msg) {
		2542	1 while
		2543	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
		2544	\|\| s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
		2545	\|\| s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
		2546	\|\| s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
		2547	\|\| s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
		2548	}
		2549
		2550	$color &= cf::NDI_COLOR_MASK;
		2551
2450	if (0 && $msg =~ /\[/) {	2552	if (0 && $msg =~ /\[/) {
2451	$self->send_packet ("drawextinfo $color 4 0 $msg")	2553	$self->send_packet ("drawextinfo $color 4 0 $msg")
2452	} else {	2554	} else {
2453	$msg =~ s/\[\/?(?:b\|i\|u\|fixed\|color)[^\]]*\]//g;	2555	$msg =~ s/\[\/?(?:b\|i\|u\|fixed\|color)[^\]]*\]//g;
2454	$self->send_packet ("drawinfo $color $msg")	2556	$self->send_packet ("drawinfo $color $msg")
2455	}	2557	}
2456	}	2558	}
2457	}	2559	}
2458	}	2560	}
2459		2561
2460	=item $client->ext_event ($type, %msg)	2562	=item $client->ext_msg ($type, @msg)
2461		2563
2462	Sends an ext event to the client.	2564	Sends an ext event to the client.
2463		2565
2464	=cut	2566	=cut
2465		2567
2466	sub cf::client::ext_event($$%) {	2568	sub cf::client::ext_msg($$@) {
2467	my ($self, $type, %msg) = @_;	2569	my ($self, $type, @msg) = @_;
2468		2570
		2571	my $extcmd = $self->extcmd;
		2572
		2573	if ($extcmd == 2) {
		2574	$self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
		2575	} elsif ($extcmd == 1) { # TODO: remove
2469	$msg{msgtype} = "event_$type";	2576	push @msg, msgtype => "event_$type";
2470	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));	2577	$self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
		2578	}
2471	}	2579	}
2472		2580
2473	=item $success = $client->query ($flags, "text", \&cb)	2581	=item $success = $client->query ($flags, "text", \&cb)
2474		2582
2475	Queues a query to the client, calling the given callback with	2583	Queues a query to the client, calling the given callback with
…		…
2530	my ($ns, $buf) = @_;	2638	my ($ns, $buf) = @_;
2531		2639
2532	my $msg = eval { $ns->{json_coder}->decode ($buf) };	2640	my $msg = eval { $ns->{json_coder}->decode ($buf) };
2533		2641
2534	if (ref $msg) {	2642	if (ref $msg) {
		2643	my ($type, $reply, @payload) =
		2644	"ARRAY" eq ref $msg
		2645	? @$msg
		2646	: ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
		2647
2535	if (my $cb = $EXTICMD{$msg->{msgtype}}) {	2648	if (my $cb = $EXTICMD{$type}) {
2536	if (my %reply = $cb->($ns, $msg)) {	2649	my @reply = $cb->($ns, @payload);
2537	$reply{msgid} = $msg->{msgid};	2650
2538	$ns->send ("ext " . $ns->{json_coder}->encode (\%reply));	2651	$ns->ext_reply ($reply, @reply)
2539	}	2652	if $reply;
2540	}	2653	}
2541	} else {	2654	} else {
2542	warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";	2655	warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
2543	}	2656	}
2544		2657
…		…
2719	{	2832	{
2720	my $faces = $facedata->{faceinfo};	2833	my $faces = $facedata->{faceinfo};
2721		2834
2722	while (my ($face, $info) = each %$faces) {	2835	while (my ($face, $info) = each %$faces) {
2723	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;	2836	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;
2724	cf::face::set $idx, $info->{visibility}, $info->{magicmap};	2837	cf::face::set_visibility $idx, $info->{visibility};
		2838	cf::face::set_magicmap $idx, $info->{magicmap};
2725	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};	2839	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};
2726	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};	2840	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};
2727	Coro::cede;	2841
		2842	cf::cede_to_tick;
2728	}	2843	}
2729		2844
2730	while (my ($face, $info) = each %$faces) {	2845	while (my ($face, $info) = each %$faces) {
2731	next unless $info->{smooth};	2846	next unless $info->{smooth};
2732	my $idx = cf::face::find $face	2847	my $idx = cf::face::find $face
2733	or next;	2848	or next;
2734	if (my $smooth = cf::face::find $info->{smooth}) {	2849	if (my $smooth = cf::face::find $info->{smooth}) {
		2850	cf::face::set_smooth $idx, $smooth;
2735	cf::face::set_smooth $idx, $smooth, $info->{smoothlevel};	2851	cf::face::set_smoothlevel $idx, $info->{smoothlevel};
2736	} else {	2852	} else {
2737	warn "smooth face '$info->{smooth}' not found for face '$face'";	2853	warn "smooth face '$info->{smooth}' not found for face '$face'";
2738	}	2854	}
2739	Coro::cede;	2855
		2856	cf::cede_to_tick;
2740	}	2857	}
2741	}	2858	}
2742		2859
2743	{	2860	{
2744	my $anims = $facedata->{animinfo};	2861	my $anims = $facedata->{animinfo};
2745		2862
2746	while (my ($anim, $info) = each %$anims) {	2863	while (my ($anim, $info) = each %$anims) {
2747	cf::anim::set $anim, $info->{frames}, $info->{facings};	2864	cf::anim::set $anim, $info->{frames}, $info->{facings};
2748	Coro::cede;	2865	cf::cede_to_tick;
2749	}	2866	}
2750		2867
2751	cf::anim::invalidate_all; # d'oh	2868	cf::anim::invalidate_all; # d'oh
2752	}	2869	}
2753		2870
		2871	{
		2872	# TODO: for gcfclient pleasure, we should give resources
		2873	# that gcfclient doesn't grok a >10000 face index.
		2874	my $res = $facedata->{resource};
		2875	my $enc = JSON::XS->new->utf8->canonical;
		2876
		2877	my $soundconf = delete $res->{"res/sound.conf"};
		2878
		2879	while (my ($name, $info) = each %$res) {
		2880	my $meta = $enc->encode ({
		2881	name => $name,
		2882	%{ $info->{meta} \|\| {} },
		2883	});
		2884
		2885	my $idx = (cf::face::find $name) \|\| cf::face::alloc $name;
		2886
		2887	if ($info->{type} & 1) {
		2888	# prepend meta info
		2889
		2890	my $data = pack "(w/a)", $meta, $info->{data};
		2891	my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
		2892
		2893	cf::face::set_data $idx, 0, $data, $chk;
		2894	} else {
		2895	cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};
		2896	}
		2897
		2898	cf::face::set_type $idx, $info->{type};
		2899
		2900	cf::cede_to_tick;
		2901	}
		2902
		2903	if ($soundconf) {
		2904	$soundconf = $enc->decode (delete $soundconf->{data});
		2905
		2906	for (0 .. SOUND_CAST_SPELL_0 - 1) {
		2907	my $sound = $soundconf->{compat}[$_]
		2908	or next;
		2909
		2910	my $face = cf::face::find "sound/$sound->[1]";
		2911
		2912	cf::sound::set $sound->[0] => $face;
		2913	cf::sound::old_sound_index $_, $face; # gcfclient-compat
		2914	}
		2915
		2916	#TODO
		2917	}
		2918	}
		2919
2754	1	2920	1
2755	}	2921	}
		2922
		2923	register_exticmd fx_want => sub {
		2924	my ($ns, $want) = @_;
		2925
		2926	while (my ($k, $v) = each %$want) {
		2927	$ns->fx_want ($k, $v);
		2928	}
		2929	};
2756		2930
2757	sub reload_regions {	2931	sub reload_regions {
2758	load_resource_file "$MAPDIR/regions"	2932	load_resource_file "$MAPDIR/regions"
2759	or die "unable to load regions file\n";	2933	or die "unable to load regions file\n";
		2934
		2935	for (cf::region::list) {
		2936	$_->{match} = qr/$_->{match}/
		2937	if exists $_->{match};
		2938	}
2760	}	2939	}
2761		2940
2762	sub reload_facedata {	2941	sub reload_facedata {
2763	load_facedata "$DATADIR/facedata"	2942	load_facedata "$DATADIR/facedata"
2764	or die "unable to load facedata\n";	2943	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.323 by root, Sat Jul 28 12:02:58 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.323 by root, Sat Jul 28 12:02:58 2007 UTC