ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.97
Committed: Wed Jul 19 16:41:51 2006 UTC (17 years, 10 months ago) by elmex
Branch: MAIN
Changes since 1.96: +19 -11 lines
Log Message:
reimplemeted scrollbars in the playerbook

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