ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.70
Committed: Tue Jun 13 10:28:38 2006 UTC (17 years, 11 months ago) by elmex
Branch: MAIN
Changes since 1.69: +1 -0 lines
Log Message:
implemented close button for frames

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