ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.85
Committed: Sun Jul 2 19:32:56 2006 UTC (17 years, 10 months ago) by elmex
Branch: MAIN
Changes since 1.84: +48 -33 lines
Log Message:
implemented player window and moved inventory, stats and spells there

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