ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.99
Committed: Sun Jul 23 08:58:44 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.98: +26 -0 lines
Log Message:
preliminary inventory sorting

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