ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.82
Committed: Wed Jun 28 10:37:19 2006 UTC (17 years, 10 months ago) by elmex
Branch: MAIN
Changes since 1.81: +3 -3 lines
Log Message:
fixed player weight update problems.
fixed Arm stat display (still displayed, but with the resist-phys value)

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