ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.71
Committed: Tue Jun 13 14:35:18 2006 UTC (17 years, 11 months ago) by elmex
Branch: MAIN
Changes since 1.70: +11 -0 lines
Log Message:
changed the fireing logic a little bit and made a checkbox for the old
one. and implemented todo item:
- log messages received and commands sent to ~/.crossfire/log.$ip

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.12 # TODO: replace by CS_STAT_RES_xxx constants
822 root 1.1 my %tbl = (
823     phys => 100,
824     magic => 101,
825     fire => 102,
826     elec => 103,
827     cold => 104,
828     conf => 105,
829     acid => 106,
830     drain => 107,
831     ghit => 108,
832     pois => 109,
833     slow => 110,
834     para => 111,
835     tund => 112,
836     fear => 113,
837     depl => 113,
838     deat => 115,
839     holyw => 116,
840 root 1.12 blind => 117,
841 root 1.1 );
842    
843 root 1.12 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
844     for keys %tbl;
845 root 1.1 }
846    
847     my $METASERVER_ATIME;
848    
849     sub update_metaserver {
850     return if $METASERVER_ATIME > time;
851     $METASERVER_ATIME = time + 60;
852    
853     my $table = $METASERVER->{table};
854     $table->clear;
855     $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
856    
857     my $buf;
858    
859     my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
860    
861     unless ($fh) {
862     $label->set_text ("unable to contact metaserver: $!");
863     return;
864     }
865    
866     Event->io (fd => $fh, poll => 'r', cb => sub {
867     my $res = sysread $fh, $buf, 8192, length $buf;
868    
869     if (!defined $res) {
870     $_[0]->w->cancel;
871     $label->set_text ("error while retrieving server list: $!");
872     } elsif ($res == 0) {
873     $_[0]->w->cancel;
874     status "server list retrieved";
875    
876     utf8::decode $buf if utf8::valid $buf;
877    
878     $table->clear;
879    
880 root 1.62 my @tip = (
881     "The current number of users logged in on the server.",
882     "The hostname of the server.",
883     "The time this server has been running without being restarted.",
884     "The server software version - a '+' indicates a Crossfire+ server.",
885     "Short information about this server provided by its admins.",
886     );
887     my @col = qw(#Users Host Uptime Version Description);
888     $table->add ($_, 0, new CFClient::UI::Label
889     can_hover => 1, can_events => 1,
890     align => 0, fg => [1, 1, 0],
891     text => $col[$_], tooltip => $tip[$_])
892     for 0 .. $#col;
893 root 1.1
894     my @align = qw(1 0 1 1 -1);
895    
896     my $y = 0;
897     for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
898     my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
899    
900     for ($desc) {
901     s/<br>/\n/gi;
902     s/<li>/\n· /gi;
903     s/<.*?>//sgi;
904     s/&/&amp;/g;
905     s/</&lt;/g;
906     s/>/&gt;/g;
907     }
908    
909     $uptime = sprintf "%dd %02d:%02d:%02d",
910     (int $m->[8] / 86400),
911     (int $m->[8] / 3600) % 24,
912     (int $m->[8] / 60) % 60,
913     $m->[8] % 60;
914    
915     $m = [$users, $host, $uptime, $version, $desc];
916    
917     $y++;
918    
919 root 1.62 $table->add (scalar @$m, $y, new CFClient::UI::VBox children => [
920     (new CFClient::UI::Button
921     text => "Use",
922     tooltip => "Put this server into the <b>Host:Port</b> field",
923     on_activate => sub {
924     $HOST_ENTRY->set_text ($CFG->{host} = $host);
925     $METASERVER->hide;
926     },
927     ),
928 root 1.1 (new CFClient::UI::Empty expand => 1),
929     ]);
930    
931 root 1.62 $table->add ($_, $y, new CFClient::UI::Label
932     ellipsise => 0,
933     align => $align[$_],
934     text => $m->[$_],
935     tooltip => $tip[$_],
936     can_hover => 1,
937     can_events => 1,
938     fontsize => 0.8)
939 root 1.1 for 0 .. $#$m;
940     }
941     }
942     });
943     }
944    
945 root 1.40 sub metaserver_dialog {
946     my $dialog = new CFClient::UI::FancyFrame
947 root 1.62 title => "Server List",
948     name => 'metaserver_dialog',
949     x => 'center',
950     y => 'center',
951     z => 3,
952     force_h => $::HEIGHT * 0.4,
953     child => (my $vbox = new CFClient::UI::VBox),
954 root 1.40 on_visibility_change => sub {
955     update_metaserver if $_[1];
956     },
957     ;
958    
959 root 1.62 $dialog->{table} = new CFClient::UI::Table;
960    
961     $vbox->add (new CFClient::UI::ScrolledWindow expand => 1, child => $dialog->{table});
962 root 1.40
963     $dialog
964     }
965    
966 root 1.1 sub server_setup {
967 root 1.49 my $vbox = new CFClient::UI::VBox;
968 elmex 1.19
969 root 1.1 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
970     $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
971    
972     {
973     $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
974    
975     $vbox->add (
976 root 1.40 $HOST_ENTRY = new CFClient::UI::Entry
977 root 1.1 expand => 1,
978     text => $CFG->{host},
979     tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
980 root 1.18 on_changed => sub {
981 root 1.1 my ($self, $value) = @_;
982     $CFG->{host} = $value;
983     }
984     );
985    
986     $METASERVER = metaserver_dialog;
987    
988 root 1.40 $vbox->add (new CFClient::UI::Button
989     expand => 1,
990     text => "Server List",
991     other => $METASERVER,
992 root 1.1 tooltip => "Show a list of available crossfire servers",
993 root 1.40 on_activate => sub { $METASERVER->toggle_visibility },
994 root 1.62 on_visibility_change => sub { $METASERVER->hide unless $_[1] },
995 root 1.1 );
996     }
997    
998     $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
999     $table->add (1, 4, new CFClient::UI::Entry
1000     text => $CFG->{user},
1001     tooltip => "The name of your character on the server",
1002 root 1.18 on_changed => sub {
1003 root 1.1 my ($self, $value) = @_;
1004     $CFG->{user} = $value;
1005     }
1006     );
1007    
1008     $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
1009     $table->add (1, 5, new CFClient::UI::Entry
1010     text => $CFG->{password},
1011     hidden => 1,
1012     tooltip => "The password for your character",
1013 root 1.18 on_changed => sub {
1014 root 1.1 my ($self, $value) = @_;
1015     $CFG->{password} = $value;
1016     }
1017     );
1018    
1019     $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
1020     $table->add (1, 7, new CFClient::UI::Slider
1021 root 1.30 force_w => 100,
1022 root 1.1 range => [$CFG->{mapsize}, 10, 100, 0, 1],
1023     tooltip => "This is the size of the portion of the map update the server sends you. "
1024     . "If you set this to a high value you will be able to see further, "
1025     . "but you also increase bandwidth requirements and latency. "
1026     . "This option is only used once at log-in.",
1027 root 1.18 on_changed => sub {
1028 root 1.1 my ($self, $value) = @_;
1029    
1030     $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
1031     },
1032     );
1033    
1034     $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Face Prefetch");
1035     $table->add (1, 8, new CFClient::UI::CheckBox
1036     state => $CFG->{face_prefetch},
1037     tooltip => "<b>Background Image Prefetch</b>\n\n"
1038     . "If enabled, the client automatically pre-fetches images from the server. "
1039     . "This might increase or create lag, but increases the chances "
1040     . "of faces being ready for display when you encounter them. "
1041     . "It also uses up server bandwidth on every connect, "
1042     . "so only set it if you really need to prefetch images. "
1043     . "This option can be set and unset any time.",
1044 root 1.18 on_changed => sub { $CFG->{face_prefetch} = $_[1] },
1045 root 1.1 );
1046    
1047     $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
1048     $table->add (1, 9, new CFClient::UI::Entry
1049     text => $CFG->{output_count},
1050     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1051 root 1.18 on_changed => sub { $CFG->{output_count} = $_[1] },
1052 root 1.1 );
1053    
1054     $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
1055     $table->add (1, 10, new CFClient::UI::Entry
1056     text => $CFG->{output_sync},
1057     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1058 root 1.18 on_changed => sub { $CFG->{output_sync} = $_[1] },
1059 root 1.1 );
1060    
1061     $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
1062     expand => 1,
1063     align => 0,
1064     text => "Login",
1065 root 1.18 on_activate => sub {
1066 root 1.1 $CONN ? stop_game
1067     : start_game;
1068     },
1069     );
1070    
1071 root 1.49 $table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
1072     $table->add (1, 12, my $saycmd = new CFClient::UI::Entry
1073     text => $CFG->{say_command},
1074     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. "
1075     . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1076     . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1077     on_changed => sub {
1078     my ($self, $value) = @_;
1079     $CFG->{say_command} = $value;
1080     }
1081     );
1082    
1083 root 1.67 $vbox->add (new CFClient::UI::Label
1084     text => "Server Info",
1085     fontsize => 1.2,
1086     padding_y => 8,
1087     fg => [1, 1, 0, 1],
1088     );
1089    
1090     $vbox->add ($SERVER_INFO = new CFClient::UI::Label ellipsise => 0);
1091    
1092 root 1.49 $vbox
1093 root 1.1 }
1094    
1095     sub message_window {
1096     my $window = new CFClient::UI::FancyFrame
1097 elmex 1.16 name => "message_window",
1098 root 1.1 title => "Messages",
1099     border_bg => [1, 1, 1, 1],
1100     bg => [0, 0, 0, 0.75],
1101 root 1.30 x => "max",
1102     y => 0,
1103 root 1.60 force_w => $::WIDTH * 0.4,
1104     force_h => $::HEIGHT * 0.5,
1105 root 1.1 child => (my $vbox = new CFClient::UI::VBox);
1106    
1107     $vbox->add ($LOGVIEW);
1108    
1109     $vbox->add (my $input = new CFClient::UI::Entry
1110     tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
1111     . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
1112     . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
1113     . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
1114 root 1.18 on_focus_in => sub {
1115 root 1.1 my ($input, $prev_focus) = @_;
1116    
1117     delete $input->{refocus_map};
1118    
1119     if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
1120     $input->{refocus_map} = 1;
1121     }
1122     delete $input->{auto_activated};
1123     },
1124 root 1.18 on_activate => sub {
1125 root 1.1 my ($input, $text) = @_;
1126     $input->set_text ('');
1127    
1128 elmex 1.46 if ($text =~ /^\/(.*)/) {
1129 root 1.1 $::CONN->user_send ($1);
1130     } else {
1131     my $say_cmd = $::CFG->{say_command} || 'say';
1132     $::CONN->user_send ("$say_cmd $text");
1133     }
1134     if ($input->{refocus_map}) {
1135     delete $input->{refocus_map};
1136     $MAPWIDGET->focus_in
1137     }
1138     },
1139 root 1.18 on_escape => sub {
1140 root 1.1 $MAPWIDGET->focus_in
1141     },
1142     );
1143    
1144     $CONSOLE = {
1145     window => $window,
1146 root 1.30 input => $input,
1147 root 1.1 };
1148    
1149     $window
1150     }
1151    
1152     sub open_quit_dialog {
1153     unless ($QUIT_DIALOG) {
1154 root 1.30 $QUIT_DIALOG = new CFClient::UI::FancyFrame
1155     x => "center",
1156     y => "center",
1157 root 1.55 z => 50,
1158 root 1.30 title => "Really Quit?",
1159     ;
1160 root 1.1
1161     $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
1162    
1163     $vb->add (new CFClient::UI::Label
1164     text => "You should find a savebed and apply it first!",
1165     max_w => $WIDTH * 0.25,
1166     ellipsize => 0,
1167     );
1168     $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
1169     $hb->add (new CFClient::UI::Button
1170     text => "Ok",
1171     expand => 1,
1172 root 1.18 on_activate => sub { $QUIT_DIALOG->hide },
1173 root 1.1 );
1174     $hb->add (new CFClient::UI::Button
1175     text => "Quit anyway",
1176     expand => 1,
1177 root 1.18 on_activate => sub { exit },
1178 root 1.1 );
1179 root 1.21 }
1180 root 1.1
1181 root 1.21 $QUIT_DIALOG->show;
1182 root 1.1 }
1183    
1184 root 1.49 sub autopickup_setup {
1185 root 1.51 my $table = new CFClient::UI::Table;
1186 elmex 1.44
1187 elmex 1.43 for (
1188 root 1.51 ["General", 0, 0,
1189 root 1.58 ["Enable autopickup" => PICKUP_NEWMODE],
1190     ["Inhibit autopickup" => PICKUP_INHIBIT],
1191     ["Stop before pickup" => PICKUP_STOP],
1192     ["Debug autopickup" => PICKUP_DEBUG],
1193 root 1.51 ],
1194     ["Weapons", 0, 6,
1195 root 1.58 ["All weapons" => PICKUP_ALLWEAPON],
1196     ["Missile weapons" => PICKUP_MISSILEWEAPON],
1197     ["Bows" => PICKUP_BOW],
1198     ["Arrows" => PICKUP_ARROW],
1199 root 1.51 ],
1200     ["Armour", 0, 12,
1201 root 1.58 ["Helmets" => PICKUP_HELMET],
1202     ["Shields" => PICKUP_SHIELD],
1203     ["Body Armour" => PICKUP_ARMOUR],
1204     ["Boots" => PICKUP_BOOTS],
1205     ["Gloves" => PICKUP_GLOVES],
1206     ["Cloaks" => PICKUP_CLOAK],
1207 root 1.51 ],
1208    
1209     ["Readables", 2, 2,
1210 root 1.58 ["Spellbooks" => PICKUP_SPELLBOOK],
1211     ["Skillscrolls" => PICKUP_SKILLSCROLL],
1212     ["Normal Books/Scrolls" => PICKUP_READABLES],
1213 root 1.51 ],
1214     ["Misc", 2, 7,
1215 root 1.58 ["Food" => PICKUP_FOOD],
1216     ["Drinks" => PICKUP_DRINK],
1217     ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1218     ["Keys" => PICKUP_KEY],
1219     ["Magical Items" => PICKUP_MAGICAL],
1220     ["Potions" => PICKUP_POTION],
1221     ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1222     ["Ignore cursed" => PICKUP_NOT_CURSED],
1223     ["Jewelery" => PICKUP_JEWELS],
1224 root 1.51 ],
1225 elmex 1.66 ["Weight/Value ratio", 2, 17]
1226 elmex 1.43 )
1227     {
1228 root 1.51 my ($title, $x, $y, @bits) = @$_;
1229     $table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1230    
1231     for (@bits) {
1232     ++$y;
1233    
1234 elmex 1.43 my $mask = $_->[1];
1235 root 1.51 $table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
1236     $table->add ($x+1, $y, new CFClient::UI::CheckBox
1237 elmex 1.43 state => $CFG->{pickup} & $mask,
1238     on_changed => sub {
1239     my ($box, $value) = @_;
1240 root 1.63
1241 elmex 1.43 if ($value) {
1242 elmex 1.45 $::CFG->{pickup} |= $mask;
1243 elmex 1.43 } else {
1244 root 1.63 $::CFG->{pickup} &= ~$mask;
1245 elmex 1.43 }
1246 root 1.63
1247     $::CONN->send_command ("pickup $::CFG->{pickup}")
1248 elmex 1.45 if defined $::CONN;
1249 elmex 1.43 });
1250     }
1251     }
1252    
1253 elmex 1.66 $table->add (2, 18, new CFClient::UI::ValSlider
1254     range => [0, 0, 16, 1, 1],
1255     to_value => sub { ">= " . 5 * $_[0] },
1256     on_changed => sub {
1257     my ($slider, $value) = @_;
1258    
1259     $::CFG->{pickup} &= ~0x7;
1260     $::CFG->{pickup} |= int $value
1261     if $value;
1262     1;
1263     });
1264     $table->add (3, 18, new CFClient::UI::Button
1265     text => "set",
1266     on_activate => sub {
1267     $::CONN->send_command ("pickup $::CFG->{pickup}")
1268     if defined $::CONN;
1269     1;
1270     });
1271    
1272 root 1.51 $table
1273 elmex 1.43 }
1274    
1275 root 1.60 sub inventory_window {
1276 root 1.23 my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
1277 root 1.32 x => "center",
1278     y => "center",
1279     force_w => $WIDTH * 9/10,
1280     force_h => $HEIGHT * 9/10,
1281     title => "Inventory",
1282 root 1.21 ;
1283 root 1.1
1284 root 1.21 $invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
1285 root 1.1
1286 root 1.21 $hb->add (my $vb1 = new CFClient::UI::VBox);
1287     $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
1288     $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
1289 root 1.1
1290 root 1.21 $hb->add (my $vb2 = new CFClient::UI::VBox);
1291 elmex 1.17
1292 elmex 1.27 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
1293 elmex 1.14
1294 root 1.1 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
1295    
1296 elmex 1.27 # XXX: Call after $INVR = ... because set_opencont sets the items
1297     CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
1298    
1299 root 1.1 $invwin
1300     }
1301    
1302 root 1.49 sub spell_setup {
1303     new CFClient::UI::SpellList
1304 elmex 1.38 }
1305    
1306 root 1.49 sub keyboard_setup {
1307 elmex 1.24 my $binding_list = new CFClient::UI::VBox;
1308    
1309 elmex 1.34 my $refresh;
1310     $refresh = sub {
1311 elmex 1.24 $binding_list->clear ();
1312    
1313     for my $mod (keys %{$::CFG->{bindings}}) {
1314     for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
1315     my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
1316     next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1317    
1318     my $lbl = join "; ", @$cmds;
1319 elmex 1.34 my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
1320 elmex 1.24 $binding_list->add (my $hb = new CFClient::UI::HBox);
1321     $hb->add (new CFClient::UI::Button
1322 elmex 1.25 text => "delete",
1323 elmex 1.34 tooltip => "Deletes the binding",
1324 elmex 1.24 on_activate => sub {
1325     $binding_list->remove ($hb);
1326     delete $::CFG->{bindings}->{$mod}->{$sym};
1327     });
1328 elmex 1.34
1329     $hb->add (new CFClient::UI::Button
1330     text => "edit",
1331     tooltip => "Edits the binding",
1332     on_activate => sub {
1333     $::BIND_EDITOR->set_binding (
1334     $mod, $sym, $::CFG->{bindings}->{$mod}->{$sym},
1335     sub {
1336     my ($nmod, $nsym, $ncmds) = @_;
1337     delete $::CFG->{bindings}->{$mod}->{$sym};
1338     $::CFG->{bindings}->{$nmod}->{$nsym} = $ncmds;
1339     $refresh->();
1340 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1341     $SETUP_DIALOG->show;
1342 elmex 1.34 },
1343     sub {
1344 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1345     $SETUP_DIALOG->show;
1346 elmex 1.34 });
1347     $::BIND_EDITOR->show;
1348 root 1.49 $SETUP_DIALOG->hide;
1349 elmex 1.34 });
1350    
1351     $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1352 elmex 1.24 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1353     }
1354     }
1355     };
1356    
1357 root 1.49 my $vb = new CFClient::UI::VBox;
1358 elmex 1.71 $vb->add (my $hb = new CFClient::UI::HBox);
1359     $hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
1360     $hb->add (new CFClient::UI::CheckBox
1361     expand => 1,
1362     state => $CFG->{shift_fire_stop},
1363     tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1364     on_changed => sub {
1365     my ($cbox, $value) = @_;
1366     $CFG->{shift_fire_stop} = $value;
1367     });
1368    
1369 elmex 1.35 $vb->add ($binding_list);
1370     $vb->add (my $hb = new CFClient::UI::HBox);
1371 root 1.49
1372 elmex 1.35 $hb->add (new CFClient::UI::Button
1373 elmex 1.34 text => "record new",
1374 elmex 1.35 expand => 1,
1375 elmex 1.34 tooltip => "This button opens the binding editor with an empty binding.",
1376     on_activate => sub {
1377     $::BIND_EDITOR->set_binding (undef, undef, [],
1378     sub {
1379     my ($mod, $sym, $cmds) = @_;
1380     $::CFG->{bindings}->{$mod}->{$sym} = $cmds;
1381     $refresh->();
1382 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1383     $SETUP_DIALOG->show;
1384 elmex 1.34 },
1385     sub {
1386 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1387     $SETUP_DIALOG->show;
1388 root 1.53 },
1389     );
1390 root 1.49 $SETUP_DIALOG->hide;
1391 elmex 1.34 $::BIND_EDITOR->show;
1392     },
1393     );
1394 root 1.49
1395 elmex 1.35 $hb->add (new CFClient::UI::Button
1396     text => "close",
1397     tooltip => "Closes the binding window",
1398     expand => 1,
1399     on_activate => sub {
1400 root 1.49 $SETUP_DIALOG->hide;
1401 elmex 1.35 }
1402     );
1403    
1404 elmex 1.24 $refresh->();
1405 root 1.49
1406     $vb
1407 elmex 1.24 }
1408    
1409 root 1.64 sub help_window {
1410 root 1.1 my $win = new CFClient::UI::FancyFrame
1411 root 1.41 x => 'center',
1412     y => 'center',
1413 root 1.55 z => 2,
1414 root 1.41 name => 'doc_browser',
1415     force_w => int $WIDTH * 7/8,
1416     force_h => int $HEIGHT * 7/8,
1417     title => "Documentation";
1418 root 1.1
1419     $win->add (my $vbox = new CFClient::UI::VBox);
1420    
1421     $vbox->add (my $buttons = new CFClient::UI::HBox);
1422 root 1.64 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1423     expand => 1, fontsize => 0.8, padding_x => 4);
1424 root 1.1
1425 root 1.64 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1426     $buttons->add (my $combo = new CFClient::UI::Combobox
1427     value => undef,
1428     options => [
1429     [intro => "Introduction"],
1430     [manual => "Manual"],
1431     [skill_help => "Skills"],
1432     [command_help => "Commands"],
1433     [dmcommand_help => "DM Commands"],
1434     [COPYING => "License Terms"],
1435     ],
1436     on_changed => sub {
1437     my ($self, $pod) = @_;
1438 root 1.1
1439 root 1.64 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
1440     doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
1441 root 1.1
1442 root 1.64 $viewer->clear;
1443    
1444     $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1445     for @$pom;
1446 root 1.1
1447 root 1.64 $viewer->set_offset (0);
1448     },
1449     on_visibility_change => sub {
1450     my ($self, $visible) = @_;
1451     return unless $visible;
1452     return if $self->{value};
1453     $self->set_value ("intro");
1454     },
1455     );
1456 root 1.1
1457     $win
1458     }
1459    
1460     sub sdl_init {
1461     CFClient::SDL_Init
1462     and die "SDL::Init failed!\n";
1463     }
1464    
1465     sub video_init {
1466     sdl_init;
1467    
1468     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1469    
1470     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1471    
1472     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1473     $FULLSCREEN = $CFG->{fullscreen};
1474     $FAST = $CFG->{fast};
1475    
1476     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1477     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1478    
1479     $SDL_ACTIVE = 1;
1480     $LAST_REFRESH = time - 0.01;
1481    
1482 root 1.10 CFClient::OpenGL::init;
1483 root 1.1
1484     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1485    
1486     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1487    
1488     #############################################################################
1489    
1490     if ($DEBUG_STATUS) {
1491     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1492     } else {
1493     # create the widgets
1494    
1495 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1496     padding => 0,
1497     z => 100,
1498     force_x => "max",
1499     force_y => 0;
1500 root 1.1 $DEBUG_STATUS->show;
1501 elmex 1.34
1502     $BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
1503    
1504 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1505 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1506 root 1.1
1507     (new CFClient::UI::Frame
1508     bg => [0, 0, 0, 0.4],
1509 root 1.30 force_x => 0,
1510     force_y => "max",
1511 root 1.1 child => $STATUSBOX,
1512     )->show;
1513    
1514     CFClient::UI::FancyFrame->new (
1515 root 1.47 title => "Map",
1516 root 1.42 name => "mapmap",
1517 root 1.30 x => 0,
1518     y => $FONTSIZE + 8,
1519 root 1.1 border_bg => [1, 1, 1, 192/255],
1520     bg => [1, 1, 1, 0],
1521 elmex 1.70 no_close_button => 1,
1522 root 1.1 child => ($MAPMAP = new CFClient::MapWidget::MapMap
1523     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1524     ),
1525     )->show;
1526    
1527     $MAPWIDGET = new CFClient::MapWidget;
1528     $MAPWIDGET->connect (activate_console => sub {
1529     my ($mapwidget, $preset) = @_;
1530    
1531     if ($CONSOLE) {
1532     $CONSOLE->{input}->{auto_activated} = 1;
1533     $CONSOLE->{input}->focus_in;
1534    
1535     if ($preset && $CONSOLE->{input}->get_text eq '') {
1536     $CONSOLE->{input}->set_text ($preset);
1537     }
1538     }
1539     });
1540     $MAPWIDGET->show;
1541     $MAPWIDGET->focus_in;
1542    
1543 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1544 root 1.1 expand => 1,
1545     font => $FONT_FIXED,
1546     fontsize => $::CFG->{log_fontsize},
1547 root 1.61 indent => -4,
1548 root 1.1 can_hover => 1,
1549     can_events => 1,
1550     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1551     ;
1552    
1553 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1554     title => "Setup",
1555     name => "setup_dialog",
1556     x => 'center',
1557     y => 'center',
1558 root 1.53 z => 2,
1559 root 1.49 force_w => $::WIDTH * 0.6,
1560     force_h => $::HEIGHT * 0.6,
1561     ;
1562    
1563 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1564 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1565 root 1.49
1566     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1567     "Configure the server to play on, your username, password and other server-related options.");
1568     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1569 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1570 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1571     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1572     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1573     "Configure the use of audio, sound effects and background music.");
1574     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1575     "Lets you define, edit and delete bindings."
1576 root 1.54 . "There is a shortcut for making bindings: <b>Left Control + Insert</b> opens the binding editor "
1577 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1578 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1579 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1580     . "binding editor closes");
1581     $SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
1582     "Displays all spells you have and lets you edit keyboard shortcuts for them.");
1583 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1584     "Some debuggign options. Do not ask.");
1585 root 1.49
1586 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1587 root 1.1
1588 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1589     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1590    
1591 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1592 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1593    
1594     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
1595    
1596 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => $STATS_WINDOW = stats_window,
1597 root 1.1 tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
1598 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => inventory_window,
1599 root 1.51 tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
1600 root 1.52 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory.");
1601 root 1.1
1602     $BUTTONBAR->add (new CFClient::UI::Button
1603     text => "Save Config",
1604     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1605 root 1.18 on_activate => sub {
1606 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1607 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1608 root 1.1 status "Configuration Saved";
1609     },
1610     );
1611    
1612 root 1.64 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => help_window,
1613 root 1.1 tooltip => "View Documentation");
1614    
1615     $BUTTONBAR->add (new CFClient::UI::Button
1616 root 1.18 text => "Quit",
1617     tooltip => "Terminates the program",
1618     on_activate => sub {
1619 root 1.1 if ($CONN) {
1620     open_quit_dialog;
1621     } else {
1622     exit;
1623     }
1624     },
1625     );
1626    
1627     $BUTTONBAR->show;
1628 root 1.49 $SETUP_DIALOG->show;
1629     }
1630 root 1.1
1631 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1632 root 1.1 }
1633    
1634     sub video_shutdown {
1635     undef $SDL_ACTIVE;
1636     }
1637    
1638     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1639     my $bgmusic;#TODO#hack#d#
1640    
1641     sub audio_channel_finished {
1642     my ($channel) = @_;
1643    
1644     #warn "channel $channel finished\n";#d#
1645     }
1646    
1647     sub audio_music_finished {
1648     return unless $CFG->{bgm_enable};
1649    
1650     # TODO: hack, do play loop and mood music
1651     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1652     $bgmusic->play (0);
1653    
1654     push @bgmusic, shift @bgmusic;
1655     }
1656    
1657     sub audio_init {
1658     if ($CFG->{audio_enable}) {
1659     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1660     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1661    
1662     unless ($SDL_MIXER) {
1663     status "Unable to open sound device: there will be no sound";
1664     return;
1665     }
1666    
1667     CFClient::Mix_AllocateChannels 8;
1668     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1669    
1670     audio_music_finished;
1671    
1672     while (<$fh>) {
1673     next if /^\s*#/;
1674     next if /^\s*$/;
1675    
1676     my ($file, $volume, $event) = split /\s+/, $_, 3;
1677    
1678     push @SOUNDS, "$volume,$file";
1679    
1680     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1681     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1682     $chunk->volume ($volume * 128 / 100);
1683     $chunk
1684     };
1685     }
1686     } else {
1687     status "unable to open sound config: $!";
1688     }
1689     }
1690     }
1691    
1692     sub audio_shutdown {
1693     CFClient::Mix_CloseAudio if $SDL_MIXER;
1694     undef $SDL_MIXER;
1695     @SOUNDS = ();
1696     %AUDIO_CHUNKS = ();
1697     }
1698    
1699     my %animate_object;
1700     my $animate_timer;
1701    
1702     my $fps = 9;
1703    
1704     my %demo;#d#
1705    
1706     sub force_refresh {
1707     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1708 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1709 root 1.1
1710     $CFClient::UI::ROOT->draw;
1711    
1712     $WANT_REFRESH = 0;
1713     $CAN_REFRESH = 0;
1714     $LAST_REFRESH = $NOW;
1715    
1716     0 && do {
1717     # some weird model-drawing code, just a joke right now
1718     use CFClient::OpenGL;
1719    
1720     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1721     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1722     $demo{r} ||= do {
1723     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1724     $mod->{v} = pack "f*", @{$mod->{v}};
1725     $_ = [scalar @$_, pack "S!*", @$_]
1726     for values %{$mod->{g}};
1727     $mod
1728     };
1729    
1730     my $r = $demo{r} or die;
1731    
1732     glDepthMask 1;
1733     glClear GL_DEPTH_BUFFER_BIT;
1734     glEnable GL_TEXTURE_2D;
1735     glEnable GL_DEPTH_TEST;
1736     glEnable GL_CULL_FACE;
1737     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1738    
1739     glMatrixMode GL_PROJECTION;
1740     glLoadIdentity;
1741     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1742     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1743     glMatrixMode GL_MODELVIEW;
1744     glLoadIdentity;
1745    
1746     glPushMatrix;
1747     glTranslate 0, 0, -800;
1748     glScale 1, -1, 1;
1749     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1750     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1751     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1752     glScale 50, 50, 50;
1753    
1754     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1755     while (my ($k, $v) = each %{$r->{g}}) {
1756     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1757     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1758     }
1759    
1760     glPopMatrix;
1761    
1762     glShadeModel GL_FLAT;
1763     glDisable GL_DEPTH_TEST;
1764     glDisable GL_TEXTURE_2D;
1765     glDepthMask 0;
1766    
1767     $WANT_REFRESH++;
1768     };
1769    
1770     CFClient::SDL_GL_SwapBuffers;
1771     }
1772    
1773 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1774 root 1.1 $NOW = time;
1775    
1776     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1777     for CFClient::SDL_PollEvent;
1778    
1779     if (%animate_object) {
1780     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1781     $WANT_REFRESH++;
1782     }
1783    
1784     if ($WANT_REFRESH) {
1785     force_refresh;
1786     } else {
1787     $CAN_REFRESH = 1;
1788     }
1789     });
1790    
1791     sub animation_start {
1792     my ($widget) = @_;
1793     $animate_object{$widget} = $widget;
1794     }
1795    
1796     sub animation_stop {
1797     my ($widget) = @_;
1798     delete $animate_object{$widget};
1799     }
1800    
1801     # check once/second for faces that need to be prefetched
1802     # this should, of course, only run on demand, but
1803     # SDL forces worse things on us....
1804    
1805     Event->timer (after => 1, interval => 0.25, cb => sub {
1806     $CONN->face_prefetch
1807     if $CONN;
1808     });
1809    
1810     %SDL_CB = (
1811     CFClient::SDL_QUIT => sub {
1812     Event::unloop -1;
1813     },
1814     CFClient::SDL_VIDEORESIZE => sub {
1815     },
1816     CFClient::SDL_VIDEOEXPOSE => sub {
1817     CFClient::UI::full_refresh;
1818     },
1819     CFClient::SDL_ACTIVEEVENT => sub {
1820     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1821     },
1822     CFClient::SDL_KEYDOWN => sub {
1823     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1824     # alt-enter
1825     video_shutdown;
1826     $CFG->{fullscreen} = !$CFG->{fullscreen};
1827     video_init;
1828     } else {
1829     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1830     }
1831     },
1832     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1833     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1834     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1835     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1836     CFClient::SDL_USEREVENT => sub {
1837     if ($_[0]{code} == 1) {
1838     audio_channel_finished $_[0]{data1};
1839     } elsif ($_[0]{code} == 0) {
1840     audio_music_finished;
1841     }
1842     },
1843     );
1844    
1845     #############################################################################
1846    
1847     $SIG{INT} = $SIG{TERM} = sub { exit };
1848    
1849     {
1850 root 1.49 local $SIG{__DIE__} = sub {
1851     return unless defined $^S && !$^S;
1852     Carp::confess $_[1];#d#TODO: remove when stable
1853     CFClient::fatal $_[0];
1854     };
1855 root 1.1
1856 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1857 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1858 root 1.1
1859     my %DEF_CFG = (
1860     sdl_mode => 0,
1861     width => 640,
1862     height => 480,
1863     fullscreen => 0,
1864     fast => 0,
1865     map_scale => 1,
1866     fow_enable => 1,
1867     fow_intensity => 0.45,
1868     fow_smooth => 0,
1869     gui_fontsize => 1,
1870 root 1.60 log_fontsize => 0.7,
1871 root 1.1 gauge_fontsize=> 1,
1872     gauge_size => 0.35,
1873 root 1.60 stat_fontsize => 0.7,
1874 root 1.1 mapsize => 100,
1875     host => "crossfire.schmorp.de",
1876     say_command => 'say',
1877     audio_enable => 1,
1878     bgm_enable => 1,
1879     bgm_volume => 0.25,
1880     face_prefetch => 0,
1881     output_sync => 1,
1882     output_count => 1,
1883 root 1.63 pickup => 0,
1884 root 1.1 );
1885    
1886     while (my ($k, $v) = each %DEF_CFG) {
1887     $CFG->{$k} = $v unless exists $CFG->{$k};
1888     }
1889    
1890     sdl_init;
1891    
1892     @SDL_MODES = reverse
1893     grep $_->[0] >= 640 && $_->[1] >= 480,
1894     CFClient::SDL_ListModes;
1895    
1896     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1897    
1898     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1899    
1900     {
1901     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1902     DejaVuSans.ttf
1903     DejaVuSansMono.ttf
1904     DejaVuSans-Bold.ttf
1905     DejaVuSansMono-Bold.ttf
1906     DejaVuSans-Oblique.ttf
1907     DejaVuSansMono-Oblique.ttf
1908     DejaVuSans-BoldOblique.ttf
1909     DejaVuSansMono-BoldOblique.ttf
1910     );
1911    
1912     CFClient::add_font $_ for @fonts;
1913    
1914     CFClient::pango_init;
1915    
1916     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1917     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1918    
1919     $FONT_PROP->make_default;
1920     }
1921    
1922     # compare mono (ft) vs. rgba (cairo)
1923     # ft - 1.8s, cairo 3s, even in alpha-only mode
1924     # for my $rgba (0..1) {
1925     # my $t1 = Time::HiRes::time;
1926     # for (1..1000) {
1927     # my $layout = CFClient::Layout->new ($rgba);
1928     # $layout->set_text ("hallo" x 100);
1929     # $layout->render;
1930     # }
1931     # my $t2 = Time::HiRes::time;
1932     # warn $t2-$t1;
1933     # }
1934    
1935     video_init;
1936     audio_init;
1937     }
1938    
1939     Event::loop;
1940 root 1.69 #CFClient::SDL_Quit;
1941     #CFClient::_exit 0;
1942 root 1.1
1943     END { CFClient::SDL_Quit }
1944    
1945     =head1 NAME
1946    
1947 root 1.28 cfplus - A Crossfire+ and Crossfire game client
1948 root 1.1
1949     =head1 SYNOPSIS
1950    
1951     Just run it - no commandline arguments are supported.
1952    
1953     =head1 USAGE
1954    
1955 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1956 root 1.1 fullscreen and interactively.
1957    
1958 root 1.39 =head1 DEBUGGING
1959    
1960    
1961     CFPLUS_DEBUG - environment variable
1962    
1963     1 draw borders around widgets
1964     2 add low-level widget info to tooltips
1965     4 show fps
1966     8 suppress tooltips
1967    
1968 root 1.1 =head1 AUTHOR
1969    
1970     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1971    
1972    
1973