ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.91
Committed: Tue Jul 11 13:51:38 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.90: +1 -0 lines
Log Message:
*** empty log message ***

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