ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.73
Committed: Sat Jun 17 15:07:54 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.72: +2 -0 lines
Log Message:
free textures on vidoe shutdown, seems useless, but maybe fixes scaras problem

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