… | |
… | |
7 | |
7 | |
8 | use CFClient; |
8 | use CFClient; |
9 | use CFClient::UI; |
9 | use CFClient::UI; |
10 | |
10 | |
11 | use base 'Crossfire::Protocol::Base'; |
11 | use base 'Crossfire::Protocol::Base'; |
12 | |
|
|
13 | our %open_logs; |
|
|
14 | |
12 | |
15 | sub new { |
13 | sub 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 | |
66 | sub logprint { |
64 | sub 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 | } |
87 | |
85 | |
88 | sub _stat_numdiff { |
86 | sub _stat_numdiff { |
89 | my ($self, $name, $old, $new) = @_; |
87 | my ($self, $name, $old, $new) = @_; |
90 | |
88 | |
… | |
… | |
155 | ); |
153 | ); |
156 | |
154 | |
157 | sub stats_update { |
155 | sub stats_update { |
158 | my ($self, $stats) = @_; |
156 | my ($self, $stats) = @_; |
159 | |
157 | |
160 | if (my $prev = $self->{prev_stats}) { |
158 | my $prev = $self->{prev_stats} || { }; |
161 | if (my $diff = $stats->{+CS_STAT_EXP64} - $prev->{+CS_STAT_EXP64}) { |
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; |
162 | $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); |
|
|
171 | } |
|
|
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 | |
|
|
180 | $self->update_stats_window ($stats, $prev); |
|
|
181 | |
|
|
182 | $self->{prev_stats} = { %$stats }; |
|
|
183 | } |
|
|
184 | |
|
|
185 | my %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 | |
|
|
206 | sub 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); |
163 | } |
281 | } |
164 | |
|
|
165 | if ( |
|
|
166 | my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange |
|
|
167 | ) { |
|
|
168 | my $msg = "<b>stat change</b>: " . (join " ", @diffs); |
|
|
169 | $self->{statusbox}->add ($msg, group => $msg, fg => [0.8, 1, 0.2, 1], timeout => 10); |
|
|
170 | } |
|
|
171 | } |
282 | } |
172 | |
283 | |
173 | $self->{prev_stats} = { %$stats }; |
284 | for (grep exists $stats->{$_}, @skills) { |
174 | |
285 | $self->{stat_widget_exp}{$_}->set_text (::formsep ($stats->{$_}[1])); |
175 | ::update_stats_window ($stats); |
286 | $self->{stat_widget_lvl}{$_}->set_text ($stats->{$_}[0] * 1); |
|
|
287 | } |
176 | } |
288 | } |
177 | |
289 | |
178 | sub user_send { |
290 | sub user_send { |
179 | my ($self, $command) = @_; |
291 | my ($self, $command) = @_; |
180 | |
292 | |