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

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents):
Revision 1.53 by root, Mon Jul 3 22:32:52 2006 UTC vs.
Revision 1.120 by root, Sat Jul 14 13:04:42 2007 UTC

…		…
1	package CFClient::Protocol;	1	package CFPlus::Protocol;
2		2
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Crossfire::Protocol::Constants;	6	use Crossfire::Protocol::Constants;
7		7
8	use CFClient;	8	use CFPlus;
		9	use CFPlus::DB;
9	use CFClient::UI;	10	use CFPlus::UI;
		11	use CFPlus::Pod;
		12	use CFPlus::Macro;
		13	use CFPlus::Item;
		14
		15	use Crossfire::Protocol::Base 0.95;
10		16
11	use base 'Crossfire::Protocol::Base';	17	use base 'Crossfire::Protocol::Base';
12		18
13	our %open_logs;
14
15	sub new {	19	sub new {
16	my $class = shift;	20	my ($class, %arg) = @_;
17		21
18	my $self = $class->SUPER::new (@_);	22	my $self = $class->SUPER::new (%arg,
		23	setup_req => {
		24	extmap => 1,
		25	excmd => 1,
		26	ywidget => 1,
		27	%{$arg{setup_req} \|\| {}},
		28	},
		29	);
19		30
20	$self->{map_widget}->clr_commands;	31	$self->{map_widget}->clr_commands;
21		32
22	my $cmd_help = CFClient::load_pod CFClient::find_rcfile "pod/command_help.pod", command_help => 1, sub {	33	my @cmd_help = map {
23	my ($pom) = @_;
24
25	my @cmd_help;
26
27	for my $head2 ($pom->head1->[-2]->head2) {
28	$head2->title =~ /^(\S+) (?:\s+ $ ([^$]*) \) )?/x	34	$_->{kw}[0] =~ /^(\S+) (?:\s+ $ ([^$]*) \) )?/x
29	or next;	35	or die "unparseable command help: $_->{kw}[0]";
30		36
31	my $cmd = $1;	37	my $cmd = $1;
32	my @args = split /\\|/, $2;	38	my @args = split /\\|/, $2;
33	@args = (".*") unless @args;	39	@args = (".*") unless @args;
34		40
		41	my (undef, @par) = CFPlus::Pod::section_of $_;
		42	my $text = CFPlus::Pod::as_label @par;
		43
35	$_ = $_ eq ".*" ? "" : " $_"	44	$_ = $_ eq ".*" ? "" : " $_"
36	for @args;	45	for @args;
37		46
38	my $text = CFClient::pod_to_pango $head2->content;	47	map ["$cmd$_", $text],
39
40	push @cmd_help, ["$cmd$_", $text]
41	for sort { (length $a) <=> (length $b) }	48	sort { (length $a) <=> (length $b) }
		49	@args
		50	} sort { $a->{par} <=> $b->{par} }
		51	CFPlus::Pod::find command => "*";
		52
		53	$self->connect_ext (event_music => sub {
		54	my ($ev) = @_;
		55
		56	return unless $::CFG->{bgm_enable};
		57
		58	my $faces = $ev->{faces};
		59	my @songs;
		60
		61	# request music from server if appropriate
		62	if (my $faces = $ev->{faces}) {
		63	for (@$faces) {
		64	my ($face, $pri, $chksum) = @$_;
		65	utf8::downgrade $chksum;
		66
		67	$chksum = unpack "H*", $chksum;
		68	$self->{music_map}{$face} = $chksum;
		69
		70	# check if already cached
		71	CFPlus::DB::get "res-metadata" => $chksum, sub {
		72	my ($meta_json) = @_;
		73	my $path = CFPlus::DB::path_of_res $chksum;
		74
		75	if (defined $meta_json) {
		76	my $meta = $self->{json_coder}->decode ($meta_json);
		77	$meta->{path} = $path;
		78	$self->{music_meta}{$chksum} = $meta;
		79	} else {
		80	::message ({ markup => "starting to download song #$face/$pri, check your output-rate setting if your connection gets laggy." });
		81	$self->ask_face ($face, -100 - $pri, undef, sub {
		82	my $len = length $_[1];
		83	my ($meta_json, $data) = unpack "(w/a)", $_[1];
		84
		85	CFPlus::DB::write_file $path, $data, sub {
		86	CFPlus::DB::put "res-metadata" => $chksum => $meta_json, sub {
		87	my $meta = $self->{json_coder}->decode ($meta_json);
		88	$meta->{path} = $path;
		89	$self->{music_meta}{$chksum} = $meta;
		90
		91	::message ({ markup => "downloaded song #$face, size $len octets" });
		92	&::audio_music_set ($self->{songs});
		93	};
42	@args;	94	};
		95	});
		96	}
		97	}
		98	}
		99	}
		100
		101	if (my $play = $ev->{play}) {
		102	&::audio_music_set ($self->{songs} = [map $self->{music_map}{$_}, @$play]);
		103	}
		104	});
		105
		106	$self->connect_ext (event_capabilities => sub {
		107	my ($cap) = @_;
		108
		109	if (my $ts = $cap->{tileset}) {
		110	if (my ($default) = grep $_->[2] & 1, @$ts) {
		111	$self->{tileset} = $default;
		112	$self->{tilesize} = $default->[3];
		113	$self->setup_req (tileset => $default->[0]);
		114
		115	my $w = int $self->{mapw} * 32 / $self->{tilesize};
		116	my $h = int $self->{maph} * 32 / $self->{tilesize};
		117
		118	$self->setup_req (mapsize => "${w}x${h}");
		119	}
		120	}
		121	});
		122
		123	$self->{json_coder}
		124	->convert_blessed
		125	->filter_json_single_key_object (__widget_ref__ => sub {
		126	$self->{widget}{$_[0]}
		127	});
		128
		129	$self->connect_ext (ws_n => sub {
		130	my ($arg) = @_;
		131
		132	$self->{widgetset}{$arg{id}} = {
		133	w => {},
43	}	134	};
44
45	\@cmd_help
46	};	135	});
		136
		137	$self->connect_ext (ws_d => sub {
		138	my ($arg) = @_;
		139
		140	my $ws = delete $self->{widgetset}{$arg{id}}
		141	or return;
		142
		143	$_->destroy
		144	for values %{$ws->{w}};
		145	});
		146
		147	$self->connect_ext (ws_c => sub {
		148	my ($arg) = @_;
		149
		150	my $args = $arg->{args} \|\| {};
		151
		152	for my $ev (grep /^on_/, keys %$args) {
		153	$args->{$ev} = sub {
		154	my $id = shift->{s_id};
		155	$self->send_exti_msg (w_e => id => $id, name => $ev, args => \@_);
		156
		157	1
		158	};
		159	}
		160
		161	if (my $widget = eval {
		162	local $SIG{__DIE__};
		163	"CFPlus::UI::$arg->{class}"->new (
		164	%$args,
		165	s_ws => $arg->{ws},
		166	s_id => $arg->{id},
		167	)
		168	}
		169	) {
		170	$self->{widget}{$arg->{id}}
		171	= $self->{widgetset}{$arg->{ws}}{w}{$arg->{id}}
		172	= $widget;
		173
		174	$widget->connect (on_destroy => sub {
		175	my ($widget) = @_;
		176
		177	delete $self->{widget}{$widget->{s_id}};
		178	delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}};
		179	});
		180	} else {
		181	warn "server failed creating client-side widget " . (CFPlus::to_json $arg) . ": $@\n";
		182	$self->send_exti_msg (w_e => id => $arg->{id}, name => "destroy");
		183	}
		184	});
		185
		186	$self->connect_ext (w_c => sub {
		187	my ($arg) = @_;
		188
		189	my $w = $self->{widget}{$arg->{id}}
		190	or return;
		191	my $m = $arg->{name};
		192
		193	my $a = $arg->{args} \|\| [];
		194
		195	if (exists $arg->{rid}) {
		196	$self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->$m (@$a)]);
		197	} else {
		198	$w->$m (@$a);
		199	}
		200	});
		201
		202	$self->connect_ext (w_s => sub {
		203	my ($arg) = @_;
		204
		205	my $w = $self->{widget}{$arg->{id}}
		206	or return;
		207
		208	$w->{$arg->{name}} = $arg->{value};
		209	});
		210
		211	$self->connect_ext (w_g => sub {
		212	my ($arg) = @_;
		213
		214	my $w = $self->{widget}{$arg->{id}}
		215	or return;
		216
		217	$self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->{$arg->{name}}]);
		218	});
		219
		220	$self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub {
		221	for my $ws (values %{delete $self->{widgetset} \|\| {}}) {
		222	$_->destroy
		223	for values %{delete $ws->{w} \|\| {}};
		224	}
		225	});
