[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/Protocol.pm

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents):
Revision 1.96 by root, Fri Apr 6 07:45:35 2007 UTC vs.
Revision 1.110 by root, Tue Jun 26 05:06:01 2007 UTC

…		…
15	use Crossfire::Protocol::Base 0.95;	15	use Crossfire::Protocol::Base 0.95;
16		16
17	use base 'Crossfire::Protocol::Base';	17	use base 'Crossfire::Protocol::Base';
18		18
19	sub new {	19	sub new {
20	my $class = shift;	20	my ($class, %arg) = @_;
21		21
22	my $self = $class->SUPER::new (@_, setup_req => { extmap => 1 });	22	my $self = $class->SUPER::new (%arg,
		23	setup_req => {
		24	extmap => 1,
		25	excmd => 1,
		26	xwidget => 1,
		27	%{$arg{setup_req} \|\| {}},
		28	},
		29	);
23		30
24	$self->{map_widget}->clr_commands;	31	$self->{map_widget}->clr_commands;
25		32
26	my @cmd_help = map {	33	my @cmd_help = map {
27	$_->{kw}[0] =~ /^(\S+) (?:\s+ $ ([^$]*) \) )?/x	34	$_->{kw}[0] =~ /^(\S+) (?:\s+ $ ([^$]*) \) )?/x
…		…
55	my $w = int $self->{mapw} * 32 / $self->{tilesize};	62	my $w = int $self->{mapw} * 32 / $self->{tilesize};
56	my $h = int $self->{maph} * 32 / $self->{tilesize};	63	my $h = int $self->{maph} * 32 / $self->{tilesize};
57		64
58	$self->setup_req (mapsize => "${w}x${h}");	65	$self->setup_req (mapsize => "${w}x${h}");
59	}	66	}
		67	}
		68	});
		69
		70	$self->connect_ext (ws_n => sub {
		71	my ($arg) = @_;
		72
		73	$self->{widgetset}{$arg{id}} = {
		74	w => {},
		75	};
		76	});
		77
		78	$self->connect_ext (ws_d => sub {
		79	my ($arg) = @_;
		80
		81	my $ws = delete $self->{widgetset}{$arg{id}}
		82	or return;
		83
		84	$_->destroy
		85	for values %{$ws->{w}};
		86	});
		87
		88	$self->connect_ext (ws_c => sub {
		89	my ($arg) = @_;
		90
		91	my $args = $arg->{args} \|\| {};
		92
		93	for my $ev (grep /^on_/, keys %$args) {
		94	$args->{$ev} = sub {
		95	my $id = shift->{s_id};
		96	$self->send_exti_msg (w_e => id => $id, name => $ev, args => \@_);
		97
		98	1
		99	};
		100	}
		101
		102	if (my $widget = eval {
		103	local $SIG{__DIE__};
		104	"CFPlus::UI::$arg->{class}"->new (
		105	%$args,
		106	s_ws => $arg->{ws},
		107	s_id => $arg->{id},
		108	)
		109	}
		110	) {
		111	$self->{widget}{$arg->{id}}
		112	= $self->{widgetset}{$arg->{ws}}{w}{$arg->{id}}
		113	= $widget;
		114
		115	$widget->connect (on_destroy => sub {
		116	my ($widget) = @_;
		117
		118	delete $self->{widget}{$widget->{s_id}};
		119	delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}};
		120	});
		121	} else {
		122	warn "server failed creating client-side widget " . (CFPlus::to_json $arg) . ": $@\n";
		123	$self->send_exti_msg (w_e => id => $arg->{id}, name => "destroy");
		124	}
		125	});
		126
		127	$self->connect_ext (w_c => sub {
		128	my ($arg) = @_;
		129
		130	my $w = $self->{widget}{$arg->{id}}
		131	or return;
		132	my $m = $arg->{name};
		133
		134	my @a = map {
		135	"HASH" eq ref && 1 == (scalar keys %$_) && exists $_->{__widget_ref__}
		136	? $self->{widget}{$_->{__widget_ref__}}
		137	: $_
		138	} @{ $arg->{args} \|\| [] };
		139
		140	if (exists $arg->{rid}) {
		141	$self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->$m (@a)]);
		142	} else {
		143	$w->$m (@a);
		144	}
		145	});
		146
		147	$self->connect_ext (w_s => sub {
		148	my ($arg) = @_;
		149
		150	my $w = $self->{widget}{$arg->{id}}
		151	or return;
		152
		153	$w->{$arg->{name}} = $arg->{value};
		154	});
		155
		156	$self->connect_ext (w_g => sub {
		157	my ($arg) = @_;
		158
		159	my $w = $self->{widget}{$arg->{id}}
		160	or return;
		161
		162	$self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->{$arg->{name}}]);
		163	});
		164
		165	$self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub {
		166	for my $ws (values %{delete $self->{widgetset} \|\| {}}) {
		167	$_->destroy
		168	for values %{delete $ws->{w} \|\| {}};
60	}	169	}
61	});	170	});
62		171
63	$self->{map_widget}->add_command (@$_)	172	$self->{map_widget}->add_command (@$_)
64	for @cmd_help;	173	for @cmd_help;
…		…
243	$::GAUGES->{mana} ->set_value ($sp, $sp_m);	352	$::GAUGES->{mana} ->set_value ($sp, $sp_m);
244	$::GAUGES->{food} ->set_value ($fo, $fo_m);	353	$::GAUGES->{food} ->set_value ($fo, $fo_m);
245	$::GAUGES->{grace} ->set_value ($gr, $gr_m);	354	$::GAUGES->{grace} ->set_value ($gr, $gr_m);
246	$::GAUGES->{exp} ->set_text ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64}))	355	$::GAUGES->{exp} ->set_text ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64}))
247	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");	356	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
248	my $rng = $stats->{+CS_STAT_RANGE};	357	$::GAUGES->{range} ->set_text ($stats->{+CS_STAT_RANGE});
249	$rng =~ s/^Range: //; # thank you so much dear server
250	$::GAUGES->{range} ->set_text ("Rng: " . $rng);
251	my $title = $stats->{+CS_STAT_TITLE};	358	my $title = $stats->{+CS_STAT_TITLE};
252	$title =~ s/^Player: //;	359	$title =~ s/^Player: //;
253	$::STATWIDS->{title} ->set_text ("Title: " . $title);	360	$::STATWIDS->{title} ->set_text ("Title: " . $title);
254		361
255	$::STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});	362	$::STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
…		…
402		509
403	$self->{map}->clear;	510	$self->{map}->clear;
404	delete $self->{map_widget}{magicmap};	511	delete $self->{map_widget}{magicmap};
405	}	512	}
406		513
		514	sub bg_fetch {
		515	my ($self) = @_;
		516
		517	my $id;
		518
		519	do {
		520	$id = pop @{$self->{bg_fetch}}
		521	or return;
		522	} while $self->{texture}[$id];
		523
		524	CFPlus::DB::get tilecache => $id, sub {
		525	my ($data) = @_;
		526
		527	return unless $self->{map}; # stop when destroyed
		528
		529	$self->set_texture ($id => $data)
		530	if defined $data;
		531
		532	$self->bg_fetch;
		533	};
		534	}
