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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.315 by root, Mon Jul 23 17:53:55 2007 UTC vs.
Revision 1.335 by root, Mon Aug 20 22:21:48 2007 UTC

…		…
10	use Event;	10	use Event;
11	use Opcode;	11	use Opcode;
12	use Safe;	12	use Safe;
13	use Safe::Hole;	13	use Safe::Hole;
14		14
15	use Coro 3.61 ();	15	use Coro 3.64 ();
16	use Coro::State;	16	use Coro::State;
17	use Coro::Handle;	17	use Coro::Handle;
18	use Coro::Event;	18	use Coro::Event;
19	use Coro::Timer;	19	use Coro::Timer;
20	use Coro::Signal;	20	use Coro::Signal;
21	use Coro::Semaphore;	21	use Coro::Semaphore;
22	use Coro::AIO;	22	use Coro::AIO;
23	use Coro::Storable;	23	use Coro::Storable;
		24	use Coro::Util ();
24		25
25	use JSON::XS 1.4 ();	26	use JSON::XS 1.4 ();
26	use BDB ();	27	use BDB ();
27	use Data::Dumper;	28	use Data::Dumper;
28	use Digest::MD5;	29	use Digest::MD5;
…		…
472	Coro::Storable. May, of course, block. Note that the executed sub may	473	Coro::Storable. May, of course, block. Note that the executed sub may
473	never block itself or use any form of Event handling.	474	never block itself or use any form of Event handling.
474		475
475	=cut	476	=cut
476		477
477	sub _store_scalar {
478	open my $fh, ">", \my $buf
479	or die "fork_call: cannot open fh-to-buf in child : $!";
480	Storable::store_fd $_[0], $fh;
481	close $fh;
482
483	$buf
484	}
485
486	sub fork_call(&@) {	478	sub fork_call(&@) {
487	my ($cb, @args) = @_;	479	my ($cb, @args) = @_;
488		480
489	# socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC	481	# we seemingly have to make a local copy of the whole thing,
490	# or die "socketpair: $!";	482	# otherwise perl prematurely frees the stuff :/
491	pipe my $fh1, my $fh2	483	# TODO: investigate and fix (liekly this will be rather laborious)
492	or die "pipe: $!";
493		484
494	if (my $pid = fork) {	485	my @res = Coro::Util::fork_eval {
495	close $fh2;
496
497	my $res = (Coro::Handle::unblock $fh1)->readline (undef);
498	warn "pst<$res>" unless $res =~ /^pst/;
499	$res = Coro::Storable::thaw $res;
500
501	waitpid $pid, 0; # should not block anymore, we expect the child to simply behave
502
503	Carp::confess $$res unless "ARRAY" eq ref $res;
504
505	return wantarray ? @$res : $res->[-1];
506	} else {
507	reset_signals;	486	reset_signals;
508	local $SIG{__WARN__};	487	&$cb
509	local $SIG{__DIE__};	488	}, @args;
510	# just in case, this hack effectively disables event
511	# in the child. cleaner and slower would be canceling all watchers,
512	# but this works for the time being.
513	local $Coro::idle;
514	$Coro::current->prio (Coro::PRIO_MAX);
515		489
516	eval {	490	wantarray ? @res : $res[-1]
517	close $fh1;
518
519	my @res = eval { $cb->(@args) };
520
521	syswrite $fh2, _store_scalar $@ ? \"$@" : \@res;
522	close $fh2;
523	};
524
525	warn $@ if $@;
526	_exit 0;
527	}
528	}	491	}
529		492
530	=item $value = cf::db_get $family => $key	493	=item $value = cf::db_get $family => $key
531		494
532	Returns a single value from the environment database.	495	Returns a single value from the environment database.
…		…
1181	my ($pl, $buf) = @_;	1144	my ($pl, $buf) = @_;
1182		1145
1183	my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };	1146	my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1184		1147
1185	if (ref $msg) {	1148	if (ref $msg) {
		1149	my ($type, $reply, @payload) =
		1150	"ARRAY" eq ref $msg
		1151	? @$msg
		1152	: ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
		1153
1186	if (my $cb = $EXTCMD{$msg->{msgtype}}) {	1154	if (my $cb = $EXTCMD{$type}) {
1187	if (my %reply = $cb->($pl, $msg)) {	1155	my @reply = $cb->($pl, @payload);
		1156
1188	$pl->ext_reply ($msg->{msgid}, %reply);	1157	$pl->ext_reply ($reply, @reply)
1189	}	1158	if $reply;
1190	}	1159	}
1191	} else {	1160	} else {
1192	warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";	1161	warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1193	}	1162	}
1194		1163
…		…
1364	$self->{deny_save} = 1;	1333	$self->{deny_save} = 1;
1365		1334
1366	$cf::PLAYER{$login} = $self;	1335	$cf::PLAYER{$login} = $self;
1367		1336
1368	$self	1337	$self
		1338	}
		1339
		1340	=item $player->send_msg ($channel, $msg, $color, [extra...])
		1341
		1342	=cut
		1343
		1344	sub send_msg {
		1345	my $ns = shift->ns
		1346	or return;
		1347	$ns->send_msg (@_);
1369	}	1348	}
1370		1349
1371	=item $pl->quit_character	1350	=item $pl->quit_character
1372		1351
1373	Nukes the player without looking back. If logged in, the connection will	1352	Nukes the player without looking back. If logged in, the connection will
…		…
1517	sub hintmode {	1496	sub hintmode {
1518	$_[0]{hintmode} = $_[1] if @_ > 1;	1497	$_[0]{hintmode} = $_[1] if @_ > 1;
1519	$_[0]{hintmode}	1498	$_[0]{hintmode}
1520	}	1499	}
1521		1500
1522	=item $player->ext_reply ($msgid, %msg)	1501	=item $player->ext_reply ($msgid, @msg)
1523		1502
1524	Sends an ext reply to the player.	1503	Sends an ext reply to the player.
1525		1504
1526	=cut	1505	=cut
1527		1506
1528	sub ext_reply($$%) {	1507	sub ext_reply($$@) {
1529	my ($self, $id, %msg) = @_;	1508	my ($self, $id, @msg) = @_;
1530		1509
1531	$msg{msgid} = $id;	1510	if ($self->ns->extcmd == 2) {
		1511	$self->send ("ext " . $self->ns->{json_coder}->encode (["reply-$id", @msg]));
		1512	} elsif ($self->ns->extcmd == 1) {
		1513	#TODO: version 1, remove
		1514	unshift @msg, msgtype => "reply", msgid => $id;
1532	$self->send ("ext " . $self->ns->{json_coder}->encode (\%msg));	1515	$self->send ("ext " . $self->ns->{json_coder}->encode ({@msg}));
		1516	}
1533	}	1517	}
1534		1518
1535	=item $player->ext_event ($type, %msg)	1519	=item $player->ext_msg ($type, @msg)
1536		1520
1537	Sends an ext event to the client.	1521	Sends an ext event to the client.
1538		1522
1539	=cut	1523	=cut
1540		1524
1541	sub ext_event($$%) {	1525	sub ext_msg($$@) {
1542	my ($self, $type, %msg) = @_;	1526	my ($self, $type, @msg) = @_;
1543		1527
1544	$self->ns->ext_event ($type, %msg);	1528	$self->ns->ext_msg ($type, @msg);
1545	}	1529	}
1546		1530
1547	=head3 cf::region	1531	=head3 cf::region
1548		1532
1549	=over 4	1533	=over 4
…		…
1910	$self->set_darkness_map;	1894	$self->set_darkness_map;
1911	Coro::cede;	1895	Coro::cede;
1912	$self->activate;	1896	$self->activate;
1913	}	1897	}
1914		1898
		1899	$self->{last_save} = $cf::RUNTIME;
		1900	$self->last_access ($cf::RUNTIME);
		1901