47		226
48	$self->{map_widget}->add_command (@$_)	227	$self->{map_widget}->add_command (@$_)
49	for @$cmd_help;	228	for @cmd_help;
50		229
		230	{
		231	$self->{dialogue} = my $tex = new_from_file CFPlus::Texture
		232	CFPlus::find_rcfile "dialogue.png", minify => 1, mipmap => 1;
		233	$self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		234	}
		235
		236	{
51	$self->{noface} = new_from_file CFClient::Texture	237	$self->{noface} = my $tex = new_from_file CFPlus::Texture
52	CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;	238	CFPlus::find_rcfile "noface.png", minify => 1, mipmap => 1;
		239	$self->{map}->set_texture (2, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		240	}
53		241
54	$self->{open_container} = 0;	242	$self->{open_container} = 0;
55		243
56	# "global"
57	$self->{tilecache} = CFClient::db_table "tilecache";
58	$self->{facemap} = CFClient::db_table "facemap";
59
60	# per server	244	# per server
61	$self->{mapcache} = CFClient::db_table "mapcache_$self->{host}_$self->{port}";	245	$self->{mapcache} = "mapcache_$self->{host}_$self->{port}";
62		246
63	$self	247	$self
64	}	248	}
65		249
66	sub logprint {	250	sub logprint {
67	my ($self, @a) = @_;	251	my ($self, @a) = @_;
		252
		253	$self->{log_fh} \|\|= do {
68	my $filename = "$Crossfire::VARDIR/log.$self->{host}";	254	my $path = "$Crossfire::VARDIR/log.$self->{host}";
69		255
70	my $fh = $open_logs{$filename};	256	open my $fh, ">>:utf8", $path
71	unless ($fh) {
72	# FIXME: handle this more gracefully?
73	open $fh, ">>", $filename
74	or die "Couldn't open logfile: log.$self->{host}: $!";	257	or die "Couldn't open logfile $path: $!";
75		258
76	$open_logs{$filename} = $fh;	259	$fh->autoflush (1);
		260
		261	$fh;
77	}	262	};
78		263
79	my ($sec, $min, $hour, $mday, $mon, $year) = localtime (time);	264	my ($sec, $min, $hour, $mday, $mon, $year) = localtime time;
80		265
81	my $ts = sprintf "%04d-%02d-%02d %02d:%02d:%02d",	266	my $ts = sprintf "%04d-%02d-%02d %02d:%02d:%02d",
82	$year + 1900, $mon + 1, $mday, $hour, $min, $sec;	267	$year + 1900, $mon + 1, $mday, $hour, $min, $sec;
83		268
84	print $fh "$ts ", @a, "\n";	269	print {$self->{log_fh}} "$ts ", @a, "\n";
85	$fh->flush;
86	}	270	}
87		271
88	sub _stat_numdiff {	272	sub _stat_numdiff {
89	my ($self, $old, $new) = @_;	273	my ($self, $name, $old, $new) = @_;
90		274
91	my $diff = $new - $old;	275	my $diff = $new - $old;
92	$diff > 0 ? "+$diff" : $diff	276
		277	$diff = 0.01 * int $diff * 100;
		278
		279	0.1 >= abs $diff ? ()
		280	: $diff < 0 ? "$name$diff" : "$name+$diff"
93	}	281	}
94		282
95	sub _stat_skillmaskdiff {	283	sub _stat_skillmaskdiff {
96	my ($self, $old, $new) = @_;	284	my ($self, $name, $old, $new) = @_;
97		285
98	my $diff = $old ^ $new;	286	my $diff = $old ^ $new
		287	or return;
99		288
100	my @diff = map	289	my @diff = map
101	{	290	{
102	$diff & $_	291	$diff & $_
103	? (($new & $_ ? "+" : "-") . $self->{spell_paths}{$_})	292	? (($new & $_ ? "+" : "-") . $self->{spell_paths}{$_})
150	);	339	);
151		340
152	sub stats_update {	341	sub stats_update {
153	my ($self, $stats) = @_;	342	my ($self, $stats) = @_;
154		343
155	if (my $prev = $self->{prev_stats}) {	344	my $prev = $self->{prev_stats} \|\| { };
156	if (my $diff = $stats->{+CS_STAT_EXP64} - $prev->{+CS_STAT_EXP64}) {	345
		346	if (my @diffs =
		347	(
		348	($stats->{+CS_STAT_EXP64} > $prev->{+CS_STAT_EXP64} ? ($stats->{+CS_STAT_EXP64} - $prev->{+CS_STAT_EXP64}) . " experience gained" : ()),
		349	map {
		350	$stats->{$_} && $prev->{$_}
		351	&& $stats->{$_}[1] > $prev->{$_}[1] ? "($self->{skill_info}{$_}+" . ($stats->{$_}[1] - $prev->{$_}[1]) . ")" : ()
		352	} sort { $a <=> $b } keys %{$self->{skill_info}}
		353	)
		354	) {
		355	my $msg = join " ", @diffs;
157	$self->{statusbox}->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5);	356	$self->{statusbox}->add ($msg, group => "experience $msg", fg => [0.5, 1, 0.5, 0.8], timeout => 5);
158	}	357	}
159		358
		359	if (
		360	my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange
		361	) {
		362	my $msg = "<b>stat change</b>: " . (join " ", @diffs);
		363	$self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 10);
		364	}
		365
		366	$self->update_stats_window ($stats, $prev);
		367
		368	$self->{prev_stats} = { %$stats };
		369	}
		370
		371	my %RES_TBL = (
		372	phys => CS_STAT_RES_PHYS,
		373	magic => CS_STAT_RES_MAG,
		374	fire => CS_STAT_RES_FIRE,
		375	elec => CS_STAT_RES_ELEC,
		376	cold => CS_STAT_RES_COLD,
		377	conf => CS_STAT_RES_CONF,
		378	acid => CS_STAT_RES_ACID,
		379	drain => CS_STAT_RES_DRAIN,
		380	ghit => CS_STAT_RES_GHOSTHIT,
		381	pois => CS_STAT_RES_POISON,
		382	slow => CS_STAT_RES_SLOW,
		383	para => CS_STAT_RES_PARA,
		384	tund => CS_STAT_TURN_UNDEAD,
		385	fear => CS_STAT_RES_FEAR,
		386	depl => CS_STAT_RES_DEPLETE,
		387	deat => CS_STAT_RES_DEATH,
		388	holyw => CS_STAT_RES_HOLYWORD,
		389	blind => CS_STAT_RES_BLIND,
		390	);
		391
		392	sub update_stats_window {
		393	my ($self, $stats, $prev) = @_;
		394
		395	# I love text protocols...
		396
		397	my $hp = $stats->{+CS_STAT_HP} * 1;
		398	my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
		399	my $sp = $stats->{+CS_STAT_SP} * 1;
		400	my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
		401	my $fo = $stats->{+CS_STAT_FOOD} * 1;
		402	my $fo_m = 999;
		403	my $gr = $stats->{+CS_STAT_GRACE} * 1;
		404	my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
		405
		406	$::GAUGES->{hp} ->set_value ($hp, $hp_m);
		407	$::GAUGES->{mana} ->set_value ($sp, $sp_m);
		408	$::GAUGES->{food} ->set_value ($fo, $fo_m);
		409	$::GAUGES->{grace} ->set_value ($gr, $gr_m);
		410	$::GAUGES->{exp} ->set_text ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64}))
		411	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
		412	$::GAUGES->{range} ->set_text ($stats->{+CS_STAT_RANGE});
		413	my $title = $stats->{+CS_STAT_TITLE};
		414	$title =~ s/^Player: //;
		415	$::STATWIDS->{title} ->set_text ("Title: " . $title);
		416
		417	$::STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
		418	$::STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
		419	$::STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
		420	$::STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
		421	$::STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
		422	$::STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
		423	$::STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
		424	$::STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
		425	$::STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
		426	$::STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
		427	$::STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_RES_PHYS});
		428	$::STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
		429	$::STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
		430
		431	$self->update_weight;
		432
		433	$::STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$RES_TBL{$_}})
		434	for keys %RES_TBL;
		435
		436	my $sktbl = $::STATWIDS->{skill_tbl};
		437	my @skills = keys %{ $self->{skill_info} };
		438
		439	if (grep +(exists $stats->{$_}) != (exists $prev->{$_}), @skills) {
		440	$sktbl->clear;
		441
		442	$sktbl->add (0, 0, new CFPlus::UI::Label text => "Experience", align => 1);
		443	$sktbl->add (1, 0, new CFPlus::UI::Label text => "Lvl.", align => 1);
		444	$sktbl->add (2, 0, new CFPlus::UI::Label text => "Skill", expand => 1);
		445	$sktbl->add (3, 0, new CFPlus::UI::Label text => "Experience", align => 1);
		446	$sktbl->add (4, 0, new CFPlus::UI::Label text => "Lvl.", align => 1);
		447	$sktbl->add (5, 0, new CFPlus::UI::Label text => "Skill", expand => 1);
		448
		449	my $TOOLTIP_ALL = "\n\n<small>Left click - ready skill\nMiddle click - use spell\nRight click - further options</small>";
		450
		451	my @TOOLTIP_LVL = (tooltip => "<b>Level</b>. The level of the skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
		452	my @TOOLTIP_EXP = (tooltip => "<b>Experience</b>. The experience points you have in this skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
		453
		454	my ($x, $y) = (0, 1);
160	if (	455	for (
161	my @diffs = map {	456	sort { $stats->{$b->[0]}[1] <=> $stats->{$a->[0]}[1] or $a->[1] cmp $b->[1] }
162	$stats->{$_->[0]} != $prev->{$_->[0]}	457	map [$_, $self->{skill_info}{$_}],
163	? $_->[2] . $_->[1]->($self, $prev->{$_->[0]}, $stats->{$_->[0]}) : ();	458	grep exists $stats->{$_},
164	}	459	@skills
165	@statchange
166	) {	460	) {
167	my $msg = "<b>stat change</b>: " . (join " ", @diffs);	461	my ($idx, $name) = @$_;
168	$self->{statusbox}->add ($msg, group => $msg, fg => [0.8, 1, 0.2, 1], timeout => 10);	462
		463	my $spell_cb = sub {
		464	my ($widget, $ev) = @_;
		465
		466	if ($ev->{button} == 1) {
		467	$::CONN->user_send ("ready_skill $name");
		468	} elsif ($ev->{button} == 2) {
		469	$::CONN->user_send ("use_skill $name");
		470	} elsif ($ev->{button} == 3) {
		471	my $shortname = CFPlus::shorten $name, 14;
		472	(new CFPlus::UI::Menu
		473	items => [
		474	["bind <i>ready_skill $shortname</i> to a key" => sub { CFPlus::Macro::quick_macro ["ready_skill $name"] }],
		475	["bind <i>use_skill $shortname</i> to a key" => sub { CFPlus::Macro::quick_macro ["use_skill $name"] }],
		476	],
		477	)->popup ($ev);
		478	} else {
		479	return 0;
		480	}
		481
		482	1
169	}	483	};
170	}
171		484
172	$self->{prev_stats} = { %$stats };	485	$sktbl->add ($x * 3 + 0, $y, $self->{stat_widget_exp}{$idx} = new CFPlus::UI::Label
		486	text => "0", align => 1, font => $::FONT_FIXED, fg => [1, 1, 0], on_button_down => $spell_cb, @TOOLTIP_EXP);
		487	$sktbl->add ($x * 3 + 1, $y, $self->{stat_widget_lvl}{$idx} = new CFPlus::UI::Label
		488	text => "0", align => 1, font => $::FONT_FIXED, fg => [0, 1, 0], padding_x => 4, on_button_down => $spell_cb, @TOOLTIP_LVL);
		489	$sktbl->add ($x * 3 + 2, $y, new CFPlus::UI::Label text => $name, on_button_down => $spell_cb,
		490	can_events => 1, can_hover => 1, tooltip => (CFPlus::Pod::section_label skill_description => $name) . $TOOLTIP_ALL);
173		491
174	::update_stats_window ($stats);	492	$x++ and ($x, $y) = (0, $y + 1);
		493	}
		494	}
		495
		496	for (grep exists $stats->{$_}, @skills) {
		497	$self->{stat_widget_exp}{$_}->set_text (::formsep ($stats->{$_}[1]));
		498	$self->{stat_widget_lvl}{$_}->set_text ($stats->{$_}[0] * 1);
		499	}
		500	}
		501
		502	sub macro_send {
		503	my ($self, $macro) = @_;
		504
		505	for my $cmd (@{ $macro->{action} }) {
		506	$self->send_command ($cmd);
		507	}
175	}	508	}
176		509
177	sub user_send {	510	sub user_send {
178	my ($self, $command) = @_;	511	my ($self, $command) = @_;
179		512
		513	$self->{record}->($command)
180	if ($self->{record}) {	514	if $self->{record};
181	push @{$self->{record}}, $command;
182	}
183		515
184	$self->logprint ("send: ", $command);	516	$self->logprint ("send: ", $command);
185	$self->send_command ($command);	517	$self->send_command ($command);
186	::status ($command);	518	::status ($command);
187	}	519	}
188		520
189	sub start_record {	521	sub record {
190	my ($self) = @_;	522	my ($self, $cb) = @_;
191		523
192	$self->{record} = [];	524	$self->{record} = $cb;
193	}
194
195	sub stop_record {
196	my ($self) = @_;
197	return delete $self->{record};
198	}	525	}
199		526
200	sub map_scroll {	527	sub map_scroll {
201	my ($self, $dx, $dy) = @_;	528	my ($self, $dx, $dy) = @_;
202		529
…		…
204	}	531	}
205		532
206	sub feed_map1a {	533	sub feed_map1a {
207	my ($self, $data) = @_;	534	my ($self, $data) = @_;
208		535
209	$self->{map}->map1a_update ($data);	536	$self->{map}->map1a_update ($data, $self->{setup}{extmap});
210	$self->{map_widget}->update;	537	$self->{map_widget}->update;
211	}	538	}
212		539
213	sub magicmap {	540	sub magicmap {
214	my ($self, $w, $h, $x, $y, $data) = @_;	541	my ($self, $w, $h, $x, $y, $data) = @_;
…		…
223	or return;	550	or return;
224		551
225	my ($hash, $x, $y, $w, $h) = @$map_info;	552	my ($hash, $x, $y, $w, $h) = @$map_info;
226		553
227	my $data = $self->{map}->get_rect ($x, $y, $w, $h);	554	my $data = $self->{map}->get_rect ($x, $y, $w, $h);
228	$self->{mapcache}->put ($hash => Compress::LZF::compress $data);	555	CFPlus::DB::put $self->{mapcache} => $hash => Compress::LZF::compress $data, sub { };
229	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#	556	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
230	}	557	}
231		558
232	sub map_clear {	559	sub map_clear {
233	my ($self) = @_;	560	my ($self) = @_;
…		…
237		564
238	$self->{map}->clear;	565	$self->{map}->clear;
239	delete $self->{map_widget}{magicmap};	566	delete $self->{map_widget}{magicmap};
240	}	567	}
241		568
		569	sub bg_fetch {
		570	my ($self) = @_;
		571
		572	my $id;
		573
		574	do {
		575	$id = pop @{$self->{bg_fetch}}
		576	or return;
		577	} while $self->{texture}[$id];
		578
		579	CFPlus::DB::get tilecache => $id, sub {
		580	my ($data) = @_;
		581
		582	return unless $self->{map}; # stop when destroyed
		583
		584	$self->set_texture ($id => $data)
		585	if defined $data;
		586
		587	$self->bg_fetch;
		588	};
		589	}
