ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.84
Committed: Sun Jul 2 18:52:05 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.83: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

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