ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.79
Committed: Fri Jun 23 23:54:31 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.78: +3 -2 lines
Log Message:
hypertext for npc dialogs

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