1915	$self->in_memory (cf::MAP_IN_MEMORY);	1902	$self->in_memory (cf::MAP_IN_MEMORY);
1916	}	1903	}
1917		1904
1918	$self->post_load;	1905	$self->post_load;
1919	}	1906	}
…		…
1929		1916
1930	$self	1917	$self
1931	}	1918	}
1932		1919
1933	# find and load all maps in the 3x3 area around a map	1920	# find and load all maps in the 3x3 area around a map
1934	sub load_diag {	1921	sub load_neighbours {
1935	my ($map) = @_;	1922	my ($map) = @_;
1936		1923
1937	my @diag; # diagonal neighbours	1924	my @neigh; # diagonal neighbours
1938		1925
1939	for (0 .. 3) {	1926	for (0 .. 3) {
1940	my $neigh = $map->tile_path ($_)	1927	my $neigh = $map->tile_path ($_)
1941	or next;	1928	or next;
1942	$neigh = find $neigh, $map	1929	$neigh = find $neigh, $map
1943	or next;	1930	or next;
1944	$neigh->load;	1931	$neigh->load;
1945		1932
		1933	push @neigh,
1946	push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],	1934	[$neigh->tile_path (($_ + 3) % 4), $neigh],
1947	[$neigh->tile_path (($_ + 1) % 4), $neigh];	1935	[$neigh->tile_path (($_ + 1) % 4), $neigh];
1948	}	1936	}
1949		1937
1950	for (@diag) {	1938	for (grep defined $_->[0], @neigh) {
		1939	my ($path, $origin) = @$_;
1951	my $neigh = find @$_	1940	my $neigh = find $path, $origin
1952	or next;	1941	or next;
1953	$neigh->load;	1942	$neigh->load;
1954	}	1943	}
1955	}	1944	}
1956		1945
…		…
2219		2208
2220	} else {	2209	} else {
2221	my $pl = $self->contr;	2210	my $pl = $self->contr;
2222		2211
2223	if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) {	2212	if ($pl->{npc_dialog} && $pl->{npc_dialog}->{id}) {
2224	my $diag = $pl->{npc_dialog};	2213	my $dialog = $pl->{npc_dialog};
2225	$diag->{pl}->ext_reply (	2214	$dialog->{pl}->ext_msg ($dialog->{id}, update => msg => $dialog->{pl}->expand_cfpod ($msg));
2226	$diag->{id},
2227	msgtype => "reply",
2228	msg => $diag->{pl}->expand_cfpod ($msg),
2229	add_topics => []
2230	);
2231		2215
2232	} else {	2216	} else {
2233	$msg = $npc->name . " says: $msg" if $npc;	2217	$msg = $npc->name . " says: $msg" if $npc;
2234	$self->message ($msg, $flags);	2218	$self->message ($msg, $flags);
2235	}	2219	}
2236	}	2220	}
		2221	}
		2222
		2223	=item $object->send_msg ($channel, $msg, $color, [extra...])
		2224
		2225	=cut
		2226
		2227	sub cf::object::send_msg {
		2228	my $pl = shift->contr
		2229	or return;
		2230	$pl->send_msg (@_);
2237	}	2231	}
2238		2232
2239	=item $player_object->may ("access")	2233	=item $player_object->may ("access")
2240		2234
2241	Returns wether the given player is authorized to access resource "access"	2235	Returns wether the given player is authorized to access resource "access"
…		…
2320	# use -1 or undef as default coordinates, not 0, 0	2314	# use -1 or undef as default coordinates, not 0, 0
2321	($x, $y) = ($map->enter_x, $map->enter_y)	2315	($x, $y) = ($map->enter_x, $map->enter_y)
2322	if $x <=0 && $y <= 0;	2316	if $x <=0 && $y <= 0;
2323		2317
2324	$map->load;	2318	$map->load;
2325	$map->load_diag;	2319	$map->load_neighbours;
2326		2320
2327	return unless $self->contr->active;	2321	return unless $self->contr->active;
2328	$self->activate_recursive;	2322	$self->activate_recursive;
2329		2323
2330	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext	2324	local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
…		…
2506	sub cf::client::send_msg {	2500	sub cf::client::send_msg {
2507	my ($self, $channel, $msg, $color, @extra) = @_;	2501	my ($self, $channel, $msg, $color, @extra) = @_;
2508		2502
2509	$msg = $self->pl->expand_cfpod ($msg);	2503	$msg = $self->pl->expand_cfpod ($msg);
2510		2504
2511	$color &= ~cf::NDI_UNIQUE; # just in case...	2505	$color &= cf::NDI_CLIENT_MASK; # just in case...
2512		2506
2513	if (ref $channel) {	2507	if (ref $channel) {
2514	# send meta info to client, if not yet sent	2508	# send meta info to client, if not yet sent
2515	unless (exists $self->{channel}{$channel->{id}}) {	2509	unless (exists $self->{channel}{$channel->{id}}) {
2516	$self->{channel}{$channel->{id}} = $channel;	2510	$self->{channel}{$channel->{id}} = $channel;
2517	$self->ext_event (channel_info => %$channel);	2511	$self->ext_msg (channel_info => $channel);
2518	}	2512	}
2519		2513
2520	$channel = $channel->{id};	2514	$channel = $channel->{id};
2521	}	2515	}
2522		2516
2523	return unless @extra \|\| length $msg;	2517	return unless @extra \|\| length $msg;
2524		2518
2525	if ($self->can_msg) {	2519	if ($self->can_msg) {
		2520	# default colour, mask it out
		2521	$color &= ~(cf::NDI_COLOR_MASK \| cf::NDI_DEF)
		2522	if $color & cf::NDI_DEF;
		2523
2526	$self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $channel, $msg, @extra]));	2524	$self->send_packet ("msg " . $self->{json_coder}->encode (
		2525	[$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]));
2527	} else {	2526	} else {
2528	# replace some tags by gcfclient-compatible ones
2529	for ($msg) {
2530	1 while
2531	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2532	\|\| s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2533	\|\| s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2534	\|\| s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2535	\|\| s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2536	}
2537
2538	if ($color >= 0) {	2527	if ($color >= 0) {
		2528	# replace some tags by gcfclient-compatible ones
		2529	for ($msg) {
		2530	1 while
		2531	s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
		2532	\|\| s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
		2533	\|\| s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
		2534	\|\| s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
		2535	\|\| s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
		2536	}
		2537
		2538	$color &= cf::NDI_COLOR_MASK;
		2539
		2540	utf8::encode $msg;
		2541
2539	if (0 && $msg =~ /\[/) {	2542	if (0 && $msg =~ /\[/) {
		2543	# COMMAND/INFO
2540	$self->send_packet ("drawextinfo $color 4 0 $msg")	2544	$self->send_packet ("drawextinfo $color 10 8 $msg")
2541	} else {	2545	} else {
2542	$msg =~ s/\[\/?(?:b\|i\|u\|fixed\|color)[^\]]*\]//g;	2546	$msg =~ s/\[\/?(?:b\|i\|u\|fixed\|color)[^\]]*\]//g;
2543	$self->send_packet ("drawinfo $color $msg")	2547	$self->send_packet ("drawinfo $color $msg")
2544	}	2548	}
2545	}	2549	}
2546	}	2550	}
2547	}	2551	}
2548		2552
2549	=item $client->ext_event ($type, %msg)	2553	=item $client->ext_msg ($type, @msg)
2550		2554
2551	Sends an ext event to the client.	2555	Sends an ext event to the client.
2552		2556
2553	=cut	2557	=cut
2554		2558
2555	sub cf::client::ext_event($$%) {	2559	sub cf::client::ext_msg($$@) {
2556	my ($self, $type, %msg) = @_;	2560	my ($self, $type, @msg) = @_;
2557		2561
2558	return unless $self->extcmd;	2562	my $extcmd = $self->extcmd;
2559		2563
		2564	if ($extcmd == 2) {
		2565	$self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
		2566	} elsif ($extcmd == 1) { # TODO: remove
2560	$msg{msgtype} = "event_$type";	2567	push @msg, msgtype => "event_$type";
2561	$self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));	2568	$self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
		2569	}
