ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.181
Committed: Sat Jul 21 16:07:53 2007 UTC (16 years, 10 months ago) by root
Branch: MAIN
Changes since 1.180: +28 -1 lines
Log Message:
the beginning of a (very simple) canvas widget

File Contents

# Content
1 #!/opt/bin/perl
2
3 my $startup_done = sub { };
4 our $PANGO = "1.5.0";
5
6 # do splash-screen thingy on win32
7 BEGIN {
8 if (%PAR::LibCache && $^O eq "MSWin32") {
9 while (my ($filename, $zip) = each %PAR::LibCache) {
10 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
11 }
12
13 require Win32::GUI::SplashScreen;
14
15 Win32::GUI::SplashScreen::Show (
16 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
17 );
18
19 $startup_done = sub {
20 Win32::GUI::SplashScreen::Done (1);
21 };
22 }
23 }
24
25 use strict;
26 use utf8;
27
28 use Carp 'verbose';
29
30 # do things only needed for single-binary version (par)
31 BEGIN {
32 if (%PAR::LibCache) {
33 @INC = grep ref, @INC; # weed out all paths except pars loader refs
34
35 my $tmp = $ENV{PAR_TEMP};
36
37 while (my ($filename, $zip) = each %PAR::LibCache) {
38 for ($zip->memberNames) {
39 next unless /^root\/(.*)/;
40 $zip->extractMember ($_, "$tmp/$1")
41 unless -e "$tmp/$1";
42 }
43 }
44
45 if ($^O eq "MSWin32") {
46 # relocatable
47 } else {
48 # unix, need to patch pango rc file
49 open my $fh, "<:perlio", "$tmp/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
50 or die "$tmp/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!";
51 local $/;
52 my $rc = <$fh>;
53 $rc =~ s/^\//$tmp\//gm; # replace abs paths by relative ones
54
55 mkdir "$tmp/pango-modules";
56 open my $fh, ">:perlio", "$tmp/pango-modules/pango.modules"
57 or die "$tmp/pango-modules/pango.modules: $!";
58 print $fh $rc;
59
60 $ENV{PANGO_RC_FILE} = "$tmp/pango.rc";
61 open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
62 or die "$ENV{PANGO_RC_FILE}: $!";
63 print $fh "[Pango]\nModuleFiles = $tmp/pango-modules\n";
64 }
65
66 unshift @INC, $tmp;
67 }
68 }
69
70 # need to do it again because that pile of garbage called PAR nukes it before main
71 unshift @INC, $ENV{PAR_TEMP}
72 if %PAR::LibCache;
73
74 use Time::HiRes 'time';
75 use Event;
76
77 use Crossfire;
78 use Crossfire::Protocol::Constants;
79
80 use Compress::LZF;
81
82 use CFPlus;
83 use CFPlus::OpenGL ();
84 use CFPlus::Protocol;
85 use CFPlus::DB;
86 use CFPlus::UI;
87 use CFPlus::UI::Canvas;
88 use CFPlus::UI::Inventory;
89 use CFPlus::UI::SpellList;
90 use CFPlus::Pod;
91 use CFPlus::MapWidget;
92 use CFPlus::Macro;
93
94 $SIG{QUIT} = sub { Carp::cluck "QUIT" };
95 $SIG{PIPE} = 'IGNORE';
96
97 $Event::Eval = 1;
98 $Event::DIED = sub {
99 CFPlus::fatal Carp::longmess $_[1]
100 };
101
102 my $MAX_FPS = 60;
103 my $MIN_FPS = 5; # unused as of yet
104
105 our $META_SERVER = "http://metaserver.schmorp.de/current.json";
106
107 our $LAST_REFRESH;
108 our $NOW;
109
110 our $CFG;
111 our $CONN;
112 our $PROFILE; # current profile
113 our $FAST; # fast, low-quality mode, possibly useful for software-rendering
114
115 our $WANT_REFRESH;
116 our $CAN_REFRESH;
117
118 our @SDL_MODES;
119 our $WIDTH;
120 our $HEIGHT;
121 our $FULLSCREEN;
122 our $FONTSIZE;
123
124 our $FONT_PROP;
125 our $FONT_FIXED;
126
127 our $MAP;
128 our $MAPMAP;
129 our $MAPWIDGET;
130 our $BUTTONBAR;
131 our $LOGVIEW;
132 our $CONSOLE;
133 our $METASERVER;
134 our $LOGIN_BUTTON;
135 our $QUIT_DIALOG;
136 our $HOST_ENTRY;
137 our $FULLSCREEN_ENABLE;
138 our $PICKUP_ENABLE;
139 our $SERVER_INFO;
140
141 our $SETUP_DIALOG;
142 our $SETUP_NOTEBOOK;
143 our $SETUP_SERVER;
144 our $SETUP_KEYBOARD;
145
146 our $PL_NOTEBOOK;
147 our $PL_WINDOW;
148
149 our $INVENTORY_PAGE;
150 our $STATS_PAGE;
151 our $SKILL_PAGE;
152 our $SPELL_PAGE;
153 our $SPELL_LIST;
154
155 our $HELP_WINDOW;
156 our $MESSAGE_WINDOW;
157 our $FLOORBOX;
158 our $GAUGES;
159 our $STATWIDS;
160
161 our $SDL_ACTIVE;
162 our %SDL_CB;
163
164 our $SDL_MIXER;
165 our $MUSIC_DEFAULT = "in_a_heartbeat.ogg";
166 our @MUSIC_WANT;
167 our $MUSIC_START;
168 our $MUSIC_PLAYING;
169 our $MUSIC_PLAYER;
170 our $MUSIC_RESUME = 30; # resume music when players less than these many seconds before
171 our @SOUNDS; # event => file mapping
172 our %AUDIO_CHUNKS; # audio files
173
174 our $ALT_ENTER_MESSAGE;
175 our $STATUSBOX;
176 our $DEBUG_STATUS;
177
178 our $INV;
179 our $INVR;
180 our $INV_RIGHT_HB;
181
182 our $PICKUP_CFG;
183
184 our $IN_BUILD_MODE;
185 our $BUILD_BUTTON;
186
187 sub status {
188 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
189 }
190
191 sub debug {
192 $DEBUG_STATUS->set_text ($_[0]);
193 }
194
195 sub message {
196 my ($para) = @_;
197
198 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
199
200 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
201
202 $LOGVIEW->add_paragraph ($para);
203 $LOGVIEW->scroll_to_bottom;
204 }
205
206 sub destroy_query_dialog {
207 (delete $_[0]{query_dialog})->destroy
208 if $_[0]{query_dialog};
209 }
210
211 # FIXME: a very ugly hack to wait for stat update look below! #d#
212 our $QUERY_TIMER; #d#
213
214 # server query dialog
215 sub server_query {
216 my ($conn, $flags, $prompt) = @_;
217
218 # FIXME: a very ugly hack to wait for stat update #d#
219 if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
220 unless ($QUERY_TIMER) {
221 $QUERY_TIMER =
222 Event->timer (
223 after => 1,
224 cb => sub {
225 server_query ($conn, $flags, $prompt, 1);
226 $QUERY_TIMER = undef
227 }
228 );
229 return;
230 }
231 }
232
233 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
234 x => "center",
235 y => "center",
236 title => "Server Query",
237 child => my $vbox = new CFPlus::UI::VBox,
238 ;
239
240 my @dialog = my $label = new CFPlus::UI::Label
241 max_w => $::WIDTH * 0.8,
242 ellipsise => 0,
243 text => $prompt;
244
245 if ($flags & CS_QUERY_YESNO) {
246 push @dialog, my $hbox = new CFPlus::UI::HBox;
247
248 $hbox->add (new CFPlus::UI::Button
249 text => "No",
250 on_activate => sub {
251 $conn->send ("reply n");
252 $dialog->destroy;
253 0
254 }
255 );
256 $hbox->add (new CFPlus::UI::Button
257 text => "Yes",
258 on_activate => sub {
259 $conn->send ("reply y");
260 destroy_query_dialog $conn;
261 0
262 },
263 );
264
265 $dialog->grab_focus;
266
267 } elsif ($flags & CS_QUERY_SINGLECHAR) {
268 if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
269 $dialog->{tooltip} = "#charcreation_focus";
270
271 unshift @dialog, new CFPlus::UI::Label
272 max_w => $::WIDTH * 0.8,
273 ellipsise => 0,
274 markup => "\nOr use your keyboard and the text entry below:\n";
275
276 unshift @dialog, my $table = new CFPlus::UI::Table;
277
278 $table->add_at (0, 0, new CFPlus::UI::Button
279 text => "Next Race",
280 on_activate => sub {
281 $conn->send ("reply n");
282 destroy_query_dialog $conn;
283 0
284 },
285 );
286 $table->add_at (2, 0, new CFPlus::UI::Button
287 text => "Accept",
288 on_activate => sub {
289 $conn->send ("reply d");
290 destroy_query_dialog $conn;
291 0
292 },
293 );
294
295 if ($conn->{chargen_race_description}) {
296 unshift @dialog, new CFPlus::UI::Label
297 max_w => $::WIDTH * 0.8,
298 ellipsise => 0,
299 markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
300 ;
301 }
302
303 unshift @dialog, new CFPlus::UI::Face
304 face => $conn->{player}{face},
305 bg => [.2, .2, .2, 1],
306 min_w => 64,
307 min_h => 64,
308 ;
309
310 if ($conn->{chargen_race_title}) {
311 unshift @dialog, new CFPlus::UI::Label
312 allign => 1,
313 ellipsise => 0,
314 markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
315 ;
316 }
317
318 unshift @dialog, new CFPlus::UI::Label
319 max_w => $::WIDTH * 0.4,
320 ellipsise => 0,
321 markup => (CFPlus::Pod::section_label ui => "chargen_race"),
322 ;
323
324 } elsif ($prompt =~ /roll new stats/) {
325 if (my $stat = delete $conn->{stat_change_with}) {
326 $conn->send ("reply $stat");
327 destroy_query_dialog $conn;
328 return;
329 }
330
331 unshift @dialog, new CFPlus::UI::Label
332 max_w => $::WIDTH * 0.4,
333 ellipsise => 0,
334 markup => "\nOr use your keyboard and the text entry below:\n";
335
336 unshift @dialog, my $table = new CFPlus::UI::Table;
337
338 # left: re-roll
339 $table->add_at (0, 0, new CFPlus::UI::Button
340 text => "Roll Again",
341 on_activate => sub {
342 $conn->send ("reply y");
343 destroy_query_dialog $conn;
344 0
345 },
346 );
347
348 # center: swap stats
349 my ($sw1, $sw2) = map +(new CFPlus::UI::Selector
350 expand => 1,
351 value => $_,
352 options => [
353 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
354 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
355 [3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"],
356 [4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"],
357 [5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"],
358 [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
359 [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
360 ],
361 ), 1 .. 2;
362
363 $table->add_at (2, 0, new CFPlus::UI::Button
364 text => "Swap Stats",
365 on_activate => sub {
366 $conn->{stat_change_with} = $sw2->{value};
367 $conn->send ("reply $sw1->{value}");
368 destroy_query_dialog $conn;
369 0
370 },
371 );
372 $table->add_at (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]);
373
374 # right: accept
375 $table->add_at (4, 0, new CFPlus::UI::Button
376 text => "Accept",
377 on_activate => sub {
378 $conn->send ("reply n");
379 $STATS_PAGE->hide;
380 destroy_query_dialog $conn;
381 0
382 },
383 );
384
385 unshift @dialog, my $hbox = new CFPlus::UI::HBox;
386 for (
387 [Str => CS_STAT_STR],
388 [Dex => CS_STAT_DEX],
389 [Con => CS_STAT_CON],
390 [Int => CS_STAT_INT],
391 [Wis => CS_STAT_WIS],
392 [Pow => CS_STAT_POW],
393 [Cha => CS_STAT_CHA],
394 ) {
395 my ($name, $id) = @$_;
396 $hbox->add (new CFPlus::UI::Label
397 markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",
398 align => 0,
399 expand => 1,
400 can_events => 1,
401 can_hover => 1,
402 tooltip => "#stat_$name",
403 );
404 }
405
406 unshift @dialog, new CFPlus::UI::Label
407 max_w => $::WIDTH * 0.4,
408 ellipsise => 0,
409 markup => (CFPlus::Pod::section_label ui => "chargen_stats"),
410 ;
411 }
412
413 push @dialog, my $entry = new CFPlus::UI::Entry
414 on_changed => sub {
415 $conn->send ("reply $_[1]");
416 destroy_query_dialog $conn;
417 0
418 },
419 ;
420
421 $entry->grab_focus;
422
423 } else {
424 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
425
426 push @dialog, my $entry = new CFPlus::UI::Entry
427 $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
428 on_activate => sub {
429 $conn->send ("reply $_[1]");
430 destroy_query_dialog $conn;
431 0
432 },
433 ;
434
435 $entry->grab_focus;
436 }
437
438 $vbox->add (@dialog);
439 $dialog->show;
440 }
441
442 sub start_game {
443 status "logging in...";
444
445 $LOGIN_BUTTON->set_text ("Logout");
446 $SETUP_DIALOG->hide;
447
448 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
449
450 my ($host, $port) = split /:/, $PROFILE->{host};
451
452 $MAP = new CFPlus::Map;
453
454 $CONN = eval {
455 new CFPlus::Protocol
456 host => $host,
457 port => $port || 13327,
458 user => $PROFILE->{user},
459 pass => $PROFILE->{password},
460 mapw => $mapsize,
461 maph => $mapsize,
462
463 client => "cfplus $CFPlus::VERSION $] $^O",
464
465 map_widget => $MAPWIDGET,
466 logview => $LOGVIEW,
467 statusbox => $STATUSBOX,
468 map => $MAP,
469 mapmap => $MAPMAP,
470 query => \&server_query,
471
472 setup_req => {
473 smoothing => $CFG->{map_smoothing}*1,
474 },
475
476 sound_play => sub {
477 my ($x, $y, $soundnum, $type) = @_;
478
479 $SDL_MIXER
480 or return;
481
482 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
483 or return;
484
485 $chunk->play;
486 },
487 };
488
489 if ($CONN) {
490 CFPlus::lowdelay fileno $CONN->{fh};
491
492 status "login successful";
493 } else {
494 status "unable to connect";
495 stop_game();
496 }
497 }
498
499 sub stop_game {
500 $LOGIN_BUTTON->set_text ("Login");
501 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
502 $SETUP_DIALOG->show;
503 $PL_WINDOW->hide;
504 $SPELL_LIST->clear_spells;
505 $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN);
506
507 &audio_music_set ([]);
508
509 return unless $CONN;
510
511 status "connection closed";
512
513 destroy_query_dialog $CONN;
514 $CONN->destroy;
515 $CONN = 0; # false, does not autovivify
516
517 undef $MAP;
518 }
519
520 sub graphics_setup {
521 my $vbox = new CFPlus::UI::VBox;
522
523 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
524
525 my $row = 0;
526
527 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info");
528 $table->add_at (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version,
529 can_events => 1,
530 tooltip => "<tt><span size='8192'>" . (CFPlus::OpenGL::gl_extensions) . "</span></tt>");
531
532 my $vidmode_tooltip =
533 "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
534 . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";
535
536 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");
537 $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);
538
539 $hbox->add (my $mode_slider = new CFPlus::UI::Slider
540 force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1],
541 tooltip => $vidmode_tooltip);
542 $hbox->add (my $mode_label = new CFPlus::UI::Label
543 align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9",
544 can_events => 1, tooltip => $vidmode_tooltip);
545
546 $mode_slider->connect (changed => sub {
547 my ($self, $value) = @_;
548
549 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
550 $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
551 });
552 $mode_slider->emit (changed => $mode_slider->{range}[0]);
553
554 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");
555 $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox
556 state => $CFG->{fullscreen},
557 tooltip => "Bring the client into fullscreen mode.",
558 on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
559 );
560
561 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
562 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
563 state => $CFG->{fast},
564 tooltip => "Lower the visual quality considerably to speed up rendering.",
565 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
566 );
567
568 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
569 $table->add_at (1, $row++, new CFPlus::UI::Slider
570 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
571 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
572 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
573 );
574
575 $table->add_at (1, $row++, new CFPlus::UI::Button
576 expand => 1, align => 0, text => "Apply",
577 tooltip => "Apply the video settings above.",
578 on_activate => sub {
579 video_shutdown ();
580 video_init ();
581 0
582 }
583 );
584
585 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");
586 $table->add_at (1, $row++, new CFPlus::UI::Slider
587 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
588 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
589 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
590 );
591
592 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Smoothing");
593 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
594 state => $CFG->{map_smoothing},
595 tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
596 . "This increases load on the graphics subsystem and works only with 2.x servers. "
597 . "Changes take effect at next connection only.",
598 on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
599 );
600
601 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");
602 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
603 state => $CFG->{fow_enable},
604 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
605 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
606 );
607
608 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity");
609 $table->add_at (1, $row++, new CFPlus::UI::Slider
610 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
611 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
612 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
613 );
614
615 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");
616 $table->add_at (1, $row++, new CFPlus::UI::Slider
617 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
618 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
619 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
620 );
621
622 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
623 $table->add_at (1, $row++, new CFPlus::UI::Slider
624 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
625 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
626 on_changed => sub {
627 $CFG->{gauge_fontsize} = $_[1];
628 &set_gauge_window_fontsize;
629 0
630 }
631 );
632
633 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size");
634 $table->add_at (1, $row++, new CFPlus::UI::Slider
635 range => [$CFG->{gauge_size}, 0.2, 0.8],
636 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
637 on_changed => sub {
638 $CFG->{gauge_size} = $_[1];
639 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
640 0
641 }
642 );
643
644 $vbox
645 }
646
647 sub audio_setup {
648 my $vbox = new CFPlus::UI::VBox;
649
650 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
651
652 my $row = 0;
653
654 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Audio Enable");
655 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
656 state => $CFG->{audio_enable},
657 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.",
658 on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 }
659 );
660 # $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume");
661 # $table->add_at (1, 8, new CFPlus::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
662 # $CFG->{effects_volume} = $_[1];
663 # });
664 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music");
665 $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);
666 $hbox->add (new CFPlus::UI::CheckBox
667 expand => 1, state => $CFG->{bgm_enable},
668 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
669 on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 }
670 );
671 $hbox->add (new CFPlus::UI::Slider
672 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
673 tooltip => "The volume of the background music. Changes are instant.",
674 on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFPlus::MixMusic::volume $_[1] * 128; 0 }
675 );
676
677 $table->add_at (1, $row++, new CFPlus::UI::Button
678 expand => 1, align => 0, text => "Apply",
679 tooltip => "Apply the audio settings",
680 on_activate => sub {
681 audio_shutdown ();
682 audio_init ();
683 0
684 }
685 );
686
687 $vbox
688 }
689
690 sub set_gauge_window_fontsize {
691 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
692 $_->set_fontsize ($::CFG->{gauge_fontsize});
693 }
694 }
695
696 sub make_gauge_window {
697 my $gh = int $HEIGHT * $CFG->{gauge_size};
698
699 my $win = new CFPlus::UI::Frame (
700 force_x => 0,
701 force_y => "max",
702 force_w => $WIDTH,
703 force_h => $gh,
704 );
705
706 $win->add (my $hbox = new CFPlus::UI::HBox
707 children => [
708 (new CFPlus::UI::HBox expand => 1),
709 (new CFPlus::UI::VBox children => [
710 (new CFPlus::UI::Empty expand => 1),
711 (new CFPlus::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFPlus::UI::Table)),
712 ]),
713 (my $vbox = new CFPlus::UI::VBox),
714 ],
715 );
716
717 $vbox->add (new CFPlus::UI::HBox
718 expand => 1,
719 children => [
720 (new CFPlus::UI::Empty expand => 1),
721 (my $hb = new CFPlus::UI::HBox),
722 ],
723 );
724
725 $hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp', tooltip => "#stat_health");
726 $hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana', tooltip => "#stat_mana");
727 $hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace', tooltip => "#stat_grace");
728 $hb->add (my $fg = new CFPlus::UI::Gauge type => 'food', tooltip => "#stat_food");
729
730 $vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
731 $vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
732
733 $GAUGES = {
734 exp => $exp, win => $win, range => $rng,
735 food => $fg, mana => $mg, hp => $hg, grace => $gg
736 };
737
738 &set_gauge_window_fontsize;
739
740 $win
741 }
742
743 sub debug_setup {
744 my $table = new CFPlus::UI::Table;
745
746 $table->add_at (0, 0, new CFPlus::UI::Label text => "Widget Borders");
747 $table->add_at (1, 0, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
748 $table->add_at (0, 1, new CFPlus::UI::Label text => "Tooltip Widget Info");
749 $table->add_at (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
750 $table->add_at (0, 2, new CFPlus::UI::Label text => "Show FPS");
751 $table->add_at (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
752 $table->add_at (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
753 $table->add_at (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
754 $table->add_at (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } );
755
756 $table->add_at (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#
757
758 $table->add_at (7,7, my $t = new CFPlus::UI::Table expand => 0);
759 $t->add_at (0,0, new CFPlus::UI::Label text => "a a a a", rowspan => 1, colspan => 2);
760 $t->add_at (2,0, new CFPlus::UI::Label text => "b\nb", rowspan => 2, colspan => 1);
761 $t->add_at (1,2, new CFPlus::UI::Label text => "c c c c", rowspan => 1, colspan => 2);
762 $t->add_at (0,1, new CFPlus::UI::Label text => "d\nd", rowspan => 2, colspan => 1);
763 $t->add_at (1,1, new CFPlus::UI::Label text => "e");
764
765 $table->add_at (7, 6, my $c = new CFPlus::UI::Canvas);
766
767 $c->add_items ({
768 type => "line_loop",
769 color => [0, 1, 0],
770 width => 9,
771 coord_mode => "abs",
772 coord => [[10, 5], [5, 50], [20, 5], [5, 60]],
773 });
774
775 $c->add_items ({
776 type => "lines",
777 color => [1, 1, 0],
778 width => 2,
779 coord_mode => "rel",
780 coord => [[0,0], [1,1], [1,0], [0,1]],
781 });
782
783 $c->add_items ({
784 type => "polygon",
785 color => [0, 0.43, 0],
786 width => 2,
787 coord_mode => "rel",
788 coord => [[0,0.2], [1,.4], [1,.6], [0,.8]],
789 });
790
791 $table
792 }
793
794 sub stats_window {
795 my $r = new CFPlus::UI::ScrolledWindow (
796 expand => 1,
797 scroll_y => 1
798 );
799 $r->add (my $vb = new CFPlus::UI::VBox);
800
801 $vb->add (new CFPlus::UI::FancyFrame
802 label => "Player",
803 child => (my $pi = new CFPlus::UI::VBox),
804 );
805
806 $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
807 can_hover => 1, can_events => 1,
808 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
809 $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
810 can_hover => 1, can_events => 1,
811 tooltip => "The map you are currently on (if supported by the server).");
812
813 $pi->add (my $hb0 = new CFPlus::UI::HBox);
814 $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
815 can_hover => 1, can_events => 1,
816 tooltip => "The weight of the player including all inventory items.");
817 $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
818 can_hover => 1, can_events => 1,
819 tooltip => "The weight limit: you cannot carry more than this.");
820
821 $vb->add (new CFPlus::UI::FancyFrame
822 label => "Primary/Secondary Statistics",
823 child => (my $hb = new CFPlus::UI::HBox expand => 1),
824 );
825 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1);
826
827 my $color2 = [1, 1, 0];
828
829 for (
830 [0, 0, st_str => "Str", 30],
831 [0, 1, st_dex => "Dex", 30],
832 [0, 2, st_con => "Con", 30],
833 [0, 3, st_int => "Int", 30],
834 [0, 4, st_wis => "Wis", 30],
835 [0, 5, st_pow => "Pow", 30],
836 [0, 6, st_cha => "Cha", 30],
837
838 [2, 0, st_wc => "Wc", -120],
839 [2, 1, st_ac => "Ac", -120],
840 [2, 2, st_dam => "Dam", 120],
841 [2, 3, st_arm => "Arm", 120],
842 [2, 4, st_spd => "Spd", 10.54],
843 [2, 5, st_wspd => "WSp", 10.54],
844 ) {
845 my ($col, $row, $id, $label, $template) = @$_;
846
847 $tbl->add_at ($col , $row, $STATWIDS->{$id} = new CFPlus::UI::Label
848 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0,
849 align => +1, template => $template, tooltip => "#stat_$label");
850 $tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label
851 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
852 align => -1, text => $label, tooltip => "#stat_$label");
853 }
854
855 $vb->add (new CFPlus::UI::FancyFrame
856 label => "Resistancies",
857 child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
858 );
859
860 my $row = 0;
861 my $col = 0;
862
863 my %resist_names = (
864 slow => ["Slow",
865 "<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.)"],
866 holyw => ["Holy Word",
867 "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"],
868 conf => ["Confusion",
869 "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)"],
870 fire => ["Fire",
871 "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"],
872 depl => ["Depletion",
873 "<b>Depletion</b> (some monsters and other effects can cause stats depletion)"],
874 magic => ["Magic",
875 "<b>Magic</b> (resistance to magic spells like magic missile or similar)"],
876 drain => ["Draining",
877 "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)"],
878 acid => ["Acid",
879 "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)"],
880 pois => ["Poison",
881 "<b>Poison</b> (resistance to getting poisoned)"],
882 para => ["Paralysation",
883 "<b>Paralysation</b> (this resistance affects the chance you get paralysed)"],
884 deat => ["Death",
885 "<b>Death</b> (resistance against death spells)"],
886 phys => ["Physical",
887 "<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.)"],
888 blind => ["Blind",
889 "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)"],
890 fear => ["Fear",
891 "<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)"],
892 tund => ["Turn undead",
893 "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."],
894 elec => ["Electricity",
895 "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)"],
896 cold => ["Cold",
897 "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)"],
898 ghit => ["Ghost hit",
899 "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)"],
900 );
901
902 for (qw/slow holyw conf fire depl magic
903 drain acid pois para deat phys
904 blind fear tund elec cold ghit/)
905 {
906 $tbl2->add_at ($col, $row,
907 $STATWIDS->{"res_$_"} =
908 new CFPlus::UI::Label
909 font => $FONT_FIXED,
910 template => "-100%",
911 align => +1,
912 valign => 0,
913 can_events => 1,
914 can_hover => 1,
915 tooltip => $resist_names{$_}->[1],
916 );
917 $tbl2->add_at ($col + 1, $row, new CFPlus::UI::Image
918 font => $FONT_FIXED,
919 can_hover => 1,
920 can_events => 1,
921 path => "ui/resist/resist_$_.png",
922 tooltip => $resist_names{$_}->[1],
923 );
924 $tbl2->add_at ($col + 2, $row, new CFPlus::UI::Label
925 text => $resist_names{$_}->[0],
926 font => $FONT_FIXED,
927 can_hover => 1,
928 can_events => 1,
929 tooltip => $resist_names{$_}->[1],
930 );
931
932 $row++;
933 if ($row % 6 == 0) {
934 $col += 3;
935 $row = 0;
936 }
937 }
938
939 #update_stats_window ({});
940
941 $r
942 }
943
944 sub skill_window {
945 my $sw = new CFPlus::UI::ScrolledWindow (expand => 1);
946 $sw->add ($STATWIDS->{skill_tbl} = new CFPlus::UI::Table expand => 1, col_expand => [0, 0, 1, 0, 0, 1]);
947 $sw
948 }
949
950 sub formsep($) {
951 scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
952 }
953
954 my $METASERVER_ATIME;
955
956 sub update_metaserver {
957 my ($metaserver_dialog) = @_;
958
959 $METASERVER = $metaserver_dialog
960 if defined $metaserver_dialog;
961
962 return if $METASERVER_ATIME > time;
963 $METASERVER_ATIME = time + 60;
964
965 my $table = $METASERVER->{table};
966 $table->clear;
967 $table->add_at (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
968
969 my $ok = 0;
970
971 CFPlus::background {
972 my $ua = CFPlus::lwp_useragent;
973
974 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
975 } sub {
976 my ($msg) = @_;
977 if ($msg) {
978 $table->clear;
979
980 my @tip = (
981 "The current number of users logged in on the server.",
982 "The hostname of the server.",
983 "The time this server has been running without being restarted.",
984 "The server software version - a '+' indicates a Crossfire+ server.",
985 "Short information about this server provided by its admins.",
986 );
987 my @col = qw(#Users Host Uptime Version Description);
988 $table->add_at ($_, 0, new CFPlus::UI::Label
989 can_hover => 1, can_events => 1,
990 align => 0, fg => [1, 1, 0],
991 text => $col[$_], tooltip => $tip[$_])
992 for 0 .. $#col;
993
994 my @align = qw(1 0 1 1 -1);
995
996 my $y = 0;
997 for my $m (@{ $msg->{servers} }) {
998 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
999 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
1000
1001 for ($desc) {
1002 s/<br>/\n/gi;
1003 s/<li>/\n· /gi;
1004 s/<.*?>//sgi;
1005 s/&amp;/&/g;
1006 s/&lt;/</g;
1007 s/&gt;/>/g;
1008 }
1009
1010 $uptime = sprintf "%dd %02d:%02d:%02d",
1011 (int $uptime / 86400),
1012 (int $uptime / 3600) % 24,
1013 (int $uptime / 60) % 60,
1014 $uptime % 60;
1015
1016 $m = [$users, $host, $uptime, $version, $desc];
1017
1018 $y++;
1019
1020 $table->add_at (scalar @$m, $y, new CFPlus::UI::VBox children => [
1021 (new CFPlus::UI::Button
1022 text => "Use",
1023 tooltip => "Put this server into the <b>Host:Port</b> field",
1024 on_activate => sub {
1025 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
1026 $METASERVER->hide;
1027 0
1028 },
1029 ),
1030 (new CFPlus::UI::Empty expand => 1),
1031 ]);
1032
1033 $table->add_at ($_, $y, new CFPlus::UI::Label
1034 max_w => $::WIDTH * 0.4,
1035 ellipsise => 0,
1036 align => $align[$_],
1037 text => $m->[$_],
1038 tooltip => $tip[$_],
1039 fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
1040 can_hover => 1,
1041 can_events => 1,
1042 fontsize => 0.8)
1043 for 0 .. $#$m;
1044 }
1045 } else {
1046 $ok or $label->set_text ("error while contacting metaserver");
1047 }
1048 };
1049
1050 }
1051
1052 sub metaserver_dialog {
1053 my $vbox = new CFPlus::UI::VBox;
1054 my $table = new CFPlus::UI::Table;
1055 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);
1056
1057 my $dialog = new CFPlus::UI::Toplevel
1058 title => "Server List",
1059 name => 'metaserver_dialog',
1060 x => 'center',
1061 y => 'center',
1062 z => 3,
1063 force_w => $::WIDTH * 0.9,
1064 force_h => $::HEIGHT * 0.7,
1065 child => $vbox,
1066 has_close_button => 1,
1067 table => $table,
1068 on_visibility_change => sub {
1069 update_metaserver ($_[0]) if $_[1];
1070 0
1071 },
1072 ;
1073
1074 $dialog
1075 }
1076
1077 sub server_setup {
1078 my $vbox = new CFPlus::UI::VBox;
1079
1080 $vbox->add (new CFPlus::UI::FancyFrame
1081 label => "Connection Settings",
1082 child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
1083 );
1084 $table->add_at (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");
1085
1086 {
1087 $table->add_at (1, 2, my $vbox = new CFPlus::UI::VBox);
1088
1089 $vbox->add (
1090 $HOST_ENTRY = new CFPlus::UI::Entry
1091 expand => 1,
1092 text => $CFG->{profile}{default}{host},
1093 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
1094 on_changed => sub {
1095 my ($self, $value) = @_;
1096 $CFG->{profile}{default}{host} = $value;
1097 0
1098 }
1099 );
1100
1101 $vbox->add (new CFPlus::UI::Button
1102 expand => 1,
1103 text => "Server List",
1104 other => $METASERVER,
1105 tooltip => "Show a list of available crossfire servers",
1106 on_activate => sub { $METASERVER->toggle_visibility; 0 },
1107 on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
1108 );
1109 }
1110
1111 $table->add_at (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username");
1112 $table->add_at (1, 4, new CFPlus::UI::Entry
1113 text => $CFG->{profile}{default}{user},
1114 tooltip => "The name of your character on the server",
1115 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
1116 );
1117
1118 $table->add_at (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password");
1119 $table->add_at (1, 5, new CFPlus::UI::Entry
1120 text => $CFG->{profile}{default}{password},
1121 hidden => 1,
1122 tooltip => "The password for your character",
1123 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
1124 );
1125
1126 $table->add_at (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size");
1127 $table->add_at (1, 7, new CFPlus::UI::Slider
1128 force_w => 100,
1129 range => [$CFG->{mapsize}, 10, 100, 0, 1],
1130 tooltip => "This is the size of the portion of the map update the server sends you. "
1131 . "If you set this to a high value you will be able to see further, "
1132 . "but you also increase bandwidth requirements and latency. "
1133 . "This option is only used once at log-in.",
1134 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
1135 );
1136
1137 $table->add_at (0, 8, new CFPlus::UI::Label valign => 0, align => 1, text => "Face Prefetch");
1138 $table->add_at (1, 8, new CFPlus::UI::CheckBox
1139 state => $CFG->{face_prefetch},
1140 tooltip => "<b>Background Image Prefetch</b>\n\n"
1141 . "If enabled, the client automatically pre-fetches images from the server. "
1142 . "This might increase or create lag, but increases the chances "
1143 . "of faces being ready for display when you encounter them. "
1144 . "It also uses up server bandwidth on every connect, "
1145 . "so only set it if you really need to prefetch images. "
1146 . "This option can be set and unset any time.",
1147 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1148 );
1149
1150 $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
1151 $table->add_at (1, 9, new CFPlus::UI::Entry
1152 text => $CFG->{output_rate},
1153 tooltip => "The approximate bandwidth in bytes per second that the server should not exceed "
1154 . "when sending images, to ensure interactiveness. When 0 or unset, the server "
1155 . "default will be used, which is usually around 100kb/s.",
1156 on_changed => sub { $CFG->{output_rate} = $_[1]; 0 },
1157 );
1158
1159 $table->add_at (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
1160 $table->add_at (1, 10, new CFPlus::UI::Entry
1161 text => $CFG->{output_count},
1162 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1163 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1164 );
1165
1166 $table->add_at (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
1167 $table->add_at (1, 11, new CFPlus::UI::Entry
1168 text => $CFG->{output_sync},
1169 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1170 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1171 );
1172
1173 $table->add_at (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button
1174 expand => 1,
1175 align => 0,
1176 text => "Login",
1177 on_activate => sub {
1178 $CONN ? stop_game
1179 : start_game;
1180 0
1181 },
1182 );
1183
1184 $vbox->add (new CFPlus::UI::FancyFrame
1185 label => "Server Info",
1186 child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
1187 );
1188
1189 $vbox
1190 }
1191
1192 sub client_setup {
1193 my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1];
1194
1195 my $row = 0;
1196
1197 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
1198 $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
1199 text => $CFG->{say_command},
1200 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. "
1201 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1202 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1203 on_changed => sub {
1204 my ($self, $value) = @_;
1205 $CFG->{say_command} = $value;
1206 0
1207 }
1208 );
1209
1210 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
1211 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
1212 state => $CFG->{show_tips},
1213 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1214 on_changed => sub {
1215 my ($self, $value) = @_;
1216 $CFG->{show_tips} = $value;
1217 0
1218 }
1219 );
1220
1221 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size");
1222 $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
1223 text => $CFG->{logview_max_par},
1224 tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "
1225 . "sends more messages than this number, older messages get removed to save memory and "
1226 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1227 on_changed => sub {
1228 my ($self, $value) = @_;
1229 $LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1;
1230 0
1231 },
1232 );
1233
1234 $table
1235 }
1236
1237 sub message_window {
1238 my $window = new CFPlus::UI::Toplevel
1239 name => "message_window",
1240 title => "Messages",
1241 border_bg => [1, 1, 1, 1],
1242 x => "max",
1243 y => 0,
1244 force_w => $::WIDTH * 0.4,
1245 force_h => $::HEIGHT * 0.5,
1246 child => (my $vbox = new CFPlus::UI::VBox),
1247 has_close_button => 1;
1248
1249 $vbox->add ($LOGVIEW);
1250
1251 $vbox->add (my $input = new CFPlus::UI::Entry
1252 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
1253 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
1254 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
1255 . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
1256 on_focus_in => sub {
1257 my ($input, $prev_focus) = @_;
1258
1259 delete $input->{refocus_map};
1260
1261 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
1262 $input->{refocus_map} = 1;
1263 }
1264 delete $input->{auto_activated};
1265
1266 0
1267 },
1268 on_activate => sub {
1269 my ($input, $text) = @_;
1270 $input->set_text ('');
1271
1272 if ($text =~ /^\/(.*)/) {
1273 $::CONN->user_send ($1);
1274 } else {
1275 my $say_cmd = $::CFG->{say_command} || 'say';
1276 $::CONN->user_send ("$say_cmd $text");
1277 }
1278 if ($input->{refocus_map}) {
1279 delete $input->{refocus_map};
1280 $MAPWIDGET->focus_in
1281 }
1282
1283 0
1284 },
1285 on_escape => sub {
1286 $MAPWIDGET->grab_focus;
1287
1288 0
1289 },
1290 );
1291
1292 $CONSOLE = {
1293 window => $window,
1294 input => $input,
1295 };
1296
1297 $window
1298 }
1299
1300 sub autopickup_setup {
1301 my $r = new CFPlus::UI::ScrolledWindow (
1302 expand => 1,
1303 scroll_y => 1
1304 );
1305 $r->add (my $table = new CFPlus::UI::Table
1306 row_expand => [0],
1307 col_expand => [0, 1, 0, 1],
1308 );
1309
1310 for (
1311 ["General", 0, 0,
1312 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
1313 ["Inhibit autopickup" => PICKUP_INHIBIT],
1314 ["Stop before pickup" => PICKUP_STOP],
1315 ["Debug autopickup" => PICKUP_DEBUG],
1316 ],
1317 ["Weapons", 0, 6,
1318 ["All weapons" => PICKUP_ALLWEAPON],
1319 ["Missile weapons" => PICKUP_MISSILEWEAPON],
1320 ["Bows" => PICKUP_BOW],
1321 ["Arrows" => PICKUP_ARROW],
1322 ],
1323 ["Armour", 0, 12,
1324 ["Helmets" => PICKUP_HELMET],
1325 ["Shields" => PICKUP_SHIELD],
1326 ["Body Armour" => PICKUP_ARMOUR],
1327 ["Boots" => PICKUP_BOOTS],
1328 ["Gloves" => PICKUP_GLOVES],
1329 ["Cloaks" => PICKUP_CLOAK],
1330 ],
1331
1332 ["Readables", 2, 0,
1333 ["Spellbooks" => PICKUP_SPELLBOOK],
1334 ["Skillscrolls" => PICKUP_SKILLSCROLL],
1335 ["Normal Books/Scrolls" => PICKUP_READABLES],
1336 ],
1337 ["Misc", 2, 5,
1338 ["Food" => PICKUP_FOOD],
1339 ["Drinks" => PICKUP_DRINK],
1340 ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1341 ["Keys" => PICKUP_KEY],
1342 ["Magical Items" => PICKUP_MAGICAL],
1343 ["Potions" => PICKUP_POTION],
1344 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1345 ["Ignore cursed" => PICKUP_NOT_CURSED],
1346 ["Jewelery" => PICKUP_JEWELS],
1347 ["Flesh" => PICKUP_FLESH],
1348 ],
1349 ["Weight/Value ratio", 2, 17]
1350 )
1351 {
1352 my ($title, $x, $y, @bits) = @$_;
1353 $table->add_at ($x, $y, new CFPlus::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1354
1355 for (@bits) {
1356 ++$y;
1357
1358 my $mask = $_->[1];
1359 $table->add_at ($x , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1);
1360 $table->add_at ($x+1, $y, my $checkbox = new CFPlus::UI::CheckBox
1361 state => $::CFG->{pickup} & $mask,
1362 on_changed => sub {
1363 my ($box, $value) = @_;
1364
1365 if ($value) {
1366 $::CFG->{pickup} |= $mask;
1367 } else {
1368 $::CFG->{pickup} &= ~$mask;
1369 }
1370
1371 $::CONN->send_command ("pickup $::CFG->{pickup}")
1372 if defined $::CONN;
1373
1374 0
1375 });
1376
1377 ${$_->[2]} = $checkbox if $_->[2];
1378 }
1379 }
1380
1381 $table->add_at (2, 18, new CFPlus::UI::ValSlider
1382 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1383 template => ">= 99",
1384 to_value => sub { ">= " . 5 * $_[0] },
1385 on_changed => sub {
1386 my ($slider, $value) = @_;
1387
1388 $::CFG->{pickup} &= ~0xF;
1389 $::CFG->{pickup} |= int $value
1390 if $value;
1391 1;
1392 });
1393
1394 $table->add_at (3, 18, new CFPlus::UI::Button
1395 text => "set",
1396 on_activate => sub {
1397 $::CONN->send_command ("pickup $::CFG->{pickup}")
1398 if defined $::CONN;
1399 0
1400 });
1401
1402 $r
1403 }
1404
1405 my %SORT_ORDER = (
1406 type => undef,
1407 mtime => sub {
1408 my $NOW = time;
1409 sort {
1410 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1411 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1412
1413 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1414 or $btime <=> $atime
1415 or $a->{type} <=> $b->{type}
1416 } @_
1417 },
1418 weight => sub { sort {
1419 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1420 or $a->{type} <=> $b->{type}
1421 } @_ },
1422 );
1423
1424 sub inventory_widget {
1425 my $hb = new CFPlus::UI::HBox homogeneous => 1;
1426
1427 $hb->add (my $vb1 = new CFPlus::UI::VBox);
1428 $vb1->add (new CFPlus::UI::Label align => 0, text => "Player");
1429
1430 $vb1->add (my $hb1 = new CFPlus::UI::HBox);
1431
1432 use sort 'stable';
1433
1434 $hb1->add (new CFPlus::UI::Selector
1435 value => $::CFG->{inv_sort},
1436 options => [
1437 [type => "Type/Name"],
1438 [mtime => "Recent/Normal/Locked"],
1439 [weight => "Weight/Type"],
1440 ],
1441 on_changed => sub {
1442 $::CFG->{inv_sort} = $_[1];
1443 $INV->set_sort_order ($SORT_ORDER{$_[1]});
1444 },
1445 );
1446 $hb1->add (new CFPlus::UI::Label text => "Weight: ", align => 1, expand => 1);
1447 #TODO# update to weigh/maxweight
1448 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1449
1450 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1451 $sw1->add ($INV = new CFPlus::UI::Inventory);
1452 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1453
1454 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1455
1456 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1457
1458 $vb2->add (my $sw2 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1459 $sw2->add ($INVR = new CFPlus::UI::Inventory);
1460
1461 # XXX: Call after $INVR = ... because set_opencont sets the items
1462 CFPlus::Protocol::set_opencont ($::CONN, 0, "Floor");
1463
1464 $hb
1465 }
1466
1467 sub toggle_player_page {
1468 my ($widget) = @_;
1469
1470 if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
1471 $PL_WINDOW->hide;
1472 } else {
1473 $PL_NOTEBOOK->set_current_page ($widget);
1474 $PL_WINDOW->show;
1475 }
1476 }
1477
1478 sub player_window {
1479 my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
1480 x => "center",
1481 y => "center",
1482 force_w => $WIDTH * 9/10,
1483 force_h => $HEIGHT * 9/10,
1484 title => "Player",
1485 name => "playerbook",
1486 has_close_button => 1
1487 ;
1488
1489 my $ntb =
1490 $PL_NOTEBOOK =
1491 new CFPlus::UI::Notebook expand => 1;
1492
1493 $ntb->add (
1494 "Statistics (F2)" => $STATS_PAGE = stats_window,
1495 "Shows statistics, where all your Stats and Resistances are shown."
1496 );
1497 $ntb->add (
1498 "Skills (F3)" => $SKILL_PAGE = skill_window,
1499 "Shows all your Skills."
1500 );
1501
1502 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1503 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1504 $ntb->add (
1505 "Spellbook (F4)" => $spellsw,
1506 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1507 );
1508 $ntb->add (
1509 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
1510 "Toggles the inventory window, where you can manage your loot (or treasures :). "
1511 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1512 );
1513 $ntb->add (Pickup => autopickup_setup,
1514 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1515
1516 $ntb->set_current_page ($INVENTORY_PAGE);
1517
1518 $plwin->add ($ntb);
1519 $plwin
1520 }
1521
1522 sub keyboard_setup {
1523 CFPlus::Macro::keyboard_setup
1524 }
1525
1526 sub help_window {
1527 my $win = new CFPlus::UI::Toplevel
1528 x => 'center',
1529 y => 'center',
1530 z => 4,
1531 name => 'doc_browser',
1532 force_w => int $WIDTH * 7/8,
1533 force_h => int $HEIGHT * 7/8,
1534 title => "Help Browser",
1535 has_close_button => 1;
1536
1537 $win->add (my $vbox = new CFPlus::UI::VBox);
1538
1539 $vbox->add (new CFPlus::UI::FancyFrame
1540 label => "Navigation",
1541 child => (my $buttons = new CFPlus::UI::HBox),
1542 );
1543 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1544 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1545
1546 my @history;
1547 my @future;
1548 my $curnode;
1549
1550 my $load_node; $load_node = sub {
1551 my ($node, $para) = @_;
1552
1553 $buttons->clear;
1554
1555 $buttons->add (new CFPlus::UI::Button
1556 text => "⇤",
1557 tooltip => "back to the starting page",
1558 on_activate => sub {
1559 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1560 unshift @future, @history;
1561 @history = ();
1562 $load_node->(@{shift @future});
1563 },
1564 );
1565
1566 if (@history) {
1567 $buttons->add (new CFPlus::UI::Button
1568 text => "⋘",
1569 tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
1570 on_activate => sub {
1571 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1572 $load_node->(@{pop @history});
1573 },
1574 );
1575 }
1576
1577 if (@future) {
1578 $buttons->add (new CFPlus::UI::Button
1579 text => "â‹™",
1580 tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
1581 on_activate => sub {
1582 push @history, [$curnode, $viewer->current_paragraph];
1583 $load_node->(@{shift @future});
1584 },
1585 );
1586 }
1587
1588 $buttons->add (new CFPlus::UI::Label text => " ");
1589
1590 my @path = CFPlus::Pod::full_path_of $node;
1591 pop @path; # drop current node
1592
1593 for my $node (@path) {
1594 $buttons->add (new CFPlus::UI::Button
1595 text => $node->{kw}[0],
1596 tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
1597 on_activate => sub {
1598 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1599 $load_node->($node);
1600 },
1601 );
1602 $buttons->add (new CFPlus::UI::Label text => "/");
1603 }
1604
1605 $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);
1606
1607 $curnode = $node;
1608
1609 $viewer->clear;
1610 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
1611 $viewer->scroll_to ($para);
1612 };
1613
1614 $load_node->(CFPlus::Pod::find pod => "mainpage");
1615
1616 $CFPlus::Pod::goto_document = sub {
1617 my (@path) = @_;
1618
1619 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1620
1621 $load_node->((CFPlus::Pod::find @path)[0]);
1622 $win->show;
1623 };
1624
1625 $win
1626 }
1627
1628 sub open_string_query {
1629 my ($title, $cb, $txt, $tooltip) = @_;
1630 my $dialog = new CFPlus::UI::Toplevel
1631 x => "center",
1632 y => "center",
1633 z => 50,
1634 force_w => $WIDTH * 4/5,
1635 title => $title;
1636
1637 $dialog->add (
1638 my $e = new CFPlus::UI::Entry
1639 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1640 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1641 tooltip => $tooltip
1642 );
1643
1644 $e->grab_focus;
1645 $e->set_text ($txt) if $txt;
1646 $dialog->show;
1647 }
1648
1649 sub open_quit_dialog {
1650 unless ($QUIT_DIALOG) {
1651 $QUIT_DIALOG = new CFPlus::UI::Toplevel
1652 x => "center",
1653 y => "center",
1654 z => 50,
1655 title => "Really Quit?",
1656 on_key_down => sub {
1657 my ($dialog, $ev) = @_;
1658 $ev->{sym} == 27 and $dialog->hide;
1659 }
1660 ;
1661
1662 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1663
1664 $vb->add (new CFPlus::UI::Label
1665 text => "You should find a savebed and apply it first!",
1666 max_w => $WIDTH * 0.25,
1667 ellipsize => 0,
1668 );
1669 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1670 $hb->add (new CFPlus::UI::Button
1671 text => "Ok",
1672 expand => 1,
1673 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1674 );
1675 $hb->add (new CFPlus::UI::Button
1676 text => "Quit anyway",
1677 expand => 1,
1678 on_activate => sub { exit },
1679 );
1680 }
1681
1682 $QUIT_DIALOG->show;
1683 $QUIT_DIALOG->grab_focus;
1684 }
1685
1686 sub show_tip_of_the_day {
1687 # find all tips
1688 my @tod = CFPlus::Pod::find tip_of_the_day => "*";
1689
1690 CFPlus::DB::get state => "tip_of_the_day", sub {
1691 my ($todindex) = @_;
1692 $todindex = 0 if $todindex >= @tod;
1693 CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { };
1694
1695 # create dialog
1696 my $dialog;
1697
1698 my $close = sub {
1699 $dialog->destroy;
1700 };
1701
1702 $dialog = new CFPlus::UI::Toplevel
1703 x => "center",
1704 y => "center",
1705 z => 3,
1706 name => 'tip_of_the_day',
1707 force_w => int $WIDTH * 4/9,
1708 force_h => int $WIDTH * 2/9,
1709 title => "Tip of the day #" . (1 + $todindex),
1710 child => my $vbox = new CFPlus::UI::VBox,
1711 has_close_button => 1,
1712 on_delete => $close,
1713 ;
1714
1715 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1716 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1717 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
1718
1719 $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);
1720
1721 $table->add_at (0, 0, new CFPlus::UI::Button
1722 text => "Close",
1723 tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the <b>Server Setup</b>.",
1724 on_activate => $close,
1725 );
1726
1727 $table->add_at (2, 0, new CFPlus::UI::Button
1728 text => "Next",
1729 tooltip => "Show the next <b>Tip of the day</b>.",
1730 on_activate => sub {
1731 $close->();
1732 &show_tip_of_the_day;
1733 },
1734 );
1735
1736 $dialog->show;
1737 };
1738 }
1739
1740 sub sdl_init {
1741 CFPlus::SDL_Init
1742 and die "SDL::Init failed!\n";
1743 }
1744
1745 sub video_init {
1746 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1747
1748 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1749
1750 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1751 $FULLSCREEN = $CFG->{fullscreen};
1752 $FAST = $CFG->{fast};
1753
1754 CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
1755 or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n";
1756
1757 $SDL_ACTIVE = 1;
1758 $LAST_REFRESH = time - 0.01;
1759
1760 CFPlus::OpenGL::init;
1761
1762 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1763
1764 $CFPlus::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1765
1766 #############################################################################
1767
1768 if ($DEBUG_STATUS) {
1769 CFPlus::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1770 } else {
1771 # create the widgets
1772
1773 $DEBUG_STATUS = new CFPlus::UI::Label
1774 padding => 0,
1775 z => 100,
1776 force_x => "max",
1777 force_y => 0;
1778 $DEBUG_STATUS->show;
1779
1780 $STATUSBOX = new CFPlus::UI::Statusbox;
1781 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1782
1783 (new CFPlus::UI::Frame
1784 bg => [0, 0, 0, 0.4],
1785 force_x => 0,
1786 force_y => "max",
1787 child => $STATUSBOX,
1788 )->show;
1789
1790 CFPlus::UI::Toplevel->new (
1791 title => "Map",
1792 name => "mapmap",
1793 x => 0,
1794 y => $FONTSIZE + 8,
1795 border_bg => [1, 1, 1, 192/255],
1796 bg => [1, 1, 1, 0],
1797 child => ($MAPMAP = new CFPlus::MapWidget::MapMap
1798 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1799 ),
1800 )->show;
1801
1802 $MAPWIDGET = new CFPlus::MapWidget;
1803 $MAPWIDGET->connect (activate_console => sub {
1804 my ($mapwidget, $preset) = @_;
1805
1806 if ($CONSOLE) {
1807 $CONSOLE->{input}->{auto_activated} = 1;
1808 $CONSOLE->{input}->grab_focus;
1809
1810 if ($preset && $CONSOLE->{input}->get_text eq '') {
1811 $CONSOLE->{input}->set_text ($preset);
1812 }
1813 }
1814 });
1815 $MAPWIDGET->show;
1816 $MAPWIDGET->grab_focus;
1817
1818 $LOGVIEW = new CFPlus::UI::TextScroller
1819 expand => 1,
1820 font => $FONT_FIXED,
1821 fontsize => $::CFG->{log_fontsize},
1822 indent => -4,
1823 can_hover => 1,
1824 can_events => 1,
1825 max_par => $CFG->{logview_max_par},
1826 tooltip => "<b>Server Log</b>. This text viewer contains all recent messages sent by the server.",
1827 ;
1828
1829 $SETUP_DIALOG = new CFPlus::UI::Toplevel
1830 title => "Setup",
1831 name => "setup_dialog",
1832 x => 'center',
1833 y => 'center',
1834 z => 2,
1835 force_w => $::WIDTH * 0.6,
1836 force_h => $::HEIGHT * 0.6,
1837 has_close_button => 1,
1838 ;
1839
1840 $METASERVER = metaserver_dialog;
1841
1842 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,
1843 filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1844
1845 $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1846 "Configure the server to play on, your username, password and other server-related options.");
1847 $SETUP_NOTEBOOK->add (Client => client_setup,
1848 "Configure various client-specific settings.");
1849 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1850 "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1851 $SETUP_NOTEBOOK->add (Audio => audio_setup,
1852 "Configure the use of audio, sound effects and background music.");
1853 $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1854 "Lets you define, edit and delete key bindings."
1855 . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
1856 . "with nothing set and the recording started. After doing the actions you "
1857 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1858 . "After pressing the combo the binding will be saved automatically and the "
1859 . "binding editor closes");
1860 $SETUP_NOTEBOOK->add (Debug => debug_setup,
1861 "Some debuggin' options. Do not ask.");
1862
1863 $BUTTONBAR = new CFPlus::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
1864
1865 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1866 tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1867
1868 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1869 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1870
1871 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
1872
1873 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Playerbook", other => player_window,
1874 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
1875
1876 $BUTTONBAR->add (new CFPlus::UI::Button
1877 text => "Save Config",
1878 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1879 on_activate => sub {
1880 $::CFG->{layout} = CFPlus::UI::get_layout;
1881 CFPlus::write_cfg "$Crossfire::VARDIR/cfplusrc";
1882 status "Configuration Saved";
1883 0
1884 },
1885 );
1886
1887 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1888 tooltip => "View Documentation");
1889
1890
1891 $BUTTONBAR->add (new CFPlus::UI::Button
1892 text => "Quit",
1893 tooltip => "Terminates the program",
1894 on_activate => sub {
1895 if ($CONN) {
1896 open_quit_dialog;
1897 } else {
1898 exit;
1899 }
1900 0
1901 },
1902 );
1903
1904 $BUTTONBAR->show;
1905 $SETUP_DIALOG->show;
1906 }
1907
1908 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1909 }
1910
1911 sub setup_build_button {
1912 my ($enabled) = @_;
1913 if ($enabled) {
1914 $BUILD_BUTTON->hide if $BUILD_BUTTON;
1915 $BUILD_BUTTON ||= new CFPlus::UI::Button
1916 text => "Build",
1917 tooltip => "Opens the ingame builder",
1918 on_activate => sub {
1919 if ($CONN) {
1920 $CONN->send_ext_req (builder_player_items => sub {
1921 open_ingame_editor ($_[0]) if exists $_[0]->{items};
1922 });
1923 }
1924 0
1925 };
1926 $BUTTONBAR->add ($BUILD_BUTTON);
1927 } else {
1928 $BUILD_BUTTON->hide if $BUILD_BUTTON;
1929 }
1930 }
1931
1932 sub open_ingame_editor {
1933 my ($msg) = @_;
1934
1935 my $win = new CFPlus::UI::Toplevel
1936 x => 0,
1937 y => 'center',
1938 z => 4,
1939 name => 'builder_window',
1940 force_w => int $WIDTH * 1/4,
1941 force_h => int $HEIGHT * 3/4,
1942 title => "In game builder",
1943 has_close_button => 1;
1944
1945 my $r = new CFPlus::UI::ScrolledWindow (
1946 expand => 1,
1947 scroll_y => 1
1948 );
1949 $r->add (my $vb = new CFPlus::UI::VBox);
1950 $win->add ($r);
1951
1952
1953 $vb->add (
1954 new CFPlus::UI::Button
1955 text => "Disable build mode",
1956 on_activate => sub { $::IN_BUILD_MODE = undef }
1957 );
1958 $vb->add (
1959 new CFPlus::UI::Button
1960 text => "ERASE",
1961 on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } }
1962 );
1963
1964 for my $itemarchname (
1965 sort {
1966 $msg->{items}->{$a}->{build_arch_name}
1967 cmp $msg->{items}->{$b}->{build_arch_name}
1968 } keys %{$msg->{items}}
1969 ) {
1970 my $info = $msg->{items}->{$itemarchname};
1971 $vb->add (
1972 new CFPlus::UI::Button text => $info->{build_arch_name},
1973 on_activate => sub {
1974 $::IN_BUILD_MODE = { item => $itemarchname, info => $info };
1975
1976 if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) {
1977 build_mode_query_arch_info ();
1978 }
1979 }
1980 );
1981 }
1982
1983 $win->show;
1984 }
1985
1986 sub build_mode_query_arch_info {
1987 my ($iteminfo) = $::IN_BUILD_MODE;
1988 my $itemarchname = $iteminfo->{item};
1989 my $info = $iteminfo->{info};
1990
1991 my $dialog = new CFPlus::UI::Toplevel
1992 x => "center",
1993 y => "center",
1994 z => 50,
1995 force_w => int $WIDTH * 1/2,
1996 title => "Enter information for placement of '$itemarchname'",
1997 has_close_button => 1;
1998
1999 $dialog->add (my $vb = new CFPlus::UI::VBox expand => 1);
2000
2001 $vb->add (my $table = new CFPlus::UI::Table expand => 1);
2002 my $row = 0;
2003 if ($info->{has_name}) {
2004 $table->add_at (0, $row, new CFPlus::UI::Label text => "Name:");
2005 $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 });
2006 }
2007 if ($info->{has_text}) {
2008 $table->add_at (0, $row, new CFPlus::UI::Label text => "Text:");
2009 $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 });
2010 }
2011 if ($info->{has_connection}) {
2012 $table->add_at (0, $row, new CFPlus::UI::Label text => "Connection ID:");
2013 $table->add_at (1, $row++,
2014 new CFPlus::UI::Entry
2015 expand => 1,
2016 on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 },
2017 tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate"
2018 );
2019 }
2020
2021 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
2022 $hb->add (new CFPlus::UI::Button
2023 text => "Close",
2024 expand => 1,
2025 on_activate => sub { $dialog->hide; 0 },
2026 );
2027 $dialog->show;
2028 }
2029
2030 sub video_shutdown {
2031 CFPlus::OpenGL::shutdown;
2032
2033 undef $SDL_ACTIVE;
2034 }
2035
2036 sub audio_channel_finished {
2037 my ($channel) = @_;
2038
2039 #warn "channel $channel finished\n";#d#
2040 }
2041
2042 sub audio_music_set {
2043 my ($songs) = @_;
2044
2045 my @want =
2046 grep $_,
2047 map $CONN->{music_meta}{$_},
2048 @$songs;
2049
2050 if (@want) {
2051 @MUSIC_WANT = @want;
2052 &audio_music_changed ();
2053 }
2054 }
2055
2056 sub audio_music_start {
2057 my $path = $MUSIC_PLAYING->{path}
2058 or return;
2059
2060 CFPlus::DB::prefetch_file $path, 1024_000, sub {
2061 # music might have changed...
2062 $path eq $MUSIC_PLAYING->{path}
2063 or return &audio_music_start ();
2064
2065 $MUSIC_PLAYER = new_from_file CFPlus::MixMusic $path;
2066
2067 my $NOW = time;
2068
2069 if ($MUSIC_PLAYING->{stop_time} > $NOW - $MUSIC_RESUME) {
2070 my $pos = $MUSIC_PLAYING->{stop_pos};
2071 $MUSIC_PLAYER->fade_in_pos (0, 1000, $pos);
2072 $MUSIC_START = time - $pos;
2073 } else {
2074 $MUSIC_PLAYER->play (0);
2075 $MUSIC_START = time;
2076 }
2077
2078 delete $MUSIC_PLAYING->{stop_time};
2079 delete $MUSIC_PLAYING->{stop_pos};
2080 }
2081 }
2082
2083 sub audio_music_changed {
2084 return unless $CFG->{bgm_enable};
2085
2086 # default MUSIC_WANT == MUSIC_DEFAULT
2087 @MUSIC_WANT = { path => CFPlus::find_rcfile "music/$MUSIC_DEFAULT" } unless @MUSIC_WANT;
2088
2089 # if the currently playing song is acceptable, let it continue
2090 return if $MUSIC_PLAYING
2091 && grep $MUSIC_PLAYING->{path} eq $_->{path}, @MUSIC_WANT;
2092
2093 my $NOW = time;
2094
2095 if ($MUSIC_PLAYING) {
2096 $MUSIC_PLAYING->{stop_time} = $NOW;
2097 $MUSIC_PLAYING->{stop_pos} = $NOW - $MUSIC_START;
2098 CFPlus::MixMusic::fade_out 1000;
2099 } else {
2100 # sort by stop time, oldest first
2101 @MUSIC_WANT = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_WANT;
2102
2103 # if the most recently-played piece played very recently,
2104 # resume it, else choose the oldest piece for rotation.
2105 $MUSIC_PLAYING =
2106 $MUSIC_WANT[-1]{stop_time} > $NOW - $MUSIC_RESUME
2107 ? $MUSIC_WANT[-1]
2108 : $MUSIC_WANT[0];
2109
2110 audio_music_start;
2111 }
2112 }
2113
2114 sub audio_music_finished {
2115 $MUSIC_PLAYING = undef;
2116 undef $MUSIC_PLAYER;
2117
2118 audio_music_changed;
2119 }
2120
2121 sub audio_init {
2122 if ($CFG->{audio_enable}) {
2123 if (open my $fh, "<", CFPlus::find_rcfile "sounds/config") {
2124 $SDL_MIXER = !CFPlus::Mix_OpenAudio;
2125
2126 unless ($SDL_MIXER) {
2127 status "Unable to open sound device: there will be no sound";
2128 return;
2129 }
2130
2131 CFPlus::Mix_AllocateChannels 8;
2132 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
2133
2134 audio_music_finished;
2135
2136 local $_;
2137 while (<$fh>) {
2138 next if /^\s*#/;
2139 next if /^\s*$/;
2140
2141 my ($file, $volume, $event) = split /\s+/, $_, 3;
2142
2143 push @SOUNDS, "$volume,$file";
2144
2145 $AUDIO_CHUNKS{"$volume,$file"} ||= do {
2146 my $chunk = new_from_file CFPlus::MixChunk CFPlus::find_rcfile "sounds/$file";
2147 $chunk->volume ($volume * 128 / 100);
2148 $chunk
2149 };
2150 }
2151 } else {
2152 status "unable to open sound config: $!";
2153 }
2154 }
2155 }
2156
2157 sub audio_shutdown {
2158 CFPlus::Mix_CloseAudio if $SDL_MIXER;
2159 undef $SDL_MIXER;
2160 @SOUNDS = ();
2161 %AUDIO_CHUNKS = ();
2162 }
2163
2164 my %animate_object;
2165 my $animate_timer;
2166
2167 my $fps = 9;
2168
2169 my %demo;#d#
2170
2171 sub force_refresh {
2172 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
2173 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
2174
2175 $CFPlus::UI::ROOT->draw;
2176
2177 $WANT_REFRESH = 0;
2178 $CAN_REFRESH = 0;
2179 $LAST_REFRESH = $NOW;
2180
2181 CFPlus::SDL_GL_SwapBuffers;
2182 }
2183
2184 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
2185 $NOW = time;
2186
2187 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
2188 for CFPlus::poll_events;
2189
2190 if (%animate_object) {
2191 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2192 ++$WANT_REFRESH;
2193 }
2194
2195 if ($WANT_REFRESH) {
2196 force_refresh;
2197 } else {
2198 $CAN_REFRESH = 1;
2199 }
2200 });
2201
2202 sub animation_start {
2203 my ($widget) = @_;
2204 $animate_object{$widget} = $widget;
2205 }
2206
2207 sub animation_stop {
2208 my ($widget) = @_;
2209 delete $animate_object{$widget};
2210 }
2211
2212 # check once/second for faces that need to be prefetched
2213 # this should, of course, only run on demand, but
2214 # SDL forces worse things on us....
2215
2216 Event->timer (after => 1, interval => 0.25, cb => sub {
2217 $CONN->face_prefetch
2218 if $CONN;
2219 });
2220
2221 %SDL_CB = (
2222 CFPlus::SDL_QUIT => sub {
2223 exit;
2224 },
2225 CFPlus::SDL_VIDEORESIZE => sub {
2226 },
2227 CFPlus::SDL_VIDEOEXPOSE => sub {
2228 CFPlus::UI::full_refresh;
2229 },
2230 CFPlus::SDL_ACTIVEEVENT => sub {
2231 # not useful, as APPACTIVE include sonly iconified state, not unmapped
2232 # printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, CFPlus::SDL_GetAppState;#d#
2233 # printf "a %x\n", CFPlus::SDL_GetAppState & CFPlus::SDL_APPACTIVE;#d#
2234 # printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
2235 # printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
2236 # printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
2237 },
2238 CFPlus::SDL_KEYDOWN => sub {
2239 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
2240 # alt-enter
2241 $FULLSCREEN_ENABLE->toggle;
2242 video_shutdown;
2243 video_init;
2244 } else {
2245 CFPlus::UI::feed_sdl_key_down_event ($_[0]);
2246 }
2247 },
2248 CFPlus::SDL_KEYUP => \&CFPlus::UI::feed_sdl_key_up_event,
2249 CFPlus::SDL_MOUSEMOTION => \&CFPlus::UI::feed_sdl_motion_event,
2250 CFPlus::SDL_MOUSEBUTTONDOWN => \&CFPlus::UI::feed_sdl_button_down_event,
2251 CFPlus::SDL_MOUSEBUTTONUP => \&CFPlus::UI::feed_sdl_button_up_event,
2252 CFPlus::SDL_USEREVENT => sub {
2253 if ($_[0]{code} == 1) {
2254 audio_channel_finished $_[0]{data1};
2255 } elsif ($_[0]{code} == 0) {
2256 audio_music_finished;
2257 }
2258 },
2259 );
2260
2261 #############################################################################
2262
2263 $SIG{INT} = $SIG{TERM} = sub { exit };
2264
2265 {
2266 CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";
2267 CFPlus::DB::Server::run;
2268
2269 CFPlus::UI::set_layout ($::CFG->{layout});
2270
2271 my %DEF_CFG = (
2272 sdl_mode => 0,
2273 width => 640,
2274 height => 480,
2275 fullscreen => 0,
2276 fast => 0,
2277 map_scale => 1,
2278 fow_enable => 1,
2279 fow_intensity => 0,
2280 map_smoothing => 1,
2281 gui_fontsize => 1,
2282 log_fontsize => 0.7,
2283 gauge_fontsize => 1,
2284 gauge_size => 0.35,
2285 stat_fontsize => 0.7,
2286 mapsize => 100,
2287 say_command => 'chat',
2288 audio_enable => 1,
2289 bgm_enable => 1,
2290 bgm_volume => 0.25,
2291 face_prefetch => 0,
2292 output_sync => 1,
2293 output_count => 1,
2294 output_rate => "",
2295 pickup => 0,
2296 inv_sort => "mtime",
2297 default => "profile", # default profile
2298 show_tips => 1,
2299 logview_max_par => 1000,
2300 );
2301
2302 while (my ($k, $v) = each %DEF_CFG) {
2303 $CFG->{$k} = $v unless exists $CFG->{$k};
2304 }
2305
2306 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
2307 $PROFILE = $CFG->{profile}{default};
2308
2309 # convert old bindings (only default profile matters)
2310 if (my $bindings = delete $PROFILE->{bindings}) {
2311 while (my ($mod, $syms) = each %$bindings) {
2312 while (my ($sym, $cmds) = each %$syms) {
2313 push @{ $PROFILE->{macro} }, {
2314 accelkey => [$mod*1, $sym*1],
2315 action => $cmds,
2316 };
2317 }
2318 }
2319 }
2320
2321 sdl_init;
2322
2323 @SDL_MODES = CFPlus::SDL_ListModes 8, 8;
2324 @SDL_MODES = CFPlus::SDL_ListModes 5, 0 unless @SDL_MODES;
2325 @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2326
2327 @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2328
2329 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
2330
2331 {
2332 my @fonts = map CFPlus::find_rcfile "fonts/$_", qw(
2333 DejaVuSans.ttf
2334 DejaVuSansMono.ttf
2335 DejaVuSans-Bold.ttf
2336 DejaVuSansMono-Bold.ttf
2337 DejaVuSans-Oblique.ttf
2338 DejaVuSansMono-Oblique.ttf
2339 DejaVuSans-BoldOblique.ttf
2340 DejaVuSansMono-BoldOblique.ttf
2341 );
2342
2343 CFPlus::add_font $_ for @fonts;
2344
2345 CFPlus::pango_init;
2346
2347 $FONT_PROP = new_from_file CFPlus::Font $fonts[0];
2348 $FONT_FIXED = new_from_file CFPlus::Font $fonts[1];
2349
2350 $FONT_PROP->make_default;
2351 }
2352
2353 # compare mono (ft) vs. rgba (cairo)
2354 # ft - 1.8s, cairo 3s, even in alpha-only mode
2355 # for my $rgba (0..1) {
2356 # my $t1 = Time::HiRes::time;
2357 # for (1..1000) {
2358 # my $layout = CFPlus::Layout->new ($rgba);
2359 # $layout->set_text ("hallo" x 100);
2360 # $layout->render;
2361 # }
2362 # my $t2 = Time::HiRes::time;
2363 # warn $t2-$t1;
2364 # }
2365
2366 $startup_done->();
2367
2368 video_init;
2369 audio_init;
2370 }
2371
2372 show_tip_of_the_day if $CFG->{show_tips};
2373
2374 Event::loop;
2375 #CFPlus::SDL_Quit;
2376 #CFPlus::_exit 0;
2377
2378 END {
2379 CFPlus::SDL_Quit;
2380 CFPlus::DB::Server::stop;
2381 }
2382
2383 =head1 NAME
2384
2385 cfplus - A Crossfire+ and Crossfire game client
2386
2387 =head1 SYNOPSIS
2388
2389 Just run it - no commandline arguments are supported.
2390
2391 =head1 USAGE
2392
2393 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2394 fullscreen and interactively.
2395
2396 =head1 DEBUGGING
2397
2398
2399 CFPLUS_DEBUG - environment variable
2400
2401 1 draw borders around widgets
2402 2 add low-level widget info to tooltips
2403 4 show fps
2404 8 suppress tooltips
2405
2406 =head1 AUTHOR
2407
2408 Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2409
2410
2411