ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.102
Committed: Mon Jul 24 04:24:43 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.101: +23 -15 lines
Log Message:
many improvements/cleanups, reduced todo quite a bit

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