ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.89
Committed: Sun Jul 9 21:11:48 2006 UTC (17 years, 10 months ago) by elmex
Branch: MAIN
Changes since 1.88: +42 -23 lines
Log Message:
skill dialog in stats window

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     has_close_button => 1
1344     ;
1345    
1346     my $ntb =
1347     $PL_NOTEBOOK =
1348     new CFClient::UI::Notebook
1349     expand => 1,
1350     debug => 1,
1351     filter => (new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1),
1352     ;
1353 root 1.86
1354 elmex 1.85 $ntb->add (
1355 root 1.86 "Stats &amp; Skills" => $STATS_PAGE = stats_window,
1356     "Shows statistics and skill window, where all your Stats, Resistances and Skills are shown."
1357 elmex 1.85 );
1358     $ntb->add (
1359 root 1.87 Spellbook => $SPELL_PAGE = new CFClient::UI::SpellList,
1360 root 1.86 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1361 elmex 1.85 );
1362     $ntb->add (
1363 root 1.86 Inventory => $INVENTORY_PAGE = inventory_widget,
1364     "Toggles the inventory window, where you can manage your loot (or treasures :). "
1365     . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1366 elmex 1.85 );
1367    
1368 root 1.88 $ntb->set_current_page ($INVENTORY_PAGE);
1369 root 1.86
1370 elmex 1.85 $plwin->add ($ntb);
1371     $plwin
1372 elmex 1.38 }
1373    
1374 elmex 1.77 sub update_bindings {
1375     $BIND_UPD_CB->() if $BIND_UPD_CB;
1376     }
1377    
1378 root 1.49 sub keyboard_setup {
1379 elmex 1.24 my $binding_list = new CFClient::UI::VBox;
1380    
1381 elmex 1.34 my $refresh;
1382 elmex 1.77 $refresh = $BIND_UPD_CB = sub {
1383 elmex 1.24 $binding_list->clear ();
1384    
1385 root 1.75 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1386     for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1387     my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1388 elmex 1.24 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1389    
1390     my $lbl = join "; ", @$cmds;
1391 root 1.84 my $nam = CFClient::BindingEditor::keycombo_to_name ($mod, $sym);
1392 elmex 1.24 $binding_list->add (my $hb = new CFClient::UI::HBox);
1393     $hb->add (new CFClient::UI::Button
1394 elmex 1.25 text => "delete",
1395 elmex 1.34 tooltip => "Deletes the binding",
1396 elmex 1.24 on_activate => sub {
1397     $binding_list->remove ($hb);
1398 root 1.75 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1399 root 1.74 0
1400 elmex 1.24 });
1401 elmex 1.34
1402     $hb->add (new CFClient::UI::Button
1403     text => "edit",
1404     tooltip => "Edits the binding",
1405     on_activate => sub {
1406     $::BIND_EDITOR->set_binding (
1407 root 1.75 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1408 elmex 1.34 sub {
1409     my ($nmod, $nsym, $ncmds) = @_;
1410 elmex 1.77 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1411     $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1412 elmex 1.34 $refresh->();
1413 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1414     $SETUP_DIALOG->show;
1415 elmex 1.34 },
1416     sub {
1417 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1418     $SETUP_DIALOG->show;
1419 elmex 1.34 });
1420     $::BIND_EDITOR->show;
1421 root 1.49 $SETUP_DIALOG->hide;
1422 root 1.74 0
1423 elmex 1.34 });
1424    
1425     $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1426 elmex 1.24 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1427     }
1428     }
1429     };
1430    
1431 root 1.49 my $vb = new CFClient::UI::VBox;
1432 elmex 1.71 $vb->add (my $hb = new CFClient::UI::HBox);
1433     $hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
1434     $hb->add (new CFClient::UI::CheckBox
1435     expand => 1,
1436     state => $CFG->{shift_fire_stop},
1437     tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1438     on_changed => sub {
1439     my ($cbox, $value) = @_;
1440     $CFG->{shift_fire_stop} = $value;
1441 root 1.74 0
1442 elmex 1.71 });
1443    
1444 elmex 1.35 $vb->add ($binding_list);
1445     $vb->add (my $hb = new CFClient::UI::HBox);
1446 root 1.49
1447 elmex 1.35 $hb->add (new CFClient::UI::Button
1448 elmex 1.34 text => "record new",
1449 elmex 1.35 expand => 1,
1450 elmex 1.34 tooltip => "This button opens the binding editor with an empty binding.",
1451     on_activate => sub {
1452     $::BIND_EDITOR->set_binding (undef, undef, [],
1453     sub {
1454     my ($mod, $sym, $cmds) = @_;
1455 elmex 1.77 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1456 elmex 1.34 $refresh->();
1457 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1458     $SETUP_DIALOG->show;
1459 elmex 1.34 },
1460     sub {
1461 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1462     $SETUP_DIALOG->show;
1463 root 1.53 },
1464     );
1465 root 1.49 $SETUP_DIALOG->hide;
1466 elmex 1.34 $::BIND_EDITOR->show;
1467 root 1.74 0
1468 elmex 1.34 },
1469     );
1470 root 1.49
1471 elmex 1.35 $hb->add (new CFClient::UI::Button
1472     text => "close",
1473     tooltip => "Closes the binding window",
1474     expand => 1,
1475     on_activate => sub {
1476 root 1.49 $SETUP_DIALOG->hide;
1477 root 1.74 0
1478 elmex 1.35 }
1479     );
1480    
1481 elmex 1.24 $refresh->();
1482 root 1.49
1483     $vb
1484 elmex 1.24 }
1485    
1486 root 1.64 sub help_window {
1487 root 1.1 my $win = new CFClient::UI::FancyFrame
1488 root 1.41 x => 'center',
1489     y => 'center',
1490 root 1.55 z => 2,
1491 root 1.41 name => 'doc_browser',
1492     force_w => int $WIDTH * 7/8,
1493     force_h => int $HEIGHT * 7/8,
1494 root 1.87 title => "Help Browser",
1495     has_close_button => 1;
1496 root 1.1
1497     $win->add (my $vbox = new CFClient::UI::VBox);
1498    
1499     $vbox->add (my $buttons = new CFClient::UI::HBox);
1500 root 1.64 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1501     expand => 1, fontsize => 0.8, padding_x => 4);
1502 root 1.1
1503 root 1.64 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1504     $buttons->add (my $combo = new CFClient::UI::Combobox
1505     value => undef,
1506     options => [
1507     [intro => "Introduction"],
1508 root 1.78 [manual => "Main Manual"],
1509     [skill_help => "Skill Reference"],
1510     [command_help => "Command Reference"],
1511 root 1.64 [dmcommand_help => "DM Commands"],
1512     [COPYING => "License Terms"],
1513     ],
1514     on_changed => sub {
1515     my ($self, $pod) = @_;
1516 root 1.1
1517 root 1.64 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
1518     doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
1519 root 1.1
1520 root 1.64 $viewer->clear;
1521 root 1.78
1522 root 1.79 # $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
1523     # (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
1524     # (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
1525 root 1.78 # ]);#d#
1526 root 1.64
1527     $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1528     for @$pom;
1529 root 1.1
1530 root 1.64 $viewer->set_offset (0);
1531 root 1.78
1532 root 1.74 0
1533 root 1.64 },
1534     on_visibility_change => sub {
1535     my ($self, $visible) = @_;
1536     return unless $visible;
1537     return if $self->{value};
1538     $self->set_value ("intro");
1539 root 1.74 0
1540 root 1.64 },
1541     );
1542 root 1.1
1543     $win
1544     }
1545    
1546     sub sdl_init {
1547     CFClient::SDL_Init
1548     and die "SDL::Init failed!\n";
1549     }
1550    
1551     sub video_init {
1552     sdl_init;
1553    
1554     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1555    
1556     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1557    
1558     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1559     $FULLSCREEN = $CFG->{fullscreen};
1560     $FAST = $CFG->{fast};
1561    
1562     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1563     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1564    
1565     $SDL_ACTIVE = 1;
1566     $LAST_REFRESH = time - 0.01;
1567    
1568 root 1.10 CFClient::OpenGL::init;
1569 root 1.1
1570     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1571    
1572     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1573    
1574     #############################################################################
1575    
1576     if ($DEBUG_STATUS) {
1577     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1578     } else {
1579     # create the widgets
1580    
1581 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1582     padding => 0,
1583     z => 100,
1584     force_x => "max",
1585     force_y => 0;
1586 root 1.1 $DEBUG_STATUS->show;
1587 elmex 1.34
1588 root 1.80 $BIND_EDITOR = new CFClient::BindingEditor (x => "max", y => 0);
1589 elmex 1.34
1590 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1591 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1592 root 1.1
1593     (new CFClient::UI::Frame
1594     bg => [0, 0, 0, 0.4],
1595 root 1.30 force_x => 0,
1596     force_y => "max",
1597 root 1.1 child => $STATUSBOX,
1598     )->show;
1599    
1600     CFClient::UI::FancyFrame->new (
1601 root 1.47 title => "Map",
1602 root 1.42 name => "mapmap",
1603 root 1.30 x => 0,
1604     y => $FONTSIZE + 8,
1605 root 1.1 border_bg => [1, 1, 1, 192/255],
1606     bg => [1, 1, 1, 0],
1607     child => ($MAPMAP = new CFClient::MapWidget::MapMap
1608     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1609     ),
1610     )->show;
1611    
1612     $MAPWIDGET = new CFClient::MapWidget;
1613     $MAPWIDGET->connect (activate_console => sub {
1614     my ($mapwidget, $preset) = @_;
1615    
1616     if ($CONSOLE) {
1617     $CONSOLE->{input}->{auto_activated} = 1;
1618 root 1.74 $CONSOLE->{input}->grab_focus;
1619 root 1.1
1620     if ($preset && $CONSOLE->{input}->get_text eq '') {
1621     $CONSOLE->{input}->set_text ($preset);
1622     }
1623     }
1624     });
1625     $MAPWIDGET->show;
1626 root 1.74 $MAPWIDGET->grab_focus;
1627 root 1.1
1628 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1629 root 1.1 expand => 1,
1630     font => $FONT_FIXED,
1631     fontsize => $::CFG->{log_fontsize},
1632 root 1.61 indent => -4,
1633 root 1.1 can_hover => 1,
1634     can_events => 1,
1635     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1636     ;
1637    
1638 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1639     title => "Setup",
1640     name => "setup_dialog",
1641     x => 'center',
1642     y => 'center',
1643 root 1.53 z => 2,
1644 root 1.49 force_w => $::WIDTH * 0.6,
1645     force_h => $::HEIGHT * 0.6,
1646 root 1.74 has_close_button => 1,
1647 root 1.49 ;
1648    
1649 elmex 1.81 $METASERVER = metaserver_dialog;
1650    
1651 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1652 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1653 root 1.49
1654     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1655     "Configure the server to play on, your username, password and other server-related options.");
1656     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1657 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1658 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1659     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1660     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1661     "Configure the use of audio, sound effects and background music.");
1662     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1663 root 1.75 "Lets you define, edit and delete key bindings."
1664     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1665 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1666 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1667 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1668     . "binding editor closes");
1669 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1670 root 1.75 "Some debuggin' options. Do not ask.");
1671 root 1.49
1672 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1673 root 1.1
1674 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1675     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1676    
1677 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1678 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1679    
1680     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
1681    
1682 root 1.87 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Playerbook", other => player_window,
1683 elmex 1.85 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
1684 root 1.1
1685     $BUTTONBAR->add (new CFClient::UI::Button
1686     text => "Save Config",
1687     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1688 root 1.18 on_activate => sub {
1689 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1690 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1691 root 1.1 status "Configuration Saved";
1692 root 1.74 0
1693 root 1.1 },
1694     );
1695    
1696 root 1.86 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1697 root 1.1 tooltip => "View Documentation");
1698    
1699     $BUTTONBAR->add (new CFClient::UI::Button
1700 root 1.18 text => "Quit",
1701     tooltip => "Terminates the program",
1702     on_activate => sub {
1703 root 1.1 if ($CONN) {
1704     open_quit_dialog;
1705     } else {
1706     exit;
1707     }
1708 root 1.74 0
1709 root 1.1 },
1710     );
1711    
1712     $BUTTONBAR->show;
1713 root 1.49 $SETUP_DIALOG->show;
1714     }
1715 root 1.1
1716 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1717 root 1.1 }
1718    
1719     sub video_shutdown {
1720 root 1.73 CFClient::OpenGL::shutdown;
1721    
1722 root 1.1 undef $SDL_ACTIVE;
1723     }
1724    
1725     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1726     my $bgmusic;#TODO#hack#d#
1727    
1728     sub audio_channel_finished {
1729     my ($channel) = @_;
1730    
1731     #warn "channel $channel finished\n";#d#
1732     }
1733    
1734     sub audio_music_finished {
1735     return unless $CFG->{bgm_enable};
1736    
1737     # TODO: hack, do play loop and mood music
1738     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1739     $bgmusic->play (0);
1740    
1741     push @bgmusic, shift @bgmusic;
1742     }
1743    
1744     sub audio_init {
1745     if ($CFG->{audio_enable}) {
1746     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1747     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1748    
1749     unless ($SDL_MIXER) {
1750     status "Unable to open sound device: there will be no sound";
1751     return;
1752     }
1753    
1754     CFClient::Mix_AllocateChannels 8;
1755     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1756    
1757     audio_music_finished;
1758    
1759     while (<$fh>) {
1760     next if /^\s*#/;
1761     next if /^\s*$/;
1762    
1763     my ($file, $volume, $event) = split /\s+/, $_, 3;
1764    
1765     push @SOUNDS, "$volume,$file";
1766    
1767     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1768     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1769     $chunk->volume ($volume * 128 / 100);
1770     $chunk
1771     };
1772     }
1773     } else {
1774     status "unable to open sound config: $!";
1775     }
1776     }
1777     }
1778    
1779     sub audio_shutdown {
1780     CFClient::Mix_CloseAudio if $SDL_MIXER;
1781     undef $SDL_MIXER;
1782     @SOUNDS = ();
1783     %AUDIO_CHUNKS = ();
1784     }
1785    
1786     my %animate_object;
1787     my $animate_timer;
1788    
1789     my $fps = 9;
1790    
1791     my %demo;#d#
1792    
1793     sub force_refresh {
1794     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1795 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1796 root 1.1
1797     $CFClient::UI::ROOT->draw;
1798    
1799     $WANT_REFRESH = 0;
1800     $CAN_REFRESH = 0;
1801     $LAST_REFRESH = $NOW;
1802    
1803     0 && do {
1804     # some weird model-drawing code, just a joke right now
1805     use CFClient::OpenGL;
1806    
1807     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1808     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1809     $demo{r} ||= do {
1810     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1811     $mod->{v} = pack "f*", @{$mod->{v}};
1812     $_ = [scalar @$_, pack "S!*", @$_]
1813     for values %{$mod->{g}};
1814     $mod
1815     };
1816    
1817     my $r = $demo{r} or die;
1818    
1819     glDepthMask 1;
1820     glClear GL_DEPTH_BUFFER_BIT;
1821     glEnable GL_TEXTURE_2D;
1822     glEnable GL_DEPTH_TEST;
1823     glEnable GL_CULL_FACE;
1824     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1825    
1826     glMatrixMode GL_PROJECTION;
1827     glLoadIdentity;
1828     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1829     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1830     glMatrixMode GL_MODELVIEW;
1831     glLoadIdentity;
1832    
1833     glPushMatrix;
1834     glTranslate 0, 0, -800;
1835     glScale 1, -1, 1;
1836     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1837     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1838     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1839     glScale 50, 50, 50;
1840    
1841     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1842     while (my ($k, $v) = each %{$r->{g}}) {
1843     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1844     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1845     }
1846    
1847     glPopMatrix;
1848    
1849     glShadeModel GL_FLAT;
1850     glDisable GL_DEPTH_TEST;
1851     glDisable GL_TEXTURE_2D;
1852     glDepthMask 0;
1853    
1854     $WANT_REFRESH++;
1855     };
1856    
1857     CFClient::SDL_GL_SwapBuffers;
1858     }
1859    
1860 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1861 root 1.1 $NOW = time;
1862    
1863     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1864     for CFClient::SDL_PollEvent;
1865    
1866     if (%animate_object) {
1867     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1868     $WANT_REFRESH++;
1869     }
1870    
1871     if ($WANT_REFRESH) {
1872     force_refresh;
1873     } else {
1874     $CAN_REFRESH = 1;
1875     }
1876     });
1877    
1878     sub animation_start {
1879     my ($widget) = @_;
1880     $animate_object{$widget} = $widget;
1881     }
1882    
1883     sub animation_stop {
1884     my ($widget) = @_;
1885     delete $animate_object{$widget};
1886     }
1887    
1888     # check once/second for faces that need to be prefetched
1889     # this should, of course, only run on demand, but
1890     # SDL forces worse things on us....
1891    
1892     Event->timer (after => 1, interval => 0.25, cb => sub {
1893     $CONN->face_prefetch
1894     if $CONN;
1895     });
1896    
1897     %SDL_CB = (
1898     CFClient::SDL_QUIT => sub {
1899     Event::unloop -1;
1900     },
1901     CFClient::SDL_VIDEORESIZE => sub {
1902     },
1903     CFClient::SDL_VIDEOEXPOSE => sub {
1904     CFClient::UI::full_refresh;
1905     },
1906     CFClient::SDL_ACTIVEEVENT => sub {
1907     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1908     },
1909     CFClient::SDL_KEYDOWN => sub {
1910     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1911     # alt-enter
1912     video_shutdown;
1913     $CFG->{fullscreen} = !$CFG->{fullscreen};
1914     video_init;
1915     } else {
1916     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1917     }
1918     },
1919     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1920     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1921     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1922     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1923     CFClient::SDL_USEREVENT => sub {
1924     if ($_[0]{code} == 1) {
1925     audio_channel_finished $_[0]{data1};
1926     } elsif ($_[0]{code} == 0) {
1927     audio_music_finished;
1928     }
1929     },
1930     );
1931    
1932     #############################################################################
1933    
1934     $SIG{INT} = $SIG{TERM} = sub { exit };
1935    
1936     {
1937 root 1.49 local $SIG{__DIE__} = sub {
1938     return unless defined $^S && !$^S;
1939     Carp::confess $_[1];#d#TODO: remove when stable
1940     CFClient::fatal $_[0];
1941     };
1942 root 1.1
1943 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1944 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1945 root 1.1
1946     my %DEF_CFG = (
1947 root 1.75 sdl_mode => 0,
1948     width => 640,
1949     height => 480,
1950     fullscreen => 0,
1951     fast => 0,
1952     map_scale => 1,
1953     fow_enable => 1,
1954     fow_intensity => 0.45,
1955     fow_smooth => 0,
1956     gui_fontsize => 1,
1957     log_fontsize => 0.7,
1958     gauge_fontsize => 1,
1959     gauge_size => 0.35,
1960     stat_fontsize => 0.7,
1961     mapsize => 100,
1962     say_command => 'say',
1963     audio_enable => 1,
1964     bgm_enable => 1,
1965     bgm_volume => 0.25,
1966     face_prefetch => 0,
1967     output_sync => 1,
1968     output_count => 1,
1969     pickup => 0,
1970     default => "profile", # default profile
1971 root 1.1 );
1972 root 1.75
1973 root 1.1 while (my ($k, $v) = each %DEF_CFG) {
1974     $CFG->{$k} = $v unless exists $CFG->{$k};
1975     }
1976    
1977 root 1.75 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
1978    
1979 root 1.1 sdl_init;
1980    
1981     @SDL_MODES = reverse
1982     grep $_->[0] >= 640 && $_->[1] >= 480,
1983     CFClient::SDL_ListModes;
1984    
1985     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1986    
1987     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1988    
1989     {
1990     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1991     DejaVuSans.ttf
1992     DejaVuSansMono.ttf
1993     DejaVuSans-Bold.ttf
1994     DejaVuSansMono-Bold.ttf
1995     DejaVuSans-Oblique.ttf
1996     DejaVuSansMono-Oblique.ttf
1997     DejaVuSans-BoldOblique.ttf
1998     DejaVuSansMono-BoldOblique.ttf
1999     );
2000    
2001     CFClient::add_font $_ for @fonts;
2002    
2003     CFClient::pango_init;
2004    
2005     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
2006     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
2007    
2008     $FONT_PROP->make_default;
2009     }
2010    
2011     # compare mono (ft) vs. rgba (cairo)
2012     # ft - 1.8s, cairo 3s, even in alpha-only mode
2013     # for my $rgba (0..1) {
2014     # my $t1 = Time::HiRes::time;
2015     # for (1..1000) {
2016     # my $layout = CFClient::Layout->new ($rgba);
2017     # $layout->set_text ("hallo" x 100);
2018     # $layout->render;
2019     # }
2020     # my $t2 = Time::HiRes::time;
2021     # warn $t2-$t1;
2022     # }
2023    
2024     video_init;
2025     audio_init;
2026     }
2027    
2028     Event::loop;
2029 root 1.69 #CFClient::SDL_Quit;
2030     #CFClient::_exit 0;
2031 root 1.1
2032     END { CFClient::SDL_Quit }
2033    
2034     =head1 NAME
2035    
2036 root 1.28 cfplus - A Crossfire+ and Crossfire game client
2037 root 1.1
2038     =head1 SYNOPSIS
2039    
2040     Just run it - no commandline arguments are supported.
2041    
2042     =head1 USAGE
2043    
2044 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2045 root 1.1 fullscreen and interactively.
2046    
2047 root 1.39 =head1 DEBUGGING
2048    
2049    
2050     CFPLUS_DEBUG - environment variable
2051    
2052     1 draw borders around widgets
2053     2 add low-level widget info to tooltips
2054     4 show fps
2055     8 suppress tooltips
2056    
2057 root 1.1 =head1 AUTHOR
2058    
2059     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2060    
2061    
2062