2562	}	2570	}
2563		2571
2564	=item $success = $client->query ($flags, "text", \&cb)	2572	=item $success = $client->query ($flags, "text", \&cb)
2565		2573
2566	Queues a query to the client, calling the given callback with	2574	Queues a query to the client, calling the given callback with
…		…
2621	my ($ns, $buf) = @_;	2629	my ($ns, $buf) = @_;
2622		2630
2623	my $msg = eval { $ns->{json_coder}->decode ($buf) };	2631	my $msg = eval { $ns->{json_coder}->decode ($buf) };
2624		2632
2625	if (ref $msg) {	2633	if (ref $msg) {
		2634	my ($type, $reply, @payload) =
		2635	"ARRAY" eq ref $msg
		2636	? @$msg
		2637	: ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
		2638
2626	if (my $cb = $EXTICMD{$msg->{msgtype}}) {	2639	if (my $cb = $EXTICMD{$type}) {
2627	if (my %reply = $cb->($ns, $msg)) {	2640	my @reply = $cb->($ns, @payload);
2628	$reply{msgid} = $msg->{msgid};	2641
2629	$ns->send ("ext " . $ns->{json_coder}->encode (\%reply));	2642	$ns->ext_reply ($reply, @reply)
2630	}	2643	if $reply;
2631	}	2644	}
2632	} else {	2645	} else {
2633	warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";	2646	warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
2634	}	2647	}
2635		2648
…		…
2683	our $safe = new Safe "safe";	2696	our $safe = new Safe "safe";
2684	our $safe_hole = new Safe::Hole;	2697	our $safe_hole = new Safe::Hole;
2685		2698
2686	$SIG{FPE} = 'IGNORE';	2699	$SIG{FPE} = 'IGNORE';
2687		2700
2688	$safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time));	2701	$safe->permit_only (Opcode::opset qw(
		2702	:base_core :base_mem :base_orig :base_math
		2703	grepstart grepwhile mapstart mapwhile
		2704	sort time
		2705	));
