ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.90
Committed: Mon Jul 10 06:59:14 2006 UTC (17 years, 10 months ago) by elmex
Branch: MAIN
Changes since 1.89: +1 -0 lines
Log Message:
implemented player book position saving and removed some done
todo items.

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     use strict;
4     use utf8;
5    
6     # do things only needed for single-binary version (par)
7     BEGIN {
8     if (%PAR::LibCache) {
9     @INC = grep ref, @INC; # weed out all paths except pars loader refs
10    
11     while (my ($filename, $zip) = each %PAR::LibCache) {
12     for ($zip->memberNames) {
13     next unless /^\/root\/(.*)/;
14     $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
15     unless -e "$ENV{PAR_TEMP}/$1";
16     }
17     }
18    
19     # TODO: pango-rc file, anybody?
20    
21     unshift @INC, $ENV{PAR_TEMP};
22     }
23     }
24    
25     # need to do it again because that pile of garbage called PAR nukes it before main
26     unshift @INC, $ENV{PAR_TEMP}
27     if %PAR::LibCache;
28    
29     use Time::HiRes 'time';
30     use Event;
31    
32     use Crossfire;
33 root 1.12 use Crossfire::Protocol::Constants;
34 root 1.1
35     use Compress::LZF;
36    
37     use CFClient;
38 root 1.10 use CFClient::OpenGL ();
39 root 1.11 use CFClient::Protocol;
40 root 1.1 use CFClient::UI;
41 root 1.80 use CFClient::BindingEditor;
42 root 1.1 use CFClient::MapWidget;
43    
44 root 1.59 $SIG{QUIT} = sub { Carp::cluck "QUIT" };
45    
46 root 1.1 $Event::DIED = sub {
47     # TODO: display dialog box or so
48 root 1.49 Carp::confess $_[1];#d#TODO: remove when stable
49 root 1.1 CFClient::error $_[1];
50     };
51    
52     #$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
53    
54     our $VERSION = '0.1';
55    
56     my $MAX_FPS = 60;
57     my $MIN_FPS = 5; # unused as of yet
58    
59     our $META_SERVER = "crossfire.real-time.com:13326";
60    
61     our $LAST_REFRESH;
62     our $NOW;
63    
64     our $CFG;
65     our $CONN;
66     our $FAST; # fast, low-quality mode, possibly useful for software-rendering
67    
68     our $WANT_REFRESH;
69     our $CAN_REFRESH;
70    
71     our @SDL_MODES;
72     our $WIDTH;
73     our $HEIGHT;
74     our $FULLSCREEN;
75     our $FONTSIZE;
76    
77     our $FONT_PROP;
78     our $FONT_FIXED;
79    
80     our $MAP;
81     our $MAPMAP;
82     our $MAPWIDGET;
83     our $BUTTONBAR;
84     our $LOGVIEW;
85     our $CONSOLE;
86     our $METASERVER;
87     our $LOGIN_BUTTON;
88     our $QUIT_DIALOG;
89 root 1.40 our $HOST_ENTRY;
90 root 1.86 our $PICKUP_ENABLE;
91 root 1.67 our $SERVER_INFO;
92 root 1.49
93     our $SETUP_DIALOG;
94     our $SETUP_NOTEBOOK;
95     our $SETUP_SERVER;
96     our $SETUP_KEYBOARD;
97 root 1.1
98 root 1.86 our $PL_NOTEBOOK;
99     our $PL_WINDOW;
100    
101     our $INVENTORY_PAGE;
102     our $STATS_PAGE;
103     our $SPELL_PAGE;
104    
105     our $HELP_WINDOW;
106 root 1.60 our $MESSAGE_WINDOW;
107 root 1.1 our $FLOORBOX;
108     our $GAUGES;
109     our $STATWIDS;
110    
111     our $SDL_ACTIVE;
112     our %SDL_CB;
113    
114     our $SDL_MIXER;
115     our @SOUNDS; # event => file mapping
116     our %AUDIO_CHUNKS; # audio files
117    
118     our $ALT_ENTER_MESSAGE;
119     our $STATUSBOX;
120     our $DEBUG_STATUS;
121    
122     our $INV;
123     our $INVR;
124 elmex 1.27 our $INV_RIGHT_HB;
125 root 1.1
126 elmex 1.34 our $BIND_EDITOR;
127 elmex 1.77 our $BIND_UPD_CB;
128 elmex 1.24
129 elmex 1.43 our $PICKUP_CFG;
130 elmex 1.38
131 root 1.1 sub status {
132     $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
133     }
134    
135     sub debug {
136     $DEBUG_STATUS->set_text ($_[0]);
137     }
138    
139 root 1.60 sub destroy_query_dialog {
140     (delete $_[0]{query_dialog})->destroy
141     if $_[0]{query_dialog};
142     }
143    
144     # server query dialog
145     sub server_query {
146     my ($conn, $flags, $prompt) = @_;
147    
148     $conn->{query_dialog} = my $dialog = new CFClient::UI::FancyFrame
149     x => "center",
150     y => "center",
151     title => "Server Query",
152     child => my $vbox = new CFClient::UI::VBox,
153     ;
154    
155     my @dialog = my $label = new CFClient::UI::Label
156     max_w => $::WIDTH * 0.4,
157     ellipsise => 0,
158     text => $prompt;
159    
160     if ($flags & CS_QUERY_YESNO) {
161     push @dialog, my $hbox = new CFClient::UI::HBox;
162    
163     $hbox->add (new CFClient::UI::Button
164     text => "No",
165     on_activate => sub {
166     $conn->send ("reply n");
167     $dialog->destroy;
168 root 1.74 0
169 root 1.60 }
170     );
171     $hbox->add (new CFClient::UI::Button
172     text => "Yes",
173     on_activate => sub {
174     $conn->send ("reply y");
175     destroy_query_dialog $conn;
176 root 1.74 0
177 root 1.60 },
178     );
179    
180 root 1.74 $dialog->grab_focus;
181 root 1.60
182     } elsif ($flags & CS_QUERY_SINGLECHAR) {
183     $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
184    
185     if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
186     $MESSAGE_WINDOW->show;
187    
188     unshift @dialog, new CFClient::UI::Label
189     max_w => $::WIDTH * 0.4,
190     ellipsise => 0,
191     markup => "\nOr use your keyboard:\n";
192    
193     unshift @dialog, my $table = new CFClient::UI::Table;
194    
195     $table->add (0, 0, new CFClient::UI::Button
196     text => "Next Race",
197     on_activate => sub {
198     $conn->send ("reply n");
199     destroy_query_dialog $conn;
200 root 1.74 0
201 root 1.60 },
202     );
203     $table->add (2, 0, new CFClient::UI::Button
204     text => "Accept",
205     on_activate => sub {
206     $conn->send ("reply d");
207     destroy_query_dialog $conn;
208 root 1.74 0
209 root 1.60 },
210     );
211    
212     unshift @dialog, new CFClient::UI::Label
213     max_w => $::WIDTH * 0.4,
214     ellipsise => 0,
215     markup =>
216     "<big><b>Character Creation: Race</b></big>\n\n"
217     . "Look at the <b>Messages</b> window to see a description of this race "
218     . "(<small>or hover with your mouse over the bottommost entry in the status area in the lower left area of the screen</small>) "
219     . "and the center of the screen to see how this race looks like "
220     . "(<small>this is below this dialog window, you may need to click on the display area to make it visible</small>).\n\n"
221     . "You can look at another race, or accept this race (you will come back to this race eventually, "
222     . "so you can take your time making this important choice."
223     ;
224    
225     } elsif ($prompt =~ /roll new stats/) {
226     if (my $stat = delete $conn->{stat_change_with}) {
227     $conn->send ("reply $stat");
228     destroy_query_dialog $conn;
229     return;
230     }
231    
232 root 1.86 $STATS_PAGE->show;
233 root 1.60 $MESSAGE_WINDOW->hide;
234    
235     unshift @dialog, new CFClient::UI::Label
236     max_w => $::WIDTH * 0.4,
237     ellipsise => 0,
238     markup => "\nOr use your keyboard:\n";
239    
240     unshift @dialog, my $table = new CFClient::UI::Table;
241    
242     # left: re-roll
243     $table->add (0, 0, new CFClient::UI::Button
244     text => "Roll Again",
245     on_activate => sub {
246     $conn->send ("reply y");
247     destroy_query_dialog $conn;
248 root 1.74 0
249 root 1.60 },
250     );
251    
252     # center: swap stats
253     my ($sw1, $sw2) = map +(new CFClient::UI::Combobox
254     value => $_,
255     options => [
256 root 1.64 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
257     [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
258     [3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"],
259     [4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"],
260     [5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"],
261     [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
262     [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
263 root 1.60 ],
264     ), 1 .. 2;
265    
266     $table->add (2, 0, new CFClient::UI::Button
267     text => "Swap Stats",
268     on_activate => sub {
269     $conn->{stat_change_with} = $sw2->{value};
270     $conn->send ("reply $sw1->{value}");
271     destroy_query_dialog $conn;
272 root 1.74 0
273 root 1.60 },
274     );
275     $table->add (2, 1, new CFClient::UI::HBox children => [$sw1, $sw2]);
276    
277     # right: accept
278     $table->add (4, 0, new CFClient::UI::Button
279     text => "Accept",
280     on_activate => sub {
281     $conn->send ("reply n");
282 root 1.86 $STATS_PAGE->hide;
283 root 1.60 destroy_query_dialog $conn;
284 root 1.74 0
285 root 1.60 },
286     );
287    
288     unshift @dialog, new CFClient::UI::Label
289     max_w => $::WIDTH * 0.4,
290     ellipsise => 0,
291     markup =>
292     "<big><b>Character Creation: Stats</b></big>\n\n"
293     . "Look at the <b>Stats</b> window to see your basic stats "
294     . "(first column: 1 strength, 2 dexterity, 3 constitution, 4 intelligence, 5 wisdom, 6 power and 7 charisma).\n\n"
295     . "You can create another set of stats, swap two stat values with each other or accept the stats as they are now and continue. "
296     . "Race selection will influence those values later on."
297     ;
298     }
299    
300     push @dialog, my $entry = new CFClient::UI::Entry
301     on_changed => sub {
302     $conn->send ("reply $_[1]");
303     destroy_query_dialog $conn;
304 root 1.74 0
305 root 1.60 },
306     ;
307    
308 root 1.74 $entry->grab_focus;
309 root 1.60
310     } else {
311     $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
312    
313     push @dialog, my $entry = new CFClient::UI::Entry
314     $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
315     on_activate => sub {
316     $conn->send ("reply $_[1]");
317     destroy_query_dialog $conn;
318 root 1.74 0
319 root 1.60 },
320     ;
321    
322 root 1.74 $entry->grab_focus;
323 root 1.60 }
324    
325     $vbox->add (@dialog);
326     $dialog->show;
327     }
328    
329 root 1.1 sub start_game {
330     status "logging in...";
331    
332 root 1.23 $LOGIN_BUTTON->set_text ("Logout");
333 root 1.49 $SETUP_DIALOG->hide;
334 root 1.23
335 root 1.1 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
336    
337 root 1.75 my ($host, $port) = split /:/, $CFG->{profile}{default}{host};
338 root 1.11
339 root 1.1 $MAP = new CFClient::Map $mapsize, $mapsize;
340    
341     $CONN = eval {
342 root 1.11 new CFClient::Protocol
343 root 1.1 host => $host,
344     port => $port || 13327,
345 root 1.75 user => $CFG->{profile}{default}{user},
346     pass => $CFG->{profile}{default}{password},
347 root 1.1 mapw => $mapsize,
348     maph => $mapsize,
349 root 1.11
350     map_widget => $MAPWIDGET,
351     logview => $LOGVIEW,
352     statusbox => $STATUSBOX,
353     map => $MAP,
354     mapmap => $MAPMAP,
355 root 1.60 query => \&server_query,
356 root 1.11
357     sound_play => sub {
358     my ($x, $y, $soundnum, $type) = @_;
359    
360     $SDL_MIXER
361     or return;
362    
363     my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
364     or return;
365    
366     $chunk->play;
367     },
368 root 1.1 };
369    
370     if ($CONN) {
371     CFClient::lowdelay fileno $CONN->{fh};
372    
373     status "login successful";
374     } else {
375     status "unable to connect";
376     stop_game();
377     }
378     }
379    
380     sub stop_game {
381 root 1.23 $LOGIN_BUTTON->set_text ("Login");
382 root 1.53 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
383 root 1.49 $SETUP_DIALOG->show;
384 elmex 1.85 $PL_WINDOW->hide;
385 root 1.86 $SPELL_PAGE->clear_spells;
386 root 1.23
387 root 1.1 return unless $CONN;
388    
389     status "connection closed";
390 root 1.23
391 root 1.60 destroy_query_dialog $CONN;
392 root 1.1 $CONN->destroy;
393     $CONN = 0; # false, does not autovivify
394 root 1.76
395     undef $MAP;
396 root 1.1 }
397    
398 root 1.49 sub graphics_setup {
399     my $vbox = new CFClient::UI::VBox;
400 root 1.30
401 root 1.1 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
402    
403     $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
404     $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
405    
406 root 1.31 $hbox->add (my $mode_slider = new CFClient::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
407 root 1.1 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
408    
409     $mode_slider->connect (changed => sub {
410     my ($self, $value) = @_;
411    
412     $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
413     $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
414     });
415     $mode_slider->emit (changed => $mode_slider->{range}[0]);
416    
417     my $row = 1;
418    
419     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
420     $table->add (1, $row++, new CFClient::UI::CheckBox
421     state => $CFG->{fullscreen},
422     tooltip => "Bring the client into fullscreen mode.",
423 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
424 root 1.1 );
425    
426     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
427     $table->add (1, $row++, new CFClient::UI::CheckBox
428     state => $CFG->{fast},
429     tooltip => "Lower the visual quality considerably to speed up rendering.",
430 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
431 root 1.1 );
432    
433     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
434     $table->add (1, $row++, new CFClient::UI::Slider
435     range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
436     tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
437 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
438 root 1.1 );
439    
440     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
441     $table->add (1, $row++, new CFClient::UI::CheckBox
442     state => $CFG->{fow_enable},
443     tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
444 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
445 root 1.1 );
446    
447     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
448     $table->add (1, $row++, new CFClient::UI::Slider
449     range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
450     tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
451 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
452 root 1.1 );
453    
454     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
455     $table->add (1, $row++, new CFClient::UI::CheckBox
456     state => $CFG->{fow_smooth},
457     tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
458 root 1.18 on_changed => sub {
459 root 1.1 my ($self, $value) = @_;
460     $CFG->{fow_smooth} = $value;
461 root 1.15 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
462 root 1.74 0
463 root 1.1 }
464     );
465    
466     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
467     $table->add (1, $row++, new CFClient::UI::Slider
468     range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
469     tooltip => "The base font size used by most GUI elements that do not have their own setting.",
470 root 1.74 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
471 root 1.1 );
472    
473     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
474     $table->add (1, $row++, new CFClient::UI::Slider
475     range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
476     tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
477 root 1.74 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
478 root 1.1 );
479    
480     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
481     $table->add (1, $row++, new CFClient::UI::Slider
482     range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
483     tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
484 root 1.18 on_changed => sub {
485 root 1.1 $CFG->{gauge_fontsize} = $_[1];
486     &set_gauge_window_fontsize;
487 root 1.74 0
488 root 1.1 }
489     );
490    
491     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
492     $table->add (1, $row++, new CFClient::UI::Slider
493 root 1.18 range => [$CFG->{gauge_size}, 0.2, 0.8],
494     tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
495     on_changed => sub {
496 root 1.1 $CFG->{gauge_size} = $_[1];
497     $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
498 root 1.74 0
499 root 1.1 }
500     );
501    
502     $table->add (1, $row++, new CFClient::UI::Button
503     expand => 1, align => 0, text => "Apply",
504     tooltip => "Apply the video settings",
505 root 1.18 on_activate => sub {
506 root 1.1 video_shutdown ();
507     video_init ();
508 root 1.74 0
509 root 1.1 }
510     );
511    
512 root 1.49 $vbox
513     }
514    
515     sub audio_setup {
516     my $vbox = new CFClient::UI::VBox;
517    
518     $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
519    
520     my $row = 0;
521    
522 root 1.1 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
523     $table->add (1, $row++, new CFClient::UI::CheckBox
524     state => $CFG->{audio_enable},
525     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.",
526 root 1.74 on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 }
527 root 1.1 );
528     # $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
529 root 1.18 # $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
530 root 1.1 # $CFG->{effects_volume} = $_[1];
531     # });
532     $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
533     $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
534     $hbox->add (new CFClient::UI::CheckBox
535     expand => 1, state => $CFG->{bgm_enable},
536     tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
537 root 1.74 on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 }
538 root 1.1 );
539     $hbox->add (new CFClient::UI::Slider
540     expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
541     tooltip => "The volume of the background music. Changes are instant.",
542 root 1.74 on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFClient::MixMusic::volume $_[1] * 128; 0 }
543 root 1.1 );
544    
545     $table->add (1, $row++, new CFClient::UI::Button
546     expand => 1, align => 0, text => "Apply",
547     tooltip => "Apply the audio settings",
548 root 1.18 on_activate => sub {
549 root 1.1 audio_shutdown ();
550     audio_init ();
551 root 1.74 0
552 root 1.1 }
553     );
554    
555 root 1.49 $vbox
556 root 1.1 }
557    
558     sub set_gauge_window_fontsize {
559     for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
560     $_->set_fontsize ($::CFG->{gauge_fontsize});
561     }
562     }
563    
564     sub make_gauge_window {
565     my $gh = int $HEIGHT * $CFG->{gauge_size};
566    
567     my $win = new CFClient::UI::Frame (
568 root 1.30 force_x => 0,
569     force_y => "max",
570     force_w => $WIDTH,
571     force_h => $gh,
572 root 1.1 );
573    
574     $win->add (my $hbox = new CFClient::UI::HBox
575     children => [
576     (new CFClient::UI::HBox expand => 1),
577     (new CFClient::UI::VBox children => [
578     (new CFClient::UI::Empty expand => 1),
579 root 1.2 (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::Table)),
580 root 1.1 ]),
581     (my $vbox = new CFClient::UI::VBox),
582     ],
583     );
584    
585     $vbox->add (new CFClient::UI::HBox
586     expand => 1,
587     children => [
588     (new CFClient::UI::Empty expand => 1),
589     (my $hb = new CFClient::UI::HBox),
590     ],
591     );
592    
593     $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
594     tooltip => "<b>Health points</b>. Measures of how much damage you can take before dying. Hit points are determined from your level and are influenced by the value of your Con. Hp value may range between 1 to beyond 500 and higher values indicate a greater ability to withstand punishment.");
595     $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
596     tooltip => "<b>Spell points</b>. Measures of how much \"fuel\" you have for casting spells and incantations. Mana is calculated from your level and your Pow. Mana values can range between 1 to beyond 500 (glowing crystals can increase the current spell points beyond your normal maximum). Higher values indicate greater amounts of mana.");
597     $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
598     tooltip => "<b>Grace points</b> - how favored you are by your god. In game terms, how much divine magic you can cast. Your level, Wis and Pow effect what the value of grace is. Prayong on an altar of your god can increase this value beyond your normal maximum. Grace can take on large positive and negative values. Positive values indicate favor by the gods.");
599     $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
600     tooltip => "<b>Food</b>. Ranges between 0 (starving) and 999 (satiated). At a value of 0 the character begins to die. Some magic can speed up or slow down the character digestion. Healing wounds will speed up digestion too.");
601    
602     $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
603     tooltip => "<b>Experience points and overall level</b> - experience is increased as a reward for appropriate action (such as killing monsters) and may decrease as a result of a magical attack or dying. Level is directly derived from the experience value. As the level of the character increases, the character becomes able to succeed at more difficult tasks. A character's level starts at a value of 0 and may range up beyond 100.");
604     $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
605     tooltip => "<b>Ranged attack</b> - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
606    
607     $GAUGES = {
608     exp => $exp, win => $win, range => $rng,
609     food => $fg, mana => $mg, hp => $hg, grace => $gg
610     };
611    
612     &set_gauge_window_fontsize;
613    
614     $win
615     }
616    
617 root 1.65 sub debug_setup {
618     my $table = new CFClient::UI::Table;
619    
620     $table->add (0, 0, new CFClient::UI::Label text => "Widget Borders");
621 root 1.74 $table->add (1, 0, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
622 root 1.65 $table->add (0, 1, new CFClient::UI::Label text => "Tooltip Widget Info");
623 root 1.74 $table->add (1, 1, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
624 root 1.65 $table->add (0, 2, new CFClient::UI::Label text => "Show FPS");
625 root 1.74 $table->add (1, 2, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
626 root 1.65 $table->add (0, 3, new CFClient::UI::Label text => "Suppress Tooltips");
627 root 1.74 $table->add (1, 3, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
628 root 1.65
629     my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);
630    
631     for my $x (0..2) {
632     for my $y (0 .. 2) {
633     $table->add ($x + 3, $y,
634     new CFClient::UI::Entry
635     text => $default_smooth[$x * 3 + $y],
636     on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 },
637     );
638     }
639     }
640    
641    
642     $table
643     }
644 elmex 1.24
645 root 1.60 sub stats_window {
646 elmex 1.89 my $vb = new CFClient::UI::VBox;
647 root 1.1
648     $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
649     can_hover => 1, can_events => 1,
650     tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
651     $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
652     can_hover => 1, can_events => 1,
653     tooltip => "The map you are currently on (if supported by the server).");
654    
655 elmex 1.5 $vb->add (my $hb0 = new CFClient::UI::HBox);
656     $hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
657     can_hover => 1, can_events => 1,
658 root 1.15 tooltip => "The weight of the player including all inventory items.");
659 elmex 1.5 $hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
660     can_hover => 1, can_events => 1,
661 root 1.15 tooltip => "The weight limit: you cannot carry more than this.");
662 elmex 1.5
663    
664 root 1.1 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
665     $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
666    
667     my $color2 = [1, 1, 0];
668    
669     for (
670     [0, 0, st_str => "Str", 30, "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
671     [0, 1, st_dex => "Dex", 30, "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed"],
672     [0, 2, st_con => "Con", 30, "<b>Constitution</b>, physical health and toughness. Determines how many healthpoints you can have"],
673     [0, 3, st_int => "Int", 30, "<b>Intelligence</b>, your ability to learn and use skills and incantations (both prayers and magic) and determines how much spell points you can have"],
674     [0, 4, st_wis => "Wis", 30, "<b>Wisdom</b>, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
675     [0, 5, st_pow => "Pow", 30, "<b>Power</b>, your magical potential. Influences the strength of spell effects, and also how much your spell and grace points increase when leveling up"],
676     [0, 6, st_cha => "Cha", 30, "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops."],
677    
678     [2, 0, st_wc => "Wc", -120, "<b>Weapon Class</b>, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."],
679     [2, 1, st_ac => "Ac", -120, "<b>Armour Class</b>, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."],
680     [2, 2, st_dam => "Dam", 120, "<b>Damage</b>, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."],
681 elmex 1.82 [2, 3, st_arm => "Arm", 120, "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value. This is the same as the physical resistance."],
682 root 1.1 [2, 4, st_spd => "Spd", 10.54, "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."],
683     [2, 5, st_wspd => "WSp", 10.54, "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."],
684     ) {
685     my ($col, $row, $id, $label, $template, $tooltip) = @$_;
686    
687     $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
688     font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
689     $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
690     font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, align => -1, text => $label, tooltip => $tooltip);
691     }
692    
693     $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
694    
695     my $row = 0;
696     my $col = 0;
697    
698     my %resist_names = (
699     slow => "<b>Slow</b> (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)",
700     holyw => "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
701     conf => "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)",
702     fire => "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
703     depl => "<b>Depletion</b> (some monsters and other effects can cause stats depletion)",
704     magic => "<b>Magic</b> (resistance to magic spells like magic missile or similar)",
705     drain => "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)",
706     acid => "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
707     pois => "<b>Poison</b> (resistance to getting poisoned)",
708     para => "<b>Paralysation</b> (this resistance affects the chance you get paralysed)",
709     deat => "<b>Death</b> (resistance against death spells)",
710 elmex 1.82 phys => "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat. The value displayed here is also displayed in the 'Arm' field on the left.)",
711 root 1.1 blind => "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)",
712     fear => "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)",
713     tund => "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...",
714     elec => "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)",
715     cold => "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)",
716     ghit => "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)",
717     );
718     for (qw/slow holyw conf fire depl magic
719     drain acid pois para deat phys
720     blind fear tund elec cold ghit/)
721     {
722     $tbl2->add ($col, $row,
723     $STATWIDS->{"res_$_"} =
724     new CFClient::UI::Label
725     font => $FONT_FIXED,
726     template => "-100%",
727     align => +1,
728     valign => 0,
729     can_events => 1,
730     can_hover => 1,
731     tooltip => $resist_names{$_},
732     );
733     $tbl2->add ($col + 1, $row, new CFClient::UI::Image
734     font => $FONT_FIXED,
735     can_hover => 1,
736     can_events => 1,
737 root 1.78 path => "ui/resist/resist_$_.png",
738 root 1.1 tooltip => $resist_names{$_},
739     );
740    
741     $row++;
742     if ($row % 6 == 0) {
743     $col += 2;
744     $row = 0;
745     }
746     }
747    
748 elmex 1.89 $vb->add (my $tbl3 = new CFClient::UI::Table expand => 1);
749     $STATWIDS->{"_skill_tbl"} = $tbl3;
750    
751 root 1.1 update_stats_window ({});
752    
753 elmex 1.89 $vb
754 root 1.1 }
755    
756 root 1.48 sub formsep($) {
757     scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
758 root 1.1 }
759    
760     sub update_stats_window {
761     my ($stats) = @_;
762    
763 root 1.12 # I love text protocols...
764    
765     my $hp = $stats->{+CS_STAT_HP} * 1;
766     my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
767     my $sp = $stats->{+CS_STAT_SP} * 1;
768     my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
769     my $fo = $stats->{+CS_STAT_FOOD} * 1;
770 root 1.1 my $fo_m = 999;
771 root 1.12 my $gr = $stats->{+CS_STAT_GRACE} * 1;
772     my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
773 root 1.1
774     $GAUGES->{hp} ->set_value ($hp, $hp_m);
775     $GAUGES->{mana} ->set_value ($sp, $sp_m);
776     $GAUGES->{food} ->set_value ($fo, $fo_m);
777     $GAUGES->{grace} ->set_value ($gr, $gr_m);
778 root 1.12 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
779     . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
780     my $rng = $stats->{+CS_STAT_RANGE};
781 root 1.1 $rng =~ s/^Range: //; # thank you so much dear server
782     $GAUGES->{range} ->set_text ("Rng: " . $rng);
783 root 1.12 my $title = $stats->{+CS_STAT_TITLE};
784 root 1.1 $title =~ s/^Player: //;
785     $STATWIDS->{title} ->set_text ("Title: " . $title);
786    
787 root 1.12 $STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
788     $STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
789     $STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
790     $STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
791     $STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
792     $STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
793     $STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
794     $STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
795     $STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
796     $STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
797 elmex 1.82 $STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_RES_PHYS});
798 root 1.12 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
799     $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
800 root 1.1
801 root 1.12 $STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
802 elmex 1.5
803 root 1.1 my %tbl = (
804 elmex 1.72 phys => CS_STAT_RES_PHYS,
805     magic => CS_STAT_RES_MAG,
806     fire => CS_STAT_RES_FIRE,
807     elec => CS_STAT_RES_ELEC,
808     cold => CS_STAT_RES_COLD,
809     conf => CS_STAT_RES_CONF,
810     acid => CS_STAT_RES_ACID,
811     drain => CS_STAT_RES_DRAIN,
812     ghit => CS_STAT_RES_GHOSTHIT,
813     pois => CS_STAT_RES_POISON,
814     slow => CS_STAT_RES_SLOW,
815     para => CS_STAT_RES_PARA,
816     tund => CS_STAT_TURN_UNDEAD,
817     fear => CS_STAT_RES_FEAR,
818     depl => CS_STAT_RES_DEPLETE,
819     deat => CS_STAT_RES_DEATH,
820     holyw => CS_STAT_RES_HOLYWORD,
821     blind => CS_STAT_RES_BLIND,
822 root 1.1 );
823    
824 elmex 1.89 if ($::CONN && !$STATWIDS->{_skill_tbl_init}) {
825     my $sktbl = $STATWIDS->{_skill_tbl};
826     $sktbl->clear;
827    
828     $sktbl->add (0, 0, new CFClient::UI::Label text => "Exp.", align => 1);
829     $sktbl->add (1, 0, new CFClient::UI::Label text => "Level", align => 1);
830     $sktbl->add (2, 0, new CFClient::UI::Label text => "Skillname");
831    
832     my @skills;
833    
834     for (my $i = CS_STAT_SKILLINFO; $i < CS_STAT_SKILLINFO+CS_NUM_SKILLS; $i++) {
835     push @skills, [$i, $::CONN->{skill_info}{$i}];
836     }
837    
838     my $y = 1;
839     for (sort { $a->[1] cmp $b->[1] } @skills) {
840     my ($idx, $name) = @$_;
841    
842     unless (defined $STATWIDS->{"sk_xp_$idx"} || !$::CONN->{skill_info}{$idx}) {
843     $sktbl->add (0, $y, $STATWIDS->{"sk_xp_$idx"} = new CFClient::UI::Label text => "0", align => 1);
844     $sktbl->add (1, $y, $STATWIDS->{"sk_lvl_$idx"} = new CFClient::UI::Label text => "0", align => 1);
845     $sktbl->add (2, $y++, new CFClient::UI::Label text => $name);
846     }
847     }
848    
849     $STATWIDS->{_skill_tbl_init} = 1;
850     }
851    
852     for (my $i = CS_STAT_SKILLINFO; $i < CS_STAT_SKILLINFO+CS_NUM_SKILLS; $i++) {
853     if (exists $stats->{$i}) {
854     $STATWIDS->{"sk_xp_$i"}->set_text (formsep $stats->{$i}->[1])
855     if $STATWIDS->{"sk_xp_$i"};
856     $STATWIDS->{"sk_lvl_$i"}->set_text (sprintf "%d", $stats->{$i}->[0])
857     if $STATWIDS->{"sk_lvl_$i"};
858     }
859     }
860    
861 root 1.12 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
862     for keys %tbl;
863 root 1.1 }
864    
865     my $METASERVER_ATIME;
866    
867     sub update_metaserver {
868 elmex 1.81 my ($metaserver_dialog) = @_;
869    
870     $METASERVER = $metaserver_dialog
871     if defined $metaserver_dialog;
872    
873 root 1.1 return if $METASERVER_ATIME > time;
874     $METASERVER_ATIME = time + 60;
875    
876     my $table = $METASERVER->{table};
877     $table->clear;
878     $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
879    
880     my $buf;
881    
882     my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
883    
884     unless ($fh) {
885     $label->set_text ("unable to contact metaserver: $!");
886     return;
887     }
888    
889     Event->io (fd => $fh, poll => 'r', cb => sub {
890     my $res = sysread $fh, $buf, 8192, length $buf;
891    
892     if (!defined $res) {
893     $_[0]->w->cancel;
894     $label->set_text ("error while retrieving server list: $!");
895     } elsif ($res == 0) {
896     $_[0]->w->cancel;
897     status "server list retrieved";
898    
899     utf8::decode $buf if utf8::valid $buf;
900    
901     $table->clear;
902    
903 root 1.62 my @tip = (
904     "The current number of users logged in on the server.",
905     "The hostname of the server.",
906     "The time this server has been running without being restarted.",
907     "The server software version - a '+' indicates a Crossfire+ server.",
908     "Short information about this server provided by its admins.",
909     );
910     my @col = qw(#Users Host Uptime Version Description);
911     $table->add ($_, 0, new CFClient::UI::Label
912     can_hover => 1, can_events => 1,
913     align => 0, fg => [1, 1, 0],
914     text => $col[$_], tooltip => $tip[$_])
915     for 0 .. $#col;
916 root 1.1
917     my @align = qw(1 0 1 1 -1);
918    
919     my $y = 0;
920     for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
921     my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
922    
923     for ($desc) {
924     s/<br>/\n/gi;
925     s/<li>/\n· /gi;
926     s/<.*?>//sgi;
927     s/&/&amp;/g;
928     s/</&lt;/g;
929     s/>/&gt;/g;
930     }
931    
932     $uptime = sprintf "%dd %02d:%02d:%02d",
933     (int $m->[8] / 86400),
934     (int $m->[8] / 3600) % 24,
935     (int $m->[8] / 60) % 60,
936     $m->[8] % 60;
937    
938     $m = [$users, $host, $uptime, $version, $desc];
939    
940     $y++;
941    
942 root 1.62 $table->add (scalar @$m, $y, new CFClient::UI::VBox children => [
943     (new CFClient::UI::Button
944     text => "Use",
945     tooltip => "Put this server into the <b>Host:Port</b> field",
946     on_activate => sub {
947 root 1.75 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
948 root 1.62 $METASERVER->hide;
949 root 1.74 0
950 root 1.62 },
951     ),
952 root 1.1 (new CFClient::UI::Empty expand => 1),
953     ]);
954    
955 root 1.62 $table->add ($_, $y, new CFClient::UI::Label
956     ellipsise => 0,
957     align => $align[$_],
958     text => $m->[$_],
959     tooltip => $tip[$_],
960     can_hover => 1,
961     can_events => 1,
962     fontsize => 0.8)
963 root 1.1 for 0 .. $#$m;
964     }
965     }
966     });
967     }
968    
969 root 1.40 sub metaserver_dialog {
970 elmex 1.81 my $vbox = new CFClient::UI::VBox;
971     my $table = new CFClient::UI::Table;
972     $vbox->add (new CFClient::UI::ScrolledWindow expand => 1, child => $table);
973    
974 root 1.40 my $dialog = new CFClient::UI::FancyFrame
975 root 1.62 title => "Server List",
976     name => 'metaserver_dialog',
977     x => 'center',
978     y => 'center',
979     z => 3,
980     force_h => $::HEIGHT * 0.4,
981 elmex 1.81 child => $vbox,
982 root 1.80 has_close_button => 1,
983 elmex 1.81 table => $table,
984 root 1.40 on_visibility_change => sub {
985 elmex 1.81 update_metaserver ($_[0]) if $_[1];
986 root 1.74 0
987 root 1.40 },
988     ;
989    
990     $dialog
991     }
992    
993 root 1.1 sub server_setup {
994 root 1.49 my $vbox = new CFClient::UI::VBox;
995 elmex 1.19
996 root 1.1 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
997     $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
998    
999     {
1000     $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
1001    
1002     $vbox->add (
1003 root 1.40 $HOST_ENTRY = new CFClient::UI::Entry
1004 root 1.1 expand => 1,
1005 root 1.75 text => $CFG->{profile}{default}{host},
1006 root 1.1 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
1007 root 1.18 on_changed => sub {
1008 root 1.1 my ($self, $value) = @_;
1009 root 1.75 $CFG->{profile}{default}{host} = $value;
1010 root 1.74 0
1011 root 1.1 }
1012     );
1013    
1014 root 1.40 $vbox->add (new CFClient::UI::Button
1015     expand => 1,
1016     text => "Server List",
1017     other => $METASERVER,
1018 root 1.1 tooltip => "Show a list of available crossfire servers",
1019 root 1.74 on_activate => sub { $METASERVER->toggle_visibility; 0 },
1020     on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
1021 root 1.1 );
1022     }
1023    
1024     $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
1025     $table->add (1, 4, new CFClient::UI::Entry
1026 root 1.75 text => $CFG->{profile}{default}{user},
1027 root 1.1 tooltip => "The name of your character on the server",
1028 root 1.75 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
1029 root 1.1 );
1030    
1031     $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
1032     $table->add (1, 5, new CFClient::UI::Entry
1033 root 1.75 text => $CFG->{profile}{default}{password},
1034 root 1.1 hidden => 1,
1035     tooltip => "The password for your character",
1036 root 1.75 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
1037 root 1.1 );
1038    
1039     $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
1040     $table->add (1, 7, new CFClient::UI::Slider
1041 root 1.30 force_w => 100,
1042 root 1.1 range => [$CFG->{mapsize}, 10, 100, 0, 1],
1043     tooltip => "This is the size of the portion of the map update the server sends you. "
1044     . "If you set this to a high value you will be able to see further, "
1045     . "but you also increase bandwidth requirements and latency. "
1046     . "This option is only used once at log-in.",
1047 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
1048 root 1.1 );
1049    
1050     $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Face Prefetch");
1051     $table->add (1, 8, new CFClient::UI::CheckBox
1052     state => $CFG->{face_prefetch},
1053     tooltip => "<b>Background Image Prefetch</b>\n\n"
1054     . "If enabled, the client automatically pre-fetches images from the server. "
1055     . "This might increase or create lag, but increases the chances "
1056     . "of faces being ready for display when you encounter them. "
1057     . "It also uses up server bandwidth on every connect, "
1058     . "so only set it if you really need to prefetch images. "
1059     . "This option can be set and unset any time.",
1060 root 1.74 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1061 root 1.1 );
1062    
1063     $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
1064     $table->add (1, 9, new CFClient::UI::Entry
1065     text => $CFG->{output_count},
1066     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1067 root 1.74 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1068 root 1.1 );
1069    
1070     $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
1071     $table->add (1, 10, new CFClient::UI::Entry
1072     text => $CFG->{output_sync},
1073     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1074 root 1.74 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1075 root 1.1 );
1076    
1077     $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
1078     expand => 1,
1079     align => 0,
1080     text => "Login",
1081 root 1.18 on_activate => sub {
1082 root 1.1 $CONN ? stop_game
1083     : start_game;
1084 root 1.74 0
1085 root 1.1 },
1086     );
1087    
1088 root 1.49 $table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
1089     $table->add (1, 12, my $saycmd = new CFClient::UI::Entry
1090     text => $CFG->{say_command},
1091     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. "
1092     . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1093     . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1094     on_changed => sub {
1095     my ($self, $value) = @_;
1096     $CFG->{say_command} = $value;
1097 root 1.74 0
1098 root 1.49 }
1099     );
1100    
1101 root 1.67 $vbox->add (new CFClient::UI::Label
1102     text => "Server Info",
1103     fontsize => 1.2,
1104     padding_y => 8,
1105     fg => [1, 1, 0, 1],
1106     );
1107    
1108     $vbox->add ($SERVER_INFO = new CFClient::UI::Label ellipsise => 0);
1109    
1110 root 1.49 $vbox
1111 root 1.1 }
1112    
1113     sub message_window {
1114     my $window = new CFClient::UI::FancyFrame
1115 elmex 1.16 name => "message_window",
1116 root 1.1 title => "Messages",
1117     border_bg => [1, 1, 1, 1],
1118     bg => [0, 0, 0, 0.75],
1119 root 1.30 x => "max",
1120     y => 0,
1121 root 1.60 force_w => $::WIDTH * 0.4,
1122     force_h => $::HEIGHT * 0.5,
1123 root 1.74 child => (my $vbox = new CFClient::UI::VBox),
1124     has_close_button => 1;
1125 root 1.1
1126     $vbox->add ($LOGVIEW);
1127    
1128     $vbox->add (my $input = new CFClient::UI::Entry
1129     tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
1130     . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
1131     . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
1132     . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
1133 root 1.18 on_focus_in => sub {
1134 root 1.1 my ($input, $prev_focus) = @_;
1135    
1136     delete $input->{refocus_map};
1137    
1138     if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
1139     $input->{refocus_map} = 1;
1140     }
1141     delete $input->{auto_activated};
1142 root 1.74
1143     0
1144 root 1.1 },
1145 root 1.18 on_activate => sub {
1146 root 1.1 my ($input, $text) = @_;
1147     $input->set_text ('');
1148    
1149 elmex 1.46 if ($text =~ /^\/(.*)/) {
1150 root 1.1 $::CONN->user_send ($1);
1151     } else {
1152     my $say_cmd = $::CFG->{say_command} || 'say';
1153     $::CONN->user_send ("$say_cmd $text");
1154     }
1155     if ($input->{refocus_map}) {
1156     delete $input->{refocus_map};
1157     $MAPWIDGET->focus_in
1158     }
1159 root 1.74
1160     0
1161 root 1.1 },
1162 root 1.18 on_escape => sub {
1163 root 1.74 $MAPWIDGET->grab_focus;
1164    
1165     0
1166 root 1.1 },
1167     );
1168    
1169     $CONSOLE = {
1170     window => $window,
1171 root 1.30 input => $input,
1172 root 1.1 };
1173    
1174     $window
1175     }
1176    
1177     sub open_quit_dialog {
1178     unless ($QUIT_DIALOG) {
1179 root 1.30 $QUIT_DIALOG = new CFClient::UI::FancyFrame
1180     x => "center",
1181     y => "center",
1182 root 1.55 z => 50,
1183 root 1.30 title => "Really Quit?",
1184     ;
1185 root 1.1
1186     $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
1187    
1188     $vb->add (new CFClient::UI::Label
1189     text => "You should find a savebed and apply it first!",
1190     max_w => $WIDTH * 0.25,
1191     ellipsize => 0,
1192     );
1193     $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
1194     $hb->add (new CFClient::UI::Button
1195     text => "Ok",
1196     expand => 1,
1197 root 1.74 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1198 root 1.1 );
1199     $hb->add (new CFClient::UI::Button
1200     text => "Quit anyway",
1201     expand => 1,
1202 root 1.18 on_activate => sub { exit },
1203 root 1.1 );
1204 root 1.21 }
1205 root 1.1
1206 root 1.21 $QUIT_DIALOG->show;
1207 root 1.1 }
1208    
1209 root 1.49 sub autopickup_setup {
1210 root 1.51 my $table = new CFClient::UI::Table;
1211 elmex 1.44
1212 elmex 1.43 for (
1213 root 1.51 ["General", 0, 0,
1214 root 1.86 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
1215 root 1.58 ["Inhibit autopickup" => PICKUP_INHIBIT],
1216     ["Stop before pickup" => PICKUP_STOP],
1217     ["Debug autopickup" => PICKUP_DEBUG],
1218 root 1.51 ],
1219     ["Weapons", 0, 6,
1220 root 1.58 ["All weapons" => PICKUP_ALLWEAPON],
1221     ["Missile weapons" => PICKUP_MISSILEWEAPON],
1222     ["Bows" => PICKUP_BOW],
1223     ["Arrows" => PICKUP_ARROW],
1224 root 1.51 ],
1225     ["Armour", 0, 12,
1226 root 1.58 ["Helmets" => PICKUP_HELMET],
1227     ["Shields" => PICKUP_SHIELD],
1228     ["Body Armour" => PICKUP_ARMOUR],
1229     ["Boots" => PICKUP_BOOTS],
1230     ["Gloves" => PICKUP_GLOVES],
1231     ["Cloaks" => PICKUP_CLOAK],
1232 root 1.51 ],
1233    
1234     ["Readables", 2, 2,
1235 root 1.58 ["Spellbooks" => PICKUP_SPELLBOOK],
1236     ["Skillscrolls" => PICKUP_SKILLSCROLL],
1237     ["Normal Books/Scrolls" => PICKUP_READABLES],
1238 root 1.51 ],
1239     ["Misc", 2, 7,
1240 root 1.58 ["Food" => PICKUP_FOOD],
1241     ["Drinks" => PICKUP_DRINK],
1242     ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1243     ["Keys" => PICKUP_KEY],
1244     ["Magical Items" => PICKUP_MAGICAL],
1245     ["Potions" => PICKUP_POTION],
1246     ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1247     ["Ignore cursed" => PICKUP_NOT_CURSED],
1248     ["Jewelery" => PICKUP_JEWELS],
1249 root 1.51 ],
1250 elmex 1.66 ["Weight/Value ratio", 2, 17]
1251 elmex 1.43 )
1252     {
1253 root 1.51 my ($title, $x, $y, @bits) = @$_;
1254     $table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1255    
1256     for (@bits) {
1257     ++$y;
1258    
1259 elmex 1.43 my $mask = $_->[1];
1260 root 1.51 $table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
1261 root 1.86 $table->add ($x+1, $y, my $checkbox = new CFClient::UI::CheckBox
1262 elmex 1.83 state => $::CFG->{pickup} & $mask,
1263 elmex 1.43 on_changed => sub {
1264     my ($box, $value) = @_;
1265 root 1.63
1266 elmex 1.43 if ($value) {
1267 elmex 1.45 $::CFG->{pickup} |= $mask;
1268 elmex 1.43 } else {
1269 root 1.63 $::CFG->{pickup} &= ~$mask;
1270 elmex 1.43 }
1271 root 1.63
1272     $::CONN->send_command ("pickup $::CFG->{pickup}")
1273 elmex 1.45 if defined $::CONN;
1274 root 1.74
1275     0
1276 elmex 1.43 });
1277 root 1.86
1278     ${$_->[2]} = $checkbox if $_->[2];
1279 elmex 1.43 }
1280     }
1281    
1282 elmex 1.66 $table->add (2, 18, new CFClient::UI::ValSlider
1283 elmex 1.83 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1284     template => ">= 99",
1285 elmex 1.66 to_value => sub { ">= " . 5 * $_[0] },
1286     on_changed => sub {
1287     my ($slider, $value) = @_;
1288    
1289 elmex 1.83 $::CFG->{pickup} &= ~0xF;
1290 elmex 1.66 $::CFG->{pickup} |= int $value
1291     if $value;
1292     1;
1293     });
1294 elmex 1.83
1295 elmex 1.66 $table->add (3, 18, new CFClient::UI::Button
1296     text => "set",
1297     on_activate => sub {
1298     $::CONN->send_command ("pickup $::CFG->{pickup}")
1299     if defined $::CONN;
1300 root 1.74 0
1301 elmex 1.66 });
1302    
1303 root 1.51 $table
1304 elmex 1.43 }
1305    
1306 elmex 1.85 sub inventory_widget {
1307     my $hb = new CFClient::UI::HBox homogeneous => 1;
1308 root 1.1
1309 root 1.21 $hb->add (my $vb1 = new CFClient::UI::VBox);
1310     $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
1311 elmex 1.85 $vb1->add ($INV = new CFClient::UI::Inventory);
1312 root 1.1
1313 root 1.21 $hb->add (my $vb2 = new CFClient::UI::VBox);
1314 elmex 1.17
1315 elmex 1.27 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
1316 elmex 1.14
1317 elmex 1.85 $vb2->add ($INVR = new CFClient::UI::Inventory);
1318 root 1.1
1319 elmex 1.27 # XXX: Call after $INVR = ... because set_opencont sets the items
1320     CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
1321    
1322 elmex 1.85 $hb
1323 root 1.1 }
1324    
1325 root 1.86 sub toggle_player_page {
1326     my ($widget) = @_;
1327    
1328     if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
1329     $PL_WINDOW->hide;
1330     } else {
1331     $PL_NOTEBOOK->set_current_page ($widget);
1332     $PL_WINDOW->show;
1333     }
1334     }
1335    
1336 elmex 1.85 sub player_window {
1337     my $plwin = $PL_WINDOW = new CFClient::UI::FancyFrame
1338     x => "center",
1339     y => "center",
1340     force_w => $WIDTH * 9/10,
1341     force_h => $HEIGHT * 9/10,
1342     title => "Player",
1343 elmex 1.90 name => "playerbook",
1344 elmex 1.85 has_close_button => 1
1345     ;
1346    
1347     my $ntb =
1348     $PL_NOTEBOOK =
1349     new CFClient::UI::Notebook
1350     expand => 1,
1351     debug => 1,
1352     filter => (new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1),
1353     ;
1354 root 1.86
1355 elmex 1.85 $ntb->add (
1356 root 1.86 "Stats &amp; Skills" => $STATS_PAGE = stats_window,
1357     "Shows statistics and skill window, where all your Stats, Resistances and Skills are shown."
1358 elmex 1.85 );
1359     $ntb->add (
1360 root 1.87 Spellbook => $SPELL_PAGE = new CFClient::UI::SpellList,
1361 root 1.86 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1362 elmex 1.85 );
1363     $ntb->add (
1364 root 1.86 Inventory => $INVENTORY_PAGE = inventory_widget,
1365     "Toggles the inventory window, where you can manage your loot (or treasures :). "
1366     . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1367 elmex 1.85 );
1368    
1369 root 1.88 $ntb->set_current_page ($INVENTORY_PAGE);
1370 root 1.86
1371 elmex 1.85 $plwin->add ($ntb);
1372     $plwin
1373 elmex 1.38 }
1374    
1375 elmex 1.77 sub update_bindings {
1376     $BIND_UPD_CB->() if $BIND_UPD_CB;
1377     }
1378    
1379 root 1.49 sub keyboard_setup {
1380 elmex 1.24 my $binding_list = new CFClient::UI::VBox;
1381    
1382 elmex 1.34 my $refresh;
1383 elmex 1.77 $refresh = $BIND_UPD_CB = sub {
1384 elmex 1.24 $binding_list->clear ();
1385    
1386 root 1.75 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1387     for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1388     my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1389 elmex 1.24 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1390    
1391     my $lbl = join "; ", @$cmds;
1392 root 1.84 my $nam = CFClient::BindingEditor::keycombo_to_name ($mod, $sym);
1393 elmex 1.24 $binding_list->add (my $hb = new CFClient::UI::HBox);
1394     $hb->add (new CFClient::UI::Button
1395 elmex 1.25 text => "delete",
1396 elmex 1.34 tooltip => "Deletes the binding",
1397 elmex 1.24 on_activate => sub {
1398     $binding_list->remove ($hb);
1399 root 1.75 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1400 root 1.74 0
1401 elmex 1.24 });
1402 elmex 1.34
1403     $hb->add (new CFClient::UI::Button
1404     text => "edit",
1405     tooltip => "Edits the binding",
1406     on_activate => sub {
1407     $::BIND_EDITOR->set_binding (
1408 root 1.75 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1409 elmex 1.34 sub {
1410     my ($nmod, $nsym, $ncmds) = @_;
1411 elmex 1.77 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1412     $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1413 elmex 1.34 $refresh->();
1414 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1415     $SETUP_DIALOG->show;
1416 elmex 1.34 },
1417     sub {
1418 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1419     $SETUP_DIALOG->show;
1420 elmex 1.34 });
1421     $::BIND_EDITOR->show;
1422 root 1.49 $SETUP_DIALOG->hide;
1423 root 1.74 0
1424 elmex 1.34 });
1425    
1426     $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1427 elmex 1.24 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1428     }
1429     }
1430     };
1431    
1432 root 1.49 my $vb = new CFClient::UI::VBox;
1433 elmex 1.71 $vb->add (my $hb = new CFClient::UI::HBox);
1434     $hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
1435     $hb->add (new CFClient::UI::CheckBox
1436     expand => 1,
1437     state => $CFG->{shift_fire_stop},
1438     tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1439     on_changed => sub {
1440     my ($cbox, $value) = @_;
1441     $CFG->{shift_fire_stop} = $value;
1442 root 1.74 0
1443 elmex 1.71 });
1444    
1445 elmex 1.35 $vb->add ($binding_list);
1446     $vb->add (my $hb = new CFClient::UI::HBox);
1447 root 1.49
1448 elmex 1.35 $hb->add (new CFClient::UI::Button
1449 elmex 1.34 text => "record new",
1450 elmex 1.35 expand => 1,
1451 elmex 1.34 tooltip => "This button opens the binding editor with an empty binding.",
1452     on_activate => sub {
1453     $::BIND_EDITOR->set_binding (undef, undef, [],
1454     sub {
1455     my ($mod, $sym, $cmds) = @_;
1456 elmex 1.77 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1457 elmex 1.34 $refresh->();
1458 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1459     $SETUP_DIALOG->show;
1460 elmex 1.34 },
1461     sub {
1462 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1463     $SETUP_DIALOG->show;
1464 root 1.53 },
1465     );
1466 root 1.49 $SETUP_DIALOG->hide;
1467 elmex 1.34 $::BIND_EDITOR->show;
1468 root 1.74 0
1469 elmex 1.34 },
1470     );
1471 root 1.49
1472 elmex 1.35 $hb->add (new CFClient::UI::Button
1473     text => "close",
1474     tooltip => "Closes the binding window",
1475     expand => 1,
1476     on_activate => sub {
1477 root 1.49 $SETUP_DIALOG->hide;
1478 root 1.74 0
1479 elmex 1.35 }
1480     );
1481    
1482 elmex 1.24 $refresh->();
1483 root 1.49
1484     $vb
1485 elmex 1.24 }
1486    
1487 root 1.64 sub help_window {
1488 root 1.1 my $win = new CFClient::UI::FancyFrame
1489 root 1.41 x => 'center',
1490     y => 'center',
1491 root 1.55 z => 2,
1492 root 1.41 name => 'doc_browser',
1493     force_w => int $WIDTH * 7/8,
1494     force_h => int $HEIGHT * 7/8,
1495 root 1.87 title => "Help Browser",
1496     has_close_button => 1;
1497 root 1.1
1498     $win->add (my $vbox = new CFClient::UI::VBox);
1499    
1500     $vbox->add (my $buttons = new CFClient::UI::HBox);
1501 root 1.64 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1502     expand => 1, fontsize => 0.8, padding_x => 4);
1503 root 1.1
1504 root 1.64 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1505     $buttons->add (my $combo = new CFClient::UI::Combobox
1506     value => undef,
1507     options => [
1508     [intro => "Introduction"],
1509 root 1.78 [manual => "Main Manual"],
1510     [skill_help => "Skill Reference"],
1511     [command_help => "Command Reference"],
1512 root 1.64 [dmcommand_help => "DM Commands"],
1513     [COPYING => "License Terms"],
1514     ],
1515     on_changed => sub {
1516     my ($self, $pod) = @_;
1517 root 1.1
1518 root 1.64 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
1519     doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
1520 root 1.1
1521 root 1.64 $viewer->clear;
1522 root 1.78
1523 root 1.79 # $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
1524     # (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
1525     # (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
1526 root 1.78 # ]);#d#
1527 root 1.64
1528     $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1529     for @$pom;
1530 root 1.1
1531 root 1.64 $viewer->set_offset (0);
1532 root 1.78
1533 root 1.74 0
1534 root 1.64 },
1535     on_visibility_change => sub {
1536     my ($self, $visible) = @_;
1537     return unless $visible;
1538     return if $self->{value};
1539     $self->set_value ("intro");
1540 root 1.74 0
1541 root 1.64 },
1542     );
1543 root 1.1
1544     $win
1545     }
1546    
1547     sub sdl_init {
1548     CFClient::SDL_Init
1549     and die "SDL::Init failed!\n";
1550     }
1551    
1552     sub video_init {
1553     sdl_init;
1554    
1555     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1556    
1557     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1558    
1559     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1560     $FULLSCREEN = $CFG->{fullscreen};
1561     $FAST = $CFG->{fast};
1562    
1563     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1564     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1565    
1566     $SDL_ACTIVE = 1;
1567     $LAST_REFRESH = time - 0.01;
1568    
1569 root 1.10 CFClient::OpenGL::init;
1570 root 1.1
1571     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1572    
1573     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1574    
1575     #############################################################################
1576    
1577     if ($DEBUG_STATUS) {
1578     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1579     } else {
1580     # create the widgets
1581    
1582 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1583     padding => 0,
1584     z => 100,
1585     force_x => "max",
1586     force_y => 0;
1587 root 1.1 $DEBUG_STATUS->show;
1588 elmex 1.34
1589 root 1.80 $BIND_EDITOR = new CFClient::BindingEditor (x => "max", y => 0);
1590 elmex 1.34
1591 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1592 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1593 root 1.1
1594     (new CFClient::UI::Frame
1595     bg => [0, 0, 0, 0.4],
1596 root 1.30 force_x => 0,
1597     force_y => "max",
1598 root 1.1 child => $STATUSBOX,
1599     )->show;
1600    
1601     CFClient::UI::FancyFrame->new (
1602 root 1.47 title => "Map",
1603 root 1.42 name => "mapmap",
1604 root 1.30 x => 0,
1605     y => $FONTSIZE + 8,
1606 root 1.1 border_bg => [1, 1, 1, 192/255],
1607     bg => [1, 1, 1, 0],
1608     child => ($MAPMAP = new CFClient::MapWidget::MapMap
1609     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1610     ),
1611     )->show;
1612    
1613     $MAPWIDGET = new CFClient::MapWidget;
1614     $MAPWIDGET->connect (activate_console => sub {
1615     my ($mapwidget, $preset) = @_;
1616    
1617     if ($CONSOLE) {
1618     $CONSOLE->{input}->{auto_activated} = 1;
1619 root 1.74 $CONSOLE->{input}->grab_focus;
1620 root 1.1
1621     if ($preset && $CONSOLE->{input}->get_text eq '') {
1622     $CONSOLE->{input}->set_text ($preset);
1623     }
1624     }
1625     });
1626     $MAPWIDGET->show;
1627 root 1.74 $MAPWIDGET->grab_focus;
1628 root 1.1
1629 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1630 root 1.1 expand => 1,
1631     font => $FONT_FIXED,
1632     fontsize => $::CFG->{log_fontsize},
1633 root 1.61 indent => -4,
1634 root 1.1 can_hover => 1,
1635     can_events => 1,
1636     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1637     ;
1638    
1639 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1640     title => "Setup",
1641     name => "setup_dialog",
1642     x => 'center',
1643     y => 'center',
1644 root 1.53 z => 2,
1645 root 1.49 force_w => $::WIDTH * 0.6,
1646     force_h => $::HEIGHT * 0.6,
1647 root 1.74 has_close_button => 1,
1648 root 1.49 ;
1649    
1650 elmex 1.81 $METASERVER = metaserver_dialog;
1651    
1652 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1653 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1654 root 1.49
1655     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1656     "Configure the server to play on, your username, password and other server-related options.");
1657     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1658 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1659 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1660     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1661     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1662     "Configure the use of audio, sound effects and background music.");
1663     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1664 root 1.75 "Lets you define, edit and delete key bindings."
1665     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1666 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1667 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1668 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1669     . "binding editor closes");
1670 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1671 root 1.75 "Some debuggin' options. Do not ask.");
1672 root 1.49
1673 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1674 root 1.1
1675 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1676     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1677    
1678 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1679 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1680    
1681     make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
1682    
1683 root 1.87 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Playerbook", other => player_window,
1684 elmex 1.85 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
1685 root 1.1
1686     $BUTTONBAR->add (new CFClient::UI::Button
1687     text => "Save Config",
1688     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1689 root 1.18 on_activate => sub {
1690 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1691 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1692 root 1.1 status "Configuration Saved";
1693 root 1.74 0
1694 root 1.1 },
1695     );
1696    
1697 root 1.86 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1698 root 1.1 tooltip => "View Documentation");
1699    
1700     $BUTTONBAR->add (new CFClient::UI::Button
1701 root 1.18 text => "Quit",
1702     tooltip => "Terminates the program",
1703     on_activate => sub {
1704 root 1.1 if ($CONN) {
1705     open_quit_dialog;
1706     } else {
1707     exit;
1708     }
1709 root 1.74 0
1710 root 1.1 },
1711     );
1712    
1713     $BUTTONBAR->show;
1714 root 1.49 $SETUP_DIALOG->show;
1715     }
1716 root 1.1
1717 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1718 root 1.1 }
1719    
1720     sub video_shutdown {
1721 root 1.73 CFClient::OpenGL::shutdown;
1722    
1723 root 1.1 undef $SDL_ACTIVE;
1724     }
1725    
1726     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1727     my $bgmusic;#TODO#hack#d#
1728    
1729     sub audio_channel_finished {
1730     my ($channel) = @_;
1731    
1732     #warn "channel $channel finished\n";#d#
1733     }
1734    
1735     sub audio_music_finished {
1736     return unless $CFG->{bgm_enable};
1737    
1738     # TODO: hack, do play loop and mood music
1739     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1740     $bgmusic->play (0);
1741    
1742     push @bgmusic, shift @bgmusic;
1743     }
1744    
1745     sub audio_init {
1746     if ($CFG->{audio_enable}) {
1747     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1748     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1749    
1750     unless ($SDL_MIXER) {
1751     status "Unable to open sound device: there will be no sound";
1752     return;
1753     }
1754    
1755     CFClient::Mix_AllocateChannels 8;
1756     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1757    
1758     audio_music_finished;
1759    
1760     while (<$fh>) {
1761     next if /^\s*#/;
1762     next if /^\s*$/;
1763    
1764     my ($file, $volume, $event) = split /\s+/, $_, 3;
1765    
1766     push @SOUNDS, "$volume,$file";
1767    
1768     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1769     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1770     $chunk->volume ($volume * 128 / 100);
1771     $chunk
1772     };
1773     }
1774     } else {
1775     status "unable to open sound config: $!";
1776     }
1777     }
1778     }
1779    
1780     sub audio_shutdown {
1781     CFClient::Mix_CloseAudio if $SDL_MIXER;
1782     undef $SDL_MIXER;
1783     @SOUNDS = ();
1784     %AUDIO_CHUNKS = ();
1785     }
1786    
1787     my %animate_object;
1788     my $animate_timer;
1789    
1790     my $fps = 9;
1791    
1792     my %demo;#d#
1793    
1794     sub force_refresh {
1795     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1796 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1797 root 1.1
1798     $CFClient::UI::ROOT->draw;
1799    
1800     $WANT_REFRESH = 0;
1801     $CAN_REFRESH = 0;
1802     $LAST_REFRESH = $NOW;
1803    
1804     0 && do {
1805     # some weird model-drawing code, just a joke right now
1806     use CFClient::OpenGL;
1807    
1808     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1809     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1810     $demo{r} ||= do {
1811     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1812     $mod->{v} = pack "f*", @{$mod->{v}};
1813     $_ = [scalar @$_, pack "S!*", @$_]
1814     for values %{$mod->{g}};
1815     $mod
1816     };
1817    
1818     my $r = $demo{r} or die;
1819    
1820     glDepthMask 1;
1821     glClear GL_DEPTH_BUFFER_BIT;
1822     glEnable GL_TEXTURE_2D;
1823     glEnable GL_DEPTH_TEST;
1824     glEnable GL_CULL_FACE;
1825     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1826    
1827     glMatrixMode GL_PROJECTION;
1828     glLoadIdentity;
1829     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1830     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1831     glMatrixMode GL_MODELVIEW;
1832     glLoadIdentity;
1833    
1834     glPushMatrix;
1835     glTranslate 0, 0, -800;
1836     glScale 1, -1, 1;
1837     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1838     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1839     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1840     glScale 50, 50, 50;
1841    
1842     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1843     while (my ($k, $v) = each %{$r->{g}}) {
1844     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1845     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1846     }
1847    
1848     glPopMatrix;
1849    
1850     glShadeModel GL_FLAT;
1851     glDisable GL_DEPTH_TEST;
1852     glDisable GL_TEXTURE_2D;
1853     glDepthMask 0;
1854    
1855     $WANT_REFRESH++;
1856     };
1857    
1858     CFClient::SDL_GL_SwapBuffers;
1859     }
1860    
1861 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1862 root 1.1 $NOW = time;
1863    
1864     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1865     for CFClient::SDL_PollEvent;
1866    
1867     if (%animate_object) {
1868     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1869     $WANT_REFRESH++;
1870     }
1871    
1872     if ($WANT_REFRESH) {
1873     force_refresh;
1874     } else {
1875     $CAN_REFRESH = 1;
1876     }
1877     });
1878    
1879     sub animation_start {
1880     my ($widget) = @_;
1881     $animate_object{$widget} = $widget;
1882     }
1883    
1884     sub animation_stop {
1885     my ($widget) = @_;
1886     delete $animate_object{$widget};
1887     }
1888    
1889     # check once/second for faces that need to be prefetched
1890     # this should, of course, only run on demand, but
1891     # SDL forces worse things on us....
1892    
1893     Event->timer (after => 1, interval => 0.25, cb => sub {
1894     $CONN->face_prefetch
1895     if $CONN;
1896     });
1897    
1898     %SDL_CB = (
1899     CFClient::SDL_QUIT => sub {
1900     Event::unloop -1;
1901     },
1902     CFClient::SDL_VIDEORESIZE => sub {
1903     },
1904     CFClient::SDL_VIDEOEXPOSE => sub {
1905     CFClient::UI::full_refresh;
1906     },
1907     CFClient::SDL_ACTIVEEVENT => sub {
1908     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1909     },
1910     CFClient::SDL_KEYDOWN => sub {
1911     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1912     # alt-enter
1913     video_shutdown;
1914     $CFG->{fullscreen} = !$CFG->{fullscreen};
1915     video_init;
1916     } else {
1917     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1918     }
1919     },
1920     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1921     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1922     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1923     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1924     CFClient::SDL_USEREVENT => sub {
1925     if ($_[0]{code} == 1) {
1926     audio_channel_finished $_[0]{data1};
1927     } elsif ($_[0]{code} == 0) {
1928     audio_music_finished;
1929     }
1930     },
1931     );
1932    
1933     #############################################################################
1934    
1935     $SIG{INT} = $SIG{TERM} = sub { exit };
1936    
1937     {
1938 root 1.49 local $SIG{__DIE__} = sub {
1939     return unless defined $^S && !$^S;
1940     Carp::confess $_[1];#d#TODO: remove when stable
1941     CFClient::fatal $_[0];
1942     };
1943 root 1.1
1944 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1945 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1946 root 1.1
1947     my %DEF_CFG = (
1948 root 1.75 sdl_mode => 0,
1949     width => 640,
1950     height => 480,
1951     fullscreen => 0,
1952     fast => 0,
1953     map_scale => 1,
1954     fow_enable => 1,
1955     fow_intensity => 0.45,
1956     fow_smooth => 0,
1957     gui_fontsize => 1,
1958     log_fontsize => 0.7,
1959     gauge_fontsize => 1,
1960     gauge_size => 0.35,
1961     stat_fontsize => 0.7,
1962     mapsize => 100,
1963     say_command => 'say',
1964     audio_enable => 1,
1965     bgm_enable => 1,
1966     bgm_volume => 0.25,
1967     face_prefetch => 0,
1968     output_sync => 1,
1969     output_count => 1,
1970     pickup => 0,
1971     default => "profile", # default profile
1972 root 1.1 );
1973 root 1.75
1974 root 1.1 while (my ($k, $v) = each %DEF_CFG) {
1975     $CFG->{$k} = $v unless exists $CFG->{$k};
1976     }
1977    
1978 root 1.75 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
1979    
1980 root 1.1 sdl_init;
1981    
1982     @SDL_MODES = reverse
1983     grep $_->[0] >= 640 && $_->[1] >= 480,
1984     CFClient::SDL_ListModes;
1985    
1986     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1987    
1988     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1989    
1990     {
1991     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1992     DejaVuSans.ttf
1993     DejaVuSansMono.ttf
1994     DejaVuSans-Bold.ttf
1995     DejaVuSansMono-Bold.ttf
1996     DejaVuSans-Oblique.ttf
1997     DejaVuSansMono-Oblique.ttf
1998     DejaVuSans-BoldOblique.ttf
1999     DejaVuSansMono-BoldOblique.ttf
2000     );
2001    
2002     CFClient::add_font $_ for @fonts;
2003    
2004     CFClient::pango_init;
2005    
2006     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
2007     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
2008    
2009     $FONT_PROP->make_default;
2010     }
2011    
2012     # compare mono (ft) vs. rgba (cairo)
2013     # ft - 1.8s, cairo 3s, even in alpha-only mode
2014     # for my $rgba (0..1) {
2015     # my $t1 = Time::HiRes::time;
2016     # for (1..1000) {
2017     # my $layout = CFClient::Layout->new ($rgba);
2018     # $layout->set_text ("hallo" x 100);
2019     # $layout->render;
2020     # }
2021     # my $t2 = Time::HiRes::time;
2022     # warn $t2-$t1;
2023     # }
2024    
2025     video_init;
2026     audio_init;
2027     }
2028    
2029     Event::loop;
2030 root 1.69 #CFClient::SDL_Quit;
2031     #CFClient::_exit 0;
2032 root 1.1
2033     END { CFClient::SDL_Quit }
2034    
2035     =head1 NAME
2036    
2037 root 1.28 cfplus - A Crossfire+ and Crossfire game client
2038 root 1.1
2039     =head1 SYNOPSIS
2040    
2041     Just run it - no commandline arguments are supported.
2042    
2043     =head1 USAGE
2044    
2045 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2046 root 1.1 fullscreen and interactively.
2047    
2048 root 1.39 =head1 DEBUGGING
2049    
2050    
2051     CFPLUS_DEBUG - environment variable
2052    
2053     1 draw borders around widgets
2054     2 add low-level widget info to tooltips
2055     4 show fps
2056     8 suppress tooltips
2057    
2058 root 1.1 =head1 AUTHOR
2059    
2060     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2061    
2062    
2063