ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.77
Committed: Wed Jun 21 12:59:23 2006 UTC (17 years, 11 months ago) by elmex
Branch: MAIN
Changes since 1.76: +9 -4 lines
Log Message:
fixed bindings in completer and fixed the binding refresh problem

File Contents

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