407		535
408	sub load_map($$$) {	536	sub load_map($$$) {
409	my ($self, $hash, $x, $y) = @_;	537	my ($self, $hash, $x, $y) = @_;
410		538
		539	my $gen = $self->{map_change_gen};
		540
411	CFPlus::DB::get $self->{mapcache} => $hash, sub {	541	CFPlus::DB::get $self->{mapcache} => $hash, sub {
		542	return unless $gen == $self->{map_change_gen};
		543
412	my ($data) = @_;	544	my ($data) = @_;
413		545
414	if (defined $data) {	546	if (defined $data) {
415	$data = Compress::LZF::decompress $data;	547	$data = Compress::LZF::decompress $data;
416	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#	548	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
417	for my $id ($self->{map}->set_rect ($x, $y, $data)) {
418	CFPlus::DB::get tilecache => $id, sub {
419	my ($data) = @_;
420		549
421	$self->set_texture ($id => $data)	550	my $inprogress = @{ $self->{bg_fetch} \|\| [] };
422	if defined $data;	551	unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $data);
423	};	552	$self->bg_fetch unless $inprogress;
424	}
425	}	553	}
426	};	554	};
427	}	555	}
428		556
429	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,	557	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
…		…
495		623
496	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)	624	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
497	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	625	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
498		626
499	} else {	627	} else {
		628	my $gen = $self->{map_change_gen};
500	$self->send_mapinfo ("spatial $path$tile", sub {	629	$self->send_mapinfo ("spatial $path$tile", sub {
		630	return unless $gen == $self->{map_change_gen};
		631
501	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;	632	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
502		633
503	return if $mode ne "spatial";	634	return if $mode ne "spatial";
504		635
505	$x += $self->{map}->ox;	636	$x += $self->{map}->ox;
…		…
519		650
520	sub map_change {	651	sub map_change {
521	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;	652	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
522		653
523	$self->flush_map;	654	$self->flush_map;
		655
		656	++$self->{map_change_gen};
524		657
525	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);	658	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
526		659
527	my $mapmapw = $self->{mapmap}->{w};	660	my $mapmapw = $self->{mapmap}->{w};
528	my $mapmaph = $self->{mapmap}->{h};	661	my $mapmaph = $self->{mapmap}->{h};
…		…
568	if $changed;	701	if $changed;
569		702
570	$self->set_texture ($face->{id} => delete $face->{image});	703	$self->set_texture ($face->{id} => delete $face->{image});
571	}	704	}
572		705
		706	sub smooth_update {
		707	my ($self, $facenum, $face) = @_;
		708
		709	$self->{map}->set_smooth ($facenum, $face->{smoothface}, $face->{smoothlevel});
		710	}
		711
573	sub set_texture {	712	sub set_texture {
574	my ($self, $id, $data) = @_;	713	my ($self, $id, $data) = @_;
575		714
576	$self->{texture}[$id] \|\|= do {	715	$self->{texture}[$id] = my $tex =
577	my $tex =
578	new_from_image CFPlus::Texture	716	new_from_image CFPlus::Texture
579	$data, minify => 1, mipmap => 1;	717	$data, minify => 1, mipmap => 1;
580		718
581	$self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});	719	$self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
582	$self->{map_widget}->update;	720	$self->{map_widget}->update;
583
584	$tex
585	};
586	}	721	}
587		722
588	sub sound_play {	723	sub sound_play {
589	my ($self, $x, $y, $soundnum, $type) = @_;	724	my ($self, $x, $y, $soundnum, $type) = @_;
590		725
…		…
600	$LAST_QUERY = $prompt;	735	$LAST_QUERY = $prompt;
601		736
602	$self->{query}-> ($self, $flags, $prompt);	737	$self->{query}-> ($self, $flags, $prompt);
603	}	738	}
604		739
605	sub drawinfo {	740	sub sanitise_xml($) {
606	my ($self, $color, $text) = @_;	741	local $_ = shift;
607		742
608	my @color = (	743	# we now weed out all tags we do not support
		744	s%<(?!/?i>\|/?u>\|/?b>\|fg \|/fg>)%<%g;
		745	# now all entities
		746	s/&(?!amp;\|lt;\|gt;\|apos;\|quot;\|#[0-9]+;\|#x[0-9a-fA-F]+;)/&/g;
		747
		748	# handle some elements
		749	s/<fg name='([^'])'>(.?)<\/fg>/<span foreground='$1'>$2<\/span>/gs;
		750	s/<fg name="([^"])">(.?)<\/fg>/<span foreground="$1">$2<\/span>/gs;
		751
		752	$_
		753	}
		754
		755	our %NAME_TO_COLOR = (
		756	black => 0,
		757	white => 1,
		758	darkblue => 2,
		759	red => 3,
		760	orange => 4,
		761	lightblue => 5,
		762	darkorange => 6,
		763	green => 7,
		764	darkgreen => 8,
		765	grey => 9,
		766	brown => 10,
		767	yellow => 11,
		768	tan => 12,
		769	);
		770
		771	our @CF_COLOR = (
609	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],	772	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
610	[1.00, 1.00, 1.00],	773	[1.00, 1.00, 1.00],
611	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]	774	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
612	[1.00, 0.00, 0.00],	775	[1.00, 0.00, 0.00],
613	[1.00, 0.54, 0.00],	776	[1.00, 0.54, 0.00],
614	[0.11, 0.56, 1.00],	777	[0.11, 0.56, 1.00],
615	[0.93, 0.46, 0.00],	778	[0.93, 0.46, 0.00],
616	[0.18, 0.54, 0.34],	779	[0.18, 0.54, 0.34],
617	[0.56, 0.73, 0.56],	780	[0.56, 0.73, 0.56],
618	[0.80, 0.80, 0.80],	781	[0.80, 0.80, 0.80],
619	[0.75, 0.61, 0.20],	782	[0.75, 0.61, 0.20],
620	[0.99, 0.77, 0.26],	783	[0.99, 0.77, 0.26],
621	[0.74, 0.65, 0.41],	784	[0.74, 0.65, 0.41],
622	);	785	);
623		786
624	my $fg = $color[$color % @color];	787	sub msg {
		788	my ($self, $color, $type, $text, @extra) = @_;
625		789
		790	$text = sanitise_xml $text;
		791
		792	if (my $cb = $self->{cb_msg}{$type}) {
		793	$_->($self, $color, $type, $text, @extra) for values %$cb;
		794	} elsif ($type =~ /^(?:chargen-race-title\|chargen-race-description)$/) {
		795	$type =~ s/-/_/g;
		796	$self->{$type} = $text;
		797	} else {
626	$self->logprint ("info: ", $text);	798	$self->logprint ("msg: ", $text);
		799	return if $color < 0; # negative color == ignore if not understood
627		800
		801	my $fg = $CF_COLOR[$color % @CF_COLOR];
		802
628	# try to create single paragraphs of multiple lines sent by the server	803	## try to create single paragraphs of multiple lines sent by the server
		804	# no longer neecssary with TRT servers
629	$text =~ s/(?<=\S)\n(?=\w)/ /g;	805	#$text =~ s/(?<=\S)\n(?=\w)/ /g;
630		806
631	$text = CFPlus::asxml $text;
632	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
633	$text =~ s/\[color=(.?)\](.?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
634
635	::message ({ fg => $fg, markup => $_ })	807	::message ({ fg => $fg, markup => $_ })
636	for split /\n/, $text;	808	for split /\n/, $text;
637		809
638	$self->{statusbox}->add ($text,	810	$self->{statusbox}->add ($text,
639	group => $text,	811	group => $text,
640	fg => $fg,	812	fg => $fg,
641	timeout => $color >= 2 ? 180 : 10,	813	timeout => $color >= 2 ? 180 : 10,
642	tooltip_font => $::FONT_FIXED,	814	tooltip_font => $::FONT_FIXED,
643	);	815	);
644	}	816	}
645
646	sub drawextinfo {
647	my ($self, $color, $type, $subtype, $message) = @_;
648
649	$self->drawinfo ($color, $message);
650	}	817	}
651		818
652	sub spell_add {	819	sub spell_add {
653	my ($self, $spell) = @_;	820	my ($self, $spell) = @_;
654		821
…		…
887	$::SERVER_INFO->set_markup (	1054	$::SERVER_INFO->set_markup (
888	"server <tt>$self->{host}:$self->{port}</tt>\n"	1055	"server <tt>$self->{host}:$self->{port}</tt>\n"
889	. "protocol version <tt>$self->{version}</tt>\n"	1056	. "protocol version <tt>$self->{version}</tt>\n"
890	. "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"	1057	. "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"
891	. "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"	1058	. "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"
		1059	. "examine command support $yesno[$self->{setup}{excmd} > 0]\n"
892	. "editing support $yesno[!!$self->{editor_support}]\n"	1060	. "editing support $yesno[!!$self->{editor_support}]\n"
893	. "map attributes $yesno[$self->{setup}{extmap} > 0]\n"	1061	. "map attributes $yesno[$self->{setup}{extmap} > 0]\n"
		1062	. "big image protocol support $yesno[$self->{setup}{fxix} > 0]\n"
894	. "cfplus support $yesno[$self->{cfplus_ext} > 0]"	1063	. "cfplus support $yesno[$self->{cfplus_ext} > 0]"
895	. ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"	1064	. ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"
896	. "map size $self->{mapw}×$self->{maph}\n"	1065	. "map size $self->{mapw}×$self->{maph}\n"
897	);	1066	);
898		1067
…		…
1061		1230
1062	if ($msg->{msgtype} eq "reply") {	1231	if ($msg->{msgtype} eq "reply") {
1063	$self->{kw}{$_} = 1 for @{$msg->{add_topics} \|\| []};	1232	$self->{kw}{$_} = 1 for @{$msg->{add_topics} \|\| []};
1064	$self->{kw}{$_} = 0 for @{$msg->{del_topics} \|\| []};	1233	$self->{kw}{$_} = 0 for @{$msg->{del_topics} \|\| []};
1065		1234
1066	my $text = "\n" . CFPlus::asxml $msg->{msg};	1235	my $text = "\n" . CFPlus::Protocol::sanitise_xml $msg->{msg};
1067	my $match = join "\|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };	1236	my $match = join "\|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };
1068	my @link;	1237	my @link;
1069	$text =~ s{	1238	$text =~ s{
1070	($match)	1239	($match)
1071	}{	1240	}{

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents): Revision 1.96 by root, Fri Apr 6 07:45:35 2007 UTC vs. Revision 1.110 by root, Tue Jun 26 05:06:01 2007 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents):
Revision 1.96 by root, Fri Apr 6 07:45:35 2007 UTC vs.
Revision 1.110 by root, Tue Jun 26 05:06:01 2007 UTC