ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.86
Committed: Sun Jul 2 21:07:27 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.85: +37 -19 lines
Log Message:
add menu to map, bind all important dialogs to f-keys

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