ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.72
Committed: Tue Jun 13 18:14:03 2006 UTC (17 years, 11 months ago) by elmex
Branch: MAIN
Changes since 1.71: +18 -19 lines
Log Message:
replaced the hardcoded stats with CS_STAT_RES_* constants and removed the todo item.

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     undef $SDL_ACTIVE;
1635     }
1636    
1637     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1638     my $bgmusic;#TODO#hack#d#
1639    
1640     sub audio_channel_finished {
1641     my ($channel) = @_;
1642    
1643     #warn "channel $channel finished\n";#d#
1644     }
1645    
1646     sub audio_music_finished {
1647     return unless $CFG->{bgm_enable};
1648    
1649     # TODO: hack, do play loop and mood music
1650     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1651     $bgmusic->play (0);
1652    
1653     push @bgmusic, shift @bgmusic;
1654     }
1655    
1656     sub audio_init {
1657     if ($CFG->{audio_enable}) {
1658     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1659     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1660    
1661     unless ($SDL_MIXER) {
1662     status "Unable to open sound device: there will be no sound";
1663     return;
1664     }
1665    
1666     CFClient::Mix_AllocateChannels 8;
1667     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1668    
1669     audio_music_finished;
1670    
1671     while (<$fh>) {
1672     next if /^\s*#/;
1673     next if /^\s*$/;
1674    
1675     my ($file, $volume, $event) = split /\s+/, $_, 3;
1676    
1677     push @SOUNDS, "$volume,$file";
1678    
1679     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1680     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1681     $chunk->volume ($volume * 128 / 100);
1682     $chunk
1683     };
1684     }
1685     } else {
1686     status "unable to open sound config: $!";
1687     }
1688     }
1689     }
1690    
1691     sub audio_shutdown {
1692     CFClient::Mix_CloseAudio if $SDL_MIXER;
1693     undef $SDL_MIXER;
1694     @SOUNDS = ();
1695     %AUDIO_CHUNKS = ();
1696     }
1697    
1698     my %animate_object;
1699     my $animate_timer;
1700    
1701     my $fps = 9;
1702    
1703     my %demo;#d#
1704    
1705     sub force_refresh {
1706     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1707 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1708 root 1.1
1709     $CFClient::UI::ROOT->draw;
1710    
1711     $WANT_REFRESH = 0;
1712     $CAN_REFRESH = 0;
1713     $LAST_REFRESH = $NOW;
1714    
1715     0 && do {
1716     # some weird model-drawing code, just a joke right now
1717     use CFClient::OpenGL;
1718    
1719     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1720     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1721     $demo{r} ||= do {
1722     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1723     $mod->{v} = pack "f*", @{$mod->{v}};
1724     $_ = [scalar @$_, pack "S!*", @$_]
1725     for values %{$mod->{g}};
1726     $mod
1727     };
1728    
1729     my $r = $demo{r} or die;
1730    
1731     glDepthMask 1;
1732     glClear GL_DEPTH_BUFFER_BIT;
1733     glEnable GL_TEXTURE_2D;
1734     glEnable GL_DEPTH_TEST;
1735     glEnable GL_CULL_FACE;
1736     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1737    
1738     glMatrixMode GL_PROJECTION;
1739     glLoadIdentity;
1740     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1741     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1742     glMatrixMode GL_MODELVIEW;
1743     glLoadIdentity;
1744    
1745     glPushMatrix;
1746     glTranslate 0, 0, -800;
1747     glScale 1, -1, 1;
1748     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1749     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1750     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1751     glScale 50, 50, 50;
1752    
1753     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1754     while (my ($k, $v) = each %{$r->{g}}) {
1755     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1756     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1757     }
1758    
1759     glPopMatrix;
1760    
1761     glShadeModel GL_FLAT;
1762     glDisable GL_DEPTH_TEST;
1763     glDisable GL_TEXTURE_2D;
1764     glDepthMask 0;
1765    
1766     $WANT_REFRESH++;
1767     };
1768    
1769     CFClient::SDL_GL_SwapBuffers;
1770     }
1771    
1772 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1773 root 1.1 $NOW = time;
1774    
1775     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1776     for CFClient::SDL_PollEvent;
1777    
1778     if (%animate_object) {
1779     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1780     $WANT_REFRESH++;
1781     }
1782    
1783     if ($WANT_REFRESH) {
1784     force_refresh;
1785     } else {
1786     $CAN_REFRESH = 1;
1787     }
1788     });
1789    
1790     sub animation_start {
1791     my ($widget) = @_;
1792     $animate_object{$widget} = $widget;
1793     }
1794    
1795     sub animation_stop {
1796     my ($widget) = @_;
1797     delete $animate_object{$widget};
1798     }
1799    
1800     # check once/second for faces that need to be prefetched
1801     # this should, of course, only run on demand, but
1802     # SDL forces worse things on us....
1803    
1804     Event->timer (after => 1, interval => 0.25, cb => sub {
1805     $CONN->face_prefetch
1806     if $CONN;
1807     });
1808    
1809     %SDL_CB = (
1810     CFClient::SDL_QUIT => sub {
1811     Event::unloop -1;
1812     },
1813     CFClient::SDL_VIDEORESIZE => sub {
1814     },
1815     CFClient::SDL_VIDEOEXPOSE => sub {
1816     CFClient::UI::full_refresh;
1817     },
1818     CFClient::SDL_ACTIVEEVENT => sub {
1819     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1820     },
1821     CFClient::SDL_KEYDOWN => sub {
1822     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1823     # alt-enter
1824     video_shutdown;
1825     $CFG->{fullscreen} = !$CFG->{fullscreen};
1826     video_init;
1827     } else {
1828     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1829     }
1830     },
1831     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1832     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1833     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1834     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1835     CFClient::SDL_USEREVENT => sub {
1836     if ($_[0]{code} == 1) {
1837     audio_channel_finished $_[0]{data1};
1838     } elsif ($_[0]{code} == 0) {
1839     audio_music_finished;
1840     }
1841     },
1842     );
1843    
1844     #############################################################################
1845    
1846     $SIG{INT} = $SIG{TERM} = sub { exit };
1847    
1848     {
1849 root 1.49 local $SIG{__DIE__} = sub {
1850     return unless defined $^S && !$^S;
1851     Carp::confess $_[1];#d#TODO: remove when stable
1852     CFClient::fatal $_[0];
1853     };
1854 root 1.1
1855 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1856 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1857 root 1.1
1858     my %DEF_CFG = (
1859     sdl_mode => 0,
1860     width => 640,
1861     height => 480,
1862     fullscreen => 0,
1863     fast => 0,
1864     map_scale => 1,
1865     fow_enable => 1,
1866     fow_intensity => 0.45,
1867     fow_smooth => 0,
1868     gui_fontsize => 1,
1869 root 1.60 log_fontsize => 0.7,
1870 root 1.1 gauge_fontsize=> 1,
1871     gauge_size => 0.35,
1872 root 1.60 stat_fontsize => 0.7,
1873 root 1.1 mapsize => 100,
1874     host => "crossfire.schmorp.de",
1875     say_command => 'say',
1876     audio_enable => 1,
1877     bgm_enable => 1,
1878     bgm_volume => 0.25,
1879     face_prefetch => 0,
1880     output_sync => 1,
1881     output_count => 1,
1882 root 1.63 pickup => 0,
1883 root 1.1 );
1884    
1885     while (my ($k, $v) = each %DEF_CFG) {
1886     $CFG->{$k} = $v unless exists $CFG->{$k};
1887     }
1888    
1889     sdl_init;
1890    
1891     @SDL_MODES = reverse
1892     grep $_->[0] >= 640 && $_->[1] >= 480,
1893     CFClient::SDL_ListModes;
1894    
1895     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1896    
1897     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1898    
1899     {
1900     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1901     DejaVuSans.ttf
1902     DejaVuSansMono.ttf
1903     DejaVuSans-Bold.ttf
1904     DejaVuSansMono-Bold.ttf
1905     DejaVuSans-Oblique.ttf
1906     DejaVuSansMono-Oblique.ttf
1907     DejaVuSans-BoldOblique.ttf
1908     DejaVuSansMono-BoldOblique.ttf
1909     );
1910    
1911     CFClient::add_font $_ for @fonts;
1912    
1913     CFClient::pango_init;
1914    
1915     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1916     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1917    
1918     $FONT_PROP->make_default;
1919     }
1920    
1921     # compare mono (ft) vs. rgba (cairo)
1922     # ft - 1.8s, cairo 3s, even in alpha-only mode
1923     # for my $rgba (0..1) {
1924     # my $t1 = Time::HiRes::time;
1925     # for (1..1000) {
1926     # my $layout = CFClient::Layout->new ($rgba);
1927     # $layout->set_text ("hallo" x 100);
1928     # $layout->render;
1929     # }
1930     # my $t2 = Time::HiRes::time;
1931     # warn $t2-$t1;
1932     # }
1933    
1934     video_init;
1935     audio_init;
1936     }
1937    
1938     Event::loop;
1939 root 1.69 #CFClient::SDL_Quit;
1940     #CFClient::_exit 0;
1941 root 1.1
1942     END { CFClient::SDL_Quit }
1943    
1944     =head1 NAME
1945    
1946 root 1.28 cfplus - A Crossfire+ and Crossfire game client
1947 root 1.1
1948     =head1 SYNOPSIS
1949    
1950     Just run it - no commandline arguments are supported.
1951    
1952     =head1 USAGE
1953    
1954 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1955 root 1.1 fullscreen and interactively.
1956    
1957 root 1.39 =head1 DEBUGGING
1958    
1959    
1960     CFPLUS_DEBUG - environment variable
1961    
1962     1 draw borders around widgets
1963     2 add low-level widget info to tooltips
1964     4 show fps
1965     8 suppress tooltips
1966    
1967 root 1.1 =head1 AUTHOR
1968    
1969     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1970    
1971    
1972