242		590
243	sub load_map($$$) {	591	sub load_map($$$) {
244	my ($self, $hash, $x, $y) = @_;	592	my ($self, $hash, $x, $y) = @_;
245		593
246	if (defined (my $data = $self->{mapcache}->get ($hash))) {	594	my $gen = $self->{map_change_gen};
		595
		596	CFPlus::DB::get $self->{mapcache} => $hash, sub {
		597	return unless $gen == $self->{map_change_gen};
		598
		599	my ($data) = @_;
		600
		601	if (defined $data) {
247	$data = Compress::LZF::decompress $data;	602	$data = Compress::LZF::decompress $data;
248	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#	603	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
249	for my $id ($self->{map}->set_rect ($x, $y, $data)) {
250	my $data = $self->{tilecache}->get ($id)
251	or next;
252		604
253	$self->set_texture ($id => $data);	605	my $inprogress = @{ $self->{bg_fetch} \|\| [] };
		606	unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $data);
		607	$self->bg_fetch unless $inprogress;
254	}	608	}
255	}	609	};
256	}	610	}
257		611
258	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,	612	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
259	# (server resource,s latency, bandwidth), so this hack is warranted.	613	# (server resource,s latency, bandwidth), so this hack is warranted.
260	# the right fix is to make real tiled maps with an overview file	614	# the right fix is to make real tiled maps with an overview file
…		…
324		678
325	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)	679	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
326	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	680	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
327		681
328	} else {	682	} else {
		683	my $gen = $self->{map_change_gen};
329	$self->send_mapinfo ("spatial $path$tile", sub {	684	$self->send_mapinfo ("spatial $path$tile", sub {
		685	return unless $gen == $self->{map_change_gen};
		686
330	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;	687	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
331		688
332	return if $mode ne "spatial";	689	return if $mode ne "spatial";
333		690
334	$x += $self->{map}->ox;	691	$x += $self->{map}->ox;
…		…
348		705
349	sub map_change {	706	sub map_change {
350	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;	707	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
351		708
352	$self->flush_map;	709	$self->flush_map;
		710
		711	++$self->{map_change_gen};
353		712
354	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);	713	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
355		714
356	my $mapmapw = $self->{mapmap}->{w};	715	my $mapmapw = $self->{mapmap}->{w};
357	my $mapmaph = $self->{mapmap}->{h};	716	my $mapmaph = $self->{mapmap}->{h};
…		…
374	$self->load_map ($hash, $x, $y);	733	$self->load_map ($hash, $x, $y);
375	$self->flood_fill (0, 0, 0, "", $hash, $flags);	734	$self->flood_fill (0, 0, 0, "", $hash, $flags);
376	}	735	}
377		736
378	sub face_find {	737	sub face_find {
		738	my ($self, $facenum, $face, $cb) = @_;
		739
		740	my $hash = "$face->{chksum},$face->{name}";
		741
		742	my $id = CFPlus::DB::get_tile_id_sync $hash;
		743
		744	$face->{id} = $id;
		745	$self->{faceid}[$facenum] = $id;
		746
		747	$self->{map}->set_tileid ($facenum => $id);
		748
		749	CFPlus::DB::get tilecache => $id, $cb;
		750	}
		751
		752	sub face_update {
		753	my ($self, $facenum, $face, $changed) = @_;
		754
		755	CFPlus::DB::put tilecache => $face->{id} => $face->{image}, sub { }
		756	if $changed;
		757
		758	$self->set_texture ($face->{id} => delete $face->{image});
		759	}
		760
		761	sub smooth_update {
379	my ($self, $facenum, $face) = @_;	762	my ($self, $facenum, $face) = @_;
380		763
381	my $hash = "$face->{chksum},$face->{name}";	764	$self->{map}->set_smooth ($facenum, $face->{smoothface}, $face->{smoothlevel});
382
383	my $id = $self->{facemap}->get ($hash);
384
385	unless ($id) {
386	# create new id for face
387	# I love transactions
388	for (1..100) {
389	my $txn = $CFClient::DB_ENV->txn_begin;
390	my $status = $self->{facemap}->db_get (id => $id);
391	if ($status == 0 \|\| $status == BerkeleyDB::DB_NOTFOUND) {
392	$id = ($id \|\| 64) + 1;
393	if ($self->{facemap}->put (id => $id) == 0
394	&& $self->{facemap}->put ($hash => $id) == 0) {
395	$txn->txn_commit;
396
397	goto gotid;
398	}
399	}
400	$txn->txn_abort;
401	}
402
403	CFClient::fatal "maximum number of transaction retries reached - database problems?";
404	}
405
406	gotid:
407	$face->{id} = $id;
408	$self->{map}->set_face ($facenum => $id);
409	$self->{faceid}[$facenum] = $id;#d#
410
411	my $face = $self->{tilecache}->get ($id);
412
413	if ($face) {
414	#$self->face_prefetch;
415	$face
416	} else {
417	my $tex = $self->{noface};
418	$self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
419	undef
420	};
421	}
422
423	sub face_update {
424	my ($self, $facenum, $face) = @_;
425
426	$self->{tilecache}->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
427
428	$self->set_texture ($face->{id} => delete $face->{image});
429	}	765	}
430		766
431	sub set_texture {	767	sub set_texture {
432	my ($self, $id, $data) = @_;	768	my ($self, $id, $data) = @_;
433		769
		770	return unless $self->{map};
		771
434	$self->{texture}[$id] \|\|= do {	772	$self->{texture}[$id] = my $tex =
435	my $tex =
436	new_from_image CFClient::Texture	773	new_from_image CFPlus::Texture
437	$data, minify => 1, mipmap => 1;	774	$data, minify => 1, mipmap => 1;
438		775
439	$self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});	776	$self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
440	$self->{map_widget}->update;	777	$self->{map_widget}->update;
441
442	$tex
443	};
444	}	778	}
445		779
446	sub sound_play {	780	sub sound_play {
447	my ($self, $x, $y, $soundnum, $type) = @_;	781	my ($self, $x, $y, $soundnum, $type) = @_;
448		782
…		…
458	$LAST_QUERY = $prompt;	792	$LAST_QUERY = $prompt;
459		793
460	$self->{query}-> ($self, $flags, $prompt);	794	$self->{query}-> ($self, $flags, $prompt);
461	}	795	}
462		796
463	sub drawinfo {	797	sub sanitise_xml($) {
464	my ($self, $color, $text) = @_;	798	local $_ = shift;
465		799
466	my @color = (	800	# we now weed out all tags we do not support
		801	s%<(?!/?i>\|/?u>\|/?b>\|fg \|/fg>)%<%g;
		802	# now all entities
		803	s/&(?!amp;\|lt;\|gt;\|apos;\|quot;\|#[0-9]+;\|#x[0-9a-fA-F]+;)/&/g;
		804
		805	# handle some elements
		806	s/<fg name='([^'])'>(.?)<\/fg>/<span foreground='$1'>$2<\/span>/gs;
		807	s/<fg name="([^"])">(.?)<\/fg>/<span foreground="$1">$2<\/span>/gs;
		808
		809	$_
		810	}
		811
		812	our %NAME_TO_COLOR = (
		813	black => 0,
		814	white => 1,
		815	darkblue => 2,
		816	red => 3,
		817	orange => 4,
		818	lightblue => 5,
		819	darkorange => 6,
		820	green => 7,
		821	darkgreen => 8,
		822	grey => 9,
		823	brown => 10,
		824	yellow => 11,
		825	tan => 12,
		826	);
		827
		828	our @CF_COLOR = (
467	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],	829	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
468	[1.00, 1.00, 1.00],	830	[1.00, 1.00, 1.00],
469	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]	831	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
470	[1.00, 0.00, 0.00],	832	[1.00, 0.00, 0.00],
471	[1.00, 0.54, 0.00],	833	[1.00, 0.54, 0.00],
472	[0.11, 0.56, 1.00],	834	[0.11, 0.56, 1.00],
473	[0.93, 0.46, 0.00],	835	[0.93, 0.46, 0.00],
474	[0.18, 0.54, 0.34],	836	[0.18, 0.54, 0.34],
475	[0.56, 0.73, 0.56],	837	[0.56, 0.73, 0.56],
476	[0.80, 0.80, 0.80],	838	[0.80, 0.80, 0.80],
477	[0.55, 0.41, 0.13],	839	[0.75, 0.61, 0.20],
478	[0.99, 0.77, 0.26],	840	[0.99, 0.77, 0.26],
479	[0.74, 0.65, 0.41],	841	[0.74, 0.65, 0.41],
480	);	842	);
481		843
		844	sub msg {
		845	my ($self, $color, $type, $text, @extra) = @_;
		846
		847	$text = sanitise_xml $text;
		848
		849	if (my $cb = $self->{cb_msg}{$type}) {
		850	$_->($self, $color, $type, $text, @extra) for values %$cb;
		851	} elsif ($type =~ /^(?:chargen-race-title\|chargen-race-description)$/) {
		852	$type =~ s/-/_/g;
		853	$self->{$type} = $text;
		854	} else {
482	$self->logprint ("info: ", $text);	855	$self->logprint ("msg: ", $text);
		856	return if $color < 0; # negative color == ignore if not understood
483		857
484	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];	858	my $fg = $CF_COLOR[$color % @CF_COLOR];
485		859
486	# try to create single paragraphs of multiple lines sent by the server	860	## try to create single paragraphs of multiple lines sent by the server
		861	# no longer neecssary with TRT servers
487	$text =~ s/(?<=\S)\n(?=\w)/ /g;	862	#$text =~ s/(?<=\S)\n(?=\w)/ /g;
488		863
489	$text = CFClient::UI::Label::escape $text;	864	::message ({ fg => $fg, markup => $_ })
490	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;	865	for split /\n/, $text;
491	$text =~ s/\[color=(.?)\](.?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
492		866
493	$self->{logview}->add_paragraph ($color[$color], $_)
494	for map "$time $_", split /\n/, $text;
495	$self->{logview}->scroll_to_bottom;
496
497	$self->{statusbox}->add ($text,	867	$self->{statusbox}->add ($text,
498	group => $text,	868	group => $text,
499	fg => $color[$color],	869	fg => $fg,
500	timeout => $color >= 2 ? 60 : 10,	870	timeout => $color >= 2 ? 180 : 10,
501	tooltip_font => $::FONT_FIXED,	871	tooltip_font => $::FONT_FIXED,
502	);	872	);
503	}	873	}
504
505	sub drawextinfo {
506	my ($self, $color, $type, $subtype, $message) = @_;
507
508	$self->drawinfo ($color, $message);
509	}	874	}
510		875
511	sub spell_add {	876	sub spell_add {
512	my ($self, $spell) = @_;	877	my ($self, $spell) = @_;
513		878
514	# try to create single paragraphs of multiple lines sent by the server	879	# try to create single paragraphs out of the multiple lines sent by the server
515	$spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g;	880	$spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g;
516	$spell->{message} =~ s/\n+$//;	881	$spell->{message} =~ s/\n+$//;
517	$spell->{message} \|\|= "Server did not provide a description for this spell.";	882	$spell->{message} \|\|= "Server did not provide a description for this spell.";
518		883
519	$::SPELL_PAGE->add_spell ($spell);	884	$::SPELL_LIST->add_spell ($spell);
520		885
521	$self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});	886	$self->{map_widget}->add_command ("invoke $spell->{name}", CFPlus::asxml $spell->{message});
522	$self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});	887	$self->{map_widget}->add_command ("cast $spell->{name}", CFPlus::asxml $spell->{message});
523	}	888	}
524		889
525	sub spell_delete {	890	sub spell_delete {
526	my ($self, $spell) = @_;	891	my ($self, $spell) = @_;
527		892
528	$::SPELL_PAGE->remove_spell ($spell);	893	$::SPELL_LIST->remove_spell ($spell);
		894	}
		895
		896	sub setup {
		897	my ($self, $setup) = @_;
		898
		899	$self->{map_widget}->set_tilesize ($self->{tilesize});
		900	$::MAP->resize ($self->{mapw}, $self->{maph});
529	}	901	}
530		902
531	sub addme_success {	903	sub addme_success {
532	my ($self) = @_;	904	my ($self) = @_;
533		905
534	my $skill_help = CFClient::load_pod CFClient::find_rcfile "pod/skill_help.pod", skill_help => 1, sub {
535	my ($pom) = @_;
536
537	my %skill_help;	906	my %skill_help;
538		907
539	for my $head2 ($pom->head1->[3]->head2) {	908	for my $node (CFPlus::Pod::find skill_description => "*") {
540	$skill_help{$head2->title} = CFClient::pod_to_pango $head2->content;	909	my (undef, @par) = CFPlus::Pod::section_of $node;
541	}	910	$skill_help{$node->{kw}[0]} = CFPlus::Pod::as_label @par;
542
543	\%skill_help
544	};	911	};
545		912
546	for my $skill (values %{$self->{skill_info}}) {	913	for my $skill (values %{$self->{skill_info}}) {
547	$self->{map_widget}->add_command ("ready_skill $skill",	914	$self->{map_widget}->add_command ("ready_skill $skill",
548	(CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")	915	(CFPlus::asxml "Ready the skill '$skill'\n\n")
549	. $skill_help->{$skill});	916	. $skill_help{$skill});
550	$self->{map_widget}->add_command ("use_skill $skill",	917	$self->{map_widget}->add_command ("use_skill $skill",
551	(CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")	918	(CFPlus::asxml "Immediately use the skill '$skill'\n\n")
552	. $skill_help->{$skill});	919	. $skill_help{$skill});
553	}	920	}
554	}	921	}
555		922
556	sub eof {	923	sub eof {
557	my ($self) = @_;	924	my ($self) = @_;
…		…
581		948
582	my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();	949	my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
583		950
584	$self->send ("requestinfo image_sums $face $face");	951	$self->send ("requestinfo image_sums $face $face");
585		952
586	$self->{statusbox}->add (CFClient::UI::Label::escape "prefetching $todo",	953	$self->{statusbox}->add (CFPlus::asxml "prefetching $todo",
587	group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);	954	group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
588	} elsif (!exists $self->{num_faces}) {	955	} elsif (!exists $self->{num_faces}) {
589	$self->send ("requestinfo image_info");	956	$self->send ("requestinfo image_info");
590		957
591	$self->{num_faces} = 0;	958	$self->{num_faces} = 0;
592		959
593	$self->{statusbox}->add (CFClient::UI::Label::escape "starting to prefetch",	960	$self->{statusbox}->add (CFPlus::asxml "starting to prefetch",
594	group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);	961	group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
595	}	962	}
596	}	963	}
597		964
598	sub update_floorbox {	965	sub update_floorbox {
599	$CFClient::UI::ROOT->on_refresh ($::FLOORBOX => sub {	966	$CFPlus::UI::ROOT->on_refresh ($::FLOORBOX => sub {
600	return unless $::CONN;	967	return unless $::CONN;
601		968
602	$::FLOORBOX->clear;	969	$::FLOORBOX->clear;
603		970
604	my $row;	971	my $row;
605	for (sort { $a->{count} <=> $b->{count} } values %{ $::CONN->{container}{0} }) {	972	for (sort { $a->{count} <=> $b->{count} } values %{ $::CONN->{container}{$::CONN->{open_container} \|\| 0} }) {
606	if ($row < 6) {	973	if ($row < 6) {
607	local $_->{face_widget}; # hack to force recreation of widget	974	local $_->{face_widget}; # hack to force recreation of widget
608	local $_->{desc_widget}; # hack to force recreation of widget	975	local $_->{desc_widget}; # hack to force recreation of widget
609	CFClient::Item::update_widgets $_;	976	CFPlus::Item::update_widgets $_;
610		977
611	$::FLOORBOX->add (0, $row, $_->{face_widget});	978	$::FLOORBOX->add (0, $row, $_->{face_widget});
612	$::FLOORBOX->add (1, $row, $_->{desc_widget});	979	$::FLOORBOX->add (1, $row, $_->{desc_widget});
613		980
614	$row++;	981	$row++;
615	} else {	982	} else {
616	$::FLOORBOX->add (1, $row, new CFClient::UI::Button	983	$::FLOORBOX->add (1, $row, new CFPlus::UI::Button
617	text => "More...",	984	text => "More...",
618	on_activate => sub { ::toggle_player_page ($::INVENTORY_PAGE); 0 },	985	on_activate => sub { ::toggle_player_page ($::INVENTORY_PAGE); 0 },
619	);	986	);
620	last;	987	last;
621	}	988	}
622	}	989	}
		990	if ($::CONN->{open_container}) {
		991	$::FLOORBOX->add (1, $row++, new CFPlus::UI::Button
		992	text => "Close container",
		993	on_activate => sub { $::CONN->send ("apply $::CONN->{open_container}") }
		994	);
		995	}
623	});	996	});
624		997
625	$::WANT_REFRESH++;	998	$::WANT_REFRESH++;
626	}	999	}
627		1000
628	sub set_opencont {	1001	sub set_opencont {
629	my ($conn, $tag, $name) = @_;	1002	my ($conn, $tag, $name) = @_;
630	$conn->{open_container} = $tag;	1003	$conn->{open_container} = $tag;
		1004	update_floorbox;
631		1005
632	$::INV_RIGHT_HB->clear ();	1006	$::INV_RIGHT_HB->clear ();
633	$::INV_RIGHT_HB->add (new CFClient::UI::Label align => 0, expand => 1, text => $name);	1007	$::INV_RIGHT_HB->add (new CFPlus::UI::Label align => 0, expand => 1, text => $name);
634		1008
635	if ($tag != 0) { # Floor isn't closable, is it?	1009	if ($tag != 0) { # Floor isn't closable, is it?
636	$::INV_RIGHT_HB->add (new CFClient::UI::Button	1010	$::INV_RIGHT_HB->add (new CFPlus::UI::Button
637	text => "Close container",	1011	text => "Close container",
638	tooltip => "Close the currently open container (if one is open)",	1012	tooltip => "Close the currently open container (if one is open)",
639	on_activate => sub {	1013	on_activate => sub {
640	$::CONN->send ("apply $tag") # $::CONN->{open_container}")	1014	$::CONN->send ("apply $tag") # $::CONN->{open_container}")
641	if $tag != 0;	1015	if $tag != 0;
…		…
649	}	1023	}
650		1024
651	sub update_containers {	1025	sub update_containers {
652	my ($self) = @_;	1026	my ($self) = @_;
653		1027
654	$CFClient::UI::ROOT->on_refresh ("update_containers_$self" => sub {	1028	$CFPlus::UI::ROOT->on_refresh ("update_containers_$self" => sub {
655	for my $tag (keys %{ delete $self->{update_container} }) {	1029	my $todo = delete $self->{update_container}
		1030	or return;
		1031
		1032	for my $tag (keys %$todo) {
		1033	update_floorbox if $tag == 0 or $tag == $self->{open_container};
656	if ($tag == 0) {	1034	if ($tag == 0) {
657	update_floorbox;
658	$::INVR->set_items ($self->{container}{0})	1035	$::INVR->set_items ($self->{container}{0})
659	if $tag == $self->{open_container};	1036	if $tag == $self->{open_container};
660	} elsif ($tag == $self->{player}{tag}) {	1037	} elsif ($tag == $self->{player}{tag}) {
661	$::INV->set_items ($self->{container}{$tag})	1038	$::INV->set_items ($self->{container}{$tag})
662	} else {	1039	} else {
…		…
693	sub item_update {	1070	sub item_update {
694	my ($self, $item) = @_;	1071	my ($self, $item) = @_;
695		1072
696	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n";	1073	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n";
697		1074
698	CFClient::Item::update_widgets $item;	1075	CFPlus::Item::update_widgets $item;
699		1076
700	if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {	1077	if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {
701	set_opencont ($::CONN, 0, "Floor");	1078	set_opencont ($::CONN, 0, "Floor");
702		1079
703	} elsif ($item->{flags} & F_OPEN) {	1080	} elsif ($item->{flags} & F_OPEN) {
704	set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item);	1081	set_opencont ($::CONN, $item->{tag}, CFPlus::Item::desc_string $item);
705		1082
706	} else {	1083	} else {
707	$self->{update_container}{$item->{container}}++;	1084	$self->{update_container}{$item->{container}}++;
708	$self->update_containers;	1085	$self->update_containers;
709	# if ($item->{container} == 0) {
710	# update_floorbox;
711	# update_container (0);
712	# } elsif ($item->{container} == $self->{player}{tag}) {
713	# $::INV->set_items ($self->{container}{$item->{container}})
714	# }
715	}	1086	}
716	}	1087	}
717		1088
718	sub player_update {	1089	sub player_update {
719	my ($self, $player) = @_;	1090	my ($self, $player) = @_;
		1091
		1092	$self->update_weight;
		1093	}
		1094
		1095	sub update_weight {
		1096	my ($self) = @_;
		1097
		1098	my $weight = .001 * $self->{player}{weight};
		1099	my $limit = .001 * $self->{stat}{+CS_STAT_WEIGHT_LIM};
		1100
720	$::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $player->{weight} / 1000);	1101	$::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $weight);
		1102	$::STATWIDS->{m_weight}->set_text (sprintf "%.1fkg", $limit);
		1103	$::STATWIDS->{i_weight}->set_text (sprintf "%.1f/%.1fkg", $weight, $limit);
721	}	1104	}
722		1105
723	sub update_server_info {	1106	sub update_server_info {
724	my ($self) = @_;	1107	my ($self) = @_;
725		1108
…		…
728	$::SERVER_INFO->set_markup (	1111	$::SERVER_INFO->set_markup (
729	"server <tt>$self->{host}:$self->{port}</tt>\n"	1112	"server <tt>$self->{host}:$self->{port}</tt>\n"
730	. "protocol version <tt>$self->{version}</tt>\n"	1113	. "protocol version <tt>$self->{version}</tt>\n"
731	. "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"	1114	. "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"
732	. "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"	1115	. "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"
		1116	. "examine command support $yesno[$self->{setup}{excmd} > 0]\n"
		1117	. "editing support $yesno[!!$self->{editor_support}]\n"
		1118	. "map attributes $yesno[$self->{setup}{extmap} > 0]\n"
		1119	. "big image protocol support $yesno[$self->{setup}{fxix} > 0]\n"
733	. "cfplus support $yesno[$self->{cfplus_ext} > 0]"	1120	. "cfplus support $yesno[$self->{cfplus_ext} > 0]"
734	. ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"	1121	. ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"
735	. "map size $self->{mapw}×$self->{maph}\n"	1122	. "map size $self->{mapw}×$self->{maph}\n"
736	);	1123	);
		1124
		1125	::setup_build_button ($self->{editor_support}->{builder_ui});
737	}	1126	}
738		1127
739	sub logged_in {	1128	sub logged_in {
740	my ($self) = @_;	1129	my ($self) = @_;
741		1130
742	$self->send_ext_req (cfplus_support => "1", sub {	1131	$self->send_ext_req (cfplus_support => version => 1, sub {
743	$self->{cfplus_ext} = $_[0];	1132	$self->{cfplus_ext} = $_[0]{version};
744	$self->update_server_info;	1133	$self->update_server_info;
		1134
		1135	if ($self->{cfplus_ext} >= 2) {
		1136	$self->send_ext_req ("editor_support", sub {
		1137	$self->{editor_support} = $_[0];
		1138	$self->update_server_info;
		1139
		1140	0
		1141	});
		1142	}
		1143
		1144	0
745	});	1145	});
746		1146
747	$self->update_server_info;	1147	$self->update_server_info;
748		1148
749	$self->send_command ("output-sync $::CFG->{output_sync}");	1149	$self->send_command ("output-sync $::CFG->{output_sync}");
750	$self->send_command ("output-count $::CFG->{output_count}");	1150	$self->send_command ("output-count $::CFG->{output_count}");
		1151	$self->send_command ("output-rate $::CFG->{output_rate}") if $::CFG->{output_rate} > 0;
751	$self->send_command ("pickup $::CFG->{pickup}");	1152	$self->send_command ("pickup $::CFG->{pickup}");
		1153	}
		1154
		1155	sub buildat {
		1156	my ($self, $builditem, $x, $y) = @_;
		1157
		1158	if ($self->{cfplus_ext}) {
		1159	$self->send_ext_msg (builder_build => dx => $x, dy => $y, (ref ($builditem) eq 'HASH') ? %$builditem : (item => $builditem));
		1160	}
752	}	1161	}
753		1162
754	sub lookat {	1163	sub lookat {
755	my ($self, $x, $y) = @_;	1164	my ($self, $x, $y) = @_;
756		1165
757	if ($self->{cfplus_ext}) {	1166	if ($self->{cfplus_ext}) {
758	$self->send_ext_req (lookat => "$x $y", sub {	1167	$self->send_ext_req (lookat => dx => $x, dy => $y, sub {
759	my %res = split /\x00/, $_[0];	1168	my ($msg) = @_;
760		1169
761	if (exists $res{npc_dialog}) {	1170	if (exists $msg->{npc_dialog}) {
762	# start npc chat dialog	1171	# start npc chat dialog
763	$self->{npc_dialog} = new CFClient::NPCDialog::	1172	$self->{npc_dialog} = new CFPlus::NPCDialog::
764	dx => $x,	1173	dx => $x,
765	dy => $y,	1174	dy => $y,
766	title => "$res{npc_dialog} (NPC)",	1175	title => "$msg->{npc_dialog} (NPC)",
767	conn => $self,	1176	conn => $self,
768	;	1177	;
769	}	1178	}
770	});	1179	});
771	}	1180	}
…		…
774	}	1183	}
775		1184
776	sub destroy {	1185	sub destroy {
777	my ($self) = @_;	1186	my ($self) = @_;
778		1187
779	$self->{npc_dialog}->destroy	1188	(delete $self->{npc_dialog})->destroy
780	if $self->{npc_dialog};	1189	if $self->{npc_dialog};
781		1190
782	$self->SUPER::destroy;	1191	$self->SUPER::destroy;
783	}
784		1192
		1193	%$self = ();
		1194	}
		1195
785	package CFClient::NPCDialog;	1196	package CFPlus::NPCDialog;
786		1197
787	our @ISA = 'CFClient::UI::FancyFrame';	1198	our @ISA = 'CFPlus::UI::Toplevel';
788		1199
789	sub new {	1200	sub new {
790	my $class = shift;	1201	my $class = shift;
791		1202
792	my $self = $class->SUPER::new (	1203	my $self = $class->SUPER::new (
…		…
795	name => "npc_dialog",	1206	name => "npc_dialog",
796	force_w => $::WIDTH * 0.7,	1207	force_w => $::WIDTH * 0.7,
797	force_h => $::HEIGHT * 0.7,	1208	force_h => $::HEIGHT * 0.7,
798	title => "NPC Dialog",	1209	title => "NPC Dialog",
799	kw => { hi => 0, yes => 0, no => 0 },	1210	kw => { hi => 0, yes => 0, no => 0 },
		1211	has_close_button => 1,
800	@_,	1212	@_,
801	);	1213	);
802		1214
803	Scalar::Util::weaken (my $this = $self);	1215	CFPlus::weaken (my $this = $self);
		1216
		1217	$self->connect (delete => sub { $this->destroy; 1 });
804		1218
805	# better use a pane...	1219	# better use a pane...
806	$self->add (my $hbox = new CFClient::UI::HBox);	1220	$self->add (my $hbox = new CFPlus::UI::HBox);
807	$hbox->add ($self->{textview} = new CFClient::UI::TextScroller expand => 1);	1221	$hbox->add ($self->{textview} = new CFPlus::UI::TextScroller expand => 1);
808		1222
809	$hbox->add (my $vbox = new CFClient::UI::VBox);	1223	$hbox->add (my $vbox = new CFPlus::UI::VBox);
810		1224
811	$vbox->add (new CFClient::UI::Label text => "Message Entry:");	1225	$vbox->add (new CFPlus::UI::Label text => "Message Entry:");
812	$vbox->add ($self->{entry} = new CFClient::UI::Entry	1226	$vbox->add ($self->{entry} = new CFPlus::UI::Entry
813	tooltip => "Enter a message you want to tell the NPC and press <b>return</b>.\n\n"	1227	tooltip => "#npc_message_entry",
814	. "Sometimes you have to tell an NPC something you cannot find out during "
815	. "a normal conversation (such as a password). In those cases you have to use "
816	. "this text entry. You can also enter responses manually instead of using the response "
817	. "buttons below.",
818	on_activate => sub {	1228	on_activate => sub {
819	my ($entry, $text) = @_;	1229	my ($entry, $text) = @_;
820		1230
821	return unless $text =~ /\S/;	1231	return unless $text =~ /\S/;
822		1232
…		…
825		1235
826	0	1236	0
827	},	1237	},
828	);	1238	);
829		1239
830	$vbox->add ($self->{options} = new CFClient::UI::VBox);	1240	$vbox->add ($self->{options} = new CFPlus::UI::VBox);
831		1241
832	$self->{bye_button} = new CFClient::UI::Button	1242	$self->{bye_button} = new CFPlus::UI::Button
833	text => "Bye (close)",	1243	text => "Bye (close)",
834	tooltip => "Use this button to end talking to the NPC. This also closes the dialog window.",	1244	tooltip => "Use this button to end talking to the NPC. This also closes the dialog window.",
835	on_activate => sub { $this->destroy; 0 },	1245	on_activate => sub { $this->destroy; 1 },
836	;	1246	;
837		1247
838	$self->update_options;	1248	$self->update_options;
839		1249
840	$self->{token} = $self->{conn}->ext_token;	1250	$self->{id} = $self->{conn}->send_ext_req (
841	$self->{conn}->connect_ext ($self->{token} => sub { $this->feed (@_) });	1251	npc_dialog_begin => dx => $self->{dx}, dy => $self->{dy},
842	$self->{conn}->send ("ext npc_dialog_begin $self->{token} $self->{dx} $self->{dy}");	1252	sub { $this && $this->feed (@_) }
		1253	);
843		1254
844	$self->{entry}->grab_focus;	1255	$self->{entry}->grab_focus;
845		1256
846	$self->{textview}->add_paragraph ([1, 1, 0, 1], "<small>[starting conversation with <b>$self->{title}</b>]</small>\n\n");	1257	$self->{textview}->add_paragraph ({
		1258	fg => [1, 1, 0, 1],
		1259	markup => "<small>[starting conversation with <b>$self->{title}</b>]</small>\n\n",
		1260	});
847		1261
848	$self->show;	1262	$self->show;
849	$self	1263	$self
850	};	1264	};
851		1265
852	sub update_options {	1266	sub update_options {
853	my ($self) = @_;	1267	my ($self) = @_;
854		1268
855	Scalar::Util::weaken $self;	1269	CFPlus::weaken $self;
856		1270
857	$self->{options}->clear;	1271	$self->{options}->clear;
858	$self->{options}->add ($self->{bye_button});	1272	$self->{options}->add ($self->{bye_button});
859		1273
860	for my $kw (sort keys %{ $self->{kw} }) {	1274	for my $kw (sort keys %{ $self->{kw} }) {
861	$self->{options}->add (new CFClient::UI::Button	1275	$self->{options}->add (new CFPlus::UI::Button
862	text => $kw,	1276	text => $kw,
863	on_activate => sub {	1277	on_activate => sub {
864	$self->send ($kw);	1278	$self->send ($kw);
865	0	1279	0
866	},	1280	},
867	);	1281	);
868	}	1282	}
869	}	1283	}
870		1284
871	sub feed {	1285	sub feed {
872	my ($self, $data) = @_;	1286	my ($self, $msg) = @_;
873		1287
874	Scalar::Util::weaken $self;	1288	CFPlus::weaken $self;
875		1289
876	my ($type, $msg) = split / /, $data, 2;	1290	if ($msg->{msgtype} eq "reply") {
		1291	$self->{kw}{$_} = 1 for @{$msg->{add_topics} \|\| []};
		1292	$self->{kw}{$_} = 0 for @{$msg->{del_topics} \|\| []};
877		1293
878	if ($type eq "msg") {	1294	my $text = "\n" . CFPlus::Protocol::sanitise_xml $msg->{msg};
879	my ($msg, @kw) = split /\x00/, $msg;
880	$self->{kw}{$_} = 1 for @kw;
881
882	$msg = "\n" . CFClient::UI::Label::escape $msg;
883	my $match = join "\|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };	1295	my $match = join "\|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };
884	my @link;	1296	my @link;
885	$msg =~ s{	1297	$text =~ s{
886	($match)	1298	($match)
887	}{	1299	}{
888	my $kw = $1;	1300	my $kw = $1;
889		1301
890	push @link, new CFClient::UI::Label	1302	push @link, new CFPlus::UI::Label
891	markup => "<span foreground='#c0c0ff' underline='single'>$kw</span>",	1303	markup => "<span foreground='#c0c0ff' underline='single'>$kw</span>",
892	can_hover => 1,	1304	can_hover => 1,
893	can_events => 1,	1305	can_events => 1,
894	padding_x => 0,	1306	padding_x => 0,
895	padding_y => 0,	1307	padding_y => 0,
896	on_button_up => sub {	1308	on_button_up => sub {
897	$self->send ($kw);	1309	$self->send ($kw);
898	};	1310	};
899		1311
900	chr 0xfffc	1312	"\x{fffc}"
901	}giex;	1313	}giex;
902		1314
903	$self->{textview}->add_paragraph ([1, 1, 1, 1], [$msg, @link]);	1315	$self->{textview}->add_paragraph ({ markup => $text, widget => \@link });
904	$self->{textview}->scroll_to_bottom;	1316	$self->{textview}->scroll_to_bottom;
905	$self->update_options;	1317	$self->update_options;
906	} else {	1318	} else {
907	$self->destroy;	1319	$self->destroy;
908	}	1320	}
…		…
911	}	1323	}
912		1324
913	sub send {	1325	sub send {
914	my ($self, $msg) = @_;	1326	my ($self, $msg) = @_;
915		1327
916	$self->{conn}->send ("ext npc_dialog_tell $self->{token} $msg");	1328	$self->{textview}->add_paragraph ({ markup => "\n" . CFPlus::asxml $msg });
917	$self->{textview}->add_paragraph ([1, 1, 0, 1], "\n" . CFClient::UI::Label::escape $msg);
918	$self->{textview}->scroll_to_bottom;	1329	$self->{textview}->scroll_to_bottom;
		1330
		1331	$self->{conn}->send_ext_msg (npc_dialog_tell => msgid => $self->{id}, msg => $msg);
919	}	1332	}
920		1333
921	sub destroy {	1334	sub destroy {
922	my ($self) = @_;	1335	my ($self) = @_;
923		1336
924	#Carp::cluck "debug\n";#d# #todo# enable: destroy gets called twice because scalar keys {} is 1	1337	#Carp::cluck "debug\n";#d# #todo# enable: destroy gets called twice because scalar keys {} is 1
925		1338
		1339	if ($self->{conn}) {
		1340	$self->{conn}->send_ext_msg (npc_dialog_end => msgid => $self->{id}) if $self->{id};
926	delete $self->{conn}{npc_dialog};	1341	delete $self->{conn}{npc_dialog};
927	$self->{conn}->disconnect_ext ($self->{token});	1342	$self->{conn}->disconnect_ext ($self->{id});
		1343	}
928		1344
929	$self->SUPER::destroy;	1345	$self->SUPER::destroy;
930	}	1346	}
931		1347
932	1;	1348	1
		1349

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents): Revision 1.53 by root, Mon Jul 3 22:32:52 2006 UTC vs. Revision 1.120 by root, Sat Jul 14 13:04:42 2007 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents):
Revision 1.53 by root, Mon Jul 3 22:32:52 2006 UTC vs.
Revision 1.120 by root, Sat Jul 14 13:04:42 2007 UTC