ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Protocol.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents):
Revision 1.49 by root, Wed Jun 28 23:39:15 2006 UTC vs.
Revision 1.59 by root, Sun Jul 16 23:30:08 2006 UTC

… …
7 7
8use CFClient; 8use CFClient;
9use CFClient::UI; 9use CFClient::UI;
10 10
11use base 'Crossfire::Protocol::Base'; 11use base 'Crossfire::Protocol::Base';
12
13our %open_logs;
14 12
15sub new { 13sub new {
16 my $class = shift; 14 my $class = shift;
17 15
18 my $self = $class->SUPER::new (@_); 16 my $self = $class->SUPER::new (@_);
… …
63 $self 61 $self
64} 62}
65 63
66sub logprint { 64sub logprint {
67 my ($self, @a) = @_; 65 my ($self, @a) = @_;
66
67 $self->{log_fh} ||= do {
68 my $filename = "$Crossfire::VARDIR/log.$self->{host}"; 68 my $path = "$Crossfire::VARDIR/log.$self->{host}";
69 69
70 my $fh = $open_logs{$filename}; 70 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}: $!"; 71 or die "Couldn't open logfile $path: $!";
75 72
76 $open_logs{$filename} = $fh; 73 $fh->autoflush (1);
74
75 $fh;
77 } 76 };
78 77
79 my ($sec, $min, $hour, $mday, $mon, $year) = localtime (time); 78 my ($sec, $min, $hour, $mday, $mon, $year) = localtime time;
80 79
81 my $ts = sprintf "%04d-%02d-%02d %02d:%02d:%02d", 80 my $ts = sprintf "%04d-%02d-%02d %02d:%02d:%02d",
82 $year + 1900, $mon + 1, $mday, $hour, $min, $sec; 81 $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
83 82
84 print $fh "$ts ", @a, "\n"; 83 print {$self->{log_fh}} "$ts ", @a, "\n";
85 $fh->flush;
86} 84}
85
86sub _stat_numdiff {
87 my ($self, $name, $old, $new) = @_;
88
89 my $diff = $new - $old;
90
91 $diff = 0.01 * int $diff * 100;
92
93 0.1 >= abs $diff ? ()
94 : $diff < 0 ? "$name$diff" : "$name+$diff"
95}
96
97sub _stat_skillmaskdiff {
98 my ($self, $name, $old, $new) = @_;
99
100 my $diff = $old ^ $new
101 or return;
102
103 my @diff = map
104 {
105 $diff & $_
106 ? (($new & $_ ? "+" : "-") . $self->{spell_paths}{$_})
107 : ()
108 }
109 sort { $a <=> $b } keys %{$self->{spell_paths}};
110
111 join "", @diff
112}
113
114# all stats that are chacked against changes
115my @statchange = (
116 [&CS_STAT_STR => \&_stat_numdiff, "Str"],
117 [&CS_STAT_INT => \&_stat_numdiff, "Int"],
118 [&CS_STAT_WIS => \&_stat_numdiff, "Wis"],
119 [&CS_STAT_DEX => \&_stat_numdiff, "Dex"],
120 [&CS_STAT_CON => \&_stat_numdiff, "Con"],
121 [&CS_STAT_CHA => \&_stat_numdiff, "Cha"],
122 [&CS_STAT_POW => \&_stat_numdiff, "Pow"],
123 [&CS_STAT_WC => \&_stat_numdiff, "Wc"],
124 [&CS_STAT_AC => \&_stat_numdiff, "Ac"],
125 [&CS_STAT_DAM => \&_stat_numdiff, "Dam"],
126 [&CS_STAT_SPEED => \&_stat_numdiff, "Speed"],
127 [&CS_STAT_WEAP_SP => \&_stat_numdiff, "WSp"],
128 [&CS_STAT_MAXHP => \&_stat_numdiff, "HP"],
129 [&CS_STAT_MAXSP => \&_stat_numdiff, "Mana"],
130 [&CS_STAT_MAXGRACE => \&_stat_numdiff, "Grace"],
131 [&CS_STAT_WEIGHT_LIM => \&_stat_numdiff, "Weight"],
132 [&CS_STAT_SPELL_ATTUNE => \&_stat_skillmaskdiff, "attuned"],
133 [&CS_STAT_SPELL_REPEL => \&_stat_skillmaskdiff, "repelled"],
134 [&CS_STAT_SPELL_DENY => \&_stat_skillmaskdiff, "denied"],
135 [&CS_STAT_RES_PHYS => \&_stat_numdiff, "phys"],
136 [&CS_STAT_RES_MAG => \&_stat_numdiff, "magic"],
137 [&CS_STAT_RES_FIRE => \&_stat_numdiff, "fire"],
138 [&CS_STAT_RES_ELEC => \&_stat_numdiff, "electricity"],
139 [&CS_STAT_RES_COLD => \&_stat_numdiff, "cold"],
140 [&CS_STAT_RES_CONF => \&_stat_numdiff, "confusion"],
141 [&CS_STAT_RES_ACID => \&_stat_numdiff, "acid"],
142 [&CS_STAT_RES_DRAIN => \&_stat_numdiff, "drain"],
143 [&CS_STAT_RES_GHOSTHIT => \&_stat_numdiff, "ghosthit"],
144 [&CS_STAT_RES_POISON => \&_stat_numdiff, "poison"],
145 [&CS_STAT_RES_SLOW => \&_stat_numdiff, "slow"],
146 [&CS_STAT_RES_PARA => \&_stat_numdiff, "paralyse"],
147 [&CS_STAT_TURN_UNDEAD => \&_stat_numdiff, "turnundead"],
148 [&CS_STAT_RES_FEAR => \&_stat_numdiff, "fear"],
149 [&CS_STAT_RES_DEPLETE => \&_stat_numdiff, "depletion"],
150 [&CS_STAT_RES_DEATH => \&_stat_numdiff, "death"],
151 [&CS_STAT_RES_HOLYWORD => \&_stat_numdiff, "godpower"],
152 [&CS_STAT_RES_BLIND => \&_stat_numdiff, "blind"],
153);
87 154
88sub stats_update { 155sub stats_update {
89 my ($self, $stats) = @_; 156 my ($self, $stats) = @_;
90 157
91 if (my $exp = $stats->{+CS_STAT_EXP64}) { 158 my $prev = $self->{prev_stats} || { };
92 my $diff = $exp - $self->{prev_exp}; 159
160 if (my @diffs =
161 (
162 ($stats->{+CS_STAT_EXP64} > $prev->{+CS_STAT_EXP64} ? ($stats->{+CS_STAT_EXP64} - $prev->{+CS_STAT_EXP64}) . " experience gained" : ()),
163 map {
164 $stats->{$_} && $prev->{$_}
165 && $stats->{$_}[1] > $prev->{$_}[1] ? "($self->{skill_info}{$_}+" . ($stats->{$_}[1] - $prev->{$_}[1]) . ")" : ()
166 } sort { $a <=> $b } keys %{$self->{skill_info}}
167 )
168 ) {
169 my $msg = join " ", @diffs;
93 $self->{statusbox}->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5) 170 $self->{statusbox}->add ($msg, group => "experience $msg", fg => [0.5, 1, 0.5, 0.8], timeout => 5);
94 if exists $self->{prev_exp} && $diff;
95 $self->{prev_exp} = $exp;
96 } 171 }
97 172
173 if (
174 my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange
175 ) {
176 my $msg = "<b>stat change</b>: " . (join " ", @diffs);
177 $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 10);
178 }
179
98 ::update_stats_window ($stats); 180 $self->update_stats_window ($stats, $prev);
181
182 $self->{prev_stats} = { %$stats };
183}
184
185my %RES_TBL = (
186 phys => CS_STAT_RES_PHYS,
187 magic => CS_STAT_RES_MAG,
188 fire => CS_STAT_RES_FIRE,
189 elec => CS_STAT_RES_ELEC,
190 cold => CS_STAT_RES_COLD,
191 conf => CS_STAT_RES_CONF,
192 acid => CS_STAT_RES_ACID,
193 drain => CS_STAT_RES_DRAIN,
194 ghit => CS_STAT_RES_GHOSTHIT,
195 pois => CS_STAT_RES_POISON,
196 slow => CS_STAT_RES_SLOW,
197 para => CS_STAT_RES_PARA,
198 tund => CS_STAT_TURN_UNDEAD,
199 fear => CS_STAT_RES_FEAR,
200 depl => CS_STAT_RES_DEPLETE,
201 deat => CS_STAT_RES_DEATH,
202 holyw => CS_STAT_RES_HOLYWORD,
203 blind => CS_STAT_RES_BLIND,
204);
205
206sub update_stats_window {
207 my ($self, $stats, $prev) = @_;
208
209 # I love text protocols...
210
211 my $hp = $stats->{+CS_STAT_HP} * 1;
212 my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
213 my $sp = $stats->{+CS_STAT_SP} * 1;
214 my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
215 my $fo = $stats->{+CS_STAT_FOOD} * 1;
216 my $fo_m = 999;
217 my $gr = $stats->{+CS_STAT_GRACE} * 1;
218 my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
219
220 $::GAUGES->{hp} ->set_value ($hp, $hp_m);
221 $::GAUGES->{mana} ->set_value ($sp, $sp_m);
222 $::GAUGES->{food} ->set_value ($fo, $fo_m);
223 $::GAUGES->{grace} ->set_value ($gr, $gr_m);
224 $::GAUGES->{exp} ->set_text ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64}))
225 . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
226 my $rng = $stats->{+CS_STAT_RANGE};
227 $rng =~ s/^Range: //; # thank you so much dear server
228 $::GAUGES->{range} ->set_text ("Rng: " . $rng);
229 my $title = $stats->{+CS_STAT_TITLE};
230 $title =~ s/^Player: //;
231 $::STATWIDS->{title} ->set_text ("Title: " . $title);
232
233 $::STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
234 $::STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
235 $::STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
236 $::STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
237 $::STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
238 $::STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
239 $::STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
240 $::STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
241 $::STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
242 $::STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
243 $::STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_RES_PHYS});
244 $::STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
245 $::STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
246
247 $::STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
248
249 $::STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$RES_TBL{$_}})
250 for keys %RES_TBL;
251
252 my $sktbl = $::STATWIDS->{skill_tbl};
253 my @skills = keys %{ $self->{skill_info} };
254
255 if (grep +(exists $stats->{$_}) != (exists $prev->{$_}), @skills) {
256 $sktbl->clear;
257
258 $sktbl->add (0, 0, new CFClient::UI::Label text => "Experience", align => 1);
259 $sktbl->add (1, 0, new CFClient::UI::Label text => "Lvl.", align => 1);
260 $sktbl->add (2, 0, new CFClient::UI::Label text => "Skill", expand => 1);
261 $sktbl->add (3, 0, new CFClient::UI::Label text => "Experience", align => 1);
262 $sktbl->add (4, 0, new CFClient::UI::Label text => "Lvl.", align => 1);
263 $sktbl->add (5, 0, new CFClient::UI::Label text => "Skill", expand => 1);
264
265 my ($x, $y) = (0, 0);
266 for (
267 sort { $stats->{$b->[0]}[1] <=> $stats->{$a->[0]}[1] or $a->[1] cmp $b->[1] }
268 map [$_, $self->{skill_info}{$_}],
269 grep exists $stats->{$_},
270 @skills
271 ) {
272 my ($idx, $name) = @$_;
273
274 $sktbl->add ($x * 3 + 0, $y, $self->{stat_widget_exp}{$idx} = new CFClient::UI::Label
275 text => "0", align => 1, font => $::FONT_FIXED, fg => [1, 1, 0]);
276 $sktbl->add ($x * 3 + 1, $y, $self->{stat_widget_lvl}{$idx} = new CFClient::UI::Label
277 text => "0", align => 1, font => $::FONT_FIXED, fg => [0, 1, 0], padding_x => 4);
278 $sktbl->add ($x * 3 + 2, $y, new CFClient::UI::Label text => $name);
279
280 $x++ and ($x, $y) = (0, $y + 1);
281 }
282 }
283
284 for (grep exists $stats->{$_}, @skills) {
285 $self->{stat_widget_exp}{$_}->set_text (::formsep ($stats->{$_}[1]));
286 $self->{stat_widget_lvl}{$_}->set_text ($stats->{$_}[0] * 1);
287 }
99} 288}
100 289
101sub user_send { 290sub user_send {
102 my ($self, $command) = @_; 291 my ($self, $command) = @_;
103 292
… …
343 undef 532 undef
344 }; 533 };
345} 534}
346 535
347sub face_update { 536sub face_update {
348 my ($self, $facenum, $face) = @_; 537 my ($self, $facenum, $face, $changed) = @_;
349 538
350 $self->{tilecache}->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes 539 $self->{tilecache}->put ($face->{id} => $face->{image}) if $changed;
351 540
352 $self->set_texture ($face->{id} => delete $face->{image}); 541 $self->set_texture ($face->{id} => delete $face->{image});
353} 542}
354 543
355sub set_texture { 544sub set_texture {
… …
438 # try to create single paragraphs of multiple lines sent by the server 627 # try to create single paragraphs of multiple lines sent by the server
439 $spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g; 628 $spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g;
440 $spell->{message} =~ s/\n+$//; 629 $spell->{message} =~ s/\n+$//;
441 $spell->{message} ||= "Server did not provide a description for this spell."; 630 $spell->{message} ||= "Server did not provide a description for this spell.";
442 631
443 $::SETUP_SPELLS->add_spell ($spell); 632 $::SPELL_PAGE->add_spell ($spell);
444 633
445 $self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message}); 634 $self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
446 $self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message}); 635 $self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
447} 636}
448 637
449sub spell_delete { 638sub spell_delete {
450 my ($self, $spell) = @_; 639 my ($self, $spell) = @_;
640
451 $::SETUP_SPELLS->remove_spell ($spell); 641 $::SPELL_PAGE->remove_spell ($spell);
452} 642}
453 643
454sub addme_success { 644sub addme_success {
455 my ($self) = @_; 645 my ($self) = @_;
456 646
… …
536 726
537 $row++; 727 $row++;
538 } else { 728 } else {
539 $::FLOORBOX->add (1, $row, new CFClient::UI::Button 729 $::FLOORBOX->add (1, $row, new CFClient::UI::Button
540 text => "More...", 730 text => "More...",
541 on_activate => sub { $::INV_WINDOW->toggle_visibility; 0 }, 731 on_activate => sub { ::toggle_player_page ($::INVENTORY_PAGE); 0 },
542 ); 732 );
543 last; 733 last;
544 } 734 }
545 } 735 }
546 }); 736 });
… …
573 763
574sub update_containers { 764sub update_containers {
575 my ($self) = @_; 765 my ($self) = @_;
576 766
577 $CFClient::UI::ROOT->on_refresh ("update_containers_$self" => sub { 767 $CFClient::UI::ROOT->on_refresh ("update_containers_$self" => sub {
578 for my $tag (keys %{ delete $self->{update_container} }) { 768 my $todo = delete $self->{update_container}
769 or return;
770
771 for my $tag (keys %$todo) {
579 if ($tag == 0) { 772 if ($tag == 0) {
580 update_floorbox; 773 update_floorbox;
581 $::INVR->set_items ($self->{container}{0}) 774 $::INVR->set_items ($self->{container}{0})
582 if $tag == $self->{open_container}; 775 if $tag == $self->{open_container};
583 } elsif ($tag == $self->{player}{tag}) { 776 } elsif ($tag == $self->{player}{tag}) {
… …
616sub item_update { 809sub item_update {
617 my ($self, $item) = @_; 810 my ($self, $item) = @_;
618 811
619 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n"; 812 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n";
620 813
621 if ($item->{tag} == $self->{player}{tag}) {
622 $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $item->{weight} / 1000);
623 return;
624 }
625
626 CFClient::Item::update_widgets $item; 814 CFClient::Item::update_widgets $item;
627 815
628 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) { 816 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {
629 set_opencont ($::CONN, 0, "Floor"); 817 set_opencont ($::CONN, 0, "Floor");
630 818
… …
632 set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item); 820 set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item);
633 821
634 } else { 822 } else {
635 $self->{update_container}{$item->{container}}++; 823 $self->{update_container}{$item->{container}}++;
636 $self->update_containers; 824 $self->update_containers;
637# if ($item->{container} == 0) {
638# update_floorbox;
639# update_container (0);
640# } elsif ($item->{container} == $self->{player}{tag}) {
641# $::INV->set_items ($self->{container}{$item->{container}})
642# }
643 } 825 }
644} 826}
645 827
646sub player_update { 828sub player_update {
647 my ($self, $player) = @_; 829 my ($self, $player) = @_;
648
649 $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $player->{weight} / 1000); 830 $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $player->{weight} / 1000);
650} 831}
651 832
652sub update_server_info { 833sub update_server_info {
653 my ($self) = @_; 834 my ($self) = @_;
… …
850sub destroy { 1031sub destroy {
851 my ($self) = @_; 1032 my ($self) = @_;
852 1033
853 #Carp::cluck "debug\n";#d# #todo# enable: destroy gets called twice because scalar keys {} is 1 1034 #Carp::cluck "debug\n";#d# #todo# enable: destroy gets called twice because scalar keys {} is 1
854 1035
1036 $self->{conn}->send ("ext npc_dialog_end $self->{token}") if $self->{token};
855 delete $self->{conn}{npc_dialog}; 1037 delete $self->{conn}{npc_dialog};
856 $self->{conn}->disconnect_ext ($self->{token}); 1038 $self->{conn}->disconnect_ext ($self->{token});
857 1039
858 $self->SUPER::destroy; 1040 $self->SUPER::destroy;
859} 1041}

Diff Legend

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