ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.100
Committed: Sun Jul 23 16:11:12 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.99: +8 -59 lines
Log Message:
*** empty log message ***

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     my ($sw1, $sw2) = map +(new CFClient::UI::Combobox
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    
694 root 1.1 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
695     $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
696    
697     my $color2 = [1, 1, 0];
698    
699     for (
700 root 1.98 [0, 0, st_str => "Str", 30],
701     [0, 1, st_dex => "Dex", 30],
702     [0, 2, st_con => "Con", 30],
703     [0, 3, st_int => "Int", 30],
704     [0, 4, st_wis => "Wis", 30],
705     [0, 5, st_pow => "Pow", 30],
706     [0, 6, st_cha => "Cha", 30],
707    
708     [2, 0, st_wc => "Wc", -120],
709     [2, 1, st_ac => "Ac", -120],
710     [2, 2, st_dam => "Dam", 120],
711     [2, 3, st_arm => "Arm", 120],
712     [2, 4, st_spd => "Spd", 10.54],
713     [2, 5, st_wspd => "WSp", 10.54],
714 root 1.1 ) {
715 root 1.98 my ($col, $row, $id, $label, $template) = @$_;
716 root 1.1
717     $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
718 root 1.98 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0,
719     align => +1, template => $template, tooltip => $CFClient::STAT_TOOLTIP{$label});
720 root 1.1 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
721 root 1.98 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
722     align => -1, text => $label, tooltip => $CFClient::STAT_TOOLTIP{$label});
723 root 1.1 }
724    
725 elmex 1.92 $vb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
726 root 1.1
727     my $row = 0;
728     my $col = 0;
729    
730     my %resist_names = (
731 elmex 1.92 slow => ["Slow",
732     "<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.)"],
733     holyw => ["Holy Word",
734     "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"],
735     conf => ["Confusion",
736     "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)"],
737     fire => ["Fire",
738     "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"],
739     depl => ["Depletion",
740     "<b>Depletion</b> (some monsters and other effects can cause stats depletion)"],
741     magic => ["Magic",
742     "<b>Magic</b> (resistance to magic spells like magic missile or similar)"],
743     drain => ["Draining",
744     "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)"],
745     acid => ["Acid",
746     "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)"],
747     pois => ["Poison",
748     "<b>Poison</b> (resistance to getting poisoned)"],
749     para => ["Paralysation",
750     "<b>Paralysation</b> (this resistance affects the chance you get paralysed)"],
751     deat => ["Death",
752     "<b>Death</b> (resistance against death spells)"],
753     phys => ["Physical",
754     "<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.)"],
755     blind => ["Blind",
756     "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)"],
757     fear => ["Fear",
758     "<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)"],
759     tund => ["Turn undead",
760     "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."],
761     elec => ["Electricity",
762     "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)"],
763     cold => ["Cold",
764     "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)"],
765     ghit => ["Ghost hit",
766     "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)"],
767 root 1.1 );
768     for (qw/slow holyw conf fire depl magic
769     drain acid pois para deat phys
770     blind fear tund elec cold ghit/)
771     {
772     $tbl2->add ($col, $row,
773     $STATWIDS->{"res_$_"} =
774     new CFClient::UI::Label
775     font => $FONT_FIXED,
776     template => "-100%",
777     align => +1,
778     valign => 0,
779     can_events => 1,
780     can_hover => 1,
781 elmex 1.92 tooltip => $resist_names{$_}->[1],
782 root 1.1 );
783     $tbl2->add ($col + 1, $row, new CFClient::UI::Image
784     font => $FONT_FIXED,
785     can_hover => 1,
786     can_events => 1,
787 root 1.78 path => "ui/resist/resist_$_.png",
788 elmex 1.92 tooltip => $resist_names{$_}->[1],
789     );
790     $tbl2->add ($col + 2, $row, new CFClient::UI::Label
791     text => $resist_names{$_}->[0],
792     font => $FONT_FIXED,
793     can_hover => 1,
794     can_events => 1,
795     tooltip => $resist_names{$_}->[1],
796 root 1.1 );
797    
798     $row++;
799     if ($row % 6 == 0) {
800 elmex 1.92 $col += 3;
801 root 1.1 $row = 0;
802     }
803     }
804    
805 root 1.95 #update_stats_window ({});
806 root 1.1
807 elmex 1.97 $r
808 root 1.1 }
809    
810 elmex 1.92 sub skill_window {
811 elmex 1.97 my $sw = new CFClient::UI::ScrolledWindow (expand => 1);
812     $sw->add ($STATWIDS->{skill_tbl} = new CFClient::UI::Table expand => 1, col_expand => [0, 0, 1, 0, 0, 1]);
813     $sw
814 elmex 1.92 }
815    
816 root 1.48 sub formsep($) {
817     scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
818 root 1.1 }
819    
820     my $METASERVER_ATIME;
821    
822     sub update_metaserver {
823 elmex 1.81 my ($metaserver_dialog) = @_;
824    
825     $METASERVER = $metaserver_dialog
826     if defined $metaserver_dialog;
827    
828 root 1.1 return if $METASERVER_ATIME > time;
829     $METASERVER_ATIME = time + 60;
830    
831     my $table = $METASERVER->{table};
832     $table->clear;
833     $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
834    
835     my $buf;
836    
837     my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
838    
839     unless ($fh) {
840     $label->set_text ("unable to contact metaserver: $!");
841     return;
842     }
843    
844     Event->io (fd => $fh, poll => 'r', cb => sub {
845     my $res = sysread $fh, $buf, 8192, length $buf;
846    
847     if (!defined $res) {
848     $_[0]->w->cancel;
849     $label->set_text ("error while retrieving server list: $!");
850     } elsif ($res == 0) {
851     $_[0]->w->cancel;
852     status "server list retrieved";
853    
854     utf8::decode $buf if utf8::valid $buf;
855    
856     $table->clear;
857    
858 root 1.62 my @tip = (
859     "The current number of users logged in on the server.",
860     "The hostname of the server.",
861     "The time this server has been running without being restarted.",
862     "The server software version - a '+' indicates a Crossfire+ server.",
863     "Short information about this server provided by its admins.",
864     );
865     my @col = qw(#Users Host Uptime Version Description);
866     $table->add ($_, 0, new CFClient::UI::Label
867     can_hover => 1, can_events => 1,
868     align => 0, fg => [1, 1, 0],
869     text => $col[$_], tooltip => $tip[$_])
870     for 0 .. $#col;
871 root 1.1
872     my @align = qw(1 0 1 1 -1);
873    
874     my $y = 0;
875     for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
876     my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
877    
878     for ($desc) {
879     s/<br>/\n/gi;
880     s/<li>/\n· /gi;
881     s/<.*?>//sgi;
882     s/&/&amp;/g;
883     s/</&lt;/g;
884     s/>/&gt;/g;
885     }
886    
887     $uptime = sprintf "%dd %02d:%02d:%02d",
888     (int $m->[8] / 86400),
889     (int $m->[8] / 3600) % 24,
890     (int $m->[8] / 60) % 60,
891     $m->[8] % 60;
892    
893     $m = [$users, $host, $uptime, $version, $desc];
894    
895     $y++;
896    
897 root 1.62 $table->add (scalar @$m, $y, new CFClient::UI::VBox children => [
898     (new CFClient::UI::Button
899     text => "Use",
900     tooltip => "Put this server into the <b>Host:Port</b> field",
901     on_activate => sub {
902 root 1.75 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
903 root 1.62 $METASERVER->hide;
904 root 1.74 0
905 root 1.62 },
906     ),
907 root 1.1 (new CFClient::UI::Empty expand => 1),
908     ]);
909    
910 root 1.62 $table->add ($_, $y, new CFClient::UI::Label
911     ellipsise => 0,
912     align => $align[$_],
913     text => $m->[$_],
914     tooltip => $tip[$_],
915     can_hover => 1,
916     can_events => 1,
917     fontsize => 0.8)
918 root 1.1 for 0 .. $#$m;
919     }
920     }
921     });
922     }
923    
924 root 1.40 sub metaserver_dialog {
925 elmex 1.81 my $vbox = new CFClient::UI::VBox;
926     my $table = new CFClient::UI::Table;
927     $vbox->add (new CFClient::UI::ScrolledWindow expand => 1, child => $table);
928    
929 root 1.40 my $dialog = new CFClient::UI::FancyFrame
930 root 1.62 title => "Server List",
931     name => 'metaserver_dialog',
932     x => 'center',
933     y => 'center',
934     z => 3,
935     force_h => $::HEIGHT * 0.4,
936 elmex 1.81 child => $vbox,
937 root 1.80 has_close_button => 1,
938 elmex 1.81 table => $table,
939 root 1.40 on_visibility_change => sub {
940 elmex 1.81 update_metaserver ($_[0]) if $_[1];
941 root 1.74 0
942 root 1.40 },
943     ;
944    
945     $dialog
946     }
947    
948 root 1.1 sub server_setup {
949 root 1.49 my $vbox = new CFClient::UI::VBox;
950 elmex 1.19
951 root 1.1 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
952     $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
953    
954     {
955     $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
956    
957     $vbox->add (
958 root 1.40 $HOST_ENTRY = new CFClient::UI::Entry
959 root 1.1 expand => 1,
960 root 1.75 text => $CFG->{profile}{default}{host},
961 root 1.1 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
962 root 1.18 on_changed => sub {
963 root 1.1 my ($self, $value) = @_;
964 root 1.75 $CFG->{profile}{default}{host} = $value;
965 root 1.74 0
966 root 1.1 }
967     );
968    
969 root 1.40 $vbox->add (new CFClient::UI::Button
970     expand => 1,
971     text => "Server List",
972     other => $METASERVER,
973 root 1.1 tooltip => "Show a list of available crossfire servers",
974 root 1.74 on_activate => sub { $METASERVER->toggle_visibility; 0 },
975     on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
976 root 1.1 );
977     }
978    
979     $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
980     $table->add (1, 4, new CFClient::UI::Entry
981 root 1.75 text => $CFG->{profile}{default}{user},
982 root 1.1 tooltip => "The name of your character on the server",
983 root 1.75 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
984 root 1.1 );
985    
986     $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
987     $table->add (1, 5, new CFClient::UI::Entry
988 root 1.75 text => $CFG->{profile}{default}{password},
989 root 1.1 hidden => 1,
990     tooltip => "The password for your character",
991 root 1.75 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
992 root 1.1 );
993    
994     $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
995     $table->add (1, 7, new CFClient::UI::Slider
996 root 1.30 force_w => 100,
997 root 1.1 range => [$CFG->{mapsize}, 10, 100, 0, 1],
998     tooltip => "This is the size of the portion of the map update the server sends you. "
999     . "If you set this to a high value you will be able to see further, "
1000     . "but you also increase bandwidth requirements and latency. "
1001     . "This option is only used once at log-in.",
1002 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
1003 root 1.1 );
1004    
1005     $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Face Prefetch");
1006     $table->add (1, 8, new CFClient::UI::CheckBox
1007     state => $CFG->{face_prefetch},
1008     tooltip => "<b>Background Image Prefetch</b>\n\n"
1009     . "If enabled, the client automatically pre-fetches images from the server. "
1010     . "This might increase or create lag, but increases the chances "
1011     . "of faces being ready for display when you encounter them. "
1012     . "It also uses up server bandwidth on every connect, "
1013     . "so only set it if you really need to prefetch images. "
1014     . "This option can be set and unset any time.",
1015 root 1.74 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1016 root 1.1 );
1017    
1018     $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
1019     $table->add (1, 9, new CFClient::UI::Entry
1020     text => $CFG->{output_count},
1021     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1022 root 1.74 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1023 root 1.1 );
1024    
1025     $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
1026     $table->add (1, 10, new CFClient::UI::Entry
1027     text => $CFG->{output_sync},
1028     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1029 root 1.74 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1030 root 1.1 );
1031    
1032     $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
1033     expand => 1,
1034     align => 0,
1035     text => "Login",
1036 root 1.18 on_activate => sub {
1037 root 1.1 $CONN ? stop_game
1038     : start_game;
1039 root 1.74 0
1040 root 1.1 },
1041     );
1042    
1043 root 1.49 $table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
1044     $table->add (1, 12, my $saycmd = new CFClient::UI::Entry
1045     text => $CFG->{say_command},
1046     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. "
1047     . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1048     . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1049     on_changed => sub {
1050     my ($self, $value) = @_;
1051     $CFG->{say_command} = $value;
1052 root 1.74 0
1053 root 1.49 }
1054     );
1055    
1056 root 1.67 $vbox->add (new CFClient::UI::Label
1057     text => "Server Info",
1058     fontsize => 1.2,
1059     padding_y => 8,
1060     fg => [1, 1, 0, 1],
1061     );
1062    
1063     $vbox->add ($SERVER_INFO = new CFClient::UI::Label ellipsise => 0);
1064    
1065 root 1.49 $vbox
1066 root 1.1 }
1067    
1068     sub message_window {
1069     my $window = new CFClient::UI::FancyFrame
1070 elmex 1.16 name => "message_window",
1071 root 1.1 title => "Messages",
1072     border_bg => [1, 1, 1, 1],
1073 root 1.30 x => "max",
1074     y => 0,
1075 root 1.60 force_w => $::WIDTH * 0.4,
1076     force_h => $::HEIGHT * 0.5,
1077 root 1.74 child => (my $vbox = new CFClient::UI::VBox),
1078     has_close_button => 1;
1079 root 1.1
1080     $vbox->add ($LOGVIEW);
1081    
1082     $vbox->add (my $input = new CFClient::UI::Entry
1083     tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
1084     . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
1085     . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
1086     . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
1087 root 1.18 on_focus_in => sub {
1088 root 1.1 my ($input, $prev_focus) = @_;
1089    
1090     delete $input->{refocus_map};
1091    
1092     if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
1093     $input->{refocus_map} = 1;
1094     }
1095     delete $input->{auto_activated};
1096 root 1.74
1097     0
1098 root 1.1 },
1099 root 1.18 on_activate => sub {
1100 root 1.1 my ($input, $text) = @_;
1101     $input->set_text ('');
1102    
1103 elmex 1.46 if ($text =~ /^\/(.*)/) {
1104 root 1.1 $::CONN->user_send ($1);
1105     } else {
1106     my $say_cmd = $::CFG->{say_command} || 'say';
1107     $::CONN->user_send ("$say_cmd $text");
1108     }
1109     if ($input->{refocus_map}) {
1110     delete $input->{refocus_map};
1111     $MAPWIDGET->focus_in
1112     }
1113 root 1.74
1114     0
1115 root 1.1 },
1116 root 1.18 on_escape => sub {
1117 root 1.74 $MAPWIDGET->grab_focus;
1118    
1119     0
1120 root 1.1 },
1121     );
1122    
1123     $CONSOLE = {
1124     window => $window,
1125 root 1.30 input => $input,
1126 root 1.1 };
1127    
1128     $window
1129     }
1130    
1131     sub open_quit_dialog {
1132     unless ($QUIT_DIALOG) {
1133 root 1.30 $QUIT_DIALOG = new CFClient::UI::FancyFrame
1134     x => "center",
1135     y => "center",
1136 root 1.55 z => 50,
1137 root 1.30 title => "Really Quit?",
1138     ;
1139 root 1.1
1140     $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
1141    
1142     $vb->add (new CFClient::UI::Label
1143     text => "You should find a savebed and apply it first!",
1144     max_w => $WIDTH * 0.25,
1145     ellipsize => 0,
1146     );
1147     $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
1148     $hb->add (new CFClient::UI::Button
1149     text => "Ok",
1150     expand => 1,
1151 root 1.74 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1152 root 1.1 );
1153     $hb->add (new CFClient::UI::Button
1154     text => "Quit anyway",
1155     expand => 1,
1156 root 1.18 on_activate => sub { exit },
1157 root 1.1 );
1158 root 1.21 }
1159 root 1.1
1160 root 1.21 $QUIT_DIALOG->show;
1161 root 1.1 }
1162    
1163 root 1.49 sub autopickup_setup {
1164 root 1.51 my $table = new CFClient::UI::Table;
1165 elmex 1.44
1166 elmex 1.43 for (
1167 root 1.51 ["General", 0, 0,
1168 root 1.86 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
1169 root 1.58 ["Inhibit autopickup" => PICKUP_INHIBIT],
1170     ["Stop before pickup" => PICKUP_STOP],
1171     ["Debug autopickup" => PICKUP_DEBUG],
1172 root 1.51 ],
1173     ["Weapons", 0, 6,
1174 root 1.58 ["All weapons" => PICKUP_ALLWEAPON],
1175     ["Missile weapons" => PICKUP_MISSILEWEAPON],
1176     ["Bows" => PICKUP_BOW],
1177     ["Arrows" => PICKUP_ARROW],
1178 root 1.51 ],
1179     ["Armour", 0, 12,
1180 root 1.58 ["Helmets" => PICKUP_HELMET],
1181     ["Shields" => PICKUP_SHIELD],
1182     ["Body Armour" => PICKUP_ARMOUR],
1183     ["Boots" => PICKUP_BOOTS],
1184     ["Gloves" => PICKUP_GLOVES],
1185     ["Cloaks" => PICKUP_CLOAK],
1186 root 1.51 ],
1187    
1188     ["Readables", 2, 2,
1189 root 1.58 ["Spellbooks" => PICKUP_SPELLBOOK],
1190     ["Skillscrolls" => PICKUP_SKILLSCROLL],
1191     ["Normal Books/Scrolls" => PICKUP_READABLES],
1192 root 1.51 ],
1193     ["Misc", 2, 7,
1194 root 1.58 ["Food" => PICKUP_FOOD],
1195     ["Drinks" => PICKUP_DRINK],
1196     ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1197     ["Keys" => PICKUP_KEY],
1198     ["Magical Items" => PICKUP_MAGICAL],
1199     ["Potions" => PICKUP_POTION],
1200     ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1201     ["Ignore cursed" => PICKUP_NOT_CURSED],
1202     ["Jewelery" => PICKUP_JEWELS],
1203 root 1.51 ],
1204 elmex 1.66 ["Weight/Value ratio", 2, 17]
1205 elmex 1.43 )
1206     {
1207 root 1.51 my ($title, $x, $y, @bits) = @$_;
1208     $table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1209    
1210     for (@bits) {
1211     ++$y;
1212    
1213 elmex 1.43 my $mask = $_->[1];
1214 root 1.51 $table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
1215 root 1.86 $table->add ($x+1, $y, my $checkbox = new CFClient::UI::CheckBox
1216 elmex 1.83 state => $::CFG->{pickup} & $mask,
1217 elmex 1.43 on_changed => sub {
1218     my ($box, $value) = @_;
1219 root 1.63
1220 elmex 1.43 if ($value) {
1221 elmex 1.45 $::CFG->{pickup} |= $mask;
1222 elmex 1.43 } else {
1223 root 1.63 $::CFG->{pickup} &= ~$mask;
1224 elmex 1.43 }
1225 root 1.63
1226     $::CONN->send_command ("pickup $::CFG->{pickup}")
1227 elmex 1.45 if defined $::CONN;
1228 root 1.74
1229     0
1230 elmex 1.43 });
1231 root 1.86
1232     ${$_->[2]} = $checkbox if $_->[2];
1233 elmex 1.43 }
1234     }
1235    
1236 elmex 1.66 $table->add (2, 18, new CFClient::UI::ValSlider
1237 elmex 1.83 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1238     template => ">= 99",
1239 elmex 1.66 to_value => sub { ">= " . 5 * $_[0] },
1240     on_changed => sub {
1241     my ($slider, $value) = @_;
1242    
1243 elmex 1.83 $::CFG->{pickup} &= ~0xF;
1244 elmex 1.66 $::CFG->{pickup} |= int $value
1245     if $value;
1246     1;
1247     });
1248 elmex 1.83
1249 elmex 1.66 $table->add (3, 18, new CFClient::UI::Button
1250     text => "set",
1251     on_activate => sub {
1252     $::CONN->send_command ("pickup $::CFG->{pickup}")
1253     if defined $::CONN;
1254 root 1.74 0
1255 elmex 1.66 });
1256    
1257 root 1.51 $table
1258 elmex 1.43 }
1259    
1260 elmex 1.85 sub inventory_widget {
1261     my $hb = new CFClient::UI::HBox homogeneous => 1;
1262 root 1.1
1263 root 1.21 $hb->add (my $vb1 = new CFClient::UI::VBox);
1264     $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
1265 root 1.99
1266     $vb1->add (my $hb1 = new CFClient::UI::HBox);
1267    
1268     use sort 'stable';
1269    
1270     $hb1->add (new CFClient::UI::Combobox
1271     value => undef,
1272     options => [
1273     [undef, "Type/Name"],
1274     [
1275     sub { sort {
1276     $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1277     or $a->{type} <=> $b->{type}
1278     } @_ },
1279     "Weight/Type",
1280     ],
1281     [sub { } => "#TODO#"],
1282     ],
1283     on_changed => sub {
1284     $INV->set_sort_order ($_[1]);
1285     },
1286     );
1287     $hb1->add (new CFClient::UI::Label text => "Weight: ", align => 1, expand => 1);
1288     #TODO# update to weigh/maxweight
1289     $hb1->add ($STATWIDS->{i_weight} = new CFClient::UI::Label align => -1);
1290    
1291 elmex 1.97 $vb1->add (my $sw1 = new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1292     $sw1->add ($INV = new CFClient::UI::Inventory);
1293 root 1.1
1294 root 1.21 $hb->add (my $vb2 = new CFClient::UI::VBox);
1295 elmex 1.17
1296 elmex 1.27 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
1297 elmex 1.14
1298 elmex 1.97 $vb2->add (my $sw2 = new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1299     $sw2->add ($INVR = new CFClient::UI::Inventory);
1300 root 1.1
1301 elmex 1.27 # XXX: Call after $INVR = ... because set_opencont sets the items
1302     CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
1303    
1304 elmex 1.85 $hb
1305 root 1.1 }
1306    
1307 root 1.86 sub toggle_player_page {
1308     my ($widget) = @_;
1309    
1310     if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
1311     $PL_WINDOW->hide;
1312     } else {
1313     $PL_NOTEBOOK->set_current_page ($widget);
1314     $PL_WINDOW->show;
1315     }
1316     }
1317    
1318 elmex 1.85 sub player_window {
1319     my $plwin = $PL_WINDOW = new CFClient::UI::FancyFrame
1320     x => "center",
1321     y => "center",
1322     force_w => $WIDTH * 9/10,
1323     force_h => $HEIGHT * 9/10,
1324     title => "Player",
1325 elmex 1.90 name => "playerbook",
1326 elmex 1.85 has_close_button => 1
1327     ;
1328    
1329     my $ntb =
1330     $PL_NOTEBOOK =
1331 elmex 1.97 new CFClient::UI::Notebook expand => 1, debug => 1;
1332 root 1.86
1333 elmex 1.85 $ntb->add (
1334 root 1.95 "Statistics (F2)" => $STATS_PAGE = stats_window,
1335 elmex 1.92 "Shows statistics, where all your Stats and Resistances are shown."
1336     );
1337     $ntb->add (
1338 root 1.95 "Skills (F3)" => $SKILL_PAGE = skill_window,
1339 elmex 1.92 "Shows all your Skills."
1340 elmex 1.85 );
1341 elmex 1.97
1342     my $spellsw = new CFClient::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1343     $spellsw->add ($SPELL_PAGE = new CFClient::UI::SpellList);
1344 elmex 1.85 $ntb->add (
1345 elmex 1.97 "Spellbook (F4)" => $spellsw,
1346 root 1.86 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1347 elmex 1.85 );
1348     $ntb->add (
1349 root 1.95 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
1350 root 1.86 "Toggles the inventory window, where you can manage your loot (or treasures :). "
1351     . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1352 elmex 1.85 );
1353    
1354 root 1.88 $ntb->set_current_page ($INVENTORY_PAGE);
1355 root 1.86
1356 elmex 1.85 $plwin->add ($ntb);
1357     $plwin
1358 elmex 1.38 }
1359    
1360 elmex 1.77 sub update_bindings {
1361     $BIND_UPD_CB->() if $BIND_UPD_CB;
1362     }
1363    
1364 root 1.49 sub keyboard_setup {
1365 elmex 1.24 my $binding_list = new CFClient::UI::VBox;
1366    
1367 elmex 1.34 my $refresh;
1368 elmex 1.77 $refresh = $BIND_UPD_CB = sub {
1369 elmex 1.24 $binding_list->clear ();
1370    
1371 root 1.75 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1372     for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1373     my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1374 elmex 1.24 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1375    
1376     my $lbl = join "; ", @$cmds;
1377 root 1.84 my $nam = CFClient::BindingEditor::keycombo_to_name ($mod, $sym);
1378 elmex 1.24 $binding_list->add (my $hb = new CFClient::UI::HBox);
1379     $hb->add (new CFClient::UI::Button
1380 elmex 1.25 text => "delete",
1381 elmex 1.34 tooltip => "Deletes the binding",
1382 elmex 1.24 on_activate => sub {
1383     $binding_list->remove ($hb);
1384 root 1.75 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1385 root 1.74 0
1386 elmex 1.24 });
1387 elmex 1.34
1388     $hb->add (new CFClient::UI::Button
1389     text => "edit",
1390     tooltip => "Edits the binding",
1391     on_activate => sub {
1392     $::BIND_EDITOR->set_binding (
1393 root 1.75 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1394 elmex 1.34 sub {
1395     my ($nmod, $nsym, $ncmds) = @_;
1396 elmex 1.77 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1397     $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1398 elmex 1.34 $refresh->();
1399 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1400     $SETUP_DIALOG->show;
1401 elmex 1.34 },
1402     sub {
1403 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1404     $SETUP_DIALOG->show;
1405 elmex 1.34 });
1406     $::BIND_EDITOR->show;
1407 root 1.49 $SETUP_DIALOG->hide;
1408 root 1.74 0
1409 elmex 1.34 });
1410    
1411     $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1412 elmex 1.24 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1413     }
1414     }
1415     };
1416    
1417 root 1.49 my $vb = new CFClient::UI::VBox;
1418 elmex 1.71 $vb->add (my $hb = new CFClient::UI::HBox);
1419     $hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
1420     $hb->add (new CFClient::UI::CheckBox
1421     expand => 1,
1422     state => $CFG->{shift_fire_stop},
1423     tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1424     on_changed => sub {
1425     my ($cbox, $value) = @_;
1426     $CFG->{shift_fire_stop} = $value;
1427 root 1.74 0
1428 elmex 1.71 });
1429    
1430 elmex 1.35 $vb->add ($binding_list);
1431     $vb->add (my $hb = new CFClient::UI::HBox);
1432 root 1.49
1433 elmex 1.35 $hb->add (new CFClient::UI::Button
1434 elmex 1.34 text => "record new",
1435 elmex 1.35 expand => 1,
1436 elmex 1.34 tooltip => "This button opens the binding editor with an empty binding.",
1437     on_activate => sub {
1438     $::BIND_EDITOR->set_binding (undef, undef, [],
1439     sub {
1440     my ($mod, $sym, $cmds) = @_;
1441 elmex 1.77 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1442 elmex 1.34 $refresh->();
1443 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1444     $SETUP_DIALOG->show;
1445 elmex 1.34 },
1446     sub {
1447 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1448     $SETUP_DIALOG->show;
1449 root 1.53 },
1450     );
1451 root 1.49 $SETUP_DIALOG->hide;
1452 elmex 1.34 $::BIND_EDITOR->show;
1453 root 1.74 0
1454 elmex 1.34 },
1455     );
1456 root 1.49
1457 elmex 1.35 $hb->add (new CFClient::UI::Button
1458     text => "close",
1459     tooltip => "Closes the binding window",
1460     expand => 1,
1461     on_activate => sub {
1462 root 1.49 $SETUP_DIALOG->hide;
1463 root 1.74 0
1464 elmex 1.35 }
1465     );
1466    
1467 elmex 1.24 $refresh->();
1468 root 1.49
1469     $vb
1470 elmex 1.24 }
1471    
1472 root 1.96 # just weirdness, pls. ignore
1473     sub load_html_page {
1474     my ($viewer, $base) = @_;
1475    
1476     $viewer->clear;
1477    
1478     require LWP::Simple;
1479     require HTML::Parser;
1480     require URI;
1481    
1482     my $page = LWP::Simple::get ($base)
1483     or return;
1484    
1485     my @s = { };
1486     my %passthrough = map ($_ => undef), qw(b i u s tt big small sub sup);
1487    
1488     my $parser = HTML::Parser->new (
1489     text_h => [sub {
1490     my ($text) = @_;
1491     $text =~ s/\s+/ /g;
1492 root 1.100 $s[-1]{text} .= CFClient::asxml $text;
1493 root 1.96 }, "dtext"],
1494     start_h => [sub {
1495     my ($tag, $attr) = @_;
1496     if ($passthrough{$tag}) {
1497     $s[-1]{text} .= "<$tag>";
1498     } elsif ($tag eq "h1") {
1499     push @s, { text => "<span foreground='#ffff00' size='x-large'>" };
1500     } elsif ($tag eq "h2") {
1501     push @s, { text => "<span foreground='#ccccff' size='large'>" };
1502     } elsif ($tag eq "h3") {
1503     push @s, { text => "<span size='large'>" };
1504     } elsif ($tag eq "a") {
1505     push @s, { text => "", url => $attr->{href} };
1506     } elsif ($tag eq "p") {
1507     push @s, { };
1508     } elsif ($tag eq "img") {
1509     eval {
1510     push @{$s[-1]{obj}}, new CFClient::UI::Image
1511     tex => (new_from_image CFClient::Texture LWP::Simple::get (URI->new ($attr->{src}, $base)->abs ($base)));
1512     $s[-1]{text} .= "\x{fffc}";
1513     };
1514     }
1515     }, "tagname, attr"],
1516     end_h => [sub {
1517     my ($tag) = @_;
1518     if ($passthrough{$tag}) {
1519     $s[-1]{text} .= "</$tag>";
1520     } elsif ($tag =~ /^h\d$/) {
1521     $s[-1]{text} .= "</span>";
1522     push @s, { };
1523     } elsif ($tag eq "a") {
1524     my $S = pop @s;
1525     $s[-1]{text} .= "\x{fffc}";
1526     push @{$s[-1]{obj}}, new CFClient::UI::Label
1527     fg => [0.8, 0.8, 1],
1528     markup => "<u>$S->{text}</u>",
1529     fontsize => 0.8,
1530     can_events => 1,
1531     can_focus => 1,
1532     on_button_up => sub {
1533     load_html_page ($viewer, URI->new ($S->{url}, $base)->abs ($base));
1534     },
1535     ;
1536     }
1537     }, "tagname"],
1538     );
1539    
1540     $parser->parse ($page);
1541     $parser->eof;
1542    
1543     $viewer->add_paragraph ([1, 1, 1, 1], [$_->{text}, @{ $_->{obj} || [] }], $_->{indent})
1544     for @s;
1545    
1546     $viewer->set_offset (0);
1547     }
1548    
1549 root 1.64 sub help_window {
1550 root 1.1 my $win = new CFClient::UI::FancyFrame
1551 root 1.41 x => 'center',
1552     y => 'center',
1553 root 1.55 z => 2,
1554 root 1.41 name => 'doc_browser',
1555     force_w => int $WIDTH * 7/8,
1556     force_h => int $HEIGHT * 7/8,
1557 root 1.87 title => "Help Browser",
1558     has_close_button => 1;
1559 root 1.1
1560     $win->add (my $vbox = new CFClient::UI::VBox);
1561    
1562     $vbox->add (my $buttons = new CFClient::UI::HBox);
1563 root 1.64 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1564     expand => 1, fontsize => 0.8, padding_x => 4);
1565 root 1.1
1566 root 1.64 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1567     $buttons->add (my $combo = new CFClient::UI::Combobox
1568     value => undef,
1569     options => [
1570     [intro => "Introduction"],
1571 root 1.78 [manual => "Main Manual"],
1572     [skill_help => "Skill Reference"],
1573     [command_help => "Command Reference"],
1574 root 1.64 [dmcommand_help => "DM Commands"],
1575     [COPYING => "License Terms"],
1576 root 1.96 [test => "test (do not select)"], #d#TODO
1577 root 1.64 ],
1578     on_changed => sub {
1579     my ($self, $pod) = @_;
1580 root 1.1
1581 root 1.96 if ($pod eq "test") {#d#TODO
1582     eval {
1583     load_html_page $viewer, "http://crossfire.real-time.com/guides/walkthrough/newbie-tower.html";
1584     };
1585     warn "$@" if $@;
1586     return;
1587     }
1588    
1589 root 1.100 my $pom = CFClient::Pod::load CFClient::find_rcfile "pod/$pod.pod",
1590     doc_viewer => 1, sub { CFClient::Pod::as_paragraphs $_[0] };
1591    
1592     #use Data::Dumper; warn Dumper $pom;#d#
1593 root 1.1
1594 root 1.64 $viewer->clear;
1595 root 1.78
1596 root 1.79 # $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
1597     # (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
1598     # (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
1599 root 1.78 # ]);#d#
1600 root 1.64
1601 root 1.100 $viewer->add_paragraph ([1, 1, 1, 1], [$_->{text}, @{ $_->{obj} || [] }], $_->{indent})
1602 root 1.64 for @$pom;
1603 root 1.1
1604 root 1.64 $viewer->set_offset (0);
1605 root 1.78
1606 root 1.74 0
1607 root 1.64 },
1608     on_visibility_change => sub {
1609     my ($self, $visible) = @_;
1610     return unless $visible;
1611     return if $self->{value};
1612     $self->set_value ("intro");
1613 root 1.74 0
1614 root 1.64 },
1615     );
1616 root 1.1
1617     $win
1618     }
1619    
1620     sub sdl_init {
1621     CFClient::SDL_Init
1622     and die "SDL::Init failed!\n";
1623     }
1624    
1625     sub video_init {
1626     sdl_init;
1627    
1628     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1629    
1630     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1631    
1632     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1633     $FULLSCREEN = $CFG->{fullscreen};
1634     $FAST = $CFG->{fast};
1635    
1636     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1637     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1638    
1639     $SDL_ACTIVE = 1;
1640     $LAST_REFRESH = time - 0.01;
1641    
1642 root 1.10 CFClient::OpenGL::init;
1643 root 1.1
1644     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1645    
1646     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1647    
1648     #############################################################################
1649    
1650     if ($DEBUG_STATUS) {
1651     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1652     } else {
1653     # create the widgets
1654    
1655 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1656     padding => 0,
1657     z => 100,
1658     force_x => "max",
1659     force_y => 0;
1660 root 1.1 $DEBUG_STATUS->show;
1661 elmex 1.34
1662 root 1.80 $BIND_EDITOR = new CFClient::BindingEditor (x => "max", y => 0);
1663 elmex 1.34
1664 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1665 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1666 root 1.1
1667     (new CFClient::UI::Frame
1668     bg => [0, 0, 0, 0.4],
1669 root 1.30 force_x => 0,
1670     force_y => "max",
1671 root 1.1 child => $STATUSBOX,
1672     )->show;
1673    
1674     CFClient::UI::FancyFrame->new (
1675 root 1.47 title => "Map",
1676 root 1.42 name => "mapmap",
1677 root 1.30 x => 0,
1678     y => $FONTSIZE + 8,
1679 root 1.1 border_bg => [1, 1, 1, 192/255],
1680     bg => [1, 1, 1, 0],
1681     child => ($MAPMAP = new CFClient::MapWidget::MapMap
1682     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1683     ),
1684     )->show;
1685    
1686     $MAPWIDGET = new CFClient::MapWidget;
1687     $MAPWIDGET->connect (activate_console => sub {
1688     my ($mapwidget, $preset) = @_;
1689    
1690     if ($CONSOLE) {
1691     $CONSOLE->{input}->{auto_activated} = 1;
1692 root 1.74 $CONSOLE->{input}->grab_focus;
1693 root 1.1
1694     if ($preset && $CONSOLE->{input}->get_text eq '') {
1695     $CONSOLE->{input}->set_text ($preset);
1696     }
1697     }
1698     });
1699     $MAPWIDGET->show;
1700 root 1.74 $MAPWIDGET->grab_focus;
1701 root 1.1
1702 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1703 root 1.1 expand => 1,
1704     font => $FONT_FIXED,
1705     fontsize => $::CFG->{log_fontsize},
1706 root 1.61 indent => -4,
1707 root 1.1 can_hover => 1,
1708     can_events => 1,
1709     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1710     ;
1711    
1712 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1713     title => "Setup",
1714     name => "setup_dialog",
1715     x => 'center',
1716     y => 'center',
1717 root 1.53 z => 2,
1718 root 1.49 force_w => $::WIDTH * 0.6,
1719     force_h => $::HEIGHT * 0.6,
1720 root 1.74 has_close_button => 1,
1721 root 1.49 ;
1722    
1723 elmex 1.81 $METASERVER = metaserver_dialog;
1724    
1725 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1726 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1727 root 1.49
1728     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1729     "Configure the server to play on, your username, password and other server-related options.");
1730     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1731 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1732 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1733     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1734     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1735     "Configure the use of audio, sound effects and background music.");
1736     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1737 root 1.75 "Lets you define, edit and delete key bindings."
1738     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1739 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1740 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1741 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1742     . "binding editor closes");
1743 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1744 root 1.75 "Some debuggin' options. Do not ask.");
1745 root 1.49
1746 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1747 root 1.1
1748 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1749     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1750    
1751 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1752 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1753    
1754     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
1755    
1756 root 1.87 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Playerbook", other => player_window,
1757 elmex 1.85 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
1758 root 1.1
1759     $BUTTONBAR->add (new CFClient::UI::Button
1760     text => "Save Config",
1761     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1762 root 1.18 on_activate => sub {
1763 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1764 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1765 root 1.1 status "Configuration Saved";
1766 root 1.74 0
1767 root 1.1 },
1768     );
1769    
1770 root 1.86 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1771 root 1.1 tooltip => "View Documentation");
1772    
1773     $BUTTONBAR->add (new CFClient::UI::Button
1774 root 1.18 text => "Quit",
1775     tooltip => "Terminates the program",
1776     on_activate => sub {
1777 root 1.1 if ($CONN) {
1778     open_quit_dialog;
1779     } else {
1780     exit;
1781     }
1782 root 1.74 0
1783 root 1.1 },
1784     );
1785    
1786     $BUTTONBAR->show;
1787 root 1.49 $SETUP_DIALOG->show;
1788     }
1789 root 1.1
1790 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1791 root 1.1 }
1792    
1793     sub video_shutdown {
1794 root 1.73 CFClient::OpenGL::shutdown;
1795    
1796 root 1.1 undef $SDL_ACTIVE;
1797     }
1798    
1799     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1800     my $bgmusic;#TODO#hack#d#
1801    
1802     sub audio_channel_finished {
1803     my ($channel) = @_;
1804    
1805     #warn "channel $channel finished\n";#d#
1806     }
1807    
1808     sub audio_music_finished {
1809     return unless $CFG->{bgm_enable};
1810    
1811     # TODO: hack, do play loop and mood music
1812     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1813     $bgmusic->play (0);
1814    
1815     push @bgmusic, shift @bgmusic;
1816     }
1817    
1818     sub audio_init {
1819     if ($CFG->{audio_enable}) {
1820     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1821     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1822    
1823     unless ($SDL_MIXER) {
1824     status "Unable to open sound device: there will be no sound";
1825     return;
1826     }
1827    
1828     CFClient::Mix_AllocateChannels 8;
1829     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1830    
1831     audio_music_finished;
1832    
1833     while (<$fh>) {
1834     next if /^\s*#/;
1835     next if /^\s*$/;
1836    
1837     my ($file, $volume, $event) = split /\s+/, $_, 3;
1838    
1839     push @SOUNDS, "$volume,$file";
1840    
1841     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1842     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1843     $chunk->volume ($volume * 128 / 100);
1844     $chunk
1845     };
1846     }
1847     } else {
1848     status "unable to open sound config: $!";
1849     }
1850     }
1851     }
1852    
1853     sub audio_shutdown {
1854     CFClient::Mix_CloseAudio if $SDL_MIXER;
1855     undef $SDL_MIXER;
1856     @SOUNDS = ();
1857     %AUDIO_CHUNKS = ();
1858     }
1859    
1860     my %animate_object;
1861     my $animate_timer;
1862    
1863     my $fps = 9;
1864    
1865     my %demo;#d#
1866    
1867     sub force_refresh {
1868     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1869 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1870 root 1.1
1871     $CFClient::UI::ROOT->draw;
1872    
1873     $WANT_REFRESH = 0;
1874     $CAN_REFRESH = 0;
1875     $LAST_REFRESH = $NOW;
1876    
1877     CFClient::SDL_GL_SwapBuffers;
1878     }
1879    
1880 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1881 root 1.1 $NOW = time;
1882    
1883     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1884     for CFClient::SDL_PollEvent;
1885    
1886     if (%animate_object) {
1887     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1888     $WANT_REFRESH++;
1889     }
1890    
1891     if ($WANT_REFRESH) {
1892     force_refresh;
1893     } else {
1894     $CAN_REFRESH = 1;
1895     }
1896     });
1897    
1898     sub animation_start {
1899     my ($widget) = @_;
1900     $animate_object{$widget} = $widget;
1901     }
1902    
1903     sub animation_stop {
1904     my ($widget) = @_;
1905     delete $animate_object{$widget};
1906     }
1907    
1908     # check once/second for faces that need to be prefetched
1909     # this should, of course, only run on demand, but
1910     # SDL forces worse things on us....
1911    
1912     Event->timer (after => 1, interval => 0.25, cb => sub {
1913     $CONN->face_prefetch
1914     if $CONN;
1915     });
1916    
1917     %SDL_CB = (
1918     CFClient::SDL_QUIT => sub {
1919     Event::unloop -1;
1920     },
1921     CFClient::SDL_VIDEORESIZE => sub {
1922     },
1923     CFClient::SDL_VIDEOEXPOSE => sub {
1924     CFClient::UI::full_refresh;
1925     },
1926     CFClient::SDL_ACTIVEEVENT => sub {
1927     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1928     },
1929     CFClient::SDL_KEYDOWN => sub {
1930     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1931     # alt-enter
1932 root 1.94 $FULLSCREEN_ENABLE->toggle;
1933 root 1.1 video_shutdown;
1934     video_init;
1935     } else {
1936     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1937     }
1938     },
1939     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1940     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1941     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1942     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1943     CFClient::SDL_USEREVENT => sub {
1944     if ($_[0]{code} == 1) {
1945     audio_channel_finished $_[0]{data1};
1946     } elsif ($_[0]{code} == 0) {
1947     audio_music_finished;
1948     }
1949     },
1950     );
1951    
1952     #############################################################################
1953    
1954     $SIG{INT} = $SIG{TERM} = sub { exit };
1955    
1956     {
1957 root 1.49 local $SIG{__DIE__} = sub {
1958     return unless defined $^S && !$^S;
1959 root 1.95 Carp::confess $_[0];#d#TODO: remove when stable
1960 root 1.49 CFClient::fatal $_[0];
1961     };
1962 root 1.1
1963 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1964 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1965 root 1.1
1966     my %DEF_CFG = (
1967 root 1.75 sdl_mode => 0,
1968     width => 640,
1969     height => 480,
1970     fullscreen => 0,
1971     fast => 0,
1972     map_scale => 1,
1973     fow_enable => 1,
1974     fow_intensity => 0.45,
1975     fow_smooth => 0,
1976     gui_fontsize => 1,
1977     log_fontsize => 0.7,
1978     gauge_fontsize => 1,
1979     gauge_size => 0.35,
1980     stat_fontsize => 0.7,
1981     mapsize => 100,
1982     say_command => 'say',
1983     audio_enable => 1,
1984     bgm_enable => 1,
1985     bgm_volume => 0.25,
1986     face_prefetch => 0,
1987     output_sync => 1,
1988     output_count => 1,
1989     pickup => 0,
1990     default => "profile", # default profile
1991 root 1.1 );
1992 root 1.75
1993 root 1.1 while (my ($k, $v) = each %DEF_CFG) {
1994     $CFG->{$k} = $v unless exists $CFG->{$k};
1995     }
1996    
1997 root 1.75 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
1998    
1999 root 1.1 sdl_init;
2000    
2001     @SDL_MODES = reverse
2002     grep $_->[0] >= 640 && $_->[1] >= 480,
2003     CFClient::SDL_ListModes;
2004    
2005     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2006    
2007     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
2008    
2009     {
2010     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
2011     DejaVuSans.ttf
2012     DejaVuSansMono.ttf
2013     DejaVuSans-Bold.ttf
2014     DejaVuSansMono-Bold.ttf
2015     DejaVuSans-Oblique.ttf
2016     DejaVuSansMono-Oblique.ttf
2017     DejaVuSans-BoldOblique.ttf
2018     DejaVuSansMono-BoldOblique.ttf
2019     );
2020    
2021     CFClient::add_font $_ for @fonts;
2022    
2023     CFClient::pango_init;
2024    
2025     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
2026     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
2027    
2028     $FONT_PROP->make_default;
2029     }
2030    
2031     # compare mono (ft) vs. rgba (cairo)
2032     # ft - 1.8s, cairo 3s, even in alpha-only mode
2033     # for my $rgba (0..1) {
2034     # my $t1 = Time::HiRes::time;
2035     # for (1..1000) {
2036     # my $layout = CFClient::Layout->new ($rgba);
2037     # $layout->set_text ("hallo" x 100);
2038     # $layout->render;
2039     # }
2040     # my $t2 = Time::HiRes::time;
2041     # warn $t2-$t1;
2042     # }
2043    
2044     video_init;
2045     audio_init;
2046     }
2047    
2048     Event::loop;
2049 root 1.69 #CFClient::SDL_Quit;
2050     #CFClient::_exit 0;
2051 root 1.1
2052     END { CFClient::SDL_Quit }
2053    
2054     =head1 NAME
2055    
2056 root 1.28 cfplus - A Crossfire+ and Crossfire game client
2057 root 1.1
2058     =head1 SYNOPSIS
2059    
2060     Just run it - no commandline arguments are supported.
2061    
2062     =head1 USAGE
2063    
2064 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2065 root 1.1 fullscreen and interactively.
2066    
2067 root 1.39 =head1 DEBUGGING
2068    
2069    
2070     CFPLUS_DEBUG - environment variable
2071    
2072     1 draw borders around widgets
2073     2 add low-level widget info to tooltips
2074     4 show fps
2075     8 suppress tooltips
2076    
2077 root 1.1 =head1 AUTHOR
2078    
2079     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2080    
2081    
2082