ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.96
Committed: Mon Jul 17 01:41:54 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.95: +86 -0 lines
Log Message:
simple wbe browser, throwaway code

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