ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Protocol.pm
Revision: 1.167
Committed: Tue Aug 28 01:23:47 2007 UTC (16 years, 9 months ago) by root
Branch: MAIN
Changes since 1.166: +0 -8 lines
Log Message:
- generalise keyboard handling a bit into a default
  keymapping + macro functions (such as "!completer shout").
- default keymappings ahve a lower priority, so its possible to
  (in theory) override them. a UI for this has not yet been created.
- re-enable NPOT texture usage, if available.

File Contents

# User Rev Content
1 root 1.69 package CFPlus::Protocol;
2 root 1.1
3     use utf8;
4     use strict;
5    
6 root 1.2 use Crossfire::Protocol::Constants;
7    
8 root 1.69 use CFPlus;
9 root 1.96 use CFPlus::DB;
10 root 1.69 use CFPlus::UI;
11     use CFPlus::Pod;
12 root 1.91 use CFPlus::Macro;
13     use CFPlus::Item;
14 root 1.1
15 root 1.87 use Crossfire::Protocol::Base 0.95;
16    
17 root 1.1 use base 'Crossfire::Protocol::Base';
18    
19     sub new {
20 root 1.101 my ($class, %arg) = @_;
21 root 1.1
22 root 1.101 my $self = $class->SUPER::new (%arg,
23 root 1.99 setup_req => {
24 root 1.101 extmap => 1,
25 root 1.103 excmd => 1,
26 root 1.155 xwidget1 => 1,#d#
27 root 1.101 %{$arg{setup_req} || {}},
28 root 1.99 },
29     );
30 root 1.1
31     $self->{map_widget}->clr_commands;
32    
33 root 1.72 my @cmd_help = map {
34     $_->{kw}[0] =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
35     or die "unparseable command help: $_->{kw}[0]";
36    
37     my $cmd = $1;
38     my @args = split /\|/, $2;
39     @args = (".*") unless @args;
40    
41     my (undef, @par) = CFPlus::Pod::section_of $_;
42     my $text = CFPlus::Pod::as_label @par;
43    
44     $_ = $_ eq ".*" ? "" : " $_"
45     for @args;
46    
47     map ["$cmd$_", $text],
48     sort { (length $a) <=> (length $b) }
49     @args
50 root 1.96 } sort { $a->{par} <=> $b->{par} }
51     CFPlus::Pod::find command => "*";
52 root 1.1
53 root 1.111 $self->{json_coder}
54     ->convert_blessed
55 root 1.130 ->filter_json_single_key_object (__w_ => sub {
56 root 1.111 $self->{widget}{$_[0]}
57     });
58    
59 root 1.123 # destroy widgets on logout
60 root 1.109 $self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub {
61     for my $ws (values %{delete $self->{widgetset} || {}}) {
62     $_->destroy
63     for values %{delete $ws->{w} || {}};
64     }
65     });
66    
67 root 1.96 $self->{map_widget}->add_command (@$_)
68     for @cmd_help;
69 root 1.1
70 root 1.83 {
71     $self->{dialogue} = my $tex = new_from_file CFPlus::Texture
72     CFPlus::find_rcfile "dialogue.png", minify => 1, mipmap => 1;
73     $self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}});
74     }
75    
76 root 1.96 {
77     $self->{noface} = my $tex = new_from_file CFPlus::Texture
78     CFPlus::find_rcfile "noface.png", minify => 1, mipmap => 1;
79     $self->{map}->set_texture (2, @$tex{qw(name w h s t)}, @{$tex->{minified}});
80     }
81    
82 root 1.1 $self->{open_container} = 0;
83    
84     # per server
85 root 1.96 $self->{mapcache} = "mapcache_$self->{host}_$self->{port}";
86 root 1.1
87     $self
88     }
89    
90 root 1.159 sub update_fx_want {
91     my ($self) = @_;
92    
93     $self->send_exti_msg (fx_want => {
94     3 => !!$::CFG->{bgm_enable}, # FT_MUSIC
95     5 => !!$::CFG->{audio_enable}, # FT_SOUND
96     6 => 1, # FT_RSRC
97     });
98     }
99    
100     sub ext_capabilities {
101     my ($self, %cap) = @_;
102    
103     #$self->send ("setup sound 0"); # we use a different protocol
104     $self->update_fx_want;
105    
106     $self->send_exti_req (resource => "exp_table", sub {
107     my ($exp_table) = @_;
108    
109     $self->register_face_handler ($exp_table, sub {
110     my ($face) = @_;
111    
112     $self->{exp_table} = $self->{json_coder}->decode (delete $face->{data});
113     $_->() for values %{ $self->{on_exp_update} || {} };
114     });
115    
116     ()
117     });
118    
119     if (my $ts = $cap{tileset}) {
120     if (my ($default) = grep $_->[2] & 1, @$ts) {
121     $self->{tileset} = $default;
122     $self->{tilesize} = $default->[3];
123     $self->setup_req (tileset => $default->[0]);
124    
125     my $w = int $self->{mapw} * 32 / $self->{tilesize};
126     my $h = int $self->{maph} * 32 / $self->{tilesize};
127    
128     $self->setup_req (mapsize => "${w}x${h}");
129     }
130     }
131     }
132    
133     sub ext_ambient_music {
134     my ($self, $songs) = @_;
135     &::audio_music_set_ambient ($songs);
136     }
137    
138     #############################################################################
139    
140 root 1.155 sub widget_associate {
141     my ($self, $ws, $id, $widget) = @_;
142    
143     if ($widget) {
144     $widget->{s_id} = $id;
145     $self->{widget}{$id} = $widget;
146    
147     if ($ws) {
148     $widget->{s_ws} = $ws;
149     $self->{widgetset}{$ws}{w}{$id} = $widget;
150     }
151    
152     $widget->connect (on_destroy => sub {
153     my ($widget) = @_;
154    
155     delete $self->{widget}{$widget->{s_id}};
156     delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}}
157     if exists $widget->{s_ws};
158     });
159    
160     1
161     } else {
162     $self->send_exti_msg (w_e => $id, undef);
163    
164     0
165     }
166     }
167    
168 root 1.159 # widgetset new
169     sub ext_ws_n {
170 root 1.160 my ($self, $id) = @_;
171 root 1.159
172     $self->{widgetset}{$id} = {
173     w => {},
174     };
175     }
176    
177     # widgetset destroy
178     sub ext_ws_d {
179 root 1.160 my ($self, $id) = @_;
180 root 1.159
181     my $ws = delete $self->{widgetset}{$id}
182     or return;
183    
184     $_->destroy
185     for values %{$ws->{w}};
186     }
187    
188     # widgetset create
189 root 1.160 sub ext_ws_c {
190     my ($self, $ws, $id, $class, $args) = @_;
191 root 1.159
192     for my $ev (grep /^on_/, keys %$args) {
193     my $rid = $args->{$ev};
194     $args->{$ev} = sub {
195     my $id = shift->{s_id};
196     $self->send_exti_msg (w_e => $id, $rid, @_);
197    
198     1
199     };
200     }
201    
202     $self->widget_associate (
203     $ws, $id => scalar eval {
204     local $SIG{__DIE__};
205     "CFPlus::UI::$class"->new (%$args)
206     }
207     ) or warn "server failed creating client-side widget " . (CFPlus::to_json $class) . ": $@\n";
208     }
209    
210     # widgetset associate
211     sub ext_ws_a {
212 root 1.160 my ($self, %ass) = @_;
213 root 1.159
214     # everything that has a name, wether conceivably useful or not
215     my %wkw = (
216     root => $CFPlus::UI::ROOT,
217     tooltip => $CFPlus::UI::TOOLTIP,
218    
219     mapwidget => $::MAPWIDGET,
220     buttonbar => $::BUTTONBAR,
221     metaserver => $::METASERVER,
222     buttonbar => $::BUTTONBAR,
223     login_button => $::LOGIN_BUTTON,
224     quit_dialog => $::QUIT_DIALOG,
225     host_entry => $::HOST_ENTRY,
226     metaserver => $::METASERVER,
227     server_info => $::SERVER_INFO,
228    
229     setup_dialog => $::SETUP_DIALOG,
230     setup_notebook => $::SETUP_NOTEBOOK,
231     setup_server => $::SETUP_SERVER,
232     setup_keyboard => $::SETUP_KEYBOARD,
233    
234     pl_notebook => $::PL_NOTEBOOK,
235     pl_window => $::PL_WINDOW,
236     inventory_page => $::INVENTORY_PAGE,
237     stats_page => $::STATS_PAGE,
238     skill_page => $::SKILL_PAGE,
239     spell_page => $::SPELL_PAGE,
240     spell_list => $::SPELL_LIST,
241    
242     floorbox => $::FLOORBOX,
243     help_window => $::HELP_WINDOW,
244     message_window => $::MESSAGE_WINDOW,
245     statusbox => $::SDTATUSBOX,
246    
247     inv => $::INV,
248     invr => $::INVR,
249     invr_hb => $::INVR_HB,
250     );
251    
252     while (my ($id, $name) = each %ass) {
253     $self->widget_associate (undef, $id => $wkw{$name})
254     or warn "server failed to associate non-existent well-known widget $name\n";
255     }
256     }
257    
258     # widget call
259     sub ext_w_c {
260 root 1.160 my ($self, $id, $rid, $method, @args) = @_;
261 root 1.159
262     my $w = $self->{widget}{$id}
263     or return;
264    
265     if ($rid) {
266     $self->send_exti_msg (w_r => $rid, $w->$method (@args));
267     } else {
268     $w->$method (@args);
269     }
270     }
271    
272     # widget set
273     sub ext_w_s {
274 root 1.160 my ($self, $id, $attr) = @_;
275 root 1.159
276     my $w = $self->{widget}{$id}
277     or return;
278    
279     for (my $i = 0; $i < $#$attr; $i += 2) {
280     my ($member, $value) = @$attr[$i, $i+1];
281     if (defined $value) {
282     $w->{$member} = $value;
283     } else {
284     delete $w->{$member};
285     }
286     $w->{parent}->realloc if $member =~ /^c_/ && $w->{visible};
287     }
288     }
289    
290     # widget get
291     sub ext_w_g {
292 root 1.160 my ($self, $id, $rid, $attr) = @_;
293 root 1.159
294     my $w = $self->{widget}{$id}
295     or return;
296    
297     $self->send_exti_msg (w_r => $rid, [map $w->{$_}, @$attr]);
298 root 1.160 }
299 root 1.147
300 root 1.159 # message window
301     sub ext_channel_info {
302 root 1.160 my ($self, $info) = @_;
303 root 1.159 $self->{channels}->{$info->{id}} = $info;
304     $::MESSAGE_WINDOW->add_channel ($info);
305 root 1.147 }
306    
307 root 1.159 #############################################################################
308    
309 elmex 1.34 sub logprint {
310     my ($self, @a) = @_;
311    
312 root 1.145 CFPlus::DB::logprint "$Crossfire::VARDIR/log.$self->{host}" => (join "", @a), sub { };
313 elmex 1.34 }
314    
315 root 1.52 sub _stat_numdiff {
316 root 1.54 my ($self, $name, $old, $new) = @_;
317 root 1.52
318     my $diff = $new - $old;
319 root 1.54
320     $diff = 0.01 * int $diff * 100;
321    
322     0.1 >= abs $diff ? ()
323     : $diff < 0 ? "$name$diff" : "$name+$diff"
324 root 1.52 }
325    
326     sub _stat_skillmaskdiff {
327 root 1.54 my ($self, $name, $old, $new) = @_;
328 root 1.52
329 root 1.54 my $diff = $old ^ $new
330     or return;
331 root 1.52
332 root 1.53 my @diff = map
333     {
334     $diff & $_
335     ? (($new & $_ ? "+" : "-") . $self->{spell_paths}{$_})
336     : ()
337     }
338     sort { $a <=> $b } keys %{$self->{spell_paths}};
339 root 1.52
340     join "", @diff
341     }
342    
343     # all stats that are chacked against changes
344     my @statchange = (
345     [&CS_STAT_STR => \&_stat_numdiff, "Str"],
346     [&CS_STAT_INT => \&_stat_numdiff, "Int"],
347     [&CS_STAT_WIS => \&_stat_numdiff, "Wis"],
348     [&CS_STAT_DEX => \&_stat_numdiff, "Dex"],
349     [&CS_STAT_CON => \&_stat_numdiff, "Con"],
350     [&CS_STAT_CHA => \&_stat_numdiff, "Cha"],
351     [&CS_STAT_POW => \&_stat_numdiff, "Pow"],
352     [&CS_STAT_WC => \&_stat_numdiff, "Wc"],
353     [&CS_STAT_AC => \&_stat_numdiff, "Ac"],
354     [&CS_STAT_DAM => \&_stat_numdiff, "Dam"],
355     [&CS_STAT_SPEED => \&_stat_numdiff, "Speed"],
356     [&CS_STAT_WEAP_SP => \&_stat_numdiff, "WSp"],
357     [&CS_STAT_MAXHP => \&_stat_numdiff, "HP"],
358     [&CS_STAT_MAXSP => \&_stat_numdiff, "Mana"],
359     [&CS_STAT_MAXGRACE => \&_stat_numdiff, "Grace"],
360     [&CS_STAT_WEIGHT_LIM => \&_stat_numdiff, "Weight"],
361     [&CS_STAT_SPELL_ATTUNE => \&_stat_skillmaskdiff, "attuned"],
362     [&CS_STAT_SPELL_REPEL => \&_stat_skillmaskdiff, "repelled"],
363     [&CS_STAT_SPELL_DENY => \&_stat_skillmaskdiff, "denied"],
364     [&CS_STAT_RES_PHYS => \&_stat_numdiff, "phys"],
365     [&CS_STAT_RES_MAG => \&_stat_numdiff, "magic"],
366     [&CS_STAT_RES_FIRE => \&_stat_numdiff, "fire"],
367     [&CS_STAT_RES_ELEC => \&_stat_numdiff, "electricity"],
368     [&CS_STAT_RES_COLD => \&_stat_numdiff, "cold"],
369     [&CS_STAT_RES_CONF => \&_stat_numdiff, "confusion"],
370     [&CS_STAT_RES_ACID => \&_stat_numdiff, "acid"],
371     [&CS_STAT_RES_DRAIN => \&_stat_numdiff, "drain"],
372     [&CS_STAT_RES_GHOSTHIT => \&_stat_numdiff, "ghosthit"],
373     [&CS_STAT_RES_POISON => \&_stat_numdiff, "poison"],
374     [&CS_STAT_RES_SLOW => \&_stat_numdiff, "slow"],
375     [&CS_STAT_RES_PARA => \&_stat_numdiff, "paralyse"],
376     [&CS_STAT_TURN_UNDEAD => \&_stat_numdiff, "turnundead"],
377     [&CS_STAT_RES_FEAR => \&_stat_numdiff, "fear"],
378     [&CS_STAT_RES_DEPLETE => \&_stat_numdiff, "depletion"],
379     [&CS_STAT_RES_DEATH => \&_stat_numdiff, "death"],
380     [&CS_STAT_RES_HOLYWORD => \&_stat_numdiff, "godpower"],
381     [&CS_STAT_RES_BLIND => \&_stat_numdiff, "blind"],
382     );
383    
384 root 1.1 sub stats_update {
385     my ($self, $stats) = @_;
386    
387 root 1.59 my $prev = $self->{prev_stats} || { };
388    
389     if (my @diffs =
390     (
391     ($stats->{+CS_STAT_EXP64} > $prev->{+CS_STAT_EXP64} ? ($stats->{+CS_STAT_EXP64} - $prev->{+CS_STAT_EXP64}) . " experience gained" : ()),
392     map {
393     $stats->{$_} && $prev->{$_}
394     && $stats->{$_}[1] > $prev->{$_}[1] ? "($self->{skill_info}{$_}+" . ($stats->{$_}[1] - $prev->{$_}[1]) . ")" : ()
395     } sort { $a <=> $b } keys %{$self->{skill_info}}
396     )
397     ) {
398     my $msg = join " ", @diffs;
399     $self->{statusbox}->add ($msg, group => "experience $msg", fg => [0.5, 1, 0.5, 0.8], timeout => 5);
400     }
401    
402     if (
403     my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange
404     ) {
405     my $msg = "<b>stat change</b>: " . (join " ", @diffs);
406 root 1.166 $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 20);
407 root 1.59 }
408    
409     $self->update_stats_window ($stats, $prev);
410    
411     $self->{prev_stats} = { %$stats };
412     }
413    
414     my %RES_TBL = (
415     phys => CS_STAT_RES_PHYS,
416     magic => CS_STAT_RES_MAG,
417     fire => CS_STAT_RES_FIRE,
418     elec => CS_STAT_RES_ELEC,
419     cold => CS_STAT_RES_COLD,
420     conf => CS_STAT_RES_CONF,
421     acid => CS_STAT_RES_ACID,
422     drain => CS_STAT_RES_DRAIN,
423     ghit => CS_STAT_RES_GHOSTHIT,
424     pois => CS_STAT_RES_POISON,
425     slow => CS_STAT_RES_SLOW,
426     para => CS_STAT_RES_PARA,
427     tund => CS_STAT_TURN_UNDEAD,
428     fear => CS_STAT_RES_FEAR,
429     depl => CS_STAT_RES_DEPLETE,
430     deat => CS_STAT_RES_DEATH,
431     holyw => CS_STAT_RES_HOLYWORD,
432     blind => CS_STAT_RES_BLIND,
433     );
434    
435     sub update_stats_window {
436     my ($self, $stats, $prev) = @_;
437    
438     # I love text protocols...
439 root 1.52
440 root 1.59 my $hp = $stats->{+CS_STAT_HP} * 1;
441     my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
442     my $sp = $stats->{+CS_STAT_SP} * 1;
443     my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
444     my $fo = $stats->{+CS_STAT_FOOD} * 1;
445     my $fo_m = 999;
446     my $gr = $stats->{+CS_STAT_GRACE} * 1;
447     my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
448    
449     $::GAUGES->{hp} ->set_value ($hp, $hp_m);
450     $::GAUGES->{mana} ->set_value ($sp, $sp_m);
451     $::GAUGES->{food} ->set_value ($fo, $fo_m);
452     $::GAUGES->{grace} ->set_value ($gr, $gr_m);
453     $::GAUGES->{exp} ->set_text ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64}))
454     . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
455 root 1.157 $::GAUGES->{prg} ->set_value ($stats->{+CS_STAT_LEVEL}, $stats->{+CS_STAT_EXP64});
456 root 1.106 $::GAUGES->{range} ->set_text ($stats->{+CS_STAT_RANGE});
457 root 1.59 my $title = $stats->{+CS_STAT_TITLE};
458     $title =~ s/^Player: //;
459     $::STATWIDS->{title} ->set_text ("Title: " . $title);
460    
461     $::STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
462     $::STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
463     $::STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
464     $::STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
465     $::STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
466     $::STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
467     $::STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
468     $::STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
469     $::STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
470     $::STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
471     $::STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_RES_PHYS});
472     $::STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
473     $::STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
474    
475 root 1.64 $self->update_weight;
476 root 1.59
477     $::STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$RES_TBL{$_}})
478     for keys %RES_TBL;
479    
480     my $sktbl = $::STATWIDS->{skill_tbl};
481     my @skills = keys %{ $self->{skill_info} };
482    
483 root 1.162 my @order = sort { $stats->{$b->[0]}[1] <=> $stats->{$a->[0]}[1] or $a->[1] cmp $b->[1] }
484     map [$_, $self->{skill_info}{$_}],
485     grep exists $stats->{$_},
486     @skills;
487    
488     if ($self->{stat_order} ne join ",", map $_->[0], @order) {
489     $self->{stat_order} = join ",", map $_->[0], @order;
490    
491 root 1.59 $sktbl->clear;
492    
493 root 1.158 my $sw = $self->{skillwid}{""} ||= [
494 root 1.124 0, 0, (new CFPlus::UI::Label text => "Experience", align => 1),
495     1, 0, (new CFPlus::UI::Label text => "Lvl.", align => 1),
496 root 1.157 2, 0, (new CFPlus::UI::Label text => "Progress", align => 0),
497     3, 0, (new CFPlus::UI::Label text => "Skill", expand => 1),
498     4, 0, (new CFPlus::UI::Label text => "Experience", align => 1),
499     5, 0, (new CFPlus::UI::Label text => "Lvl.", align => 1),
500     6, 0, (new CFPlus::UI::Label text => "Progress", align => 0),
501     7, 0, (new CFPlus::UI::Label text => "Skill", expand => 1),
502 root 1.158 ];
503    
504     my @add = @$sw;
505 root 1.59
506 elmex 1.68 my $TOOLTIP_ALL = "\n\n<small>Left click - ready skill\nMiddle click - use spell\nRight click - further options</small>";
507    
508     my @TOOLTIP_LVL = (tooltip => "<b>Level</b>. The level of the skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
509     my @TOOLTIP_EXP = (tooltip => "<b>Experience</b>. The experience points you have in this skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
510    
511 root 1.65 my ($x, $y) = (0, 1);
512 root 1.162 for (@order) {
513 root 1.59 my ($idx, $name) = @$_;
514    
515 elmex 1.68 my $spell_cb = sub {
516     my ($widget, $ev) = @_;
517    
518     if ($ev->{button} == 1) {
519     $::CONN->user_send ("ready_skill $name");
520     } elsif ($ev->{button} == 2) {
521     $::CONN->user_send ("use_skill $name");
522     } elsif ($ev->{button} == 3) {
523 root 1.90 my $shortname = CFPlus::shorten $name, 14;
524 root 1.69 (new CFPlus::UI::Menu
525 elmex 1.68 items => [
526 root 1.91 ["bind <i>ready_skill $shortname</i> to a key" => sub { CFPlus::Macro::quick_macro ["ready_skill $name"] }],
527     ["bind <i>use_skill $shortname</i> to a key" => sub { CFPlus::Macro::quick_macro ["use_skill $name"] }],
528 elmex 1.68 ],
529     )->popup ($ev);
530     } else {
531     return 0;
532     }
533    
534     1
535     };
536    
537 root 1.158 my $sw = $self->{skillwid}{$idx} ||= [
538     # exp
539     (new CFPlus::UI::Label
540     align => 1, font => $::FONT_FIXED, fg => [1, 1, 0], on_button_down => $spell_cb, @TOOLTIP_EXP),
541    
542     # level
543     (new CFPlus::UI::Label
544     text => "0", align => 1, font => $::FONT_FIXED, fg => [0, 1, 0], padding_x => 4, on_button_down => $spell_cb, @TOOLTIP_LVL),
545    
546     # progress
547     (new CFPlus::UI::ExperienceProgress),
548    
549     # label
550     (new CFPlus::UI::Label text => $name, on_button_down => $spell_cb,
551     can_events => 1, can_hover => 1, tooltip => (CFPlus::Pod::section_label skill_description => $name) . $TOOLTIP_ALL),
552     ];
553    
554 root 1.124 push @add,
555 root 1.158 $x * 4 + 0, $y, $sw->[0],
556     $x * 4 + 1, $y, $sw->[1],
557     $x * 4 + 2, $y, $sw->[2],
558     $x * 4 + 3, $y, $sw->[3],
559 root 1.124 ;
560 root 1.59
561     $x++ and ($x, $y) = (0, $y + 1);
562 root 1.52 }
563 root 1.124
564     $sktbl->add_at (@add);
565 root 1.1 }
566    
567 root 1.163 for (@order) {
568     my ($idx, $name) = @$_;
569     my $val = $stats->{$idx};
570    
571 root 1.166 next if $prev->{$idx}[1] eq $val->[1];
572 root 1.163
573     my $sw = $self->{skillwid}{$idx};
574     $sw->[0]->set_text (::formsep ($val->[1]));
575     $sw->[1]->set_text ($val->[0] * 1);
576     $sw->[2]->set_value (@$val);
577 root 1.162
578 root 1.164 $::GAUGES->{sklprg}->set_label ("$name %d%%");
579 root 1.163 $::GAUGES->{sklprg}->set_value (@$val);
580 root 1.59 }
581 root 1.1 }
582    
583     sub user_send {
584     my ($self, $command) = @_;
585    
586 root 1.91 $self->{record}->($command)
587 root 1.87 if $self->{record};
588 elmex 1.9
589 elmex 1.34 $self->logprint ("send: ", $command);
590 root 1.1 $self->send_command ($command);
591     }
592    
593 root 1.91 sub record {
594     my ($self, $cb) = @_;
595 elmex 1.9
596 root 1.91 $self->{record} = $cb;
597 elmex 1.9 }
598    
599 root 1.1 sub map_scroll {
600     my ($self, $dx, $dy) = @_;
601    
602     $self->{map}->scroll ($dx, $dy);
603     }
604    
605     sub feed_map1a {
606     my ($self, $data) = @_;
607    
608 root 1.148 my $missing = $self->{map}->map1a_update ($data, $self->{setup}{extmap});
609     my $delay;
610    
611     for my $tile (@$missing) {
612     next if $self->{delay}{$tile};
613    
614     $delay = 1;
615    
616     if (my $tex = $::CONN->{texture}[$tile]) {
617     $tex->upload;
618     } else {
619     $self->{delay}{$tile} = 1;
620    
621     # we assume the face is in-flight and will eventually come
622 root 1.156 push @{$self->{tile_cb}{$tile}}, sub {
623 root 1.148 delete $self->{delay}{$tile};
624     $_[0]->upload;
625     };
626     }
627     }
628    
629     if ($delay) {
630     # delay the map drawing a tiny bit in the hope of getting the missing fetched
631     Event->timer (after => 0.03, cb => sub {
632     $_[0]->w->cancel;
633 root 1.161 $self->{map_widget}->update
634     if $self->{map_widget};
635 root 1.148 });
636     } else {
637     $self->{map_widget}->update;
638     }
639 root 1.1 }
640    
641 root 1.36 sub magicmap {
642     my ($self, $w, $h, $x, $y, $data) = @_;
643    
644     $self->{map_widget}->set_magicmap ($w, $h, $x, $y, $data);
645     }
646    
647 root 1.1 sub flush_map {
648     my ($self) = @_;
649    
650     my $map_info = delete $self->{map_info}
651     or return;
652    
653     my ($hash, $x, $y, $w, $h) = @$map_info;
654    
655 root 1.153 my $data = Compress::LZF::compress $self->{map}->get_rect ($x, $y, $w, $h);
656     $self->{map_cache_new}{$hash} = \$data;
657     CFPlus::DB::put $self->{mapcache} => $hash => $data, sub { };
658 root 1.1 }
659    
660     sub map_clear {
661     my ($self) = @_;
662    
663     $self->flush_map;
664     delete $self->{neigh_map};
665    
666     $self->{map}->clear;
667 root 1.37 delete $self->{map_widget}{magicmap};
668 root 1.1 }
669    
670 root 1.97 sub bg_fetch {
671     my ($self) = @_;
672    
673 root 1.156 my $tile;
674 root 1.97
675     do {
676 root 1.156 $tile = pop @{$self->{bg_fetch}}
677 root 1.97 or return;
678 root 1.156 } while $self->{texture}[$tile];
679 root 1.97
680 root 1.156 CFPlus::DB::get tilecache => $tile, sub {
681     my ($data) = @_;
682 root 1.97
683 root 1.98 return unless $self->{map}; # stop when destroyed
684    
685 root 1.156 if (defined $data) {
686     $self->have_tile ($tile, $data);
687     $self->{texture}[$tile]->upload;
688 root 1.150 }
689 root 1.97
690     $self->bg_fetch;
691     };
692     }
693 root 1.1
694     sub load_map($$$) {
695     my ($self, $hash, $x, $y) = @_;
696    
697 root 1.100 my $gen = $self->{map_change_gen};
698    
699 root 1.152 my $cb = sub {
700 root 1.100 return unless $gen == $self->{map_change_gen};
701    
702 root 1.96 my ($data) = @_;
703    
704     if (defined $data) {
705 root 1.152 $self->{map_cache_new}{$hash} = \$data;
706    
707     my $data = Compress::LZF::decompress $data;
708 root 1.1
709 root 1.97 my $inprogress = @{ $self->{bg_fetch} || [] };
710 root 1.98 unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $data);
711 root 1.97 $self->bg_fetch unless $inprogress;
712 root 1.1 }
713 root 1.96 };
714 root 1.152
715     if (my $rdata = $self->{map_cache_old}{$hash}) {
716     $cb->($$rdata);
717     } else {
718     CFPlus::DB::get $self->{mapcache} => $hash, $cb;
719     }
720 root 1.1 }
721    
722     # hardcode /world/world_xxx_xxx map names, the savings are enourmous,
723     # (server resource,s latency, bandwidth), so this hack is warranted.
724     # the right fix is to make real tiled maps with an overview file
725     sub send_mapinfo {
726     my ($self, $data, $cb) = @_;
727    
728     if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
729     my ($wx, $wy) = ($1, $2);
730    
731     if ($data =~ /^spatial ([1-4]+)$/) {
732     my @dx = (0, 0, 1, 0, -1);
733     my @dy = (0, -1, 0, 1, 0);
734     my ($dx, $dy);
735    
736     for (split //, $1) {
737     $dx += $dx[$_];
738     $dy += $dy[$_];
739     }
740    
741     $cb->(spatial => 15,
742     $self->{map_info}[1] - $self->{map}->ox + $dx * 50,
743     $self->{map_info}[2] - $self->{map}->oy + $dy * 50,
744     50, 50,
745     sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
746     );
747    
748     return;
749     }
750     }
751    
752     $self->SUPER::send_mapinfo ($data, $cb);
753     }
754    
755     # this method does a "flood fill" into every tile direction
756     # it assumes that tiles are arranged in a rectangular grid,
757     # i.e. a map is the same as the left of the right map etc.
758     # failure to comply are harmless and result in display errors
759     # at worst.
760     sub flood_fill {
761     my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
762    
763     # the server does not allow map paths > 6
764     return if 7 <= length $path;
765    
766     my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
767    
768     for (
769     [1, 3, 0, -1],
770     [2, 4, 1, 0],
771     [3, 1, 0, 1],
772     [4, 2, -1, 0],
773     ) {
774     my ($tile, $tile2, $dx, $dy) = @$_;
775    
776     next if $block & (1 << $tile);
777     my $block = $block | (1 << $tile2);
778    
779     my $gx = $gx + $dx;
780     my $gy = $gy + $dy;
781    
782     next unless $flags & (1 << ($tile - 1));
783     next if $self->{neigh_grid}{$gx, $gy}++;
784    
785     my $neigh = $self->{neigh_map}{$hash} ||= [];
786     if (my $info = $neigh->[$tile]) {
787     my ($flags, $x, $y, $w, $h, $hash) = @$info;
788    
789     $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
790     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
791    
792     } else {
793 root 1.100 my $gen = $self->{map_change_gen};
794 root 1.1 $self->send_mapinfo ("spatial $path$tile", sub {
795 root 1.100 return unless $gen == $self->{map_change_gen};
796    
797 root 1.1 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
798    
799     return if $mode ne "spatial";
800    
801     $x += $self->{map}->ox;
802     $y += $self->{map}->oy;
803    
804     $self->load_map ($hash, $x, $y)
805     unless $self->{neigh_map}{$hash}[5]++;#d#
806    
807     $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
808    
809     $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
810     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
811     });
812     }
813     }
814     }
815    
816     sub map_change {
817     my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
818    
819     $self->flush_map;
820    
821 root 1.100 ++$self->{map_change_gen};
822 root 1.152 $self->{map_cache_old} = delete $self->{map_cache_new};
823 root 1.100
824 root 1.1 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
825    
826     my $mapmapw = $self->{mapmap}->{w};
827     my $mapmaph = $self->{mapmap}->{h};
828    
829     $self->{neigh_rect} = [
830     $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
831     $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
832     ];
833    
834     delete $self->{neigh_grid};
835    
836     $x += $ox;
837     $y += $oy;
838    
839     $self->{map_info} = [$hash, $x, $y, $w, $h];
840    
841     (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
842     $::STATWIDS->{map}->set_text ("Map: " . $map);
843    
844     $self->load_map ($hash, $x, $y);
845     $self->flood_fill (0, 0, 0, "", $hash, $flags);
846     }
847    
848     sub face_find {
849 root 1.96 my ($self, $facenum, $face, $cb) = @_;
850 root 1.1
851 root 1.131 if ($face->{type} == 0) { # FT_FACE
852     my $id = CFPlus::DB::get_tile_id_sync $face->{name};
853 root 1.1
854 root 1.156 $face->{id} = $id;
855 root 1.131 $self->{map}->set_tileid ($facenum => $id);
856 root 1.1
857 root 1.131 CFPlus::DB::get tilecache => $id, $cb;
858 root 1.1
859 root 1.131 } elsif ($face->{type} & 1) { # with metadata
860 root 1.140 CFPlus::DB::get res_meta => $face->{name}, $cb;
861 root 1.156
862     } else { # no metadata
863     CFPlus::DB::get res_data => $face->{name}, $cb;
864 root 1.131 }
865 root 1.1 }
866    
867     sub face_update {
868 root 1.58 my ($self, $facenum, $face, $changed) = @_;
869 root 1.1
870 root 1.156 if ($face->{type} == 0) {
871     # image, FT_FACE
872 root 1.132 CFPlus::DB::put tilecache => $face->{id} => $face->{data}, sub { }
873 root 1.131 if $changed;
874    
875 root 1.156 $self->have_tile ($face->{id}, delete $face->{data});
876 root 1.1
877 root 1.156 } elsif ($face->{type} & 1) {
878     # split metadata case, FT_MUSIC, FT_SOUND
879 root 1.147 if ($changed) { # new data
880 root 1.156 my ($meta, $data) = unpack "(w/a*)*", $face->{data};
881     $face->{data} = $meta;
882 root 1.147
883     CFPlus::DB::put res_data => $face->{name} => $data, sub { };
884 root 1.156 CFPlus::DB::put res_meta => $face->{name} => $meta, sub { };
885 root 1.147 }
886    
887 root 1.156 $face->{data} = $self->{json_coder}->decode ($face->{data});
888    
889 root 1.147 ::add_license ($face);
890 root 1.131
891     if ($face->{type} == 3) { # FT_MUSIC
892 root 1.147 ::message ({ markup => "downloaded song #$facenum" })
893     if $changed;
894 root 1.131
895 root 1.147 &::audio_music_push ($facenum);
896 root 1.139 } elsif ($face->{type} == 5) { # FT_SOUND
897 root 1.147 ::message ({ markup => "downloaded sound #$facenum" })
898     if $changed;
899 root 1.141
900 root 1.147 &::audio_sound_push ($facenum);
901 root 1.131 }
902    
903 root 1.156 } else {
904     # flat resource case, FT_RSRC
905     CFPlus::DB::put res_data => $face->{name} => $face->{data}, sub { }
906     if $changed;
907     }
908    
909     if (my $cbs = $self->{face_cb}{$facenum}) {
910     $_->($face, $changed) for @$cbs;
911 root 1.131 }
912 root 1.1 }
913    
914 root 1.99 sub smooth_update {
915     my ($self, $facenum, $face) = @_;
916    
917     $self->{map}->set_smooth ($facenum, $face->{smoothface}, $face->{smoothlevel});
918     }
919    
920 root 1.146 sub have_tile {
921 root 1.156 my ($self, $tile, $data) = @_;
922 root 1.1
923 root 1.118 return unless $self->{map};
924    
925 root 1.148 my $tex = $self->{texture}[$tile] ||=
926 root 1.146 new CFPlus::Texture
927 root 1.156 tile => $tile,
928     image => $data, delete_image => 1,
929     minify => 1, mipmap => 1;
930 root 1.122
931 root 1.156 if (my $cbs = delete $self->{tile_cb}{$tile}) {
932     $_->($tex) for @$cbs;
933     }
934     }
935    
936     # call in non-void context registers a temporary
937     # hook with handle, otherwise its permanent
938     sub on_face_change {
939     my ($self, $num, $cb) = @_;
940    
941     push @{$self->{face_cb}{$num}}, $cb;
942    
943     defined wantarray
944     ? CFPlus::guard {
945     @{$self->{face_cb}{$num}}
946     = grep $_ != $cb,
947     @{$self->{face_cb}{$num}};
948     }
949     : ()
950 root 1.122 }
951    
952 root 1.156 # call in non-void context registers a temporary
953     # hook with handle, otherwise its permanent
954     sub register_face_handler {
955     my ($self, $num, $cb) = @_;
956 root 1.122
957 root 1.157 return unless $num;
958    
959 root 1.156 # invoke if available right now
960     $cb->($self->{face}[$num], 0)
961     unless exists $self->{face}[$num]{loading};
962 root 1.122
963 root 1.156 # future changes
964     $self->on_face_change ($num => $cb)
965 root 1.1 }
966    
967     sub sound_play {
968 root 1.141 my ($self, $type, $face, $dx, $dy, $vol) = @_;
969 root 1.1
970 root 1.141 &::audio_sound_play ($face, $dx, $dy, $vol)
971     unless $type & 1; # odd types are silent for future expansion
972 root 1.1 }
973    
974     my $LAST_QUERY; # server is stupid, stupid, stupid
975    
976     sub query {
977     my ($self, $flags, $prompt) = @_;
978    
979     $prompt = $LAST_QUERY unless length $prompt;
980     $LAST_QUERY = $prompt;
981    
982 root 1.22 $self->{query}-> ($self, $flags, $prompt);
983 root 1.1 }
984    
985 root 1.108 sub sanitise_xml($) {
986     local $_ = shift;
987    
988     # we now weed out all tags we do not support
989     s%<(?!/?i>|/?u>|/?b>|fg |/fg>)%&lt;%g;
990     # now all entities
991     s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&amp;/g;
992    
993     # handle some elements
994     s/<fg name='([^']*)'>(.*?)<\/fg>/<span foreground='$1'>$2<\/span>/gs;
995     s/<fg name="([^"]*)">(.*?)<\/fg>/<span foreground="$1">$2<\/span>/gs;
996    
997     $_
998     }
999    
1000 root 1.105 our %NAME_TO_COLOR = (
1001     black => 0,
1002     white => 1,
1003     darkblue => 2,
1004     red => 3,
1005     orange => 4,
1006     lightblue => 5,
1007     darkorange => 6,
1008     green => 7,
1009     darkgreen => 8,
1010     grey => 9,
1011     brown => 10,
1012     yellow => 11,
1013     tan => 12,
1014     );
1015    
1016 root 1.103 our @CF_COLOR = (
1017     [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1018     [1.00, 1.00, 1.00],
1019     [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1020     [1.00, 0.00, 0.00],
1021     [1.00, 0.54, 0.00],
1022     [0.11, 0.56, 1.00],
1023     [0.93, 0.46, 0.00],
1024     [0.18, 0.54, 0.34],
1025     [0.56, 0.73, 0.56],
1026     [0.80, 0.80, 0.80],
1027     [0.75, 0.61, 0.20],
1028     [0.99, 0.77, 0.26],
1029     [0.74, 0.65, 0.41],
1030     );
1031    
1032 root 1.105 sub msg {
1033     my ($self, $color, $type, $text, @extra) = @_;
1034 root 1.1
1035 root 1.108 $text = sanitise_xml $text;
1036 root 1.107
1037 root 1.105 if (my $cb = $self->{cb_msg}{$type}) {
1038     $_->($self, $color, $type, $text, @extra) for values %$cb;
1039     } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) {
1040     $type =~ s/-/_/g;
1041     $self->{$type} = $text;
1042     } else {
1043     $self->logprint ("msg: ", $text);
1044     return if $color < 0; # negative color == ignore if not understood
1045 root 1.93
1046 elmex 1.154 my $fg = $CF_COLOR[$color & NDI_COLOR_MASK] || [1, 0, 0];
1047 elmex 1.34
1048 root 1.105 ## try to create single paragraphs of multiple lines sent by the server
1049     # no longer neecssary with TRT servers
1050     #$text =~ s/(?<=\S)\n(?=\w)/ /g;
1051    
1052 elmex 1.154 ::message ({
1053     fg => $fg,
1054     markup => $_,
1055     type => $type,
1056     extra => [@extra],
1057     color_flags => $color
1058     }) for split /\n/, $text;
1059 root 1.105
1060     $self->{statusbox}->add ($text,
1061     group => $text,
1062     fg => $fg,
1063     timeout => $color >= 2 ? 180 : 10,
1064     tooltip_font => $::FONT_FIXED,
1065     );
1066     }
1067 root 1.1 }
1068    
1069     sub spell_add {
1070     my ($self, $spell) = @_;
1071    
1072 root 1.66 # try to create single paragraphs out of the multiple lines sent by the server
1073 root 1.27 $spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g;
1074     $spell->{message} =~ s/\n+$//;
1075     $spell->{message} ||= "Server did not provide a description for this spell.";
1076    
1077 root 1.88 $::SPELL_LIST->add_spell ($spell);
1078 elmex 1.14
1079 root 1.69 $self->{map_widget}->add_command ("invoke $spell->{name}", CFPlus::asxml $spell->{message});
1080     $self->{map_widget}->add_command ("cast $spell->{name}", CFPlus::asxml $spell->{message});
1081 root 1.1 }
1082    
1083     sub spell_delete {
1084     my ($self, $spell) = @_;
1085 root 1.51
1086 root 1.88 $::SPELL_LIST->remove_spell ($spell);
1087 root 1.1 }
1088    
1089 root 1.87 sub setup {
1090     my ($self, $setup) = @_;
1091    
1092 root 1.95 $self->{map_widget}->set_tilesize ($self->{tilesize});
1093 root 1.87 $::MAP->resize ($self->{mapw}, $self->{maph});
1094     }
1095    
1096 root 1.1 sub addme_success {
1097     my ($self) = @_;
1098    
1099 root 1.72 my %skill_help;
1100 root 1.21
1101 root 1.72 for my $node (CFPlus::Pod::find skill_description => "*") {
1102     my (undef, @par) = CFPlus::Pod::section_of $node;
1103     $skill_help{$node->{kw}[0]} = CFPlus::Pod::as_label @par;
1104 root 1.21 };
1105 root 1.72
1106 root 1.1 for my $skill (values %{$self->{skill_info}}) {
1107     $self->{map_widget}->add_command ("ready_skill $skill",
1108 root 1.69 (CFPlus::asxml "Ready the skill '$skill'\n\n")
1109 root 1.72 . $skill_help{$skill});
1110 root 1.1 $self->{map_widget}->add_command ("use_skill $skill",
1111 root 1.69 (CFPlus::asxml "Immediately use the skill '$skill'\n\n")
1112 root 1.72 . $skill_help{$skill});
1113 root 1.1 }
1114     }
1115    
1116     sub eof {
1117     my ($self) = @_;
1118    
1119     $self->{map_widget}->clr_commands;
1120    
1121     ::stop_game ();
1122     }
1123    
1124     sub update_floorbox {
1125 root 1.69 $CFPlus::UI::ROOT->on_refresh ($::FLOORBOX => sub {
1126 root 1.1 return unless $::CONN;
1127 elmex 1.62
1128 root 1.1 $::FLOORBOX->clear;
1129    
1130 root 1.124 my @add;
1131    
1132 root 1.1 my $row;
1133 elmex 1.62 for (sort { $a->{count} <=> $b->{count} } values %{ $::CONN->{container}{$::CONN->{open_container} || 0} }) {
1134 root 1.25 if ($row < 6) {
1135 root 1.1 local $_->{face_widget}; # hack to force recreation of widget
1136     local $_->{desc_widget}; # hack to force recreation of widget
1137 root 1.69 CFPlus::Item::update_widgets $_;
1138 root 1.1
1139 root 1.124 push @add,
1140     0, $row, $_->{face_widget},
1141     1, $row, $_->{desc_widget};
1142 root 1.1
1143     $row++;
1144     } else {
1145 root 1.124 push @add, 1, $row, new CFPlus::UI::Button
1146 root 1.30 text => "More...",
1147 root 1.51 on_activate => sub { ::toggle_player_page ($::INVENTORY_PAGE); 0 },
1148 root 1.124 ;
1149 root 1.1 last;
1150     }
1151     }
1152 elmex 1.62 if ($::CONN->{open_container}) {
1153 root 1.124 push @add, 1, $row++, new CFPlus::UI::Button
1154 elmex 1.62 text => "Close container",
1155     on_activate => sub { $::CONN->send ("apply $::CONN->{open_container}") }
1156 root 1.124 ;
1157 elmex 1.62 }
1158 root 1.124
1159     $::FLOORBOX->add_at (@add);
1160 root 1.1 });
1161 elmex 1.62
1162 root 1.148 $::WANT_REFRESH->start;
1163 root 1.1 }
1164    
1165     sub set_opencont {
1166     my ($conn, $tag, $name) = @_;
1167     $conn->{open_container} = $tag;
1168 elmex 1.62 update_floorbox;
1169 elmex 1.10
1170 root 1.155 $::INVR_HB->clear ();
1171     $::INVR_HB->add (new CFPlus::UI::Label align => 0, expand => 1, text => $name);
1172 elmex 1.10
1173     if ($tag != 0) { # Floor isn't closable, is it?
1174 root 1.155 $::INVR_HB->add (new CFPlus::UI::Button
1175 elmex 1.10 text => "Close container",
1176     tooltip => "Close the currently open container (if one is open)",
1177     on_activate => sub {
1178     $::CONN->send ("apply $tag") # $::CONN->{open_container}")
1179     if $tag != 0;
1180 root 1.38 0
1181 elmex 1.10 },
1182     );
1183     }
1184    
1185 root 1.1 $::INVR->set_items ($conn->{container}{$tag});
1186     }
1187    
1188 root 1.47 sub update_containers {
1189     my ($self) = @_;
1190 root 1.1
1191 root 1.69 $CFPlus::UI::ROOT->on_refresh ("update_containers_$self" => sub {
1192 root 1.55 my $todo = delete $self->{update_container}
1193     or return;
1194    
1195     for my $tag (keys %$todo) {
1196 elmex 1.62 update_floorbox if $tag == 0 or $tag == $self->{open_container};
1197 root 1.47 if ($tag == 0) {
1198 root 1.48 $::INVR->set_items ($self->{container}{0})
1199     if $tag == $self->{open_container};
1200 root 1.47 } elsif ($tag == $self->{player}{tag}) {
1201     $::INV->set_items ($self->{container}{$tag})
1202     } else {
1203 root 1.48 $::INVR->set_items ($self->{container}{$tag})
1204     if $tag == $self->{open_container};
1205 root 1.47 }
1206     }
1207     });
1208 root 1.1 }
1209    
1210 root 1.48 sub container_add {
1211     my ($self, $tag, $items) = @_;
1212    
1213     $self->{update_container}{$tag}++;
1214     $self->update_containers;
1215     }
1216    
1217 root 1.1 sub container_clear {
1218     my ($self, $tag) = @_;
1219    
1220 root 1.47 $self->{update_container}{$tag}++;
1221     $self->update_containers;
1222 root 1.1 }
1223    
1224     sub item_delete {
1225     my ($self, @items) = @_;
1226    
1227 root 1.49 $self->{update_container}{$_->{container}}++
1228 root 1.47 for @items;
1229    
1230     $self->update_containers;
1231 root 1.1 }
1232    
1233     sub item_update {
1234     my ($self, $item) = @_;
1235    
1236     #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n";
1237    
1238 root 1.69 CFPlus::Item::update_widgets $item;
1239 root 1.1
1240 root 1.2 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {
1241 root 1.1 set_opencont ($::CONN, 0, "Floor");
1242    
1243 root 1.2 } elsif ($item->{flags} & F_OPEN) {
1244 root 1.69 set_opencont ($::CONN, $item->{tag}, CFPlus::Item::desc_string $item);
1245 root 1.47
1246 root 1.1 } else {
1247 root 1.47 $self->{update_container}{$item->{container}}++;
1248     $self->update_containers;
1249 root 1.1 }
1250     }
1251    
1252 elmex 1.3 sub player_update {
1253     my ($self, $player) = @_;
1254 root 1.64
1255     $self->update_weight;
1256     }
1257    
1258     sub update_weight {
1259     my ($self) = @_;
1260    
1261     my $weight = .001 * $self->{player}{weight};
1262     my $limit = .001 * $self->{stat}{+CS_STAT_WEIGHT_LIM};
1263    
1264     $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $weight);
1265     $::STATWIDS->{m_weight}->set_text (sprintf "%.1fkg", $limit);
1266     $::STATWIDS->{i_weight}->set_text (sprintf "%.1f/%.1fkg", $weight, $limit);
1267 root 1.28 }
1268    
1269 root 1.32 sub update_server_info {
1270     my ($self) = @_;
1271    
1272     my @yesno = ("<span foreground='red'>no</span>", "<span foreground='green'>yes</span>");
1273    
1274     $::SERVER_INFO->set_markup (
1275     "server <tt>$self->{host}:$self->{port}</tt>\n"
1276     . "protocol version <tt>$self->{version}</tt>\n"
1277     . "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"
1278     . "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"
1279 root 1.104 . "examine command support $yesno[$self->{setup}{excmd} > 0]\n"
1280 root 1.86 . "editing support $yesno[!!$self->{editor_support}]\n"
1281 root 1.80 . "map attributes $yesno[$self->{setup}{extmap} > 0]\n"
1282 root 1.104 . "big image protocol support $yesno[$self->{setup}{fxix} > 0]\n"
1283 root 1.32 . "cfplus support $yesno[$self->{cfplus_ext} > 0]"
1284     . ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"
1285     . "map size $self->{mapw}×$self->{maph}\n"
1286     );
1287 elmex 1.89
1288 root 1.32 }
1289    
1290 root 1.28 sub logged_in {
1291     my ($self) = @_;
1292    
1293 root 1.128 $self->send_ext_req (cfplus_support => version => 2, sub {
1294     my (%msg) = @_;
1295    
1296     $self->{cfplus_ext} = $msg{version};
1297 root 1.32 $self->update_server_info;
1298 root 1.70
1299 root 1.85 if ($self->{cfplus_ext} >= 2) {
1300     $self->send_ext_req ("editor_support", sub {
1301 root 1.128 $self->{editor_support} = { @_ };
1302 root 1.85 $self->update_server_info;
1303    
1304     0
1305     });
1306     }
1307    
1308 root 1.70 0
1309 root 1.32 });
1310 root 1.31
1311 root 1.32 $self->update_server_info;
1312 root 1.13
1313     $self->send_command ("output-sync $::CFG->{output_sync}");
1314     $self->send_command ("output-count $::CFG->{output_count}");
1315 root 1.94 $self->send_command ("output-rate $::CFG->{output_rate}") if $::CFG->{output_rate} > 0;
1316 root 1.29 $self->send_command ("pickup $::CFG->{pickup}");
1317 elmex 1.3 }
1318    
1319 root 1.32 sub lookat {
1320     my ($self, $x, $y) = @_;
1321    
1322     if ($self->{cfplus_ext}) {
1323 root 1.128 $self->send_ext_req (lookat => $x, $y, sub {
1324     my (%msg) = @_;
1325 root 1.32
1326 root 1.128 if (exists $msg{npc_dialog}) {
1327 root 1.32 # start npc chat dialog
1328 root 1.69 $self->{npc_dialog} = new CFPlus::NPCDialog::
1329 root 1.128 token => $msg{npc_dialog},
1330     title => "$msg{npc_dialog}[0] (NPC)",
1331 root 1.32 conn => $self,
1332     ;
1333     }
1334     });
1335     }
1336    
1337     $self->send ("lookat $x $y");
1338     }
1339    
1340     sub destroy {
1341     my ($self) = @_;
1342    
1343 root 1.79 (delete $self->{npc_dialog})->destroy
1344 root 1.32 if $self->{npc_dialog};
1345    
1346     $self->SUPER::destroy;
1347 root 1.111
1348     %$self = ();
1349 root 1.32 }
1350    
1351 root 1.69 package CFPlus::NPCDialog;
1352 root 1.32
1353 root 1.76 our @ISA = 'CFPlus::UI::Toplevel';
1354 root 1.32
1355     sub new {
1356     my $class = shift;
1357    
1358     my $self = $class->SUPER::new (
1359     x => 'center',
1360     y => 'center',
1361     name => "npc_dialog",
1362     force_w => $::WIDTH * 0.7,
1363     force_h => $::HEIGHT * 0.7,
1364     title => "NPC Dialog",
1365     kw => { hi => 0, yes => 0, no => 0 },
1366 root 1.64 has_close_button => 1,
1367 root 1.32 @_,
1368     );
1369    
1370 root 1.92 CFPlus::weaken (my $this = $self);
1371 root 1.32
1372 root 1.64 $self->connect (delete => sub { $this->destroy; 1 });
1373    
1374 root 1.32 # better use a pane...
1375 root 1.69 $self->add (my $hbox = new CFPlus::UI::HBox);
1376     $hbox->add ($self->{textview} = new CFPlus::UI::TextScroller expand => 1);
1377 root 1.32
1378 root 1.69 $hbox->add (my $vbox = new CFPlus::UI::VBox);
1379 root 1.32
1380 root 1.69 $vbox->add (new CFPlus::UI::Label text => "Message Entry:");
1381     $vbox->add ($self->{entry} = new CFPlus::UI::Entry
1382 root 1.73 tooltip => "#npc_message_entry",
1383 root 1.32 on_activate => sub {
1384     my ($entry, $text) = @_;
1385    
1386     return unless $text =~ /\S/;
1387    
1388     $entry->set_text ("");
1389     $this->send ($text);
1390 root 1.38
1391     0
1392 root 1.32 },
1393     );
1394    
1395 root 1.69 $vbox->add ($self->{options} = new CFPlus::UI::VBox);
1396 root 1.32
1397 root 1.69 $self->{bye_button} = new CFPlus::UI::Button
1398 root 1.32 text => "Bye (close)",
1399     tooltip => "Use this button to end talking to the NPC. This also closes the dialog window.",
1400 root 1.64 on_activate => sub { $this->destroy; 1 },
1401 root 1.32 ;
1402    
1403     $self->update_options;
1404    
1405 root 1.128 $self->{id} = "npc-channel-" . $self->{conn}->token;
1406     $self->{conn}->connect_ext ($self->{id} => sub {
1407     $this->feed (@_) if $this;
1408     });
1409    
1410     $self->{conn}->send_ext_msg (npc_dialog_begin => $self->{id}, $self->{token});
1411 root 1.32
1412 root 1.38 $self->{entry}->grab_focus;
1413 root 1.32
1414 root 1.67 $self->{textview}->add_paragraph ({
1415     fg => [1, 1, 0, 1],
1416     markup => "<small>[starting conversation with <b>$self->{title}</b>]</small>\n\n",
1417     });
1418 root 1.32
1419     $self->show;
1420     $self
1421     };
1422    
1423     sub update_options {
1424     my ($self) = @_;
1425    
1426 root 1.92 CFPlus::weaken $self;
1427 root 1.32
1428     $self->{options}->clear;
1429 root 1.39 $self->{options}->add ($self->{bye_button});
1430 root 1.32
1431     for my $kw (sort keys %{ $self->{kw} }) {
1432 root 1.69 $self->{options}->add (new CFPlus::UI::Button
1433 root 1.32 text => $kw,
1434     on_activate => sub {
1435     $self->send ($kw);
1436 root 1.38 0
1437 root 1.32 },
1438     );
1439     }
1440     }
1441    
1442     sub feed {
1443 root 1.128 my ($self, $type, @arg) = @_;
1444 root 1.32
1445 root 1.92 CFPlus::weaken $self;
1446 root 1.42
1447 root 1.128 if ($type eq "update") {
1448     my (%info) = @arg;
1449 root 1.41
1450 root 1.128 $self->{kw}{$_} = 1 for @{$info{add_topics} || []};
1451     $self->{kw}{$_} = 0 for @{$info{del_topics} || []};
1452 root 1.32
1453 root 1.128 if (exists $info{msg}) {
1454     my $text = "\n" . CFPlus::Protocol::sanitise_xml $info{msg};
1455     my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };
1456     my @link;
1457     $text =~ s{
1458     ($match)
1459     }{
1460     my $kw = $1;
1461    
1462     push @link, new CFPlus::UI::Label
1463     markup => "<span foreground='#c0c0ff' underline='single'>$kw</span>",
1464     can_hover => 1,
1465     can_events => 1,
1466     padding_x => 0,
1467     padding_y => 0,
1468     on_button_up => sub {
1469     $self->send ($kw);
1470     };
1471    
1472     "\x{fffc}"
1473     }giex;
1474    
1475     $self->{textview}->add_paragraph ({ markup => $text, widget => \@link });
1476     $self->{textview}->scroll_to_bottom;
1477     }
1478    
1479 root 1.32 $self->update_options;
1480     } else {
1481     $self->destroy;
1482     }
1483    
1484     1
1485     }
1486    
1487     sub send {
1488     my ($self, $msg) = @_;
1489    
1490 root 1.69 $self->{textview}->add_paragraph ({ markup => "\n" . CFPlus::asxml $msg });
1491 root 1.42 $self->{textview}->scroll_to_bottom;
1492 root 1.61
1493 root 1.128 $self->{conn}->send_ext_msg (npc_dialog_tell => $self->{id}, $msg);
1494 root 1.32 }
1495    
1496     sub destroy {
1497     my ($self) = @_;
1498    
1499 root 1.39 #Carp::cluck "debug\n";#d# #todo# enable: destroy gets called twice because scalar keys {} is 1
1500 root 1.32
1501 root 1.70 if ($self->{conn}) {
1502 root 1.128 $self->{conn}->send_ext_msg (npc_dialog_end => $self->{id}) if $self->{id};
1503 root 1.70 delete $self->{conn}{npc_dialog};
1504     $self->{conn}->disconnect_ext ($self->{id});
1505     }
1506 root 1.32
1507     $self->SUPER::destroy;
1508     }
1509    
1510 root 1.67 1
1511 root 1.84