ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.98
Committed: Sat Jul 22 13:20:33 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.97: +55 -32 lines
Log Message:
character creation works again

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 elmex 1.97 $vb1->add (my $sw1 = new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1265     $sw1->add ($INV = new CFClient::UI::Inventory);
1266 root 1.1
1267 root 1.21 $hb->add (my $vb2 = new CFClient::UI::VBox);
1268 elmex 1.17
1269 elmex 1.27 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
1270 elmex 1.14
1271 elmex 1.97 $vb2->add (my $sw2 = new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1272     $sw2->add ($INVR = new CFClient::UI::Inventory);
1273 root 1.1
1274 elmex 1.27 # XXX: Call after $INVR = ... because set_opencont sets the items
1275     CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
1276    
1277 elmex 1.85 $hb
1278 root 1.1 }
1279    
1280 root 1.86 sub toggle_player_page {
1281     my ($widget) = @_;
1282    
1283     if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
1284     $PL_WINDOW->hide;
1285     } else {
1286     $PL_NOTEBOOK->set_current_page ($widget);
1287     $PL_WINDOW->show;
1288     }
1289     }
1290    
1291 elmex 1.85 sub player_window {
1292     my $plwin = $PL_WINDOW = new CFClient::UI::FancyFrame
1293     x => "center",
1294     y => "center",
1295     force_w => $WIDTH * 9/10,
1296     force_h => $HEIGHT * 9/10,
1297     title => "Player",
1298 elmex 1.90 name => "playerbook",
1299 elmex 1.85 has_close_button => 1
1300     ;
1301    
1302     my $ntb =
1303     $PL_NOTEBOOK =
1304 elmex 1.97 new CFClient::UI::Notebook expand => 1, debug => 1;
1305 root 1.86
1306 elmex 1.85 $ntb->add (
1307 root 1.95 "Statistics (F2)" => $STATS_PAGE = stats_window,
1308 elmex 1.92 "Shows statistics, where all your Stats and Resistances are shown."
1309     );
1310     $ntb->add (
1311 root 1.95 "Skills (F3)" => $SKILL_PAGE = skill_window,
1312 elmex 1.92 "Shows all your Skills."
1313 elmex 1.85 );
1314 elmex 1.97
1315     my $spellsw = new CFClient::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1316     $spellsw->add ($SPELL_PAGE = new CFClient::UI::SpellList);
1317 elmex 1.85 $ntb->add (
1318 elmex 1.97 "Spellbook (F4)" => $spellsw,
1319 root 1.86 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1320 elmex 1.85 );
1321     $ntb->add (
1322 root 1.95 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
1323 root 1.86 "Toggles the inventory window, where you can manage your loot (or treasures :). "
1324     . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1325 elmex 1.85 );
1326    
1327 root 1.88 $ntb->set_current_page ($INVENTORY_PAGE);
1328 root 1.86
1329 elmex 1.85 $plwin->add ($ntb);
1330     $plwin
1331 elmex 1.38 }
1332    
1333 elmex 1.77 sub update_bindings {
1334     $BIND_UPD_CB->() if $BIND_UPD_CB;
1335     }
1336    
1337 root 1.49 sub keyboard_setup {
1338 elmex 1.24 my $binding_list = new CFClient::UI::VBox;
1339    
1340 elmex 1.34 my $refresh;
1341 elmex 1.77 $refresh = $BIND_UPD_CB = sub {
1342 elmex 1.24 $binding_list->clear ();
1343    
1344 root 1.75 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1345     for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1346     my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1347 elmex 1.24 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1348    
1349     my $lbl = join "; ", @$cmds;
1350 root 1.84 my $nam = CFClient::BindingEditor::keycombo_to_name ($mod, $sym);
1351 elmex 1.24 $binding_list->add (my $hb = new CFClient::UI::HBox);
1352     $hb->add (new CFClient::UI::Button
1353 elmex 1.25 text => "delete",
1354 elmex 1.34 tooltip => "Deletes the binding",
1355 elmex 1.24 on_activate => sub {
1356     $binding_list->remove ($hb);
1357 root 1.75 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1358 root 1.74 0
1359 elmex 1.24 });
1360 elmex 1.34
1361     $hb->add (new CFClient::UI::Button
1362     text => "edit",
1363     tooltip => "Edits the binding",
1364     on_activate => sub {
1365     $::BIND_EDITOR->set_binding (
1366 root 1.75 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1367 elmex 1.34 sub {
1368     my ($nmod, $nsym, $ncmds) = @_;
1369 elmex 1.77 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1370     $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1371 elmex 1.34 $refresh->();
1372 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1373     $SETUP_DIALOG->show;
1374 elmex 1.34 },
1375     sub {
1376 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1377     $SETUP_DIALOG->show;
1378 elmex 1.34 });
1379     $::BIND_EDITOR->show;
1380 root 1.49 $SETUP_DIALOG->hide;
1381 root 1.74 0
1382 elmex 1.34 });
1383    
1384     $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1385 elmex 1.24 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1386     }
1387     }
1388     };
1389    
1390 root 1.49 my $vb = new CFClient::UI::VBox;
1391 elmex 1.71 $vb->add (my $hb = new CFClient::UI::HBox);
1392     $hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
1393     $hb->add (new CFClient::UI::CheckBox
1394     expand => 1,
1395     state => $CFG->{shift_fire_stop},
1396     tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1397     on_changed => sub {
1398     my ($cbox, $value) = @_;
1399     $CFG->{shift_fire_stop} = $value;
1400 root 1.74 0
1401 elmex 1.71 });
1402    
1403 elmex 1.35 $vb->add ($binding_list);
1404     $vb->add (my $hb = new CFClient::UI::HBox);
1405 root 1.49
1406 elmex 1.35 $hb->add (new CFClient::UI::Button
1407 elmex 1.34 text => "record new",
1408 elmex 1.35 expand => 1,
1409 elmex 1.34 tooltip => "This button opens the binding editor with an empty binding.",
1410     on_activate => sub {
1411     $::BIND_EDITOR->set_binding (undef, undef, [],
1412     sub {
1413     my ($mod, $sym, $cmds) = @_;
1414 elmex 1.77 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1415 elmex 1.34 $refresh->();
1416 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1417     $SETUP_DIALOG->show;
1418 elmex 1.34 },
1419     sub {
1420 root 1.49 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1421     $SETUP_DIALOG->show;
1422 root 1.53 },
1423     );
1424 root 1.49 $SETUP_DIALOG->hide;
1425 elmex 1.34 $::BIND_EDITOR->show;
1426 root 1.74 0
1427 elmex 1.34 },
1428     );
1429 root 1.49
1430 elmex 1.35 $hb->add (new CFClient::UI::Button
1431     text => "close",
1432     tooltip => "Closes the binding window",
1433     expand => 1,
1434     on_activate => sub {
1435 root 1.49 $SETUP_DIALOG->hide;
1436 root 1.74 0
1437 elmex 1.35 }
1438     );
1439    
1440 elmex 1.24 $refresh->();
1441 root 1.49
1442     $vb
1443 elmex 1.24 }
1444    
1445 root 1.96 # just weirdness, pls. ignore
1446     sub load_html_page {
1447     my ($viewer, $base) = @_;
1448    
1449     $viewer->clear;
1450    
1451     require LWP::Simple;
1452     require HTML::Parser;
1453     require URI;
1454    
1455     my $page = LWP::Simple::get ($base)
1456     or return;
1457    
1458     my @s = { };
1459     my %passthrough = map ($_ => undef), qw(b i u s tt big small sub sup);
1460    
1461     my $parser = HTML::Parser->new (
1462     text_h => [sub {
1463     my ($text) = @_;
1464     $text =~ s/\s+/ /g;
1465     $s[-1]{text} .= CFClient::UI::Label::escape $text;
1466     }, "dtext"],
1467     start_h => [sub {
1468     my ($tag, $attr) = @_;
1469     if ($passthrough{$tag}) {
1470     $s[-1]{text} .= "<$tag>";
1471     } elsif ($tag eq "h1") {
1472     push @s, { text => "<span foreground='#ffff00' size='x-large'>" };
1473     } elsif ($tag eq "h2") {
1474     push @s, { text => "<span foreground='#ccccff' size='large'>" };
1475     } elsif ($tag eq "h3") {
1476     push @s, { text => "<span size='large'>" };
1477     } elsif ($tag eq "a") {
1478     push @s, { text => "", url => $attr->{href} };
1479     } elsif ($tag eq "p") {
1480     push @s, { };
1481     } elsif ($tag eq "img") {
1482     eval {
1483     push @{$s[-1]{obj}}, new CFClient::UI::Image
1484     tex => (new_from_image CFClient::Texture LWP::Simple::get (URI->new ($attr->{src}, $base)->abs ($base)));
1485     $s[-1]{text} .= "\x{fffc}";
1486     };
1487     }
1488     }, "tagname, attr"],
1489     end_h => [sub {
1490     my ($tag) = @_;
1491     if ($passthrough{$tag}) {
1492     $s[-1]{text} .= "</$tag>";
1493     } elsif ($tag =~ /^h\d$/) {
1494     $s[-1]{text} .= "</span>";
1495     push @s, { };
1496     } elsif ($tag eq "a") {
1497     my $S = pop @s;
1498     $s[-1]{text} .= "\x{fffc}";
1499     push @{$s[-1]{obj}}, new CFClient::UI::Label
1500     fg => [0.8, 0.8, 1],
1501     markup => "<u>$S->{text}</u>",
1502     fontsize => 0.8,
1503     can_events => 1,
1504     can_focus => 1,
1505     on_button_up => sub {
1506     load_html_page ($viewer, URI->new ($S->{url}, $base)->abs ($base));
1507     },
1508     ;
1509     }
1510     }, "tagname"],
1511     );
1512    
1513     $parser->parse ($page);
1514     $parser->eof;
1515    
1516     $viewer->add_paragraph ([1, 1, 1, 1], [$_->{text}, @{ $_->{obj} || [] }], $_->{indent})
1517     for @s;
1518    
1519     $viewer->set_offset (0);
1520     }
1521    
1522 root 1.64 sub help_window {
1523 root 1.1 my $win = new CFClient::UI::FancyFrame
1524 root 1.41 x => 'center',
1525     y => 'center',
1526 root 1.55 z => 2,
1527 root 1.41 name => 'doc_browser',
1528     force_w => int $WIDTH * 7/8,
1529     force_h => int $HEIGHT * 7/8,
1530 root 1.87 title => "Help Browser",
1531     has_close_button => 1;
1532 root 1.1
1533     $win->add (my $vbox = new CFClient::UI::VBox);
1534    
1535     $vbox->add (my $buttons = new CFClient::UI::HBox);
1536 root 1.64 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1537     expand => 1, fontsize => 0.8, padding_x => 4);
1538 root 1.1
1539 root 1.64 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1540     $buttons->add (my $combo = new CFClient::UI::Combobox
1541     value => undef,
1542     options => [
1543     [intro => "Introduction"],
1544 root 1.78 [manual => "Main Manual"],
1545     [skill_help => "Skill Reference"],
1546     [command_help => "Command Reference"],
1547 root 1.64 [dmcommand_help => "DM Commands"],
1548     [COPYING => "License Terms"],
1549 root 1.96 [test => "test (do not select)"], #d#TODO
1550 root 1.64 ],
1551     on_changed => sub {
1552     my ($self, $pod) = @_;
1553 root 1.1
1554 root 1.96 if ($pod eq "test") {#d#TODO
1555     eval {
1556     load_html_page $viewer, "http://crossfire.real-time.com/guides/walkthrough/newbie-tower.html";
1557     };
1558     warn "$@" if $@;
1559     return;
1560     }
1561    
1562 root 1.64 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
1563     doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
1564 root 1.1
1565 root 1.64 $viewer->clear;
1566 root 1.78
1567 root 1.79 # $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
1568     # (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
1569     # (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
1570 root 1.78 # ]);#d#
1571 root 1.64
1572     $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1573     for @$pom;
1574 root 1.1
1575 root 1.64 $viewer->set_offset (0);
1576 root 1.78
1577 root 1.74 0
1578 root 1.64 },
1579     on_visibility_change => sub {
1580     my ($self, $visible) = @_;
1581     return unless $visible;
1582     return if $self->{value};
1583     $self->set_value ("intro");
1584 root 1.74 0
1585 root 1.64 },
1586     );
1587 root 1.1
1588     $win
1589     }
1590    
1591     sub sdl_init {
1592     CFClient::SDL_Init
1593     and die "SDL::Init failed!\n";
1594     }
1595    
1596     sub video_init {
1597     sdl_init;
1598    
1599     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1600    
1601     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1602    
1603     ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1604     $FULLSCREEN = $CFG->{fullscreen};
1605     $FAST = $CFG->{fast};
1606    
1607     CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
1608     or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
1609    
1610     $SDL_ACTIVE = 1;
1611     $LAST_REFRESH = time - 0.01;
1612    
1613 root 1.10 CFClient::OpenGL::init;
1614 root 1.1
1615     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1616    
1617     $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1618    
1619     #############################################################################
1620    
1621     if ($DEBUG_STATUS) {
1622     CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1623     } else {
1624     # create the widgets
1625    
1626 root 1.30 $DEBUG_STATUS = new CFClient::UI::Label
1627     padding => 0,
1628     z => 100,
1629     force_x => "max",
1630     force_y => 0;
1631 root 1.1 $DEBUG_STATUS->show;
1632 elmex 1.34
1633 root 1.80 $BIND_EDITOR = new CFClient::BindingEditor (x => "max", y => 0);
1634 elmex 1.34
1635 root 1.1 $STATUSBOX = new CFClient::UI::Statusbox;
1636 root 1.54 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1637 root 1.1
1638     (new CFClient::UI::Frame
1639     bg => [0, 0, 0, 0.4],
1640 root 1.30 force_x => 0,
1641     force_y => "max",
1642 root 1.1 child => $STATUSBOX,
1643     )->show;
1644    
1645     CFClient::UI::FancyFrame->new (
1646 root 1.47 title => "Map",
1647 root 1.42 name => "mapmap",
1648 root 1.30 x => 0,
1649     y => $FONTSIZE + 8,
1650 root 1.1 border_bg => [1, 1, 1, 192/255],
1651     bg => [1, 1, 1, 0],
1652     child => ($MAPMAP = new CFClient::MapWidget::MapMap
1653     tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1654     ),
1655     )->show;
1656    
1657     $MAPWIDGET = new CFClient::MapWidget;
1658     $MAPWIDGET->connect (activate_console => sub {
1659     my ($mapwidget, $preset) = @_;
1660    
1661     if ($CONSOLE) {
1662     $CONSOLE->{input}->{auto_activated} = 1;
1663 root 1.74 $CONSOLE->{input}->grab_focus;
1664 root 1.1
1665     if ($preset && $CONSOLE->{input}->get_text eq '') {
1666     $CONSOLE->{input}->set_text ($preset);
1667     }
1668     }
1669     });
1670     $MAPWIDGET->show;
1671 root 1.74 $MAPWIDGET->grab_focus;
1672 root 1.1
1673 root 1.64 $LOGVIEW = new CFClient::UI::TextScroller
1674 root 1.1 expand => 1,
1675     font => $FONT_FIXED,
1676     fontsize => $::CFG->{log_fontsize},
1677 root 1.61 indent => -4,
1678 root 1.1 can_hover => 1,
1679     can_events => 1,
1680     tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1681     ;
1682    
1683 root 1.49 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1684     title => "Setup",
1685     name => "setup_dialog",
1686     x => 'center',
1687     y => 'center',
1688 root 1.53 z => 2,
1689 root 1.49 force_w => $::WIDTH * 0.6,
1690     force_h => $::HEIGHT * 0.6,
1691 root 1.74 has_close_button => 1,
1692 root 1.49 ;
1693    
1694 elmex 1.81 $METASERVER = metaserver_dialog;
1695    
1696 root 1.50 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1697 root 1.60 filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1698 root 1.49
1699     $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1700     "Configure the server to play on, your username, password and other server-related options.");
1701     $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1702 root 1.58 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1703 root 1.49 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1704     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1705     $SETUP_NOTEBOOK->add (Audio => audio_setup,
1706     "Configure the use of audio, sound effects and background music.");
1707     $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1708 root 1.75 "Lets you define, edit and delete key bindings."
1709     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1710 root 1.49 . "with nothing set and the recording started. After doing the actions you "
1711 root 1.54 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1712 root 1.49 . "After pressing the combo the binding will be saved automatically and the "
1713     . "binding editor closes");
1714 root 1.65 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1715 root 1.75 "Some debuggin' options. Do not ask.");
1716 root 1.49
1717 root 1.57 $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1718 root 1.1
1719 root 1.49 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1720     tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1721    
1722 root 1.60 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1723 root 1.1 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1724    
1725     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
1726    
1727 root 1.87 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Playerbook", other => player_window,
1728 elmex 1.85 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
1729 root 1.1
1730     $BUTTONBAR->add (new CFClient::UI::Button
1731     text => "Save Config",
1732     tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1733 root 1.18 on_activate => sub {
1734 elmex 1.16 $::CFG->{layout} = CFClient::UI::get_layout;
1735 root 1.28 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1736 root 1.1 status "Configuration Saved";
1737 root 1.74 0
1738 root 1.1 },
1739     );
1740    
1741 root 1.86 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1742 root 1.1 tooltip => "View Documentation");
1743    
1744     $BUTTONBAR->add (new CFClient::UI::Button
1745 root 1.18 text => "Quit",
1746     tooltip => "Terminates the program",
1747     on_activate => sub {
1748 root 1.1 if ($CONN) {
1749     open_quit_dialog;
1750     } else {
1751     exit;
1752     }
1753 root 1.74 0
1754 root 1.1 },
1755     );
1756    
1757     $BUTTONBAR->show;
1758 root 1.49 $SETUP_DIALOG->show;
1759     }
1760 root 1.1
1761 root 1.49 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1762 root 1.1 }
1763    
1764     sub video_shutdown {
1765 root 1.73 CFClient::OpenGL::shutdown;
1766    
1767 root 1.1 undef $SDL_ACTIVE;
1768     }
1769    
1770     my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1771     my $bgmusic;#TODO#hack#d#
1772    
1773     sub audio_channel_finished {
1774     my ($channel) = @_;
1775    
1776     #warn "channel $channel finished\n";#d#
1777     }
1778    
1779     sub audio_music_finished {
1780     return unless $CFG->{bgm_enable};
1781    
1782     # TODO: hack, do play loop and mood music
1783     $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
1784     $bgmusic->play (0);
1785    
1786     push @bgmusic, shift @bgmusic;
1787     }
1788    
1789     sub audio_init {
1790     if ($CFG->{audio_enable}) {
1791     if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
1792     $SDL_MIXER = !CFClient::Mix_OpenAudio;
1793    
1794     unless ($SDL_MIXER) {
1795     status "Unable to open sound device: there will be no sound";
1796     return;
1797     }
1798    
1799     CFClient::Mix_AllocateChannels 8;
1800     CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
1801    
1802     audio_music_finished;
1803    
1804     while (<$fh>) {
1805     next if /^\s*#/;
1806     next if /^\s*$/;
1807    
1808     my ($file, $volume, $event) = split /\s+/, $_, 3;
1809    
1810     push @SOUNDS, "$volume,$file";
1811    
1812     $AUDIO_CHUNKS{"$volume,$file"} ||= do {
1813     my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
1814     $chunk->volume ($volume * 128 / 100);
1815     $chunk
1816     };
1817     }
1818     } else {
1819     status "unable to open sound config: $!";
1820     }
1821     }
1822     }
1823    
1824     sub audio_shutdown {
1825     CFClient::Mix_CloseAudio if $SDL_MIXER;
1826     undef $SDL_MIXER;
1827     @SOUNDS = ();
1828     %AUDIO_CHUNKS = ();
1829     }
1830    
1831     my %animate_object;
1832     my $animate_timer;
1833    
1834     my $fps = 9;
1835    
1836     my %demo;#d#
1837    
1838     sub force_refresh {
1839     $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1840 root 1.33 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1841 root 1.1
1842     $CFClient::UI::ROOT->draw;
1843    
1844     $WANT_REFRESH = 0;
1845     $CAN_REFRESH = 0;
1846     $LAST_REFRESH = $NOW;
1847    
1848     0 && do {
1849     # some weird model-drawing code, just a joke right now
1850     use CFClient::OpenGL;
1851    
1852     $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1853     $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1854     $demo{r} ||= do {
1855     my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1856     $mod->{v} = pack "f*", @{$mod->{v}};
1857     $_ = [scalar @$_, pack "S!*", @$_]
1858     for values %{$mod->{g}};
1859     $mod
1860     };
1861    
1862     my $r = $demo{r} or die;
1863    
1864     glDepthMask 1;
1865     glClear GL_DEPTH_BUFFER_BIT;
1866     glEnable GL_TEXTURE_2D;
1867     glEnable GL_DEPTH_TEST;
1868     glEnable GL_CULL_FACE;
1869     glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1870    
1871     glMatrixMode GL_PROJECTION;
1872     glLoadIdentity;
1873     glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1874     #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1875     glMatrixMode GL_MODELVIEW;
1876     glLoadIdentity;
1877    
1878     glPushMatrix;
1879     glTranslate 0, 0, -800;
1880     glScale 1, -1, 1;
1881     glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1882     glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1883     glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1884     glScale 50, 50, 50;
1885    
1886     glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1887     while (my ($k, $v) = each %{$r->{g}}) {
1888     glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1889     glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1890     }
1891    
1892     glPopMatrix;
1893    
1894     glShadeModel GL_FLAT;
1895     glDisable GL_DEPTH_TEST;
1896     glDisable GL_TEXTURE_2D;
1897     glDepthMask 0;
1898    
1899     $WANT_REFRESH++;
1900     };
1901    
1902     CFClient::SDL_GL_SwapBuffers;
1903     }
1904    
1905 root 1.49 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1906 root 1.1 $NOW = time;
1907    
1908     ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1909     for CFClient::SDL_PollEvent;
1910    
1911     if (%animate_object) {
1912     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1913     $WANT_REFRESH++;
1914     }
1915    
1916     if ($WANT_REFRESH) {
1917     force_refresh;
1918     } else {
1919     $CAN_REFRESH = 1;
1920     }
1921     });
1922    
1923     sub animation_start {
1924     my ($widget) = @_;
1925     $animate_object{$widget} = $widget;
1926     }
1927    
1928     sub animation_stop {
1929     my ($widget) = @_;
1930     delete $animate_object{$widget};
1931     }
1932    
1933     # check once/second for faces that need to be prefetched
1934     # this should, of course, only run on demand, but
1935     # SDL forces worse things on us....
1936    
1937     Event->timer (after => 1, interval => 0.25, cb => sub {
1938     $CONN->face_prefetch
1939     if $CONN;
1940     });
1941    
1942     %SDL_CB = (
1943     CFClient::SDL_QUIT => sub {
1944     Event::unloop -1;
1945     },
1946     CFClient::SDL_VIDEORESIZE => sub {
1947     },
1948     CFClient::SDL_VIDEOEXPOSE => sub {
1949     CFClient::UI::full_refresh;
1950     },
1951     CFClient::SDL_ACTIVEEVENT => sub {
1952     # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1953     },
1954     CFClient::SDL_KEYDOWN => sub {
1955     if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1956     # alt-enter
1957 root 1.94 $FULLSCREEN_ENABLE->toggle;
1958 root 1.1 video_shutdown;
1959     video_init;
1960     } else {
1961     CFClient::UI::feed_sdl_key_down_event ($_[0]);
1962     }
1963     },
1964     CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1965     CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1966     CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1967     CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1968     CFClient::SDL_USEREVENT => sub {
1969     if ($_[0]{code} == 1) {
1970     audio_channel_finished $_[0]{data1};
1971     } elsif ($_[0]{code} == 0) {
1972     audio_music_finished;
1973     }
1974     },
1975     );
1976    
1977     #############################################################################
1978    
1979     $SIG{INT} = $SIG{TERM} = sub { exit };
1980    
1981     {
1982 root 1.49 local $SIG{__DIE__} = sub {
1983     return unless defined $^S && !$^S;
1984 root 1.95 Carp::confess $_[0];#d#TODO: remove when stable
1985 root 1.49 CFClient::fatal $_[0];
1986     };
1987 root 1.1
1988 root 1.28 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1989 elmex 1.16 CFClient::UI::set_layout ($::CFG->{layout});
1990 root 1.1
1991     my %DEF_CFG = (
1992 root 1.75 sdl_mode => 0,
1993     width => 640,
1994     height => 480,
1995     fullscreen => 0,
1996     fast => 0,
1997     map_scale => 1,
1998     fow_enable => 1,
1999     fow_intensity => 0.45,
2000     fow_smooth => 0,
2001     gui_fontsize => 1,
2002     log_fontsize => 0.7,
2003     gauge_fontsize => 1,
2004     gauge_size => 0.35,
2005     stat_fontsize => 0.7,
2006     mapsize => 100,
2007     say_command => 'say',
2008     audio_enable => 1,
2009     bgm_enable => 1,
2010     bgm_volume => 0.25,
2011     face_prefetch => 0,
2012     output_sync => 1,
2013     output_count => 1,
2014     pickup => 0,
2015     default => "profile", # default profile
2016 root 1.1 );
2017 root 1.75
2018 root 1.1 while (my ($k, $v) = each %DEF_CFG) {
2019     $CFG->{$k} = $v unless exists $CFG->{$k};
2020     }
2021    
2022 root 1.75 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
2023    
2024 root 1.1 sdl_init;
2025    
2026     @SDL_MODES = reverse
2027     grep $_->[0] >= 640 && $_->[1] >= 480,
2028     CFClient::SDL_ListModes;
2029    
2030     @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2031    
2032     $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
2033    
2034     {
2035     my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
2036     DejaVuSans.ttf
2037     DejaVuSansMono.ttf
2038     DejaVuSans-Bold.ttf
2039     DejaVuSansMono-Bold.ttf
2040     DejaVuSans-Oblique.ttf
2041     DejaVuSansMono-Oblique.ttf
2042     DejaVuSans-BoldOblique.ttf
2043     DejaVuSansMono-BoldOblique.ttf
2044     );
2045    
2046     CFClient::add_font $_ for @fonts;
2047    
2048     CFClient::pango_init;
2049    
2050     $FONT_PROP = new_from_file CFClient::Font $fonts[0];
2051     $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
2052    
2053     $FONT_PROP->make_default;
2054     }
2055    
2056     # compare mono (ft) vs. rgba (cairo)
2057     # ft - 1.8s, cairo 3s, even in alpha-only mode
2058     # for my $rgba (0..1) {
2059     # my $t1 = Time::HiRes::time;
2060     # for (1..1000) {
2061     # my $layout = CFClient::Layout->new ($rgba);
2062     # $layout->set_text ("hallo" x 100);
2063     # $layout->render;
2064     # }
2065     # my $t2 = Time::HiRes::time;
2066     # warn $t2-$t1;
2067     # }
2068    
2069     video_init;
2070     audio_init;
2071     }
2072    
2073     Event::loop;
2074 root 1.69 #CFClient::SDL_Quit;
2075     #CFClient::_exit 0;
2076 root 1.1
2077     END { CFClient::SDL_Quit }
2078    
2079     =head1 NAME
2080    
2081 root 1.28 cfplus - A Crossfire+ and Crossfire game client
2082 root 1.1
2083     =head1 SYNOPSIS
2084    
2085     Just run it - no commandline arguments are supported.
2086    
2087     =head1 USAGE
2088    
2089 root 1.28 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2090 root 1.1 fullscreen and interactively.
2091    
2092 root 1.39 =head1 DEBUGGING
2093    
2094    
2095     CFPLUS_DEBUG - environment variable
2096    
2097     1 draw borders around widgets
2098     2 add low-level widget info to tooltips
2099     4 show fps
2100     8 suppress tooltips
2101    
2102 root 1.1 =head1 AUTHOR
2103    
2104     Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2105    
2106    
2107