ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.78
Committed: Fri Jun 23 20:28:20 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.77: +9 -4 lines
Log Message:
faster textviewer, embeddable widgets, no scroll-to-bottom for docviewer

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 root 1.78 path => "ui/resist/resist_$_.png",
755 root 1.1 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 root 1.78 [manual => "Main Manual"],
1441     [skill_help => "Skill Reference"],
1442     [command_help => "Command Reference"],
1443 root 1.64 [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 root 1.78
1454     # $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc}\n",
1455     # (new CFClient::UI::Image path => "x.png"),
1456     # ]);#d#
1457 root 1.64
1458     $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1459     for @$pom;
1460 root 1.1
1461 root 1.64 $viewer->set_offset (0);
1462 root 1.78
1463 root 1.74 0
1464 root 1.64 },
1465     on_visibility_change => sub {
1466     my ($self, $visible) = @_;
1467     return unless $visible;
1468     return if $self->{value};
1469     $self->set_value ("intro");
1470 root 1.74 0
1471 root 1.64 },
1472     );
1473 root 1.1
1474     $win
1475     }
1476    
1477     sub sdl_init {
1478     CFClient::SDL_Init
1479     and die "SDL::Init failed!\n";
1480     }
1481    
1482     sub video_init {
1483     sdl_init;
1484    
1485     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1486    
1487     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1488    
1489     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1490     $FULLSCREEN = $CFG->{fullscreen};
1491     $FAST = $CFG->{fast};
1492    
1493     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1494     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1495    
1496     $SDL_ACTIVE = 1;
1497     $LAST_REFRESH = time - 0.01;
1498    
1499 root 1.10 CFClient::OpenGL::init;
1500 root 1.1
1501     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1502    
1503     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1504    
1505     #############################################################################
1506    
1507     if ($DEBUG_STATUS) {
1508     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1509     } else {
1510     # create the widgets
1511    
1512 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1513     padding => 0,
1514     z => 100,
1515     force_x => "max",
1516     force_y => 0;
1517 root 1.1 $DEBUG_STATUS->show;
1518 elmex 1.34
1519     $BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
1520    
1521 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1522 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1523 root 1.1
1524     (new CFClient::UI::Frame
1525     bg => [0, 0, 0, 0.4],
1526 root 1.30 force_x => 0,
1527     force_y => "max",
1528 root 1.1 child => $STATUSBOX,
1529     )->show;
1530    
1531     CFClient::UI::FancyFrame->new (
1532 root 1.47 title => "Map",
1533 root 1.42 name => "mapmap",
1534 root 1.30 x => 0,
1535     y => $FONTSIZE + 8,
1536 root 1.1 border_bg => [1, 1, 1, 192/255],
1537     bg => [1, 1, 1, 0],
1538     child => ($MAPMAP = new CFClient::MapWidget::MapMap
1539     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1540     ),
1541     )->show;
1542    
1543     $MAPWIDGET = new CFClient::MapWidget;
1544     $MAPWIDGET->connect (activate_console => sub {
1545     my ($mapwidget, $preset) = @_;
1546    
1547     if ($CONSOLE) {
1548     $CONSOLE->{input}->{auto_activated} = 1;
1549 root 1.74 $CONSOLE->{input}->grab_focus;
1550 root 1.1
1551     if ($preset && $CONSOLE->{input}->get_text eq '') {
1552     $CONSOLE->{input}->set_text ($preset);
1553     }
1554     }
1555     });
1556     $MAPWIDGET->show;
1557 root 1.74 $MAPWIDGET->grab_focus;
1558 root 1.1
1559 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1560 root 1.1 expand => 1,
1561     font => $FONT_FIXED,
1562     fontsize => $::CFG->{log_fontsize},
1563 root 1.61 indent => -4,
1564 root 1.1 can_hover => 1,
1565     can_events => 1,
1566     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1567     ;
1568    
1569 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1570     title => "Setup",
1571     name => "setup_dialog",
1572     x => 'center',
1573     y => 'center',
1574 root 1.53 z => 2,
1575 root 1.49 force_w => $::WIDTH * 0.6,
1576     force_h => $::HEIGHT * 0.6,
1577 root 1.74 has_close_button => 1,
1578 root 1.49 ;
1579    
1580 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1581 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1582 root 1.49
1583     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1584     "Configure the server to play on, your username, password and other server-related options.");
1585     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1586 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1587 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1588     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1589     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1590     "Configure the use of audio, sound effects and background music.");
1591     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1592 root 1.75 "Lets you define, edit and delete key bindings."
1593     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1594 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1595 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1596 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1597     . "binding editor closes");
1598     $SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
1599     "Displays all spells you have and lets you edit keyboard shortcuts for them.");
1600 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1601 root 1.75 "Some debuggin' options. Do not ask.");
1602 root 1.49
1603 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1604 root 1.1
1605 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1606     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1607    
1608 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1609 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1610    
1611     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
1612    
1613 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => $STATS_WINDOW = stats_window,
1614 root 1.1 tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
1615 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => inventory_window,
1616 root 1.51 tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
1617 root 1.52 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory.");
1618 root 1.1
1619     $BUTTONBAR->add (new CFClient::UI::Button
1620     text => "Save Config",
1621     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1622 root 1.18 on_activate => sub {
1623 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1624 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1625 root 1.1 status "Configuration Saved";
1626 root 1.74 0
1627 root 1.1 },
1628     );
1629    
1630 root 1.64 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => help_window,
1631 root 1.1 tooltip => "View Documentation");
1632    
1633     $BUTTONBAR->add (new CFClient::UI::Button
1634 root 1.18 text => "Quit",
1635     tooltip => "Terminates the program",
1636     on_activate => sub {
1637 root 1.1 if ($CONN) {
1638     open_quit_dialog;
1639     } else {
1640     exit;
1641     }
1642 root 1.74 0
1643 root 1.1 },
1644     );
1645    
1646     $BUTTONBAR->show;
1647 root 1.49 $SETUP_DIALOG->show;
1648     }
1649 root 1.1
1650 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1651 root 1.1 }
1652    
1653     sub video_shutdown {
1654 root 1.73 CFClient::OpenGL::shutdown;
1655    
1656 root 1.1 undef $SDL_ACTIVE;
1657     }
1658    
1659     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1660     my $bgmusic;#TODO#hack#d#
1661    
1662     sub audio_channel_finished {
1663     my ($channel) = @_;
1664    
1665     #warn "channel $channel finished\n";#d#
1666     }
1667    
1668     sub audio_music_finished {
1669     return unless $CFG->{bgm_enable};
1670    
1671     # TODO: hack, do play loop and mood music
1672     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1673     $bgmusic->play (0);
1674    
1675     push @bgmusic, shift @bgmusic;
1676     }
1677    
1678     sub audio_init {
1679     if ($CFG->{audio_enable}) {
1680     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1681     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1682    
1683     unless ($SDL_MIXER) {
1684     status "Unable to open sound device: there will be no sound";
1685     return;
1686     }
1687    
1688     CFClient::Mix_AllocateChannels 8;
1689     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1690    
1691     audio_music_finished;
1692    
1693     while (<$fh>) {
1694     next if /^\s*#/;
1695     next if /^\s*$/;
1696    
1697     my ($file, $volume, $event) = split /\s+/, $_, 3;
1698    
1699     push @SOUNDS, "$volume,$file";
1700    
1701     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1702     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1703     $chunk->volume ($volume * 128 / 100);
1704     $chunk
1705     };
1706     }
1707     } else {
1708     status "unable to open sound config: $!";
1709     }
1710     }
1711     }
1712    
1713     sub audio_shutdown {
1714     CFClient::Mix_CloseAudio if $SDL_MIXER;
1715     undef $SDL_MIXER;
1716     @SOUNDS = ();
1717     %AUDIO_CHUNKS = ();
1718     }
1719    
1720     my %animate_object;
1721     my $animate_timer;
1722    
1723     my $fps = 9;
1724    
1725     my %demo;#d#
1726    
1727     sub force_refresh {
1728     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1729 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1730 root 1.1
1731     $CFClient::UI::ROOT->draw;
1732    
1733     $WANT_REFRESH = 0;
1734     $CAN_REFRESH = 0;
1735     $LAST_REFRESH = $NOW;
1736    
1737     0 && do {
1738     # some weird model-drawing code, just a joke right now
1739     use CFClient::OpenGL;
1740    
1741     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1742     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1743     $demo{r} ||= do {
1744     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1745     $mod->{v} = pack "f*", @{$mod->{v}};
1746     $_ = [scalar @$_, pack "S!*", @$_]
1747     for values %{$mod->{g}};
1748     $mod
1749     };
1750    
1751     my $r = $demo{r} or die;
1752    
1753     glDepthMask 1;
1754     glClear GL_DEPTH_BUFFER_BIT;
1755     glEnable GL_TEXTURE_2D;
1756     glEnable GL_DEPTH_TEST;
1757     glEnable GL_CULL_FACE;
1758     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1759    
1760     glMatrixMode GL_PROJECTION;
1761     glLoadIdentity;
1762     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1763     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1764     glMatrixMode GL_MODELVIEW;
1765     glLoadIdentity;
1766    
1767     glPushMatrix;
1768     glTranslate 0, 0, -800;
1769     glScale 1, -1, 1;
1770     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1771     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1772     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1773     glScale 50, 50, 50;
1774    
1775     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1776     while (my ($k, $v) = each %{$r->{g}}) {
1777     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1778     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1779     }
1780    
1781     glPopMatrix;
1782    
1783     glShadeModel GL_FLAT;
1784     glDisable GL_DEPTH_TEST;
1785     glDisable GL_TEXTURE_2D;
1786     glDepthMask 0;
1787    
1788     $WANT_REFRESH++;
1789     };
1790    
1791     CFClient::SDL_GL_SwapBuffers;
1792     }
1793    
1794 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1795 root 1.1 $NOW = time;
1796    
1797     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1798     for CFClient::SDL_PollEvent;
1799    
1800     if (%animate_object) {
1801     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1802     $WANT_REFRESH++;
1803     }
1804    
1805     if ($WANT_REFRESH) {
1806     force_refresh;
1807     } else {
1808     $CAN_REFRESH = 1;
1809     }
1810     });
1811    
1812     sub animation_start {
1813     my ($widget) = @_;
1814     $animate_object{$widget} = $widget;
1815     }
1816    
1817     sub animation_stop {
1818     my ($widget) = @_;
1819     delete $animate_object{$widget};
1820     }
1821    
1822     # check once/second for faces that need to be prefetched
1823     # this should, of course, only run on demand, but
1824     # SDL forces worse things on us....
1825    
1826     Event->timer (after => 1, interval => 0.25, cb => sub {
1827     $CONN->face_prefetch
1828     if $CONN;
1829     });
1830    
1831     %SDL_CB = (
1832     CFClient::SDL_QUIT => sub {
1833     Event::unloop -1;
1834     },
1835     CFClient::SDL_VIDEORESIZE => sub {
1836     },
1837     CFClient::SDL_VIDEOEXPOSE => sub {
1838     CFClient::UI::full_refresh;
1839     },
1840     CFClient::SDL_ACTIVEEVENT => sub {
1841     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1842     },
1843     CFClient::SDL_KEYDOWN => sub {
1844     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1845     # alt-enter
1846     video_shutdown;
1847     $CFG->{fullscreen} = !$CFG->{fullscreen};
1848     video_init;
1849     } else {
1850     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1851     }
1852     },
1853     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1854     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1855     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1856     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1857     CFClient::SDL_USEREVENT => sub {
1858     if ($_[0]{code} == 1) {
1859     audio_channel_finished $_[0]{data1};
1860     } elsif ($_[0]{code} == 0) {
1861     audio_music_finished;
1862     }
1863     },
1864     );
1865    
1866     #############################################################################
1867    
1868     $SIG{INT} = $SIG{TERM} = sub { exit };
1869    
1870     {
1871 root 1.49 local $SIG{__DIE__} = sub {
1872     return unless defined $^S && !$^S;
1873     Carp::confess $_[1];#d#TODO: remove when stable
1874     CFClient::fatal $_[0];
1875     };
1876 root 1.1
1877 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1878 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1879 root 1.1
1880     my %DEF_CFG = (
1881 root 1.75 sdl_mode => 0,
1882     width => 640,
1883     height => 480,
1884     fullscreen => 0,
1885     fast => 0,
1886     map_scale => 1,
1887     fow_enable => 1,
1888     fow_intensity => 0.45,
1889     fow_smooth => 0,
1890     gui_fontsize => 1,
1891     log_fontsize => 0.7,
1892     gauge_fontsize => 1,
1893     gauge_size => 0.35,
1894     stat_fontsize => 0.7,
1895     mapsize => 100,
1896     say_command => 'say',
1897     audio_enable => 1,
1898     bgm_enable => 1,
1899     bgm_volume => 0.25,
1900     face_prefetch => 0,
1901     output_sync => 1,
1902     output_count => 1,
1903     pickup => 0,
1904     default => "profile", # default profile
1905 root 1.1 );
1906 root 1.75
1907 root 1.1 while (my ($k, $v) = each %DEF_CFG) {
1908     $CFG->{$k} = $v unless exists $CFG->{$k};
1909     }
1910    
1911 root 1.75 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
1912    
1913 root 1.1 sdl_init;
1914    
1915     @SDL_MODES = reverse
1916     grep $_->[0] >= 640 && $_->[1] >= 480,
1917     CFClient::SDL_ListModes;
1918    
1919     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1920    
1921     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1922    
1923     {
1924     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1925     DejaVuSans.ttf
1926     DejaVuSansMono.ttf
1927     DejaVuSans-Bold.ttf
1928     DejaVuSansMono-Bold.ttf
1929     DejaVuSans-Oblique.ttf
1930     DejaVuSansMono-Oblique.ttf
1931     DejaVuSans-BoldOblique.ttf
1932     DejaVuSansMono-BoldOblique.ttf
1933     );
1934    
1935     CFClient::add_font $_ for @fonts;
1936    
1937     CFClient::pango_init;
1938    
1939     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1940     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1941    
1942     $FONT_PROP->make_default;
1943     }
1944    
1945     # compare mono (ft) vs. rgba (cairo)
1946     # ft - 1.8s, cairo 3s, even in alpha-only mode
1947     # for my $rgba (0..1) {
1948     # my $t1 = Time::HiRes::time;
1949     # for (1..1000) {
1950     # my $layout = CFClient::Layout->new ($rgba);
1951     # $layout->set_text ("hallo" x 100);
1952     # $layout->render;
1953     # }
1954     # my $t2 = Time::HiRes::time;
1955     # warn $t2-$t1;
1956     # }
1957    
1958     video_init;
1959     audio_init;
1960     }
1961    
1962     Event::loop;
1963 root 1.69 #CFClient::SDL_Quit;
1964     #CFClient::_exit 0;
1965 root 1.1
1966     END { CFClient::SDL_Quit }
1967    
1968     =head1 NAME
1969    
1970 root 1.28 cfplus - A Crossfire+ and Crossfire game client
1971 root 1.1
1972     =head1 SYNOPSIS
1973    
1974     Just run it - no commandline arguments are supported.
1975    
1976     =head1 USAGE
1977    
1978 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1979 root 1.1 fullscreen and interactively.
1980    
1981 root 1.39 =head1 DEBUGGING
1982    
1983    
1984     CFPLUS_DEBUG - environment variable
1985    
1986     1 draw borders around widgets
1987     2 add low-level widget info to tooltips
1988     4 show fps
1989     8 suppress tooltips
1990    
1991 root 1.1 =head1 AUTHOR
1992    
1993     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1994    
1995    
1996