ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.75
Committed: Sun Jun 18 17:23:36 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.74: +48 -46 lines
Log Message:
put profile-specific stuff into ->{profile}{default}

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