ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.10 by root, Fri May 26 18:28:23 2006 UTC vs.
Revision 1.18 by root, Sat May 27 20:46:54 2006 UTC

… …
29use Time::HiRes 'time'; 29use Time::HiRes 'time';
30use Pod::POM; 30use Pod::POM;
31use Event; 31use Event;
32 32
33use Crossfire; 33use Crossfire;
34use Crossfire::Protocol; 34use Crossfire::Protocol::Constants;
35 35
36use Compress::LZF; 36use Compress::LZF;
37 37
38use CFClient; 38use CFClient;
39use CFClient::OpenGL (); 39use CFClient::OpenGL ();
40use CFClient::Protocol;
40use CFClient::UI; 41use CFClient::UI;
41use CFClient::MapWidget; 42use CFClient::MapWidget;
42 43
43$Event::DIED = sub { 44$Event::DIED = sub {
44 # TODO: display dialog box or so 45 # TODO: display dialog box or so
… …
51 52
52my $MAX_FPS = 60; 53my $MAX_FPS = 60;
53my $MIN_FPS = 5; # unused as of yet 54my $MIN_FPS = 5; # unused as of yet
54 55
55our $META_SERVER = "crossfire.real-time.com:13326"; 56our $META_SERVER = "crossfire.real-time.com:13326";
56
57our $FACEMAP;
58our $TILECACHE;
59our $MAPCACHE;
60 57
61our $LAST_REFRESH; 58our $LAST_REFRESH;
62our $NOW; 59our $NOW;
63 60
64our $CFG; 61our $CFG;
… …
100 97
101our $ALT_ENTER_MESSAGE; 98our $ALT_ENTER_MESSAGE;
102our $STATUSBOX; 99our $STATUSBOX;
103our $DEBUG_STATUS; 100our $DEBUG_STATUS;
104 101
105our $INVWIN;
106our $INV; 102our $INV;
107our $INVR; 103our $INVR;
108our $INVR_LBL; 104our $INVR_LBL;
109 105
110sub status { 106sub status {
… …
120sub start_game { 116sub start_game {
121 status "logging in..."; 117 status "logging in...";
122 118
123 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 119 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124 120
125 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; 121 my ($host, $port) = split /:/, $CFG->{host};
122
126 $MAP = new CFClient::Map $mapsize, $mapsize; 123 $MAP = new CFClient::Map $mapsize, $mapsize;
127
128 my ($host, $port) = split /:/, $CFG->{host};
129 124
130 $CONN = eval { 125 $CONN = eval {
131 new conn 126 new CFClient::Protocol
132 host => $host, 127 host => $host,
133 port => $port || 13327, 128 port => $port || 13327,
134 user => $CFG->{user}, 129 user => $CFG->{user},
135 pass => $CFG->{password}, 130 pass => $CFG->{password},
136 mapw => $mapsize, 131 mapw => $mapsize,
137 maph => $mapsize, 132 maph => $mapsize,
138 ; 133
134 map_widget => $MAPWIDGET,
135 logview => $LOGVIEW,
136 statusbox => $STATUSBOX,
137 map => $MAP,
138 mapmap => $MAPMAP,
139
140 sound_play => sub {
141 my ($x, $y, $soundnum, $type) = @_;
142
143 $SDL_MIXER
144 or return;
145
146 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
147 or return;
148
149 $chunk->play;
150 },
139 }; 151 };
140 152
141 if ($CONN) { 153 if ($CONN) {
142 CFClient::lowdelay fileno $CONN->{fh}; 154 CFClient::lowdelay fileno $CONN->{fh};
143 155
… …
161 $CONN->destroy; 173 $CONN->destroy;
162 $CONN = 0; # false, does not autovivify 174 $CONN = 0; # false, does not autovivify
163 175
164 $BUTTONBAR->{children}[1]->emit ("activate") 176 $BUTTONBAR->{children}[1]->emit ("activate")
165 unless $BUTTONBAR->{children}[1]->{state}; 177 unless $BUTTONBAR->{children}[1]->{state};
166
167 undef $MAPCACHE;
168 undef $MAP;
169} 178}
170 179
171sub client_setup { 180sub client_setup {
172 my $dialog = new CFClient::UI::FancyFrame 181 my $dialog = new CFClient::UI::FancyFrame
182 name => "client_setup",
173 title => "Client Setup", 183 title => "Client Setup",
174 child => (my $vbox = new CFClient::UI::VBox); 184 child => (my $vbox = new CFClient::UI::VBox);
175 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 185 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176 186
177 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); 187 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
… …
192 202
193 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); 203 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194 $table->add (1, $row++, new CFClient::UI::CheckBox 204 $table->add (1, $row++, new CFClient::UI::CheckBox
195 state => $CFG->{fullscreen}, 205 state => $CFG->{fullscreen},
196 tooltip => "Bring the client into fullscreen mode.", 206 tooltip => "Bring the client into fullscreen mode.",
197 connect_changed => sub { 207 on_changed => sub {
198 my ($self, $value) = @_; 208 my ($self, $value) = @_;
199 $CFG->{fullscreen} = $value; 209 $CFG->{fullscreen} = $value;
200 } 210 }
201 ); 211 );
202 212
203 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 213 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204 $table->add (1, $row++, new CFClient::UI::CheckBox 214 $table->add (1, $row++, new CFClient::UI::CheckBox
205 state => $CFG->{fast}, 215 state => $CFG->{fast},
206 tooltip => "Lower the visual quality considerably to speed up rendering.", 216 tooltip => "Lower the visual quality considerably to speed up rendering.",
207 connect_changed => sub { 217 on_changed => sub {
208 my ($self, $value) = @_; 218 my ($self, $value) = @_;
209 $CFG->{fast} = $value; 219 $CFG->{fast} = $value;
210 } 220 }
211 ); 221 );
212 222
213 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale"); 223 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214 $table->add (1, $row++, new CFClient::UI::Slider 224 $table->add (1, $row++, new CFClient::UI::Slider
215 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], 225 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216 tooltip => "Enlarge or shrink the displayed map. Changes are instant.", 226 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217 connect_changed => sub { 227 on_changed => sub {
218 my ($self, $value) = @_; 228 my ($self, $value) = @_;
219 $CFG->{map_scale} = 2 ** $value; 229 $CFG->{map_scale} = 2 ** $value;
220 } 230 }
221 ); 231 );
222 232
223 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 233 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
224 $table->add (1, $row++, new CFClient::UI::CheckBox 234 $table->add (1, $row++, new CFClient::UI::CheckBox
225 state => $CFG->{fow_enable}, 235 state => $CFG->{fow_enable},
226 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.", 236 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227 connect_changed => sub { 237 on_changed => sub {
228 my ($self, $value) = @_; 238 my ($self, $value) = @_;
229 $CFG->{fow_enable} = $value; 239 $CFG->{fow_enable} = $value;
230 } 240 }
231 ); 241 );
232 242
233 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 243 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234 $table->add (1, $row++, new CFClient::UI::Slider 244 $table->add (1, $row++, new CFClient::UI::Slider
235 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256], 245 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
236 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.", 246 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
237 connect_changed => sub { 247 on_changed => sub {
238 my ($self, $value) = @_; 248 my ($self, $value) = @_;
239 $CFG->{fow_intensity} = $value; 249 $CFG->{fow_intensity} = $value;
240 } 250 }
241 ); 251 );
242 252
243 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); 253 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244 $table->add (1, $row++, new CFClient::UI::CheckBox 254 $table->add (1, $row++, new CFClient::UI::CheckBox
245 state => $CFG->{fow_smooth}, 255 state => $CFG->{fow_smooth},
246 tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.", 256 tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247 connect_changed => sub { 257 on_changed => sub {
248 my ($self, $value) = @_; 258 my ($self, $value) = @_;
249 $CFG->{fow_smooth} = $value; 259 $CFG->{fow_smooth} = $value;
250 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2; 260 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
251 } 261 }
252 ); 262 );
253 263
254 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 264 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255 $table->add (1, $row++, new CFClient::UI::Slider 265 $table->add (1, $row++, new CFClient::UI::Slider
256 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1], 266 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
257 tooltip => "The base font size used by most GUI elements that do not have their own setting.", 267 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
258 connect_changed => sub { $CFG->{gui_fontsize} = $_[1] }, 268 on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
259 ); 269 );
260 270
261 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize"); 271 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262 $table->add (1, $row++, new CFClient::UI::Slider 272 $table->add (1, $row++, new CFClient::UI::Slider
263 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1], 273 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
264 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.", 274 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
265 connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) }, 275 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
266 ); 276 );
267 277
268 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize"); 278 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269 279
270 $table->add (1, $row++, new CFClient::UI::Slider 280 $table->add (1, $row++, new CFClient::UI::Slider
271 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1], 281 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
272 tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.", 282 tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273 connect_changed => sub { 283 on_changed => sub {
274 $CFG->{stat_fontsize} = $_[1]; 284 $CFG->{stat_fontsize} = $_[1];
275 &set_stats_window_fontsize; 285 &set_stats_window_fontsize;
276 } 286 }
277 ); 287 );
278 288
279 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); 289 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280 $table->add (1, $row++, new CFClient::UI::Slider 290 $table->add (1, $row++, new CFClient::UI::Slider
281 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1], 291 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
282 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.", 292 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283 connect_changed => sub { 293 on_changed => sub {
284 $CFG->{gauge_fontsize} = $_[1]; 294 $CFG->{gauge_fontsize} = $_[1];
285 &set_gauge_window_fontsize; 295 &set_gauge_window_fontsize;
286 } 296 }
287 ); 297 );
288 298
289 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size"); 299 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290 $table->add (1, $row++, new CFClient::UI::Slider 300 $table->add (1, $row++, new CFClient::UI::Slider
291 range => [$CFG->{gauge_size}, 0.2, 0.8], 301 range => [$CFG->{gauge_size}, 0.2, 0.8],
292 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.", 302 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293 connect_changed => sub { 303 on_changed => sub {
294 $CFG->{gauge_size} = $_[1]; 304 $CFG->{gauge_size} = $_[1];
295 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); 305 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
296 } 306 }
297 ); 307 );
298 308
299 $table->add (1, $row++, new CFClient::UI::Button 309 $table->add (1, $row++, new CFClient::UI::Button
300 expand => 1, align => 0, text => "Apply", 310 expand => 1, align => 0, text => "Apply",
301 tooltip => "Apply the video settings", 311 tooltip => "Apply the video settings",
302 connect_activate => sub { 312 on_activate => sub {
303 video_shutdown (); 313 video_shutdown ();
304 video_init (); 314 video_init ();
305 } 315 }
306 ); 316 );
307 317
308 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); 318 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309 $table->add (1, $row++, new CFClient::UI::CheckBox 319 $table->add (1, $row++, new CFClient::UI::CheckBox
310 state => $CFG->{audio_enable}, 320 state => $CFG->{audio_enable},
311 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.", 321 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
312 connect_changed => sub { 322 on_changed => sub {
313 $CFG->{audio_enable} = $_[1]; 323 $CFG->{audio_enable} = $_[1];
314 } 324 }
315 ); 325 );
316# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); 326# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
317# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub { 327# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318# $CFG->{effects_volume} = $_[1]; 328# $CFG->{effects_volume} = $_[1];
319# }); 329# });
320 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); 330 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
321 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox); 331 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322 $hbox->add (new CFClient::UI::CheckBox 332 $hbox->add (new CFClient::UI::CheckBox
323 expand => 1, state => $CFG->{bgm_enable}, 333 expand => 1, state => $CFG->{bgm_enable},
324 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.", 334 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325 connect_changed => sub { 335 on_changed => sub {
326 $CFG->{bgm_enable} = $_[1]; 336 $CFG->{bgm_enable} = $_[1];
327 } 337 }
328 ); 338 );
329 $hbox->add (new CFClient::UI::Slider 339 $hbox->add (new CFClient::UI::Slider
330 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128], 340 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331 tooltip => "The volume of the background music. Changes are instant.", 341 tooltip => "The volume of the background music. Changes are instant.",
332 connect_changed => sub { 342 on_changed => sub {
333 $CFG->{bgm_volume} = $_[1]; 343 $CFG->{bgm_volume} = $_[1];
334 CFClient::MixMusic::volume $_[1] * 128; 344 CFClient::MixMusic::volume $_[1] * 128;
335 } 345 }
336 ); 346 );
337 347
338 $table->add (1, $row++, new CFClient::UI::Button 348 $table->add (1, $row++, new CFClient::UI::Button
339 expand => 1, align => 0, text => "Apply", 349 expand => 1, align => 0, text => "Apply",
340 tooltip => "Apply the audio settings", 350 tooltip => "Apply the audio settings",
341 connect_activate => sub { 351 on_activate => sub {
342 audio_shutdown (); 352 audio_shutdown ();
343 audio_init (); 353 audio_init ();
344 } 354 }
345 ); 355 );
346 356
… …
348 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry 358 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349 text => $CFG->{say_command}, 359 text => $CFG->{say_command},
350 tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. " 360 tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
351 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. " 361 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
352 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.", 362 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
353 connect_changed => sub { 363 on_changed => sub {
354 my ($self, $value) = @_; 364 my ($self, $value) = @_;
355 $CFG->{say_command} = $value; 365 $CFG->{say_command} = $value;
356 } 366 }
357 ); 367 );
358 368
… …
422 432
423 $win 433 $win
424} 434}
425 435
426sub make_stats_window { 436sub make_stats_window {
427 my $tgw = new CFClient::UI::FancyFrame title => "Stats"; 437 my $tgw = new CFClient::UI::FancyFrame title => "Stats", name => "stats_window";
428 438
429 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox); 439 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
430 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1, 440 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431 can_hover => 1, can_events => 1, 441 can_hover => 1, can_events => 1,
432 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server."); 442 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
… …
435 tooltip => "The map you are currently on (if supported by the server)."); 445 tooltip => "The map you are currently on (if supported by the server).");
436 446
437 $vb->add (my $hb0 = new CFClient::UI::HBox); 447 $vb->add (my $hb0 = new CFClient::UI::HBox);
438 $hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1, 448 $hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
439 can_hover => 1, can_events => 1, 449 can_hover => 1, can_events => 1,
440 tooltip => "This is the amount the Player weights."); 450 tooltip => "The weight of the player including all inventory items.");
441 $hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1, 451 $hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
442 can_hover => 1, can_events => 1, 452 can_hover => 1, can_events => 1,
443 tooltip => "The weight limit, you can't carry more than this."); 453 tooltip => "The weight limit: you cannot carry more than this.");
444 454
445 455
446 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 456 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
447 $hb->add (my $tbl = new CFClient::UI::Table expand => 1); 457 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
448 458
… …
538} 548}
539 549
540sub update_stats_window { 550sub update_stats_window {
541 my ($stats) = @_; 551 my ($stats) = @_;
542 552
543 # i love text protocols!!! 553 # I love text protocols...
554
544 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1; 555 my $hp = $stats->{+CS_STAT_HP} * 1;
545 my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1; 556 my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
546 my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1; 557 my $sp = $stats->{+CS_STAT_SP} * 1;
547 my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1; 558 my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
548 my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1; 559 my $fo = $stats->{+CS_STAT_FOOD} * 1;
549 my $fo_m = 999; 560 my $fo_m = 999;
550 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1; 561 my $gr = $stats->{+CS_STAT_GRACE} * 1;
551 my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1; 562 my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
552 563
553 $GAUGES->{hp} ->set_value ($hp, $hp_m); 564 $GAUGES->{hp} ->set_value ($hp, $hp_m);
554 $GAUGES->{mana} ->set_value ($sp, $sp_m); 565 $GAUGES->{mana} ->set_value ($sp, $sp_m);
555 $GAUGES->{food} ->set_value ($fo, $fo_m); 566 $GAUGES->{food} ->set_value ($fo, $fo_m);
556 $GAUGES->{grace} ->set_value ($gr, $gr_m); 567 $GAUGES->{grace} ->set_value ($gr, $gr_m);
557 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64}) 568 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
558 . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")"); 569 . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
559 my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE}; 570 my $rng = $stats->{+CS_STAT_RANGE};
560 $rng =~ s/^Range: //; # thank you so much dear server 571 $rng =~ s/^Range: //; # thank you so much dear server
561 $GAUGES->{range} ->set_text ("Rng: " . $rng); 572 $GAUGES->{range} ->set_text ("Rng: " . $rng);
562 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE}; 573 my $title = $stats->{+CS_STAT_TITLE};
563 $title =~ s/^Player: //; 574 $title =~ s/^Player: //;
564 $STATWIDS->{title} ->set_text ("Title: " . $title); 575 $STATWIDS->{title} ->set_text ("Title: " . $title);
565 576
566 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5}); 577 $STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
567 $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8}); 578 $STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
568 $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9}); 579 $STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
569 $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6}); 580 $STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
570 $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7}); 581 $STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
571 $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22}); 582 $STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
572 $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10}); 583 $STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
573 $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13}); 584 $STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
574 $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14}); 585 $STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
575 $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15}); 586 $STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
576 $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16}); 587 $STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
577 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED}); 588 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
578 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP}); 589 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
579 590
580 $STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{Crossfire::Protocol::CS_STAT_WEIGHT_LIM} / 1000); 591 $STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
581 592
593 # TODO: replace by CS_STAT_RES_xxx constants
582 my %tbl = ( 594 my %tbl = (
583 phys => 100, 595 phys => 100,
584 magic => 101, 596 magic => 101,
585 fire => 102, 597 fire => 102,
586 elec => 103, 598 elec => 103,
… …
595 tund => 112, 607 tund => 112,
596 fear => 113, 608 fear => 113,
597 depl => 113, 609 depl => 113,
598 deat => 115, 610 deat => 115,
599 holyw => 116, 611 holyw => 116,
600 blind => 117 612 blind => 117,
601 ); 613 );
602 614
603 for (keys %tbl) {
604 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}}); 615 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
605 } 616 for keys %tbl;
606
607} 617}
608 618
609sub metaserver_dialog { 619sub metaserver_dialog {
610 my $dialog = new CFClient::UI::FancyFrame 620 my $dialog = new CFClient::UI::FancyFrame
611 title => "Server List", 621 title => "Server List",
… …
679 $m = [$users, $host, $uptime, $version, $desc]; 689 $m = [$users, $host, $uptime, $version, $desc];
680 690
681 $y++; 691 $y++;
682 692
683 $table->add (0, $y, new CFClient::UI::VBox children => [ 693 $table->add (0, $y, new CFClient::UI::VBox children => [
684 (new CFClient::UI::Button text => "Use", connect_activate => sub { 694 (new CFClient::UI::Button text => "Use", on_activate => sub {
685 $HOST->set_text ($CFG->{host} = $host); 695 $HOST->set_text ($CFG->{host} = $host);
686 }), 696 }),
687 (new CFClient::UI::Empty expand => 1), 697 (new CFClient::UI::Empty expand => 1),
688 ]); 698 ]);
689 699
… …
695 }); 705 });
696} 706}
697 707
698sub server_setup { 708sub server_setup {
699 my $dialog = new CFClient::UI::FancyFrame 709 my $dialog = new CFClient::UI::FancyFrame
710 name => "server_setup",
700 title => "Server Setup", 711 title => "Server Setup",
701 child => (my $vbox = new CFClient::UI::VBox); 712 child => (my $vbox = new CFClient::UI::VBox);
702 713
703 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 714 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
704 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); 715 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
… …
709 $vbox->add ( 720 $vbox->add (
710 my $HOST = new CFClient::UI::Entry 721 my $HOST = new CFClient::UI::Entry
711 expand => 1, 722 expand => 1,
712 text => $CFG->{host}, 723 text => $CFG->{host},
713 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to", 724 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
714 connect_changed => sub { 725 on_changed => sub {
715 my ($self, $value) = @_; 726 my ($self, $value) = @_;
716 $CFG->{host} = $value; 727 $CFG->{host} = $value;
717 } 728 }
718 ); 729 );
719 730
… …
722 $vbox->add (new CFClient::UI::Flopper 733 $vbox->add (new CFClient::UI::Flopper
723 expand => 1, 734 expand => 1,
724 text => "Server List", 735 text => "Server List",
725 other => $METASERVER, 736 other => $METASERVER,
726 tooltip => "Show a list of available crossfire servers", 737 tooltip => "Show a list of available crossfire servers",
727 connect_open => sub { 738 on_open => sub {
728 update_metaserver $HOST; 739 update_metaserver $HOST;
729 } 740 }
730 ); 741 );
731 } 742 }
732 743
733 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username"); 744 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
734 $table->add (1, 4, new CFClient::UI::Entry 745 $table->add (1, 4, new CFClient::UI::Entry
735 text => $CFG->{user}, 746 text => $CFG->{user},
736 tooltip => "The name of your character on the server", 747 tooltip => "The name of your character on the server",
737 connect_changed => sub { 748 on_changed => sub {
738 my ($self, $value) = @_; 749 my ($self, $value) = @_;
739 $CFG->{user} = $value; 750 $CFG->{user} = $value;
740 } 751 }
741 ); 752 );
742 753
743 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); 754 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
744 $table->add (1, 5, new CFClient::UI::Entry 755 $table->add (1, 5, new CFClient::UI::Entry
745 text => $CFG->{password}, 756 text => $CFG->{password},
746 hidden => 1, 757 hidden => 1,
747 tooltip => "The password for your character", 758 tooltip => "The password for your character",
748 connect_changed => sub { 759 on_changed => sub {
749 my ($self, $value) = @_; 760 my ($self, $value) = @_;
750 $CFG->{password} = $value; 761 $CFG->{password} = $value;
751 } 762 }
752 ); 763 );
753 764
… …
757 range => [$CFG->{mapsize}, 10, 100, 0, 1], 768 range => [$CFG->{mapsize}, 10, 100, 0, 1],
758 tooltip => "This is the size of the portion of the map update the server sends you. " 769 tooltip => "This is the size of the portion of the map update the server sends you. "
759 . "If you set this to a high value you will be able to see further, " 770 . "If you set this to a high value you will be able to see further, "
760 . "but you also increase bandwidth requirements and latency. " 771 . "but you also increase bandwidth requirements and latency. "
761 . "This option is only used once at log-in.", 772 . "This option is only used once at log-in.",
762 connect_changed => sub { 773 on_changed => sub {
763 my ($self, $value) = @_; 774 my ($self, $value) = @_;
764 775
765 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 776 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
766 }, 777 },
767 ); 778 );
… …
774 . "This might increase or create lag, but increases the chances " 785 . "This might increase or create lag, but increases the chances "
775 . "of faces being ready for display when you encounter them. " 786 . "of faces being ready for display when you encounter them. "
776 . "It also uses up server bandwidth on every connect, " 787 . "It also uses up server bandwidth on every connect, "
777 . "so only set it if you really need to prefetch images. " 788 . "so only set it if you really need to prefetch images. "
778 . "This option can be set and unset any time.", 789 . "This option can be set and unset any time.",
779 connect_changed => sub { $CFG->{face_prefetch} = $_[1] }, 790 on_changed => sub { $CFG->{face_prefetch} = $_[1] },
780 ); 791 );
781 792
782 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count"); 793 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
783 $table->add (1, 9, new CFClient::UI::Entry 794 $table->add (1, 9, new CFClient::UI::Entry
784 text => $CFG->{output_count}, 795 text => $CFG->{output_count},
785 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 796 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
786 connect_changed => sub { $CFG->{output_count} = $_[1] }, 797 on_changed => sub { $CFG->{output_count} = $_[1] },
787 ); 798 );
788 799
789 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync"); 800 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
790 $table->add (1, 10, new CFClient::UI::Entry 801 $table->add (1, 10, new CFClient::UI::Entry
791 text => $CFG->{output_sync}, 802 text => $CFG->{output_sync},
792 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 803 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
793 connect_changed => sub { $CFG->{output_sync} = $_[1] }, 804 on_changed => sub { $CFG->{output_sync} = $_[1] },
794 ); 805 );
795 806
796 $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button 807 $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
797 expand => 1, 808 expand => 1,
798 align => 0, 809 align => 0,
799 text => "Login", 810 text => "Login",
800 connect_activate => sub { 811 on_activate => sub {
801 $CONN ? stop_game 812 $CONN ? stop_game
802 : start_game; 813 : start_game;
803 }, 814 },
804 ); 815 );
805 816
806 $dialog 817 $dialog
807} 818}
808 819
809sub message_window { 820sub message_window {
810 my $window = new CFClient::UI::FancyFrame 821 my $window = new CFClient::UI::FancyFrame
822 name => "message_window",
811 title => "Messages", 823 title => "Messages",
812 border_bg => [1, 1, 1, 1], 824 border_bg => [1, 1, 1, 1],
813 bg => [0, 0, 0, 0.75], 825 bg => [0, 0, 0, 0.75],
814 user_w => int $::WIDTH / 3, 826 user_w => int $::WIDTH / 3,
815 user_h => int $::HEIGHT / 5, 827 user_h => int $::HEIGHT / 5,
… …
820 $vbox->add (my $input = new CFClient::UI::Entry 832 $vbox->add (my $input = new CFClient::UI::Entry
821 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> " 833 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
822 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). " 834 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
823 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). " 835 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
824 . "A better way to submit commands (and the occasional chat command) is often the map command completer.", 836 . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
825 connect_focus_in => sub { 837 on_focus_in => sub {
826 my ($input, $prev_focus) = @_; 838 my ($input, $prev_focus) = @_;
827 839
828 delete $input->{refocus_map}; 840 delete $input->{refocus_map};
829 841
830 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) { 842 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
831 $input->{refocus_map} = 1; 843 $input->{refocus_map} = 1;
832 } 844 }
833 delete $input->{auto_activated}; 845 delete $input->{auto_activated};
834 }, 846 },
835 connect_activate => sub { 847 on_activate => sub {
836 my ($input, $text) = @_; 848 my ($input, $text) = @_;
837 $input->set_text (''); 849 $input->set_text ('');
838 850
839 if ($text =~ /^\/(.*)/) { 851 if ($text =~ /^\/(.*)/) {
840 $::CONN->user_send ($1); 852 $::CONN->user_send ($1);
… …
845 if ($input->{refocus_map}) { 857 if ($input->{refocus_map}) {
846 delete $input->{refocus_map}; 858 delete $input->{refocus_map};
847 $MAPWIDGET->focus_in 859 $MAPWIDGET->focus_in
848 } 860 }
849 }, 861 },
850 connect_escape => sub { 862 on_escape => sub {
851 $MAPWIDGET->focus_in 863 $MAPWIDGET->focus_in
852 }, 864 },
853 ); 865 );
854 866
855 $CONSOLE = { 867 $CONSOLE = {
… …
874 ); 886 );
875 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 887 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
876 $hb->add (new CFClient::UI::Button 888 $hb->add (new CFClient::UI::Button
877 text => "Ok", 889 text => "Ok",
878 expand => 1, 890 expand => 1,
879 connect_activate => sub { $QUIT_DIALOG->hide }, 891 on_activate => sub { $QUIT_DIALOG->hide },
880 ); 892 );
881 $hb->add (new CFClient::UI::Button 893 $hb->add (new CFClient::UI::Button
882 text => "Quit anyway", 894 text => "Quit anyway",
883 expand => 1, 895 expand => 1,
884 connect_activate => sub { exit }, 896 on_activate => sub { exit },
885 ); 897 );
886 898
887 $QUIT_DIALOG->show_centered; 899 $QUIT_DIALOG->show_centered;
888 } else { 900 } else {
889 $QUIT_DIALOG->show_centered; 901 $QUIT_DIALOG->show_centered;
890 } 902 }
891} 903}
892 904
893sub make_inventory_window { 905sub make_inventory_window {
894 my $invwin = new CFClient::UI::FancyFrame 906 my $invwin = new CFClient::UI::FancyFrame
895 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory"; 907 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory", name => "inventory_window";
896 908
897 $invwin->add (my $hb = new CFClient::UI::HBox expand => 1); 909 $invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
898 910
899 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1); 911 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
900 $vb1->add (my $lbl = new CFClient::UI::Label xalign => 0.5); 912 $vb1->add (my $lbl = new CFClient::UI::Label align => 0);
901 $lbl->set_text ("Player"); 913 $lbl->set_text ("Player");
902 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1); 914 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
903 915
904 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1); 916 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
917
918 $vb2->add (my $hb2 = new CFClient::UI::HBox);
905 $vb2->add ($INVR_LBL = new CFClient::UI::Label xalign => 0.5); 919 $hb2->add ($INVR_LBL = new CFClient::UI::Label align => 0, expand => 1);
920 $hb2->add (new CFClient::UI::Button
921 text => "Close",
922 tooltip => "Close the currently open container (if one is open)",
923 on_activate => sub {
924 $CONN->send ("apply $CONN->{open_container}")
925 if $CONN->{open_container} != 0;
926 },
927 );
928
906 $INVR_LBL->set_text ("Floor"); 929 $INVR_LBL->set_text ("Floor");
907 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1); 930 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
908 931
909 $invwin 932 $invwin
910} 933}
… …
926 ) { 949 ) {
927 my ($pod, $label) = @$_; 950 my ($pod, $label) = @$_;
928 951
929 $buttons->add (new CFClient::UI::Button 952 $buttons->add (new CFClient::UI::Button
930 text => $label, 953 text => $label,
931 connect_activate => sub { 954 on_activate => sub {
932 my $parser = new Pod::POM; 955 my $parser = new Pod::POM;
933 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod"); 956 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
934 957
935 $viewer->clear; 958 $viewer->clear;
936 959
… …
1044 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :)."); 1067 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
1045 1068
1046 $BUTTONBAR->add (new CFClient::UI::Button 1069 $BUTTONBAR->add (new CFClient::UI::Button
1047 text => "Save Config", 1070 text => "Save Config",
1048 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.", 1071 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1049 connect_activate => sub { 1072 on_activate => sub {
1073 $::CFG->{layout} = CFClient::UI::get_layout;
1050 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 1074 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
1051 status "Configuration Saved"; 1075 status "Configuration Saved";
1052 }, 1076 },
1053 ); 1077 );
1054 1078
1055 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window, 1079 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1056 tooltip => "View Documentation"); 1080 tooltip => "View Documentation");
1057 1081
1058 $BUTTONBAR->add (new CFClient::UI::Button 1082 $BUTTONBAR->add (new CFClient::UI::Button
1059 text => "Quit", 1083 text => "Quit",
1060 tooltip => "Terminates the program", 1084 tooltip => "Terminates the program",
1061 connect_activate => sub { 1085 on_activate => sub {
1062 if ($CONN) { 1086 if ($CONN) {
1063 open_quit_dialog; 1087 open_quit_dialog;
1064 } else { 1088 } else {
1065 exit; 1089 exit;
1066 } 1090 }
… …
1246sub animation_stop { 1270sub animation_stop {
1247 my ($widget) = @_; 1271 my ($widget) = @_;
1248 delete $animate_object{$widget}; 1272 delete $animate_object{$widget};
1249} 1273}
1250 1274
1251@conn::ISA = Crossfire::Protocol::;
1252
1253sub conn::new {
1254 my $class = shift;
1255
1256 my $self = $class->Crossfire::Protocol::new (@_);
1257
1258 $MAPWIDGET->clr_commands;
1259
1260 my $parser = new Pod::POM;
1261 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1262
1263 for my $head2 ($pod->head1->[-2]->head2) {
1264 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1265 or next;
1266
1267 my $cmd = $1;
1268 my @args = split /\|/, $2;
1269 @args = (".*") unless @args;
1270
1271 my $text = CFClient::pod_to_pango $head2->content;
1272
1273 for my $arg (@args) {
1274 $arg = $arg eq ".*" ? "" : " $arg";
1275
1276 $MAPWIDGET->add_command ("$cmd$arg", $text);
1277 }
1278 }
1279
1280 $self->{noface} = new_from_file CFClient::Texture
1281 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1282
1283 $self->{open_container} = 0;
1284
1285 $self
1286}
1287
1288sub conn::stats_update {
1289 my ($self, $stats) = @_;
1290
1291 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1292 my $diff = $exp - $self->{prev_exp};
1293 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1294 if exists $self->{prev_exp} && $diff;
1295 $self->{prev_exp} = $exp;
1296 }
1297
1298 update_stats_window ($stats);
1299}
1300
1301sub conn::user_send {
1302 my ($self, $command) = @_;
1303
1304 $self->send_command ($command);
1305 status $command;
1306}
1307
1308sub conn::map_scroll {
1309 my ($self, $dx, $dy) = @_;
1310
1311 $MAP->scroll ($dx, $dy);
1312}
1313
1314sub conn::feed_map1a {
1315 my ($self, $data) = @_;
1316
1317# $self->Crossfire::Protocol::feed_map1a ($data);
1318
1319 $MAP->map1a_update ($data);
1320 $MAPWIDGET->update;
1321}
1322
1323sub conn::flush_map {
1324 my ($self) = @_;
1325
1326 my $map_info = delete $self->{map_info}
1327 or return;
1328
1329 my ($hash, $x, $y, $w, $h) = @$map_info;
1330
1331 my $data = $MAP->get_rect ($x, $y, $w, $h);
1332 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
1333 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
1334}
1335
1336sub conn::map_clear {
1337 my ($self) = @_;
1338
1339 $self->flush_map;
1340 delete $self->{neigh_map};
1341
1342 $MAP->clear;
1343}
1344
1345
1346sub conn::load_map($$$) {
1347 my ($self, $hash, $x, $y) = @_;
1348
1349 if (defined (my $data = $MAPCACHE->get ($hash))) {
1350 $data = Compress::LZF::decompress $data;
1351 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
1352 for my $id ($MAP->set_rect ($x, $y, $data)) {
1353 my $data = $TILECACHE->get ($id)
1354 or next;
1355
1356 $self->set_texture ($id => $data);
1357 }
1358 }
1359}
1360
1361# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1362# (server resource,s latency, bandwidth), so this hack is warranted.
1363# the right fix is to make real tiled maps with an overview file
1364sub conn::send_mapinfo {
1365 my ($self, $data, $cb) = @_;
1366
1367 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1368 my ($wx, $wy) = ($1, $2);
1369
1370 if ($data =~ /^spatial ([1-4]+)$/) {
1371 my @dx = (0, 0, 1, 0, -1);
1372 my @dy = (0, -1, 0, 1, 0);
1373 my ($dx, $dy);
1374
1375 for (split //, $1) {
1376 $dx += $dx[$_];
1377 $dy += $dy[$_];
1378 }
1379
1380 $cb->(spatial => 15,
1381 $self->{map_info}[1] - $MAP->ox + $dx * 50,
1382 $self->{map_info}[2] - $MAP->oy + $dy * 50,
1383 50, 50,
1384 sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1385 );
1386
1387 return;
1388 }
1389 }
1390
1391 $self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1392}
1393
1394# this method does a "flood fill" into every tile direction
1395# it assumes that tiles are arranged in a rectangular grid,
1396# i.e. a map is the same as the left of the right map etc.
1397# failure to comply are harmless and result in display errors
1398# at worst.
1399sub conn::flood_fill {
1400 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1401
1402 # the server does not allow map paths > 6
1403 return if 7 <= length $path;
1404
1405 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1406
1407 for (
1408 [1, 3, 0, -1],
1409 [2, 4, 1, 0],
1410 [3, 1, 0, 1],
1411 [4, 2, -1, 0],
1412 ) {
1413 my ($tile, $tile2, $dx, $dy) = @$_;
1414
1415 next if $block & (1 << $tile);
1416 my $block = $block | (1 << $tile2);
1417
1418 my $gx = $gx + $dx;
1419 my $gy = $gy + $dy;
1420
1421 next unless $flags & (1 << ($tile - 1));
1422 next if $self->{neigh_grid}{$gx, $gy}++;
1423
1424 my $neigh = $self->{neigh_map}{$hash} ||= [];
1425 if (my $info = $neigh->[$tile]) {
1426 my ($flags, $x, $y, $w, $h, $hash) = @$info;
1427
1428 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1429 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1430
1431 } else {
1432 $self->send_mapinfo ("spatial $path$tile", sub {
1433 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1434
1435 return if $mode ne "spatial";
1436
1437 $x += $MAP->ox;
1438 $y += $MAP->oy;
1439
1440 $self->load_map ($hash, $x, $y)
1441 unless $self->{neigh_map}{$hash}[5]++;#d#
1442
1443 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1444
1445 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1446 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1447 });
1448 }
1449 }
1450}
1451
1452sub conn::map_change {
1453 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1454
1455 $self->flush_map;
1456
1457 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1458
1459 my $mapmapw = $MAPMAP->{w};
1460 my $mapmaph = $MAPMAP->{h};
1461
1462 $self->{neigh_rect} = [
1463 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1464 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1465 ];
1466
1467 delete $self->{neigh_grid};
1468
1469 $x += $ox;
1470 $y += $oy;
1471
1472 $self->{map_info} = [$hash, $x, $y, $w, $h];
1473
1474 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1475 $STATWIDS->{map}->set_text ("Map: " . $map);
1476
1477 $self->load_map ($hash, $x, $y);
1478 $self->flood_fill (0, 0, 0, "", $hash, $flags);
1479}
1480
1481sub conn::face_find {
1482 my ($self, $facenum, $face) = @_;
1483
1484 my $hash = "$face->{chksum},$face->{name}";
1485
1486 my $id = $FACEMAP->get ($hash);
1487
1488 unless ($id) {
1489 # create new id for face
1490 # I love transactions
1491 for (1..100) {
1492 my $txn = $CFClient::DB_ENV->txn_begin;
1493 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1494 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1495 $id = ($id || 16) + 1;
1496 if ($FACEMAP->put (id => $id) == 0
1497 && $FACEMAP->put ($hash => $id) == 0) {
1498 $txn->txn_commit;
1499
1500 goto gotid;
1501 }
1502 }
1503 $txn->abort;
1504 }
1505
1506 CFClient::fatal "maximum number of transaction retries reached - database problems?";
1507 }
1508
1509gotid:
1510 $face->{id} = $id;
1511 $MAP->set_face ($facenum => $id);
1512 $self->{faceid}[$facenum] = $id;#d#
1513
1514 my $face = $TILECACHE->get ($id);
1515
1516 if ($face) {
1517 #$self->face_prefetch;
1518 $face
1519 } else {
1520 my $tex = $self->{noface};
1521 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1522 undef
1523 };
1524}
1525
1526sub conn::face_update {
1527 my ($self, $facenum, $face) = @_;
1528
1529 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1530
1531 $self->set_texture ($face->{id} => delete $face->{image});
1532}
1533
1534sub conn::set_texture {
1535 my ($self, $id, $data) = @_;
1536
1537 $self->{texture}[$id] ||= do {
1538 my $tex =
1539 new_from_image CFClient::Texture
1540 $data, minify => 1, mipmap => 1;
1541
1542 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1543 $MAPWIDGET->update;
1544
1545 $tex
1546 };
1547}
1548
1549sub conn::sound_play {
1550 my ($self, $x, $y, $soundnum, $type) = @_;
1551
1552 $SDL_MIXER
1553 or return;
1554
1555 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1556 or return;
1557
1558 $chunk->play;
1559# warn "sound $x,$y,$soundnum,$type\n";#d#
1560}
1561
1562my $LAST_QUERY; # server is stupid, stupid, stupid
1563
1564sub conn::query {
1565 my ($self, $flags, $prompt) = @_;
1566
1567 $prompt = $LAST_QUERY unless length $prompt;
1568 $LAST_QUERY = $prompt;
1569
1570 my $dialog = new CFClient::UI::FancyFrame
1571 title => "Query",
1572 child => my $vbox = new CFClient::UI::VBox;
1573
1574 $vbox->add (new CFClient::UI::Label
1575 max_w => $::WIDTH * 0.4,
1576 ellipsise => 0,
1577 text => $prompt);
1578
1579 if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1580 $vbox->add (my $hbox = new CFClient::HBox);
1581 $hbox->add (new CFClient::Button
1582 text => "No",
1583 connect_activate => sub {
1584 $self->send ("reply n");
1585 $dialog->destroy;
1586 $MAPWIDGET->focus_in;
1587 }
1588 );
1589 $hbox->add (new CFClient::Button
1590 text => "Yes",
1591 connect_activate => sub {
1592 $self->send ("reply y");
1593 $dialog->destroy;
1594 },
1595 );
1596
1597 $dialog->focus_in;
1598
1599 } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1600 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1601 $vbox->add (my $entry = new CFClient::UI::Entry
1602 connect_changed => sub {
1603 $self->send ("reply $_[1]");
1604 $dialog->destroy;
1605 },
1606 );
1607
1608 $entry->focus_in;
1609
1610 } else {
1611 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1612
1613 $vbox->add (my $entry = new CFClient::UI::Entry
1614 $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1615 connect_activate => sub {
1616 $self->send ("reply $_[1]");
1617 $dialog->destroy;
1618 },
1619 );
1620
1621 $entry->focus_in;
1622 }
1623
1624 $dialog->show_centered;
1625}
1626
1627sub conn::drawinfo {
1628 my ($self, $color, $text) = @_;
1629
1630 my @color = (
1631 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1632 [1.00, 1.00, 1.00],
1633 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1634 [1.00, 0.00, 0.00],
1635 [1.00, 0.54, 0.00],
1636 [0.11, 0.56, 1.00],
1637 [0.93, 0.46, 0.00],
1638 [0.18, 0.54, 0.34],
1639 [0.56, 0.73, 0.56],
1640 [0.80, 0.80, 0.80],
1641 [0.55, 0.41, 0.13],
1642 [0.99, 0.77, 0.26],
1643 [0.74, 0.65, 0.41],
1644 );
1645
1646 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1647
1648 $text = CFClient::UI::Label::escape $text;
1649 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1650 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1651
1652 $LOGVIEW->add_paragraph ($color[$color],
1653 join "\n", map "$time $_", split /\n/, $text);
1654
1655 $STATUSBOX->add ($text,
1656 group => $text,
1657 fg => $color[$color],
1658 timeout => 10,
1659 tooltip_font => $::FONT_FIXED,
1660 );
1661}
1662
1663sub conn::drawextinfo {
1664 my ($self, $color, $type, $subtype, $message) = @_;
1665
1666 $self->drawinfo ($color, $message);
1667}
1668
1669sub conn::spell_add {
1670 my ($self, $spell) = @_;
1671
1672 # TODO
1673 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1674 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1675 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1676}
1677
1678sub conn::spell_delete {
1679 my ($self, $spell) = @_;
1680}
1681
1682sub conn::addme_success {
1683 my ($self) = @_;
1684
1685 $self->send ("command output-sync $CFG->{output_sync}");
1686 $self->send ("command output-count $CFG->{output_count}");
1687
1688 my $parser = new Pod::POM;
1689 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1690
1691 my %skill_tooltip;
1692
1693 for my $head2 ($pod->head1->[-2]->head2) {
1694 $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1695 }
1696
1697 for my $skill (values %{$self->{skill_info}}) {
1698 $MAPWIDGET->add_command ("ready_skill $skill",
1699 (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1700 . $skill_tooltip{$skill});
1701 $MAPWIDGET->add_command ("use_skill $skill",
1702 (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1703 . $skill_tooltip{$skill});
1704 }
1705}
1706
1707sub conn::eof {
1708 $MAPWIDGET->clr_commands;
1709
1710 stop_game;
1711}
1712
1713sub conn::image_info {
1714 my ($self, $numfaces) = @_;
1715
1716 $self->{num_faces} = $numfaces;
1717 $self->{face_prefetch} = [1 .. $numfaces];
1718 $self->face_prefetch;
1719}
1720
1721sub conn::face_prefetch {
1722 my ($self) = @_;
1723
1724 return unless $CFG->{face_prefetch};
1725
1726 if ($self->{num_faces}) {
1727 return if @{ $self->{send_queue} || [] };
1728 my $todo = @{ $self->{face_prefetch} }
1729 or return;
1730
1731 my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
1732
1733 $self->send ("requestinfo image_sums $face $face");
1734
1735 $STATUSBOX->add (CFClient::UI::Label::escape "prefetching $todo",
1736 group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1737 } elsif (!exists $self->{num_faces}) {
1738 $self->send ("requestinfo image_info");
1739
1740 $self->{num_faces} = 0;
1741
1742 $STATUSBOX->add (CFClient::UI::Label::escape "starting to prefetch",
1743 group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1744 }
1745}
1746
1747# check once/second for faces that need to be prefetched 1275# check once/second for faces that need to be prefetched
1748# this should, of course, only run on demand, but 1276# this should, of course, only run on demand, but
1749# SDL forces worse things on us.... 1277# SDL forces worse things on us....
1750 1278
1751Event->timer (after => 1, interval => 0.25, cb => sub { 1279Event->timer (after => 1, interval => 0.25, cb => sub {
1752 $CONN->face_prefetch 1280 $CONN->face_prefetch
1753 if $CONN; 1281 if $CONN;
1754}); 1282});
1755
1756sub update_floorbox {
1757 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1758 return unless $CONN;
1759
1760 $FLOORBOX->clear;
1761
1762 my $row;
1763 for (@{ $CONN->{container}{0} }) {
1764 if ($row < 7) {
1765 local $_->{face_widget}; # hack to force recreation of widget
1766 local $_->{desc_widget}; # hack to force recreation of widget
1767 CFClient::Item::update_widgets $_;
1768
1769 $FLOORBOX->add (0, $row, $_->{face_widget});
1770 $FLOORBOX->add (1, $row, $_->{desc_widget});
1771
1772 $row++;
1773 } else {
1774 $FLOORBOX->add (1, $row, new CFClient::UI::Label text => "More...");
1775 last;
1776 }
1777 }
1778 });
1779
1780 $WANT_REFRESH++;
1781}
1782
1783sub set_opencont {
1784 my ($conn, $tag, $name) = @_;
1785 $conn->{open_container} = $tag;
1786 $INVR_LBL->set_text ($name);
1787 $INVR->set_items ($conn->{container}{$tag});
1788}
1789
1790sub update_container {
1791 my ($tag) = @_;
1792 $INVR->set_items ($::CONN->{container}{$CONN->{open_container}})
1793 if $tag == $CONN->{open_container};
1794}
1795
1796sub conn::container_add {
1797 my ($self, $tag, $items) = @_;
1798
1799 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1800
1801 if ($tag == 0) {
1802 update_floorbox;
1803 update_container (0);
1804 } elsif ($tag == $self->{player}{tag}) {
1805 $INV->set_items ($self->{container}{$self->{player}{tag}})
1806 } else {
1807 update_container ($tag);
1808 }
1809
1810 # $self-<{player}{tag} => player inv
1811 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1812}
1813
1814sub conn::container_clear {
1815 my ($self, $tag) = @_;
1816
1817 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1818
1819 if ($tag == 0) {
1820 update_floorbox;
1821 update_container (0);
1822 } elsif ($tag == $self->{player}{tag}) {
1823 $INV->set_items ($self->{container}{$tag})
1824 }
1825
1826# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1827}
1828
1829sub conn::item_delete {
1830 my ($self, @items) = @_;
1831
1832 for (@items) {
1833 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1834
1835 if ($_->{container} == 0) {
1836 update_floorbox;
1837 update_container ($_->{tag});
1838 } elsif ($_->{container} == $self->{player}{tag}) {
1839 $INV->set_items ($self->{container}{$self->{player}{tag}})
1840 } else {
1841 update_container ($_->{tag});
1842 }
1843 }
1844}
1845
1846sub conn::item_update {
1847 my ($self, $item) = @_;
1848
1849 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($CONN->{open_container})\n";
1850
1851 if ($item->{tag} == $self->{player}{tag}) {
1852 $STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $item->{weight} / 1000);
1853 return
1854 }
1855
1856 CFClient::Item::update_widgets $item;
1857
1858 if ($item->{tag} == $CONN->{open_container} && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1859 set_opencont ($CONN, 0, "Floor");
1860
1861 } elsif ($item->{flags} & Crossfire::Protocol::F_OPEN) {
1862 set_opencont ($CONN, $item->{tag}, CFClient::Item::desc_string $item);
1863 } else {
1864 if ($item->{container} == 0) {
1865 update_floorbox;
1866 update_container (0);
1867 } elsif ($item->{container} == $self->{player}{tag}) {
1868 $INV->set_items ($self->{container}{$item->{container}})
1869 }
1870 }
1871}
1872 1283
1873%SDL_CB = ( 1284%SDL_CB = (
1874 CFClient::SDL_QUIT => sub { 1285 CFClient::SDL_QUIT => sub {
1875 Event::unloop -1; 1286 Event::unloop -1;
1876 }, 1287 },
… …
1911 1322
1912{ 1323{
1913 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] }; 1324 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1914 1325
1915 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 1326 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1916 1327 CFClient::UI::set_layout ($::CFG->{layout});
1917 $TILECACHE = CFClient::db_table "tilecache";
1918 $FACEMAP = CFClient::db_table "facemap";
1919 1328
1920 my %DEF_CFG = ( 1329 my %DEF_CFG = (
1921 sdl_mode => 0, 1330 sdl_mode => 0,
1922 width => 640, 1331 width => 640,
1923 height => 480, 1332 height => 480,

Diff Legend

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