2689		2706
2690	# here we export the classes and methods available to script code	2707	# here we export the classes and methods available to script code
2691		2708
2692	=pod	2709	=pod
2693		2710
2694	The following functions and methods are available within a safe environment:	2711	The following functions and methods are available within a safe environment:
2695		2712
2696	cf::object	2713	cf::object
2697	contr pay_amount pay_player map x y force_find force_add	2714	contr pay_amount pay_player map x y force_find force_add
2698	insert remove	2715	insert remove name archname title slaying race
2699		2716
2700	cf::object::player	2717	cf::object::player
2701	player	2718	player
2702		2719
2703	cf::player	2720	cf::player
…		…
2708		2725
2709	=cut	2726	=cut
2710		2727
2711	for (	2728	for (
2712	["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y	2729	["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
2713	insert remove)],	2730	insert remove inv name archname title slaying race)],
2714	["cf::object::player" => qw(player)],	2731	["cf::object::player" => qw(player)],
2715	["cf::player" => qw(peaceful)],	2732	["cf::player" => qw(peaceful)],
2716	["cf::map" => qw(trigger)],	2733	["cf::map" => qw(trigger)],
2717	) {	2734	) {
2718	no strict 'refs';	2735	no strict 'refs';
…		…
2794	# the server's init and main functions	2811	# the server's init and main functions
2795		2812
2796	sub load_facedata($) {	2813	sub load_facedata($) {
2797	my ($path) = @_;	2814	my ($path) = @_;
2798		2815
		2816	my $enc = JSON::XS->new->utf8->canonical;
		2817
2799	warn "loading facedata from $path\n";	2818	warn "loading facedata from $path\n";
2800		2819
2801	my $facedata;	2820	my $facedata;
2802	0 < aio_load $path, $facedata	2821	0 < aio_load $path, $facedata
2803	or die "$path: $!";	2822	or die "$path: $!";
2804		2823
2805	$facedata = Coro::Storable::thaw $facedata;	2824	$facedata = Coro::Storable::thaw $facedata;
2806		2825
2807	$facedata->{version} == 2	2826	$facedata->{version} == 2
2808	or cf::cleanup "$path: version mismatch, cannot proceed.";	2827	or cf::cleanup "$path: version mismatch, cannot proceed.";
		2828
		2829	# patch in the exptable
		2830	$facedata->{resource}{"res/exp_table"} = {
		2831	type => FT_RSRC,
		2832	data => $enc->encode ([map cf::level_to_min_exp $_, 0 .. cf::settings->max_level]),
		2833	};
		2834	cf::cede_to_tick;
2809		2835
2810	{	2836	{
2811	my $faces = $facedata->{faceinfo};	2837	my $faces = $facedata->{faceinfo};
2812		2838
2813	while (my ($face, $info) = each %$faces) {	2839	while (my ($face, $info) = each %$faces) {
2814	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;	2840	my $idx = (cf::face::find $face) \|\| cf::face::alloc $face;
2815	cf::face::set_visibility $idx, $info->{visibility};	2841	cf::face::set_visibility $idx, $info->{visibility};
2816	cf::face::set_magicmap $idx, $info->{magicmap};	2842	cf::face::set_magicmap $idx, $info->{magicmap};
2817	cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};	2843	cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
2818	cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};	2844	cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
2819		2845
2820	cf::cede_to_tick;	2846	cf::cede_to_tick;
2821	}	2847	}
2822		2848
2823	while (my ($face, $info) = each %$faces) {	2849	while (my ($face, $info) = each %$faces) {
…		…
2848		2874
2849	{	2875	{
2850	# TODO: for gcfclient pleasure, we should give resources	2876	# TODO: for gcfclient pleasure, we should give resources
2851	# that gcfclient doesn't grok a >10000 face index.	2877	# that gcfclient doesn't grok a >10000 face index.
2852	my $res = $facedata->{resource};	2878	my $res = $facedata->{resource};
2853	my $enc = JSON::XS->new->utf8->canonical;	2879
		2880	my $soundconf = delete $res->{"res/sound.conf"};
2854		2881
2855	while (my ($name, $info) = each %$res) {	2882	while (my ($name, $info) = each %$res) {
2856	my $meta = $enc->encode ({
2857	name => $name,
2858	type => $info->{type},
2859	copyright => $info->{copyright}, #TODO#
2860	});
2861
2862	my $idx = (cf::face::find $name) \|\| cf::face::alloc $name;	2883	my $idx = (cf::face::find $name) \|\| cf::face::alloc $name;
		2884	my $data;
2863		2885
2864	if ($name =~ /\.jpg$/) {	2886	if ($info->{type} & 1) {
2865	cf::face::set_data $idx, 0, $info->{data}, $info->{chksum};#d# temp hack	2887	# prepend meta info
2866	cf::face::set_data $idx, 1, $info->{data}, $info->{chksum};#d# temp hack	2888
2867	} else {	2889	my $meta = $enc->encode ({
		2890	name => $name,
		2891	%{ $info->{meta} \|\| {} },
		2892	});
		2893
2868	my $data = pack "(w/a)", $meta, $info->{data};	2894	$data = pack "(w/a)", $meta, $info->{data};
2869	my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
2870
2871	cf::face::set_type $idx, 1;
2872	cf::face::set_data $idx, 0, $data, $chk;
2873	}	2895	}
2874		2896
		2897	cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
		2898	cf::face::set_type $idx, $info->{type};
		2899
2875	cf::cede_to_tick;	2900	cf::cede_to_tick;
2876	}	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	cf::sound::set $sound->[0] => $face;
		2912	cf::sound::old_sound_index $_, $face; # gcfclient-compat
		2913	}
		2914
		2915	while (my ($k, $v) = each %{$soundconf->{event}}) {
		2916	my $face = cf::face::find "sound/$v";
		2917	cf::sound::set $k => $face;
		2918	}
		2919	}
2877	}	2920	}
2878		2921
2879	1	2922	1
2880	}	2923	}
		2924
		2925	register_exticmd fx_want => sub {
		2926	my ($ns, $want) = @_;
		2927
		2928	while (my ($k, $v) = each %$want) {
		2929	$ns->fx_want ($k, $v);
		2930	}
		2931	};
2881		2932
2882	sub reload_regions {	2933	sub reload_regions {
2883	load_resource_file "$MAPDIR/regions"	2934	load_resource_file "$MAPDIR/regions"
2884	or die "unable to load regions file\n";	2935	or die "unable to load regions file\n";
2885		2936

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.315 by root, Mon Jul 23 17:53:55 2007 UTC vs. Revision 1.335 by root, Mon Aug 20 22:21:48 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.315 by root, Mon Jul 23 17:53:55 2007 UTC vs.
Revision 1.335 by root, Mon Aug 20 22:21:48 2007 UTC