ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.76
Committed: Tue Jun 20 08:49:40 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.75: +2 -0 lines
Log Message:
add -lGL for those systemswhere sdl does not offer native opengl support

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