ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.80
Committed: Mon Jun 26 21:59:04 2006 UTC (17 years, 11 months ago) by root
Branch: MAIN
Changes since 1.79: +3 -1 lines
Log Message:
misc

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     [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."],
700     [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     phys => "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
729     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     $STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
814     $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     return if $METASERVER_ATIME > time;
848     $METASERVER_ATIME = time + 60;
849    
850     my $table = $METASERVER->{table};
851     $table->clear;
852     $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
853    
854     my $buf;
855    
856     my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
857    
858     unless ($fh) {
859     $label->set_text ("unable to contact metaserver: $!");
860     return;
861     }
862    
863     Event->io (fd => $fh, poll => 'r', cb => sub {
864     my $res = sysread $fh, $buf, 8192, length $buf;
865    
866     if (!defined $res) {
867     $_[0]->w->cancel;
868     $label->set_text ("error while retrieving server list: $!");
869     } elsif ($res == 0) {
870     $_[0]->w->cancel;
871     status "server list retrieved";
872    
873     utf8::decode $buf if utf8::valid $buf;
874    
875     $table->clear;
876    
877 root 1.62 my @tip = (
878     "The current number of users logged in on the server.",
879     "The hostname of the server.",
880     "The time this server has been running without being restarted.",
881     "The server software version - a '+' indicates a Crossfire+ server.",
882     "Short information about this server provided by its admins.",
883     );
884     my @col = qw(#Users Host Uptime Version Description);
885     $table->add ($_, 0, new CFClient::UI::Label
886     can_hover => 1, can_events => 1,
887     align => 0, fg => [1, 1, 0],
888     text => $col[$_], tooltip => $tip[$_])
889     for 0 .. $#col;
890 root 1.1
891     my @align = qw(1 0 1 1 -1);
892    
893     my $y = 0;
894     for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
895     my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
896    
897     for ($desc) {
898     s/<br>/\n/gi;
899     s/<li>/\n· /gi;
900     s/<.*?>//sgi;
901     s/&/&amp;/g;
902     s/</&lt;/g;
903     s/>/&gt;/g;
904     }
905    
906     $uptime = sprintf "%dd %02d:%02d:%02d",
907     (int $m->[8] / 86400),
908     (int $m->[8] / 3600) % 24,
909     (int $m->[8] / 60) % 60,
910     $m->[8] % 60;
911    
912     $m = [$users, $host, $uptime, $version, $desc];
913    
914     $y++;
915    
916 root 1.62 $table->add (scalar @$m, $y, new CFClient::UI::VBox children => [
917     (new CFClient::UI::Button
918     text => "Use",
919     tooltip => "Put this server into the <b>Host:Port</b> field",
920     on_activate => sub {
921 root 1.75 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
922 root 1.62 $METASERVER->hide;
923 root 1.74 0
924 root 1.62 },
925     ),
926 root 1.1 (new CFClient::UI::Empty expand => 1),
927     ]);
928    
929 root 1.62 $table->add ($_, $y, new CFClient::UI::Label
930     ellipsise => 0,
931     align => $align[$_],
932     text => $m->[$_],
933     tooltip => $tip[$_],
934     can_hover => 1,
935     can_events => 1,
936     fontsize => 0.8)
937 root 1.1 for 0 .. $#$m;
938     }
939     }
940     });
941     }
942    
943 root 1.40 sub metaserver_dialog {
944     my $dialog = new CFClient::UI::FancyFrame
945 root 1.62 title => "Server List",
946     name => 'metaserver_dialog',
947     x => 'center',
948     y => 'center',
949     z => 3,
950     force_h => $::HEIGHT * 0.4,
951     child => (my $vbox = new CFClient::UI::VBox),
952 root 1.80 has_close_button => 1,
953 root 1.40 on_visibility_change => sub {
954     update_metaserver if $_[1];
955 root 1.74 0
956 root 1.40 },
957     ;
958    
959 root 1.62 $dialog->{table} = new CFClient::UI::Table;
960    
961     $vbox->add (new CFClient::UI::ScrolledWindow expand => 1, child => $dialog->{table});
962 root 1.40
963     $dialog
964     }
965    
966 root 1.1 sub server_setup {
967 root 1.49 my $vbox = new CFClient::UI::VBox;
968 elmex 1.19
969 root 1.1 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
970     $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
971    
972     {
973     $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
974    
975     $vbox->add (
976 root 1.40 $HOST_ENTRY = new CFClient::UI::Entry
977 root 1.1 expand => 1,
978 root 1.75 text => $CFG->{profile}{default}{host},
979 root 1.1 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
980 root 1.18 on_changed => sub {
981 root 1.1 my ($self, $value) = @_;
982 root 1.75 $CFG->{profile}{default}{host} = $value;
983 root 1.74 0
984 root 1.1 }
985     );
986    
987     $METASERVER = metaserver_dialog;
988    
989 root 1.40 $vbox->add (new CFClient::UI::Button
990     expand => 1,
991     text => "Server List",
992     other => $METASERVER,
993 root 1.1 tooltip => "Show a list of available crossfire servers",
994 root 1.74 on_activate => sub { $METASERVER->toggle_visibility; 0 },
995     on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
996 root 1.1 );
997     }
998    
999     $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
1000     $table->add (1, 4, new CFClient::UI::Entry
1001 root 1.75 text => $CFG->{profile}{default}{user},
1002 root 1.1 tooltip => "The name of your character on the server",
1003 root 1.75 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
1004 root 1.1 );
1005    
1006     $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
1007     $table->add (1, 5, new CFClient::UI::Entry
1008 root 1.75 text => $CFG->{profile}{default}{password},
1009 root 1.1 hidden => 1,
1010     tooltip => "The password for your character",
1011 root 1.75 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
1012 root 1.1 );
1013    
1014     $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
1015     $table->add (1, 7, new CFClient::UI::Slider
1016 root 1.30 force_w => 100,
1017 root 1.1 range => [$CFG->{mapsize}, 10, 100, 0, 1],
1018     tooltip => "This is the size of the portion of the map update the server sends you. "
1019     . "If you set this to a high value you will be able to see further, "
1020     . "but you also increase bandwidth requirements and latency. "
1021     . "This option is only used once at log-in.",
1022 root 1.74 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
1023 root 1.1 );
1024    
1025     $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Face Prefetch");
1026     $table->add (1, 8, new CFClient::UI::CheckBox
1027     state => $CFG->{face_prefetch},
1028     tooltip => "<b>Background Image Prefetch</b>\n\n"
1029     . "If enabled, the client automatically pre-fetches images from the server. "
1030     . "This might increase or create lag, but increases the chances "
1031     . "of faces being ready for display when you encounter them. "
1032     . "It also uses up server bandwidth on every connect, "
1033     . "so only set it if you really need to prefetch images. "
1034     . "This option can be set and unset any time.",
1035 root 1.74 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1036 root 1.1 );
1037    
1038     $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
1039     $table->add (1, 9, new CFClient::UI::Entry
1040     text => $CFG->{output_count},
1041     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1042 root 1.74 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1043 root 1.1 );
1044    
1045     $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
1046     $table->add (1, 10, new CFClient::UI::Entry
1047     text => $CFG->{output_sync},
1048     tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1049 root 1.74 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1050 root 1.1 );
1051    
1052     $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
1053     expand => 1,
1054     align => 0,
1055     text => "Login",
1056 root 1.18 on_activate => sub {
1057 root 1.1 $CONN ? stop_game
1058     : start_game;
1059 root 1.74 0
1060 root 1.1 },
1061     );
1062    
1063 root 1.49 $table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
1064     $table->add (1, 12, my $saycmd = new CFClient::UI::Entry
1065     text => $CFG->{say_command},
1066     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. "
1067     . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1068     . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1069     on_changed => sub {
1070     my ($self, $value) = @_;
1071     $CFG->{say_command} = $value;
1072 root 1.74 0
1073 root 1.49 }
1074     );
1075    
1076 root 1.67 $vbox->add (new CFClient::UI::Label
1077     text => "Server Info",
1078     fontsize => 1.2,
1079     padding_y => 8,
1080     fg => [1, 1, 0, 1],
1081     );
1082    
1083     $vbox->add ($SERVER_INFO = new CFClient::UI::Label ellipsise => 0);
1084    
1085 root 1.49 $vbox
1086 root 1.1 }
1087    
1088     sub message_window {
1089     my $window = new CFClient::UI::FancyFrame
1090 elmex 1.16 name => "message_window",
1091 root 1.1 title => "Messages",
1092     border_bg => [1, 1, 1, 1],
1093     bg => [0, 0, 0, 0.75],
1094 root 1.30 x => "max",
1095     y => 0,
1096 root 1.60 force_w => $::WIDTH * 0.4,
1097     force_h => $::HEIGHT * 0.5,
1098 root 1.74 child => (my $vbox = new CFClient::UI::VBox),
1099     has_close_button => 1;
1100 root 1.1
1101     $vbox->add ($LOGVIEW);
1102    
1103     $vbox->add (my $input = new CFClient::UI::Entry
1104     tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
1105     . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
1106     . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
1107     . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
1108 root 1.18 on_focus_in => sub {
1109 root 1.1 my ($input, $prev_focus) = @_;
1110    
1111     delete $input->{refocus_map};
1112    
1113     if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
1114     $input->{refocus_map} = 1;
1115     }
1116     delete $input->{auto_activated};
1117 root 1.74
1118     0
1119 root 1.1 },
1120 root 1.18 on_activate => sub {
1121 root 1.1 my ($input, $text) = @_;
1122     $input->set_text ('');
1123    
1124 elmex 1.46 if ($text =~ /^\/(.*)/) {
1125 root 1.1 $::CONN->user_send ($1);
1126     } else {
1127     my $say_cmd = $::CFG->{say_command} || 'say';
1128     $::CONN->user_send ("$say_cmd $text");
1129     }
1130     if ($input->{refocus_map}) {
1131     delete $input->{refocus_map};
1132     $MAPWIDGET->focus_in
1133     }
1134 root 1.74
1135     0
1136 root 1.1 },
1137 root 1.18 on_escape => sub {
1138 root 1.74 $MAPWIDGET->grab_focus;
1139    
1140     0
1141 root 1.1 },
1142     );
1143    
1144     $CONSOLE = {
1145     window => $window,
1146 root 1.30 input => $input,
1147 root 1.1 };
1148    
1149     $window
1150     }
1151    
1152     sub open_quit_dialog {
1153     unless ($QUIT_DIALOG) {
1154 root 1.30 $QUIT_DIALOG = new CFClient::UI::FancyFrame
1155     x => "center",
1156     y => "center",
1157 root 1.55 z => 50,
1158 root 1.30 title => "Really Quit?",
1159     ;
1160 root 1.1
1161     $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
1162    
1163     $vb->add (new CFClient::UI::Label
1164     text => "You should find a savebed and apply it first!",
1165     max_w => $WIDTH * 0.25,
1166     ellipsize => 0,
1167     );
1168     $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
1169     $hb->add (new CFClient::UI::Button
1170     text => "Ok",
1171     expand => 1,
1172 root 1.74 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1173 root 1.1 );
1174     $hb->add (new CFClient::UI::Button
1175     text => "Quit anyway",
1176     expand => 1,
1177 root 1.18 on_activate => sub { exit },
1178 root 1.1 );
1179 root 1.21 }
1180 root 1.1
1181 root 1.21 $QUIT_DIALOG->show;
1182 root 1.1 }
1183    
1184 root 1.49 sub autopickup_setup {
1185 root 1.51 my $table = new CFClient::UI::Table;
1186 elmex 1.44
1187 elmex 1.43 for (
1188 root 1.51 ["General", 0, 0,
1189 root 1.58 ["Enable autopickup" => PICKUP_NEWMODE],
1190     ["Inhibit autopickup" => PICKUP_INHIBIT],
1191     ["Stop before pickup" => PICKUP_STOP],
1192     ["Debug autopickup" => PICKUP_DEBUG],
1193 root 1.51 ],
1194     ["Weapons", 0, 6,
1195 root 1.58 ["All weapons" => PICKUP_ALLWEAPON],
1196     ["Missile weapons" => PICKUP_MISSILEWEAPON],
1197     ["Bows" => PICKUP_BOW],
1198     ["Arrows" => PICKUP_ARROW],
1199 root 1.51 ],
1200     ["Armour", 0, 12,
1201 root 1.58 ["Helmets" => PICKUP_HELMET],
1202     ["Shields" => PICKUP_SHIELD],
1203     ["Body Armour" => PICKUP_ARMOUR],
1204     ["Boots" => PICKUP_BOOTS],
1205     ["Gloves" => PICKUP_GLOVES],
1206     ["Cloaks" => PICKUP_CLOAK],
1207 root 1.51 ],
1208    
1209     ["Readables", 2, 2,
1210 root 1.58 ["Spellbooks" => PICKUP_SPELLBOOK],
1211     ["Skillscrolls" => PICKUP_SKILLSCROLL],
1212     ["Normal Books/Scrolls" => PICKUP_READABLES],
1213 root 1.51 ],
1214     ["Misc", 2, 7,
1215 root 1.58 ["Food" => PICKUP_FOOD],
1216     ["Drinks" => PICKUP_DRINK],
1217     ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1218     ["Keys" => PICKUP_KEY],
1219     ["Magical Items" => PICKUP_MAGICAL],
1220     ["Potions" => PICKUP_POTION],
1221     ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1222     ["Ignore cursed" => PICKUP_NOT_CURSED],
1223     ["Jewelery" => PICKUP_JEWELS],
1224 root 1.51 ],
1225 elmex 1.66 ["Weight/Value ratio", 2, 17]
1226 elmex 1.43 )
1227     {
1228 root 1.51 my ($title, $x, $y, @bits) = @$_;
1229     $table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1230    
1231     for (@bits) {
1232     ++$y;
1233    
1234 elmex 1.43 my $mask = $_->[1];
1235 root 1.51 $table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
1236     $table->add ($x+1, $y, new CFClient::UI::CheckBox
1237 elmex 1.43 state => $CFG->{pickup} & $mask,
1238     on_changed => sub {
1239     my ($box, $value) = @_;
1240 root 1.63
1241 elmex 1.43 if ($value) {
1242 elmex 1.45 $::CFG->{pickup} |= $mask;
1243 elmex 1.43 } else {
1244 root 1.63 $::CFG->{pickup} &= ~$mask;
1245 elmex 1.43 }
1246 root 1.63
1247     $::CONN->send_command ("pickup $::CFG->{pickup}")
1248 elmex 1.45 if defined $::CONN;
1249 root 1.74
1250     0
1251 elmex 1.43 });
1252     }
1253     }
1254    
1255 elmex 1.66 $table->add (2, 18, new CFClient::UI::ValSlider
1256     range => [0, 0, 16, 1, 1],
1257     to_value => sub { ">= " . 5 * $_[0] },
1258     on_changed => sub {
1259     my ($slider, $value) = @_;
1260    
1261     $::CFG->{pickup} &= ~0x7;
1262     $::CFG->{pickup} |= int $value
1263     if $value;
1264     1;
1265     });
1266     $table->add (3, 18, new CFClient::UI::Button
1267     text => "set",
1268     on_activate => sub {
1269     $::CONN->send_command ("pickup $::CFG->{pickup}")
1270     if defined $::CONN;
1271 root 1.74 0
1272 elmex 1.66 });
1273    
1274 root 1.51 $table
1275 elmex 1.43 }
1276    
1277 root 1.60 sub inventory_window {
1278 root 1.23 my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
1279 root 1.32 x => "center",
1280     y => "center",
1281     force_w => $WIDTH * 9/10,
1282     force_h => $HEIGHT * 9/10,
1283     title => "Inventory",
1284 root 1.74 has_close_button => 1,
1285 root 1.21 ;
1286 root 1.1
1287 root 1.21 $invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
1288 root 1.1
1289 root 1.21 $hb->add (my $vb1 = new CFClient::UI::VBox);
1290     $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
1291     $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
1292 root 1.1
1293 root 1.21 $hb->add (my $vb2 = new CFClient::UI::VBox);
1294 elmex 1.17
1295 elmex 1.27 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
1296 elmex 1.14
1297 root 1.1 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
1298    
1299 elmex 1.27 # XXX: Call after $INVR = ... because set_opencont sets the items
1300     CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
1301    
1302 root 1.1 $invwin
1303     }
1304    
1305 root 1.49 sub spell_setup {
1306     new CFClient::UI::SpellList
1307 elmex 1.38 }
1308    
1309 elmex 1.77 sub update_bindings {
1310     $BIND_UPD_CB->() if $BIND_UPD_CB;
1311     }
1312    
1313 root 1.49 sub keyboard_setup {
1314 elmex 1.24 my $binding_list = new CFClient::UI::VBox;
1315    
1316 elmex 1.34 my $refresh;
1317 elmex 1.77 $refresh = $BIND_UPD_CB = sub {
1318 elmex 1.24 $binding_list->clear ();
1319    
1320 root 1.75 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1321     for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1322     my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1323 elmex 1.24 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1324    
1325     my $lbl = join "; ", @$cmds;
1326 elmex 1.34 my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
1327 elmex 1.24 $binding_list->add (my $hb = new CFClient::UI::HBox);
1328     $hb->add (new CFClient::UI::Button
1329 elmex 1.25 text => "delete",
1330 elmex 1.34 tooltip => "Deletes the binding",
1331 elmex 1.24 on_activate => sub {
1332     $binding_list->remove ($hb);
1333 root 1.75 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1334 root 1.74 0
1335 elmex 1.24 });
1336 elmex 1.34
1337     $hb->add (new CFClient::UI::Button
1338     text => "edit",
1339     tooltip => "Edits the binding",
1340     on_activate => sub {
1341     $::BIND_EDITOR->set_binding (
1342 root 1.75 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1343 elmex 1.34 sub {
1344     my ($nmod, $nsym, $ncmds) = @_;
1345 elmex 1.77 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1346     $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1347 elmex 1.34 $refresh->();
1348 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1349     $SETUP_DIALOG->show;
1350 elmex 1.34 },
1351     sub {
1352 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1353     $SETUP_DIALOG->show;
1354 elmex 1.34 });
1355     $::BIND_EDITOR->show;
1356 root 1.49 $SETUP_DIALOG->hide;
1357 root 1.74 0
1358 elmex 1.34 });
1359    
1360     $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1361 elmex 1.24 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1362     }
1363     }
1364     };
1365    
1366 root 1.49 my $vb = new CFClient::UI::VBox;
1367 elmex 1.71 $vb->add (my $hb = new CFClient::UI::HBox);
1368     $hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
1369     $hb->add (new CFClient::UI::CheckBox
1370     expand => 1,
1371     state => $CFG->{shift_fire_stop},
1372     tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1373     on_changed => sub {
1374     my ($cbox, $value) = @_;
1375     $CFG->{shift_fire_stop} = $value;
1376 root 1.74 0
1377 elmex 1.71 });
1378    
1379 elmex 1.35 $vb->add ($binding_list);
1380     $vb->add (my $hb = new CFClient::UI::HBox);
1381 root 1.49
1382 elmex 1.35 $hb->add (new CFClient::UI::Button
1383 elmex 1.34 text => "record new",
1384 elmex 1.35 expand => 1,
1385 elmex 1.34 tooltip => "This button opens the binding editor with an empty binding.",
1386     on_activate => sub {
1387     $::BIND_EDITOR->set_binding (undef, undef, [],
1388     sub {
1389     my ($mod, $sym, $cmds) = @_;
1390 elmex 1.77 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1391 elmex 1.34 $refresh->();
1392 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1393     $SETUP_DIALOG->show;
1394 elmex 1.34 },
1395     sub {
1396 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1397     $SETUP_DIALOG->show;
1398 root 1.53 },
1399     );
1400 root 1.49 $SETUP_DIALOG->hide;
1401 elmex 1.34 $::BIND_EDITOR->show;
1402 root 1.74 0
1403 elmex 1.34 },
1404     );
1405 root 1.49
1406 elmex 1.35 $hb->add (new CFClient::UI::Button
1407     text => "close",
1408     tooltip => "Closes the binding window",
1409     expand => 1,
1410     on_activate => sub {
1411 root 1.49 $SETUP_DIALOG->hide;
1412 root 1.74 0
1413 elmex 1.35 }
1414     );
1415    
1416 elmex 1.24 $refresh->();
1417 root 1.49
1418     $vb
1419 elmex 1.24 }
1420    
1421 root 1.64 sub help_window {
1422 root 1.1 my $win = new CFClient::UI::FancyFrame
1423 root 1.41 x => 'center',
1424     y => 'center',
1425 root 1.55 z => 2,
1426 root 1.41 name => 'doc_browser',
1427     force_w => int $WIDTH * 7/8,
1428     force_h => int $HEIGHT * 7/8,
1429     title => "Documentation";
1430 root 1.1
1431     $win->add (my $vbox = new CFClient::UI::VBox);
1432    
1433     $vbox->add (my $buttons = new CFClient::UI::HBox);
1434 root 1.64 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1435     expand => 1, fontsize => 0.8, padding_x => 4);
1436 root 1.1
1437 root 1.64 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1438     $buttons->add (my $combo = new CFClient::UI::Combobox
1439     value => undef,
1440     options => [
1441     [intro => "Introduction"],
1442 root 1.78 [manual => "Main Manual"],
1443     [skill_help => "Skill Reference"],
1444     [command_help => "Command Reference"],
1445 root 1.64 [dmcommand_help => "DM Commands"],
1446     [COPYING => "License Terms"],
1447     ],
1448     on_changed => sub {
1449     my ($self, $pod) = @_;
1450 root 1.1
1451 root 1.64 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
1452     doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
1453 root 1.1
1454 root 1.64 $viewer->clear;
1455 root 1.78
1456 root 1.79 # $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
1457     # (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
1458     # (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
1459 root 1.78 # ]);#d#
1460 root 1.64
1461     $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1462     for @$pom;
1463 root 1.1
1464 root 1.64 $viewer->set_offset (0);
1465 root 1.78
1466 root 1.74 0
1467 root 1.64 },
1468     on_visibility_change => sub {
1469     my ($self, $visible) = @_;
1470     return unless $visible;
1471     return if $self->{value};
1472     $self->set_value ("intro");
1473 root 1.74 0
1474 root 1.64 },
1475     );
1476 root 1.1
1477     $win
1478     }
1479    
1480     sub sdl_init {
1481     CFClient::SDL_Init
1482     and die "SDL::Init failed!\n";
1483     }
1484    
1485     sub video_init {
1486     sdl_init;
1487    
1488     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1489    
1490     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1491    
1492     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1493     $FULLSCREEN = $CFG->{fullscreen};
1494     $FAST = $CFG->{fast};
1495    
1496     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1497     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1498    
1499     $SDL_ACTIVE = 1;
1500     $LAST_REFRESH = time - 0.01;
1501    
1502 root 1.10 CFClient::OpenGL::init;
1503 root 1.1
1504     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1505    
1506     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1507    
1508     #############################################################################
1509    
1510     if ($DEBUG_STATUS) {
1511     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1512     } else {
1513     # create the widgets
1514    
1515 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1516     padding => 0,
1517     z => 100,
1518     force_x => "max",
1519     force_y => 0;
1520 root 1.1 $DEBUG_STATUS->show;
1521 elmex 1.34
1522 root 1.80 $BIND_EDITOR = new CFClient::BindingEditor (x => "max", y => 0);
1523 elmex 1.34
1524 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1525 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1526 root 1.1
1527     (new CFClient::UI::Frame
1528     bg => [0, 0, 0, 0.4],
1529 root 1.30 force_x => 0,
1530     force_y => "max",
1531 root 1.1 child => $STATUSBOX,
1532     )->show;
1533    
1534     CFClient::UI::FancyFrame->new (
1535 root 1.47 title => "Map",
1536 root 1.42 name => "mapmap",
1537 root 1.30 x => 0,
1538     y => $FONTSIZE + 8,
1539 root 1.1 border_bg => [1, 1, 1, 192/255],
1540     bg => [1, 1, 1, 0],
1541     child => ($MAPMAP = new CFClient::MapWidget::MapMap
1542     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1543     ),
1544     )->show;
1545    
1546     $MAPWIDGET = new CFClient::MapWidget;
1547     $MAPWIDGET->connect (activate_console => sub {
1548     my ($mapwidget, $preset) = @_;
1549    
1550     if ($CONSOLE) {
1551     $CONSOLE->{input}->{auto_activated} = 1;
1552 root 1.74 $CONSOLE->{input}->grab_focus;
1553 root 1.1
1554     if ($preset && $CONSOLE->{input}->get_text eq '') {
1555     $CONSOLE->{input}->set_text ($preset);
1556     }
1557     }
1558     });
1559     $MAPWIDGET->show;
1560 root 1.74 $MAPWIDGET->grab_focus;
1561 root 1.1
1562 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1563 root 1.1 expand => 1,
1564     font => $FONT_FIXED,
1565     fontsize => $::CFG->{log_fontsize},
1566 root 1.61 indent => -4,
1567 root 1.1 can_hover => 1,
1568     can_events => 1,
1569     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1570     ;
1571    
1572 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1573     title => "Setup",
1574     name => "setup_dialog",
1575     x => 'center',
1576     y => 'center',
1577 root 1.53 z => 2,
1578 root 1.49 force_w => $::WIDTH * 0.6,
1579     force_h => $::HEIGHT * 0.6,
1580 root 1.74 has_close_button => 1,
1581 root 1.49 ;
1582    
1583 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1584 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1585 root 1.49
1586     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1587     "Configure the server to play on, your username, password and other server-related options.");
1588     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1589 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1590 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1591     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1592     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1593     "Configure the use of audio, sound effects and background music.");
1594     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1595 root 1.75 "Lets you define, edit and delete key bindings."
1596     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1597 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1598 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1599 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1600     . "binding editor closes");
1601     $SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
1602     "Displays all spells you have and lets you edit keyboard shortcuts for them.");
1603 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1604 root 1.75 "Some debuggin' options. Do not ask.");
1605 root 1.49
1606 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1607 root 1.1
1608 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1609     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1610    
1611 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1612 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1613    
1614     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
1615    
1616 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => $STATS_WINDOW = stats_window,
1617 root 1.1 tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
1618 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => inventory_window,
1619 root 1.51 tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
1620 root 1.52 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory.");
1621 root 1.1
1622     $BUTTONBAR->add (new CFClient::UI::Button
1623     text => "Save Config",
1624     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1625 root 1.18 on_activate => sub {
1626 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1627 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1628 root 1.1 status "Configuration Saved";
1629 root 1.74 0
1630 root 1.1 },
1631     );
1632    
1633 root 1.64 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => help_window,
1634 root 1.1 tooltip => "View Documentation");
1635    
1636     $BUTTONBAR->add (new CFClient::UI::Button
1637 root 1.18 text => "Quit",
1638     tooltip => "Terminates the program",
1639     on_activate => sub {
1640 root 1.1 if ($CONN) {
1641     open_quit_dialog;
1642     } else {
1643     exit;
1644     }
1645 root 1.74 0
1646 root 1.1 },
1647     );
1648    
1649     $BUTTONBAR->show;
1650 root 1.49 $SETUP_DIALOG->show;
1651     }
1652 root 1.1
1653 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1654 root 1.1 }
1655    
1656     sub video_shutdown {
1657 root 1.73 CFClient::OpenGL::shutdown;
1658    
1659 root 1.1 undef $SDL_ACTIVE;
1660     }
1661    
1662     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1663     my $bgmusic;#TODO#hack#d#
1664    
1665     sub audio_channel_finished {
1666     my ($channel) = @_;
1667    
1668     #warn "channel $channel finished\n";#d#
1669     }
1670    
1671     sub audio_music_finished {
1672     return unless $CFG->{bgm_enable};
1673    
1674     # TODO: hack, do play loop and mood music
1675     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1676     $bgmusic->play (0);
1677    
1678     push @bgmusic, shift @bgmusic;
1679     }
1680    
1681     sub audio_init {
1682     if ($CFG->{audio_enable}) {
1683     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1684     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1685    
1686     unless ($SDL_MIXER) {
1687     status "Unable to open sound device: there will be no sound";
1688     return;
1689     }
1690    
1691     CFClient::Mix_AllocateChannels 8;
1692     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1693    
1694     audio_music_finished;
1695    
1696     while (<$fh>) {
1697     next if /^\s*#/;
1698     next if /^\s*$/;
1699    
1700     my ($file, $volume, $event) = split /\s+/, $_, 3;
1701    
1702     push @SOUNDS, "$volume,$file";
1703    
1704     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1705     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1706     $chunk->volume ($volume * 128 / 100);
1707     $chunk
1708     };
1709     }
1710     } else {
1711     status "unable to open sound config: $!";
1712     }
1713     }
1714     }
1715    
1716     sub audio_shutdown {
1717     CFClient::Mix_CloseAudio if $SDL_MIXER;
1718     undef $SDL_MIXER;
1719     @SOUNDS = ();
1720     %AUDIO_CHUNKS = ();
1721     }
1722    
1723     my %animate_object;
1724     my $animate_timer;
1725    
1726     my $fps = 9;
1727    
1728     my %demo;#d#
1729    
1730     sub force_refresh {
1731     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1732 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1733 root 1.1
1734     $CFClient::UI::ROOT->draw;
1735    
1736     $WANT_REFRESH = 0;
1737     $CAN_REFRESH = 0;
1738     $LAST_REFRESH = $NOW;
1739    
1740     0 && do {
1741     # some weird model-drawing code, just a joke right now
1742     use CFClient::OpenGL;
1743    
1744     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1745     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1746     $demo{r} ||= do {
1747     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1748     $mod->{v} = pack "f*", @{$mod->{v}};
1749     $_ = [scalar @$_, pack "S!*", @$_]
1750     for values %{$mod->{g}};
1751     $mod
1752     };
1753    
1754     my $r = $demo{r} or die;
1755    
1756     glDepthMask 1;
1757     glClear GL_DEPTH_BUFFER_BIT;
1758     glEnable GL_TEXTURE_2D;
1759     glEnable GL_DEPTH_TEST;
1760     glEnable GL_CULL_FACE;
1761     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1762    
1763     glMatrixMode GL_PROJECTION;
1764     glLoadIdentity;
1765     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1766     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1767     glMatrixMode GL_MODELVIEW;
1768     glLoadIdentity;
1769    
1770     glPushMatrix;
1771     glTranslate 0, 0, -800;
1772     glScale 1, -1, 1;
1773     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1774     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1775     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1776     glScale 50, 50, 50;
1777    
1778     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1779     while (my ($k, $v) = each %{$r->{g}}) {
1780     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1781     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1782     }
1783    
1784     glPopMatrix;
1785    
1786     glShadeModel GL_FLAT;
1787     glDisable GL_DEPTH_TEST;
1788     glDisable GL_TEXTURE_2D;
1789     glDepthMask 0;
1790    
1791     $WANT_REFRESH++;
1792     };
1793    
1794     CFClient::SDL_GL_SwapBuffers;
1795     }
1796    
1797 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1798 root 1.1 $NOW = time;
1799    
1800     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1801     for CFClient::SDL_PollEvent;
1802    
1803     if (%animate_object) {
1804     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1805     $WANT_REFRESH++;
1806     }
1807    
1808     if ($WANT_REFRESH) {
1809     force_refresh;
1810     } else {
1811     $CAN_REFRESH = 1;
1812     }
1813     });
1814    
1815     sub animation_start {
1816     my ($widget) = @_;
1817     $animate_object{$widget} = $widget;
1818     }
1819    
1820     sub animation_stop {
1821     my ($widget) = @_;
1822     delete $animate_object{$widget};
1823     }
1824    
1825     # check once/second for faces that need to be prefetched
1826     # this should, of course, only run on demand, but
1827     # SDL forces worse things on us....
1828    
1829     Event->timer (after => 1, interval => 0.25, cb => sub {
1830     $CONN->face_prefetch
1831     if $CONN;
1832     });
1833    
1834     %SDL_CB = (
1835     CFClient::SDL_QUIT => sub {
1836     Event::unloop -1;
1837     },
1838     CFClient::SDL_VIDEORESIZE => sub {
1839     },
1840     CFClient::SDL_VIDEOEXPOSE => sub {
1841     CFClient::UI::full_refresh;
1842     },
1843     CFClient::SDL_ACTIVEEVENT => sub {
1844     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1845     },
1846     CFClient::SDL_KEYDOWN => sub {
1847     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1848     # alt-enter
1849     video_shutdown;
1850     $CFG->{fullscreen} = !$CFG->{fullscreen};
1851     video_init;
1852     } else {
1853     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1854     }
1855     },
1856     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1857     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1858     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1859     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1860     CFClient::SDL_USEREVENT => sub {
1861     if ($_[0]{code} == 1) {
1862     audio_channel_finished $_[0]{data1};
1863     } elsif ($_[0]{code} == 0) {
1864     audio_music_finished;
1865     }
1866     },
1867     );
1868    
1869     #############################################################################
1870    
1871     $SIG{INT} = $SIG{TERM} = sub { exit };
1872    
1873     {
1874 root 1.49 local $SIG{__DIE__} = sub {
1875     return unless defined $^S && !$^S;
1876     Carp::confess $_[1];#d#TODO: remove when stable
1877     CFClient::fatal $_[0];
1878     };
1879 root 1.1
1880 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1881 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1882 root 1.1
1883     my %DEF_CFG = (
1884 root 1.75 sdl_mode => 0,
1885     width => 640,
1886     height => 480,
1887     fullscreen => 0,
1888     fast => 0,
1889     map_scale => 1,
1890     fow_enable => 1,
1891     fow_intensity => 0.45,
1892     fow_smooth => 0,
1893     gui_fontsize => 1,
1894     log_fontsize => 0.7,
1895     gauge_fontsize => 1,
1896     gauge_size => 0.35,
1897     stat_fontsize => 0.7,
1898     mapsize => 100,
1899     say_command => 'say',
1900     audio_enable => 1,
1901     bgm_enable => 1,
1902     bgm_volume => 0.25,
1903     face_prefetch => 0,
1904     output_sync => 1,
1905     output_count => 1,
1906     pickup => 0,
1907     default => "profile", # default profile
1908 root 1.1 );
1909 root 1.75
1910 root 1.1 while (my ($k, $v) = each %DEF_CFG) {
1911     $CFG->{$k} = $v unless exists $CFG->{$k};
1912     }
1913    
1914 root 1.75 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
1915    
1916 root 1.1 sdl_init;
1917    
1918     @SDL_MODES = reverse
1919     grep $_->[0] >= 640 && $_->[1] >= 480,
1920     CFClient::SDL_ListModes;
1921    
1922     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1923    
1924     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1925    
1926     {
1927     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1928     DejaVuSans.ttf
1929     DejaVuSansMono.ttf
1930     DejaVuSans-Bold.ttf
1931     DejaVuSansMono-Bold.ttf
1932     DejaVuSans-Oblique.ttf
1933     DejaVuSansMono-Oblique.ttf
1934     DejaVuSans-BoldOblique.ttf
1935     DejaVuSansMono-BoldOblique.ttf
1936     );
1937    
1938     CFClient::add_font $_ for @fonts;
1939    
1940     CFClient::pango_init;
1941    
1942     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1943     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1944    
1945     $FONT_PROP->make_default;
1946     }
1947    
1948     # compare mono (ft) vs. rgba (cairo)
1949     # ft - 1.8s, cairo 3s, even in alpha-only mode
1950     # for my $rgba (0..1) {
1951     # my $t1 = Time::HiRes::time;
1952     # for (1..1000) {
1953     # my $layout = CFClient::Layout->new ($rgba);
1954     # $layout->set_text ("hallo" x 100);
1955     # $layout->render;
1956     # }
1957     # my $t2 = Time::HiRes::time;
1958     # warn $t2-$t1;
1959     # }
1960    
1961     video_init;
1962     audio_init;
1963     }
1964    
1965     Event::loop;
1966 root 1.69 #CFClient::SDL_Quit;
1967     #CFClient::_exit 0;
1968 root 1.1
1969     END { CFClient::SDL_Quit }
1970    
1971     =head1 NAME
1972    
1973 root 1.28 cfplus - A Crossfire+ and Crossfire game client
1974 root 1.1
1975     =head1 SYNOPSIS
1976    
1977     Just run it - no commandline arguments are supported.
1978    
1979     =head1 USAGE
1980    
1981 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1982 root 1.1 fullscreen and interactively.
1983    
1984 root 1.39 =head1 DEBUGGING
1985    
1986    
1987     CFPLUS_DEBUG - environment variable
1988    
1989     1 draw borders around widgets
1990     2 add low-level widget info to tooltips
1991     4 show fps
1992     8 suppress tooltips
1993    
1994 root 1.1 =head1 AUTHOR
1995    
1996     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1997    
1998    
1999