ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.111 by root, Sun Aug 13 19:47:05 2006 UTC vs.
Revision 1.172 by root, Tue Jul 17 16:02:14 2007 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2
3my $startup_done = sub { };
4our $PANGO = "1.5.0";
5
6# do splash-screen thingy on win32
7BEGIN {
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}
2 24
3use strict; 25use strict;
4use utf8; 26use utf8;
27
28use Carp 'verbose';
5 29
6# do things only needed for single-binary version (par) 30# do things only needed for single-binary version (par)
7BEGIN { 31BEGIN {
8 if (%PAR::LibCache) { 32 if (%PAR::LibCache) {
9 @INC = grep ref, @INC; # weed out all paths except pars loader refs 33 @INC = grep ref, @INC; # weed out all paths except pars loader refs
10 34
35 my $tmp = $ENV{PAR_TEMP};
36
11 while (my ($filename, $zip) = each %PAR::LibCache) { 37 while (my ($filename, $zip) = each %PAR::LibCache) {
12 for ($zip->memberNames) { 38 for ($zip->memberNames) {
13 next unless /^\/root\/(.*)/; 39 next unless /^root\/(.*)/;
14 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") 40 $zip->extractMember ($_, "$tmp/$1")
15 unless -e "$ENV{PAR_TEMP}/$1"; 41 unless -e "$tmp/$1";
16 } 42 }
17 } 43 }
18 44
19 # TODO: pango-rc file, anybody? 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
20 54
21 unshift @INC, $ENV{PAR_TEMP}; 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;
22 } 67 }
23} 68}
24 69
25# need to do it again because that pile of garbage called PAR nukes it before main 70# need to do it again because that pile of garbage called PAR nukes it before main
26unshift @INC, $ENV{PAR_TEMP} 71unshift @INC, $ENV{PAR_TEMP}
35use Compress::LZF; 80use Compress::LZF;
36 81
37use CFPlus; 82use CFPlus;
38use CFPlus::OpenGL (); 83use CFPlus::OpenGL ();
39use CFPlus::Protocol; 84use CFPlus::Protocol;
85use CFPlus::DB;
40use CFPlus::UI; 86use CFPlus::UI;
87use CFPlus::UI::Inventory;
88use CFPlus::UI::SpellList;
41use CFPlus::Pod; 89use CFPlus::Pod;
42use CFPlus::BindingEditor;
43use CFPlus::MapWidget; 90use CFPlus::MapWidget;
91use CFPlus::Macro;
44 92
45$SIG{QUIT} = sub { Carp::cluck "QUIT" }; 93$SIG{QUIT} = sub { Carp::cluck "QUIT" };
46$SIG{PIPE} = 'IGNORE'; 94$SIG{PIPE} = 'IGNORE';
47 95
48$Event::Eval = 0; 96$Event::Eval = 1;
49$Event::DIED = sub { 97$Event::DIED = sub {
50 # TODO: display dialog box or so 98 CFPlus::fatal Carp::longmess $_[1]
51 Carp::cluck $_[1];#d#TODO: remove when stable
52 CFPlus::error $_[1];
53}; 99};
54
55$SIG{__DIE__} = sub {
56 return if CFPlus::in_destruct;
57 Carp::cluck $_[0];
58 CFPlus::error $_[0];
59 return;#d#
60 #return unless defined $^S && !$^S;
61 $Event::DIED->(undef, $_[0]);
62};
63
64our $VERSION = '0.1';
65 100
66my $MAX_FPS = 60; 101my $MAX_FPS = 60;
67my $MIN_FPS = 5; # unused as of yet 102my $MIN_FPS = 5; # unused as of yet
68 103
69our $META_SERVER = "crossfire.real-time.com:13326"; 104our $META_SERVER = "http://metaserver.schmorp.de/current.json";
70 105
71our $LAST_REFRESH; 106our $LAST_REFRESH;
72our $NOW; 107our $NOW;
73 108
74our $CFG; 109our $CFG;
75our $CONN; 110our $CONN;
111our $PROFILE; # current profile
76our $FAST; # fast, low-quality mode, possibly useful for software-rendering 112our $FAST; # fast, low-quality mode, possibly useful for software-rendering
77 113
78our $WANT_REFRESH; 114our $WANT_REFRESH;
79our $CAN_REFRESH; 115our $CAN_REFRESH;
80 116
111 147
112our $INVENTORY_PAGE; 148our $INVENTORY_PAGE;
113our $STATS_PAGE; 149our $STATS_PAGE;
114our $SKILL_PAGE; 150our $SKILL_PAGE;
115our $SPELL_PAGE; 151our $SPELL_PAGE;
152our $SPELL_LIST;
116 153
117our $HELP_WINDOW; 154our $HELP_WINDOW;
118our $MESSAGE_WINDOW; 155our $MESSAGE_WINDOW;
119our $FLOORBOX; 156our $FLOORBOX;
120our $GAUGES; 157our $GAUGES;
122 159
123our $SDL_ACTIVE; 160our $SDL_ACTIVE;
124our %SDL_CB; 161our %SDL_CB;
125 162
126our $SDL_MIXER; 163our $SDL_MIXER;
164our $MUSIC_DEFAULT = "in_a_heartbeat.ogg";
165our @MUSIC_WANT;
166our $MUSIC_START;
167our $MUSIC_PLAYING;
168our $MUSIC_PLAYER;
169our $MUSIC_RESUME = 30; # resume music when players less than these many seconds before
127our @SOUNDS; # event => file mapping 170our @SOUNDS; # event => file mapping
128our %AUDIO_CHUNKS; # audio files 171our %AUDIO_CHUNKS; # audio files
129 172
130our $ALT_ENTER_MESSAGE; 173our $ALT_ENTER_MESSAGE;
131our $STATUSBOX; 174our $STATUSBOX;
133 176
134our $INV; 177our $INV;
135our $INVR; 178our $INVR;
136our $INV_RIGHT_HB; 179our $INV_RIGHT_HB;
137 180
138our $BIND_EDITOR;
139our $BIND_UPD_CB;
140
141our $PICKUP_CFG; 181our $PICKUP_CFG;
182
183our $IN_BUILD_MODE;
184our $BUILD_BUTTON;
142 185
143sub status { 186sub status {
144 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 187 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
145} 188}
146 189
147sub debug { 190sub debug {
148 $DEBUG_STATUS->set_text ($_[0]); 191 $DEBUG_STATUS->set_text ($_[0]);
192}
193
194sub message {
195 my ($para) = @_;
196
197 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
198
199 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
200
201 $LOGVIEW->add_paragraph ($para);
202 $LOGVIEW->scroll_to_bottom;
149} 203}
150 204
151sub destroy_query_dialog { 205sub destroy_query_dialog {
152 (delete $_[0]{query_dialog})->destroy 206 (delete $_[0]{query_dialog})->destroy
153 if $_[0]{query_dialog}; 207 if $_[0]{query_dialog};
154} 208}
155 209
210# FIXME: a very ugly hack to wait for stat update look below! #d#
211our $QUERY_TIMER; #d#
212
156# server query dialog 213# server query dialog
157sub server_query { 214sub server_query {
158 my ($conn, $flags, $prompt) = @_; 215 my ($conn, $flags, $prompt) = @_;
159 216
217 # FIXME: a very ugly hack to wait for stat update #d#
218 if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
219 unless ($QUERY_TIMER) {
220 $QUERY_TIMER =
221 Event->timer (
222 after => 1,
223 cb => sub {
224 server_query ($conn, $flags, $prompt, 1);
225 $QUERY_TIMER = undef
226 }
227 );
228 return;
229 }
230 }
231
160 $conn->{query_dialog} = my $dialog = new CFPlus::UI::FancyFrame 232 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
161 x => "center", 233 x => "center",
162 y => "center", 234 y => "center",
163 title => "Server Query", 235 title => "Server Query",
164 child => my $vbox = new CFPlus::UI::VBox, 236 child => my $vbox = new CFPlus::UI::VBox,
165 ; 237 ;
166 238
167 my @dialog = my $label = new CFPlus::UI::Label 239 my @dialog = my $label = new CFPlus::UI::Label
168 max_w => $::WIDTH * 0.4, 240 max_w => $::WIDTH * 0.8,
169 ellipsise => 0, 241 ellipsise => 0,
170 text => $prompt; 242 text => $prompt;
171 243
172 if ($flags & CS_QUERY_YESNO) { 244 if ($flags & CS_QUERY_YESNO) {
173 push @dialog, my $hbox = new CFPlus::UI::HBox; 245 push @dialog, my $hbox = new CFPlus::UI::HBox;
190 ); 262 );
191 263
192 $dialog->grab_focus; 264 $dialog->grab_focus;
193 265
194 } elsif ($flags & CS_QUERY_SINGLECHAR) { 266 } elsif ($flags & CS_QUERY_SINGLECHAR) {
195 $dialog->{tooltip} = "#charcreation_focus";
196
197 if ($prompt =~ /Now choose a character|Press any key for the next race/i) { 267 if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
198 $MESSAGE_WINDOW->show; 268 $dialog->{tooltip} = "#charcreation_focus";
199 269
200 unshift @dialog, new CFPlus::UI::Label 270 unshift @dialog, new CFPlus::UI::Label
201 max_w => $::WIDTH * 0.4, 271 max_w => $::WIDTH * 0.8,
202 ellipsise => 0, 272 ellipsise => 0,
203 markup => "\nOr use your keyboard and the text entry below:\n"; 273 markup => "\nOr use your keyboard and the text entry below:\n";
204 274
205 unshift @dialog, my $table = new CFPlus::UI::Table; 275 unshift @dialog, my $table = new CFPlus::UI::Table;
206 276
218 $conn->send ("reply d"); 288 $conn->send ("reply d");
219 destroy_query_dialog $conn; 289 destroy_query_dialog $conn;
220 0 290 0
221 }, 291 },
222 ); 292 );
293
294 if ($conn->{chargen_race_description}) {
295 unshift @dialog, new CFPlus::UI::Label
296 max_w => $::WIDTH * 0.8,
297 ellipsise => 0,
298 markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
299 ;
300 }
301
302 unshift @dialog, new CFPlus::UI::Face
303 face => $conn->{player}{face},
304 bg => [.2, .2, .2, 1],
305 min_w => 64,
306 min_h => 64,
307 ;
308
309 if ($conn->{chargen_race_title}) {
310 unshift @dialog, new CFPlus::UI::Label
311 allign => 1,
312 ellipsise => 0,
313 markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
314 ;
315 }
223 316
224 unshift @dialog, new CFPlus::UI::Label 317 unshift @dialog, new CFPlus::UI::Label
225 max_w => $::WIDTH * 0.4, 318 max_w => $::WIDTH * 0.4,
226 ellipsise => 0, 319 ellipsise => 0,
227 markup => (CFPlus::Pod::section_label ui => "chargen_race"), 320 markup => (CFPlus::Pod::section_label ui => "chargen_race"),
354 $LOGIN_BUTTON->set_text ("Logout"); 447 $LOGIN_BUTTON->set_text ("Logout");
355 $SETUP_DIALOG->hide; 448 $SETUP_DIALOG->hide;
356 449
357 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 450 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
358 451
359 my ($host, $port) = split /:/, $CFG->{profile}{default}{host}; 452 my ($host, $port) = split /:/, $PROFILE->{host};
360 453
361 $MAP = new CFPlus::Map $mapsize, $mapsize; 454 $MAP = new CFPlus::Map;
362 455
363 $CONN = eval { 456 $CONN = eval {
364 new CFPlus::Protocol 457 new CFPlus::Protocol
365 host => $host, 458 host => $host,
366 port => $port || 13327, 459 port => $port || 13327,
367 user => $CFG->{profile}{default}{user}, 460 user => $PROFILE->{user},
368 pass => $CFG->{profile}{default}{password}, 461 pass => $PROFILE->{password},
369 mapw => $mapsize, 462 mapw => $mapsize,
370 maph => $mapsize, 463 maph => $mapsize,
464
465 client => "cfplus $CFPlus::VERSION $] $^O",
371 466
372 map_widget => $MAPWIDGET, 467 map_widget => $MAPWIDGET,
373 logview => $LOGVIEW, 468 logview => $LOGVIEW,
374 statusbox => $STATUSBOX, 469 statusbox => $STATUSBOX,
375 map => $MAP, 470 map => $MAP,
376 mapmap => $MAPMAP, 471 mapmap => $MAPMAP,
377 query => \&server_query, 472 query => \&server_query,
378 473
474 setup_req => {
475 smoothing => $CFG->{map_smoothing}*1,
476 },
477
379 sound_play => sub { 478 sound_play => sub {
380 my ($x, $y, $soundnum, $type) = @_; 479 my ($x, $y, $soundnum, $type) = @_;
381 480
382 $SDL_MIXER 481 $SDL_MIXER
383 or return; 482 or return;
402sub stop_game { 501sub stop_game {
403 $LOGIN_BUTTON->set_text ("Login"); 502 $LOGIN_BUTTON->set_text ("Login");
404 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER); 503 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
405 $SETUP_DIALOG->show; 504 $SETUP_DIALOG->show;
406 $PL_WINDOW->hide; 505 $PL_WINDOW->hide;
407 $SPELL_PAGE->clear_spells; 506 $SPELL_LIST->clear_spells;
507 $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN);
508
509 &audio_music_set ([]);
408 510
409 return unless $CONN; 511 return unless $CONN;
410 512
411 status "connection closed"; 513 status "connection closed";
412 514
420sub graphics_setup { 522sub graphics_setup {
421 my $vbox = new CFPlus::UI::VBox; 523 my $vbox = new CFPlus::UI::VBox;
422 524
423 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]); 525 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
424 526
527 my $row = 0;
528
529 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info");
530 $table->add (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version,
531 can_events => 1,
532 tooltip => "<tt><span size='8192'>" . (CFPlus::OpenGL::gl_extensions) . "</span></tt>");
533
534 my $vidmode_tooltip =
535 "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
536 . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";
537
425 $table->add (0, 0, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode"); 538 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");
426 $table->add (1, 0, my $hbox = new CFPlus::UI::HBox); 539 $table->add (1, $row++, my $hbox = new CFPlus::UI::HBox);
427 540
541 $hbox->add (my $mode_slider = new CFPlus::UI::Slider
428 $hbox->add (my $mode_slider = new CFPlus::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]); 542 force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1],
429 $hbox->add (my $mode_label = new CFPlus::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999"); 543 tooltip => $vidmode_tooltip);
544 $hbox->add (my $mode_label = new CFPlus::UI::Label
545 align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9",
546 can_events => 1, tooltip => $vidmode_tooltip);
430 547
431 $mode_slider->connect (changed => sub { 548 $mode_slider->connect (changed => sub {
432 my ($self, $value) = @_; 549 my ($self, $value) = @_;
433 550
434 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 551 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
435 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); 552 $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
436 }); 553 });
437 $mode_slider->emit (changed => $mode_slider->{range}[0]); 554 $mode_slider->emit (changed => $mode_slider->{range}[0]);
438
439 my $row = 1;
440 555
441 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen"); 556 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");
442 $table->add (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox 557 $table->add (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox
443 state => $CFG->{fullscreen}, 558 state => $CFG->{fullscreen},
444 tooltip => "Bring the client into fullscreen mode.", 559 tooltip => "Bring the client into fullscreen mode.",
450 state => $CFG->{fast}, 565 state => $CFG->{fast},
451 tooltip => "Lower the visual quality considerably to speed up rendering.", 566 tooltip => "Lower the visual quality considerably to speed up rendering.",
452 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 } 567 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
453 ); 568 );
454 569
570 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
571 $table->add (1, $row++, new CFPlus::UI::Slider
572 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
573 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
574 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
575 );
576
577 $table->add (1, $row++, new CFPlus::UI::Button
578 expand => 1, align => 0, text => "Apply",
579 tooltip => "Apply the video settings above.",
580 on_activate => sub {
581 video_shutdown ();
582 video_init ();
583 0
584 }
585 );
586
455 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale"); 587 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");
456 $table->add (1, $row++, new CFPlus::UI::Slider 588 $table->add (1, $row++, new CFPlus::UI::Slider
457 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], 589 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
458 tooltip => "Enlarge or shrink the displayed map. Changes are instant.", 590 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
459 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 } 591 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
592 );
593
594 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Smoothing");
595 $table->add (1, $row++, new CFPlus::UI::CheckBox
596 state => $CFG->{map_smoothing},
597 tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
598 . "This increases load on the graphics subsystem and works only with 2.x servers. "
599 . "Changes take effect at next connection only.",
600 on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
460 ); 601 );
461 602
462 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War"); 603 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");
463 $table->add (1, $row++, new CFPlus::UI::CheckBox 604 $table->add (1, $row++, new CFPlus::UI::CheckBox
464 state => $CFG->{fow_enable}, 605 state => $CFG->{fow_enable},
483 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFPlus::OpenGL::GL_VERSION < 1.2; 624 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFPlus::OpenGL::GL_VERSION < 1.2;
484 0 625 0
485 } 626 }
486 ); 627 );
487 628
488 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
489 $table->add (1, $row++, new CFPlus::UI::Slider
490 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
491 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
492 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
493 );
494
495 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize"); 629 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");
496 $table->add (1, $row++, new CFPlus::UI::Slider 630 $table->add (1, $row++, new CFPlus::UI::Slider
497 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1], 631 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
498 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.", 632 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
499 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 }, 633 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
515 range => [$CFG->{gauge_size}, 0.2, 0.8], 649 range => [$CFG->{gauge_size}, 0.2, 0.8],
516 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.", 650 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
517 on_changed => sub { 651 on_changed => sub {
518 $CFG->{gauge_size} = $_[1]; 652 $CFG->{gauge_size} = $_[1];
519 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); 653 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
520 0
521 }
522 );
523
524 $table->add (1, $row++, new CFPlus::UI::Button
525 expand => 1, align => 0, text => "Apply",
526 tooltip => "Apply the video settings",
527 on_activate => sub {
528 video_shutdown ();
529 video_init ();
530 0 654 0
531 } 655 }
532 ); 656 );
533 657
534 $vbox 658 $vbox
639 $table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 }); 763 $table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
640 $table->add (0, 2, new CFPlus::UI::Label text => "Show FPS"); 764 $table->add (0, 2, new CFPlus::UI::Label text => "Show FPS");
641 $table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 }); 765 $table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
642 $table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips"); 766 $table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
643 $table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 }); 767 $table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
768 $table->add (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } );
644 769
645 my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05); 770 my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);
646 771
647 for my $x (0..2) { 772 for my $x (0..2) {
648 for my $y (0 .. 2) { 773 for my $y (0 .. 2) {
652 on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 }, 777 on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 },
653 ); 778 );
654 } 779 }
655 } 780 }
656 781
782 $table->add (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#
657 783
658 $table 784 $table
659} 785}
660 786
661sub stats_window { 787sub stats_window {
663 expand => 1, 789 expand => 1,
664 scroll_y => 1 790 scroll_y => 1
665 ); 791 );
666 $r->add (my $vb = new CFPlus::UI::VBox); 792 $r->add (my $vb = new CFPlus::UI::VBox);
667 793
794 $vb->add (new CFPlus::UI::FancyFrame
795 label => "Player",
796 child => (my $pi = new CFPlus::UI::VBox),
797 );
798
668 $vb->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1, 799 $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
669 can_hover => 1, can_events => 1, 800 can_hover => 1, can_events => 1,
670 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server."); 801 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
671 $vb->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1, 802 $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
672 can_hover => 1, can_events => 1, 803 can_hover => 1, can_events => 1,
673 tooltip => "The map you are currently on (if supported by the server)."); 804 tooltip => "The map you are currently on (if supported by the server).");
674 805
675 $vb->add (my $hb0 = new CFPlus::UI::HBox); 806 $pi->add (my $hb0 = new CFPlus::UI::HBox);
676 $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1, 807 $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
677 can_hover => 1, can_events => 1, 808 can_hover => 1, can_events => 1,
678 tooltip => "The weight of the player including all inventory items."); 809 tooltip => "The weight of the player including all inventory items.");
679 $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1, 810 $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
680 can_hover => 1, can_events => 1, 811 can_hover => 1, can_events => 1,
681 tooltip => "The weight limit: you cannot carry more than this."); 812 tooltip => "The weight limit: you cannot carry more than this.");
682 813
814 $vb->add (new CFPlus::UI::FancyFrame
815 label => "Primary/Secondary Statistics",
683 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1); 816 child => (my $hb = new CFPlus::UI::HBox expand => 1),
817 );
684 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1); 818 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1);
685 819
686 my $color2 = [1, 1, 0]; 820 my $color2 = [1, 1, 0];
687 821
688 for ( 822 for (
709 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label 843 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label
710 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, 844 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
711 align => -1, text => $label, tooltip => "#stat_$label"); 845 align => -1, text => $label, tooltip => "#stat_$label");
712 } 846 }
713 847
848 $vb->add (new CFPlus::UI::FancyFrame
849 label => "Resistancies",
714 $vb->add (my $tbl2 = new CFPlus::UI::Table expand => 1); 850 child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
851 );
715 852
716 my $row = 0; 853 my $row = 0;
717 my $col = 0; 854 my $col = 0;
718 855
719 my %resist_names = ( 856 my %resist_names = (
819 956
820 my $table = $METASERVER->{table}; 957 my $table = $METASERVER->{table};
821 $table->clear; 958 $table->clear;
822 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); 959 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
823 960
824 my $buf; 961 my $ok = 0;
825 962
826 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 963 CFPlus::background {
964 my $ua = CFPlus::lwp_useragent;
827 965
828 unless ($fh) { 966 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
829 $label->set_text ("unable to contact metaserver: $!"); 967 } sub {
830 return; 968 my ($msg) = @_;
831 } 969 if ($msg) {
832
833 Event->io (fd => $fh, poll => 'r', cb => sub {
834 my $res = sysread $fh, $buf, 8192, length $buf;
835
836 if (!defined $res) {
837 $_[0]->w->cancel;
838 $label->set_text ("error while retrieving server list: $!");
839 } elsif ($res == 0) {
840 $_[0]->w->cancel;
841 status "server list retrieved";
842
843 utf8::decode $buf if utf8::valid $buf;
844
845 $table->clear; 970 $table->clear;
846 971
847 my @tip = ( 972 my @tip = (
848 "The current number of users logged in on the server.", 973 "The current number of users logged in on the server.",
849 "The hostname of the server.", 974 "The hostname of the server.",
859 for 0 .. $#col; 984 for 0 .. $#col;
860 985
861 my @align = qw(1 0 1 1 -1); 986 my @align = qw(1 0 1 1 -1);
862 987
863 my $y = 0; 988 my $y = 0;
864 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) { 989 for my $m (@{ $msg->{servers} }) {
865 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; 990 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
991 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
866 992
867 for ($desc) { 993 for ($desc) {
868 s/<br>/\n/gi; 994 s/<br>/\n/gi;
869 s/<li>/\n· /gi; 995 s/<li>/\n· /gi;
870 s/<.*?>//sgi; 996 s/<.*?>//sgi;
871 s/&/&amp;/g; 997 s/&amp;/&/g;
872 s/</&lt;/g; 998 s/&lt;/</g;
873 s/>/&gt;/g; 999 s/&gt;/>/g;
874 } 1000 }
875 1001
876 $uptime = sprintf "%dd %02d:%02d:%02d", 1002 $uptime = sprintf "%dd %02d:%02d:%02d",
877 (int $m->[8] / 86400), 1003 (int $uptime / 86400),
878 (int $m->[8] / 3600) % 24, 1004 (int $uptime / 3600) % 24,
879 (int $m->[8] / 60) % 60, 1005 (int $uptime / 60) % 60,
880 $m->[8] % 60; 1006 $uptime % 60;
881 1007
882 $m = [$users, $host, $uptime, $version, $desc]; 1008 $m = [$users, $host, $uptime, $version, $desc];
883 1009
884 $y++; 1010 $y++;
885 1011
895 ), 1021 ),
896 (new CFPlus::UI::Empty expand => 1), 1022 (new CFPlus::UI::Empty expand => 1),
897 ]); 1023 ]);
898 1024
899 $table->add ($_, $y, new CFPlus::UI::Label 1025 $table->add ($_, $y, new CFPlus::UI::Label
1026 max_w => $::WIDTH * 0.4,
900 ellipsise => 0, 1027 ellipsise => 0,
901 align => $align[$_], 1028 align => $align[$_],
902 text => $m->[$_], 1029 text => $m->[$_],
903 tooltip => $tip[$_], 1030 tooltip => $tip[$_],
1031 fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
904 can_hover => 1, 1032 can_hover => 1,
905 can_events => 1, 1033 can_events => 1,
906 fontsize => 0.8) 1034 fontsize => 0.8)
907 for 0 .. $#$m; 1035 for 0 .. $#$m;
908 } 1036 }
1037 } else {
1038 $ok or $label->set_text ("error while contacting metaserver");
909 } 1039 }
910 }); 1040 };
1041
911} 1042}
912 1043
913sub metaserver_dialog { 1044sub metaserver_dialog {
914 my $vbox = new CFPlus::UI::VBox; 1045 my $vbox = new CFPlus::UI::VBox;
915 my $table = new CFPlus::UI::Table; 1046 my $table = new CFPlus::UI::Table;
916 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table); 1047 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);
917 1048
918 my $dialog = new CFPlus::UI::FancyFrame 1049 my $dialog = new CFPlus::UI::Toplevel
919 title => "Server List", 1050 title => "Server List",
920 name => 'metaserver_dialog', 1051 name => 'metaserver_dialog',
921 x => 'center', 1052 x => 'center',
922 y => 'center', 1053 y => 'center',
923 z => 3, 1054 z => 3,
1055 force_w => $::WIDTH * 0.9,
924 force_h => $::HEIGHT * 0.4, 1056 force_h => $::HEIGHT * 0.7,
925 child => $vbox, 1057 child => $vbox,
926 has_close_button => 1, 1058 has_close_button => 1,
927 table => $table, 1059 table => $table,
928 on_visibility_change => sub { 1060 on_visibility_change => sub {
929 update_metaserver ($_[0]) if $_[1]; 1061 update_metaserver ($_[0]) if $_[1];
935} 1067}
936 1068
937sub server_setup { 1069sub server_setup {
938 my $vbox = new CFPlus::UI::VBox; 1070 my $vbox = new CFPlus::UI::VBox;
939 1071
1072 $vbox->add (new CFPlus::UI::FancyFrame
1073 label => "Connection Settings",
940 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]); 1074 child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
1075 );
941 $table->add (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port"); 1076 $table->add (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");
942 1077
943 { 1078 {
944 $table->add (1, 2, my $vbox = new CFPlus::UI::VBox); 1079 $table->add (1, 2, my $vbox = new CFPlus::UI::VBox);
945 1080
1002 . "so only set it if you really need to prefetch images. " 1137 . "so only set it if you really need to prefetch images. "
1003 . "This option can be set and unset any time.", 1138 . "This option can be set and unset any time.",
1004 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 }, 1139 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1005 ); 1140 );
1006 1141
1007 $table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count"); 1142 $table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
1008 $table->add (1, 9, new CFPlus::UI::Entry 1143 $table->add (1, 9, new CFPlus::UI::Entry
1144 text => $CFG->{output_rate},
1145 tooltip => "The approximate bandwidth in bytes per second that the server should not exceed "
1146 . "when sending images, to ensure interactiveness. When 0 or unset, the server "
1147 . "default will be used, which is usually around 100kb/s.",
1148 on_changed => sub { $CFG->{output_rate} = $_[1]; 0 },
1149 );
1150
1151 $table->add (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
1152 $table->add (1, 10, new CFPlus::UI::Entry
1009 text => $CFG->{output_count}, 1153 text => $CFG->{output_count},
1010 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 1154 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1011 on_changed => sub { $CFG->{output_count} = $_[1]; 0 }, 1155 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1012 ); 1156 );
1013 1157
1014 $table->add (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync"); 1158 $table->add (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
1015 $table->add (1, 10, new CFPlus::UI::Entry 1159 $table->add (1, 11, new CFPlus::UI::Entry
1016 text => $CFG->{output_sync}, 1160 text => $CFG->{output_sync},
1017 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 1161 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1018 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 }, 1162 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1019 ); 1163 );
1020 1164
1021 $table->add (1, 11, $LOGIN_BUTTON = new CFPlus::UI::Button 1165 $table->add (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button
1022 expand => 1, 1166 expand => 1,
1023 align => 0, 1167 align => 0,
1024 text => "Login", 1168 text => "Login",
1025 on_activate => sub { 1169 on_activate => sub {
1026 $CONN ? stop_game 1170 $CONN ? stop_game
1027 : start_game; 1171 : start_game;
1028 0 1172 0
1029 }, 1173 },
1030 ); 1174 );
1031 1175
1176 $vbox->add (new CFPlus::UI::FancyFrame
1177 label => "Server Info",
1178 child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
1179 );
1180
1181 $vbox
1182}
1183
1184sub client_setup {
1185 my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1];
1186
1187 my $row = 0;
1188
1032 $table->add (0, 12, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command"); 1189 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
1033 $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry 1190 $table->add (1, $row++, my $saycmd = new CFPlus::UI::Entry
1034 text => $CFG->{say_command}, 1191 text => $CFG->{say_command},
1035 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. " 1192 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. "
1036 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. " 1193 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1037 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.", 1194 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1038 on_changed => sub { 1195 on_changed => sub {
1039 my ($self, $value) = @_; 1196 my ($self, $value) = @_;
1040 $CFG->{say_command} = $value; 1197 $CFG->{say_command} = $value;
1041 0 1198 0
1042 } 1199 }
1043 ); 1200 );
1044 1201
1045 $vbox->add (new CFPlus::UI::Label 1202 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
1046 text => "Server Info", 1203 $table->add (1, $row++, new CFPlus::UI::CheckBox
1047 fontsize => 1.2, 1204 state => $CFG->{show_tips},
1048 padding_y => 8, 1205 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1049 fg => [1, 1, 0, 1], 1206 on_changed => sub {
1207 my ($self, $value) = @_;
1208 $CFG->{show_tips} = $value;
1209 0
1210 }
1050 ); 1211 );
1051 1212
1052 $vbox->add ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0); 1213 $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size");
1214 $table->add (1, $row++, my $saycmd = new CFPlus::UI::Entry
1215 text => $CFG->{logview_max_par},
1216 tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "
1217 . "sends more messages than this number, older messages get removed to save memory and "
1218 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1219 on_changed => sub {
1220 my ($self, $value) = @_;
1221 $LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1;
1222 0
1223 },
1224 );
1053 1225
1054 $vbox 1226 $table
1055} 1227}
1056 1228
1057sub message_window { 1229sub message_window {
1058 my $window = new CFPlus::UI::FancyFrame 1230 my $window = new CFPlus::UI::Toplevel
1059 name => "message_window", 1231 name => "message_window",
1060 title => "Messages", 1232 title => "Messages",
1061 border_bg => [1, 1, 1, 1], 1233 border_bg => [1, 1, 1, 1],
1062 x => "max", 1234 x => "max",
1063 y => 0, 1235 y => 0,
1115 }; 1287 };
1116 1288
1117 $window 1289 $window
1118} 1290}
1119 1291
1120sub open_string_query {
1121 my $cb = $_[1];
1122 my $dialog = new CFPlus::UI::FancyFrame
1123 x => "center",
1124 y => "center",
1125 z => 50,
1126 force_w => $WIDTH * 4/5,
1127 title => $_[0];
1128
1129 $dialog->add (
1130 my $e = new CFPlus::UI::Entry
1131 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1132 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1133 );
1134
1135 $e->grab_focus;
1136 $dialog->show;
1137}
1138
1139sub open_quit_dialog {
1140 unless ($QUIT_DIALOG) {
1141 $QUIT_DIALOG = new CFPlus::UI::FancyFrame
1142 x => "center",
1143 y => "center",
1144 z => 50,
1145 title => "Really Quit?",
1146 on_key_down => sub {
1147 my ($dialog, $ev) = @_;
1148 $ev->{sym} == 27 and $dialog->hide;
1149 }
1150 ;
1151
1152 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1153
1154 $vb->add (new CFPlus::UI::Label
1155 text => "You should find a savebed and apply it first!",
1156 max_w => $WIDTH * 0.25,
1157 ellipsize => 0,
1158 );
1159 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1160 $hb->add (new CFPlus::UI::Button
1161 text => "Ok",
1162 expand => 1,
1163 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1164 );
1165 $hb->add (new CFPlus::UI::Button
1166 text => "Quit anyway",
1167 expand => 1,
1168 on_activate => sub { exit },
1169 );
1170 }
1171
1172 $QUIT_DIALOG->show;
1173 $QUIT_DIALOG->grab_focus;
1174}
1175
1176sub autopickup_setup { 1292sub autopickup_setup {
1293 my $r = new CFPlus::UI::ScrolledWindow (
1294 expand => 1,
1295 scroll_y => 1
1296 );
1177 my $table = new CFPlus::UI::Table; 1297 $r->add (my $table = new CFPlus::UI::Table
1298 row_expand => [0],
1299 col_expand => [0, 1, 0, 1],
1300 );
1178 1301
1179 for ( 1302 for (
1180 ["General", 0, 0, 1303 ["General", 0, 0,
1181 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE], 1304 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
1182 ["Inhibit autopickup" => PICKUP_INHIBIT], 1305 ["Inhibit autopickup" => PICKUP_INHIBIT],
1196 ["Boots" => PICKUP_BOOTS], 1319 ["Boots" => PICKUP_BOOTS],
1197 ["Gloves" => PICKUP_GLOVES], 1320 ["Gloves" => PICKUP_GLOVES],
1198 ["Cloaks" => PICKUP_CLOAK], 1321 ["Cloaks" => PICKUP_CLOAK],
1199 ], 1322 ],
1200 1323
1201 ["Readables", 2, 2, 1324 ["Readables", 2, 0,
1202 ["Spellbooks" => PICKUP_SPELLBOOK], 1325 ["Spellbooks" => PICKUP_SPELLBOOK],
1203 ["Skillscrolls" => PICKUP_SKILLSCROLL], 1326 ["Skillscrolls" => PICKUP_SKILLSCROLL],
1204 ["Normal Books/Scrolls" => PICKUP_READABLES], 1327 ["Normal Books/Scrolls" => PICKUP_READABLES],
1205 ], 1328 ],
1206 ["Misc", 2, 7, 1329 ["Misc", 2, 5,
1207 ["Food" => PICKUP_FOOD], 1330 ["Food" => PICKUP_FOOD],
1208 ["Drinks" => PICKUP_DRINK], 1331 ["Drinks" => PICKUP_DRINK],
1209 ["Valuables (Money, Gems)" => PICKUP_VALUABLES], 1332 ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1210 ["Keys" => PICKUP_KEY], 1333 ["Keys" => PICKUP_KEY],
1211 ["Magical Items" => PICKUP_MAGICAL], 1334 ["Magical Items" => PICKUP_MAGICAL],
1212 ["Potions" => PICKUP_POTION], 1335 ["Potions" => PICKUP_POTION],
1213 ["Magic Devices" => PICKUP_MAGIC_DEVICE], 1336 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1214 ["Ignore cursed" => PICKUP_NOT_CURSED], 1337 ["Ignore cursed" => PICKUP_NOT_CURSED],
1215 ["Jewelery" => PICKUP_JEWELS], 1338 ["Jewelery" => PICKUP_JEWELS],
1339 ["Flesh" => PICKUP_FLESH],
1216 ], 1340 ],
1217 ["Weight/Value ratio", 2, 17] 1341 ["Weight/Value ratio", 2, 17]
1218 ) 1342 )
1219 { 1343 {
1220 my ($title, $x, $y, @bits) = @$_; 1344 my ($title, $x, $y, @bits) = @$_;
1265 $::CONN->send_command ("pickup $::CFG->{pickup}") 1389 $::CONN->send_command ("pickup $::CFG->{pickup}")
1266 if defined $::CONN; 1390 if defined $::CONN;
1267 0 1391 0
1268 }); 1392 });
1269 1393
1270 $table 1394 $r
1271} 1395}
1272 1396
1273my %SORT_ORDER = ( 1397my %SORT_ORDER = (
1274 type => undef, 1398 type => undef,
1275 mtime => sub { sort { 1399 mtime => sub {
1400 my $NOW = time;
1401 sort {
1402 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1403 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1404
1276 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) 1405 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1277 or $b->{mtime} <=> $a->{mtime} 1406 or $btime <=> $atime
1278 or $a->{type} <=> $b->{type} 1407 or $a->{type} <=> $b->{type}
1408 } @_
1279 } @_ }, 1409 },
1280 weight => sub { sort { 1410 weight => sub { sort {
1281 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1) 1411 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1282 or $a->{type} <=> $b->{type} 1412 or $a->{type} <=> $b->{type}
1283 } @_ }, 1413 } @_ },
1284); 1414);
1309 #TODO# update to weigh/maxweight 1439 #TODO# update to weigh/maxweight
1310 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); 1440 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1311 1441
1312 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); 1442 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1313 $sw1->add ($INV = new CFPlus::UI::Inventory); 1443 $sw1->add ($INV = new CFPlus::UI::Inventory);
1444 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1314 1445
1315 $hb->add (my $vb2 = new CFPlus::UI::VBox); 1446 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1316 1447
1317 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); 1448 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1318 1449
1335 $PL_WINDOW->show; 1466 $PL_WINDOW->show;
1336 } 1467 }
1337} 1468}
1338 1469
1339sub player_window { 1470sub player_window {
1340 my $plwin = $PL_WINDOW = new CFPlus::UI::FancyFrame 1471 my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
1341 x => "center", 1472 x => "center",
1342 y => "center", 1473 y => "center",
1343 force_w => $WIDTH * 9/10, 1474 force_w => $WIDTH * 9/10,
1344 force_h => $HEIGHT * 9/10, 1475 force_h => $HEIGHT * 9/10,
1345 title => "Player", 1476 title => "Player",
1347 has_close_button => 1 1478 has_close_button => 1
1348 ; 1479 ;
1349 1480
1350 my $ntb = 1481 my $ntb =
1351 $PL_NOTEBOOK = 1482 $PL_NOTEBOOK =
1352 new CFPlus::UI::Notebook expand => 1, debug => 1; 1483 new CFPlus::UI::Notebook expand => 1;
1353 1484
1354 $ntb->add ( 1485 $ntb->add (
1355 "Statistics (F2)" => $STATS_PAGE = stats_window, 1486 "Statistics (F2)" => $STATS_PAGE = stats_window,
1356 "Shows statistics, where all your Stats and Resistances are shown." 1487 "Shows statistics, where all your Stats and Resistances are shown."
1357 ); 1488 );
1358 $ntb->add ( 1489 $ntb->add (
1359 "Skills (F3)" => $SKILL_PAGE = skill_window, 1490 "Skills (F3)" => $SKILL_PAGE = skill_window,
1360 "Shows all your Skills." 1491 "Shows all your Skills."
1361 ); 1492 );
1362 1493
1363 my $spellsw = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1); 1494 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1364 $spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList); 1495 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1365 $ntb->add ( 1496 $ntb->add (
1366 "Spellbook (F4)" => $spellsw, 1497 "Spellbook (F4)" => $spellsw,
1367 "Displays all spells you have and lets you edit keyboard shortcuts for them." 1498 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1368 ); 1499 );
1369 $ntb->add ( 1500 $ntb->add (
1370 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget, 1501 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
1371 "Toggles the inventory window, where you can manage your loot (or treasures :). " 1502 "Toggles the inventory window, where you can manage your loot (or treasures :). "
1372 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory." 1503 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1373 ); 1504 );
1505 $ntb->add (Pickup => autopickup_setup,
1506 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1374 1507
1375 $ntb->set_current_page ($INVENTORY_PAGE); 1508 $ntb->set_current_page ($INVENTORY_PAGE);
1376 1509
1377 $plwin->add ($ntb); 1510 $plwin->add ($ntb);
1378 $plwin 1511 $plwin
1379} 1512}
1380 1513
1381sub update_bindings {
1382 $BIND_UPD_CB->() if $BIND_UPD_CB;
1383}
1384
1385sub keyboard_setup { 1514sub keyboard_setup {
1386 my $binding_list = new CFPlus::UI::VBox; 1515 CFPlus::Macro::keyboard_setup
1387
1388 my $refresh;
1389 $refresh = $BIND_UPD_CB = sub {
1390 $binding_list->clear ();
1391
1392 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1393 for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1394 my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1395 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1396
1397 my $lbl = join "; ", @$cmds;
1398 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym);
1399 $binding_list->add (my $hb = new CFPlus::UI::HBox);
1400 $hb->add (new CFPlus::UI::Button
1401 text => "delete",
1402 tooltip => "Deletes the binding",
1403 on_activate => sub {
1404 $binding_list->remove ($hb);
1405 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1406 0
1407 });
1408
1409 $hb->add (new CFPlus::UI::Button
1410 text => "edit",
1411 tooltip => "Edits the binding",
1412 on_activate => sub {
1413 $::BIND_EDITOR->set_binding (
1414 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1415 sub {
1416 my ($nmod, $nsym, $ncmds) = @_;
1417 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1418 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1419 $refresh->();
1420 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1421 $SETUP_DIALOG->show;
1422 },
1423 sub {
1424 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1425 $SETUP_DIALOG->show;
1426 });
1427 $::BIND_EDITOR->show;
1428 $SETUP_DIALOG->hide;
1429 0
1430 });
1431
1432 $hb->add (new CFPlus::UI::Label text => "(Key: $nam)");
1433 $hb->add (new CFPlus::UI::Label text => $lbl, expand => 1);
1434 }
1435 }
1436 };
1437
1438 my $vb = new CFPlus::UI::VBox;
1439 $vb->add (my $hb = new CFPlus::UI::HBox);
1440 $hb->add (new CFPlus::UI::Label text => "only shift-up stops fire");
1441 $hb->add (new CFPlus::UI::CheckBox
1442 expand => 1,
1443 state => $CFG->{shift_fire_stop},
1444 tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1445 on_changed => sub {
1446 my ($cbox, $value) = @_;
1447 $CFG->{shift_fire_stop} = $value;
1448 0
1449 });
1450
1451 $vb->add ($binding_list);
1452 $vb->add (my $hb = new CFPlus::UI::HBox);
1453
1454 $hb->add (new CFPlus::UI::Button
1455 text => "record new",
1456 expand => 1,
1457 tooltip => "This button opens the binding editor with an empty binding.",
1458 on_activate => sub {
1459 $::BIND_EDITOR->set_binding (undef, undef, [],
1460 sub {
1461 my ($mod, $sym, $cmds) = @_;
1462 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1463 $refresh->();
1464 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1465 $SETUP_DIALOG->show;
1466 },
1467 sub {
1468 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1469 $SETUP_DIALOG->show;
1470 },
1471 );
1472 $SETUP_DIALOG->hide;
1473 $::BIND_EDITOR->show;
1474 0
1475 },
1476 );
1477
1478 $hb->add (new CFPlus::UI::Button
1479 text => "close",
1480 tooltip => "Closes the binding window",
1481 expand => 1,
1482 on_activate => sub {
1483 $SETUP_DIALOG->hide;
1484 0
1485 }
1486 );
1487
1488 $refresh->();
1489
1490 $vb
1491} 1516}
1492 1517
1493sub help_window { 1518sub help_window {
1494 my $win = new CFPlus::UI::FancyFrame 1519 my $win = new CFPlus::UI::Toplevel
1495 x => 'center', 1520 x => 'center',
1496 y => 'center', 1521 y => 'center',
1497 z => 2, 1522 z => 4,
1498 name => 'doc_browser', 1523 name => 'doc_browser',
1499 force_w => int $WIDTH * 7/8, 1524 force_w => int $WIDTH * 7/8,
1500 force_h => int $HEIGHT * 7/8, 1525 force_h => int $HEIGHT * 7/8,
1501 title => "Help Browser", 1526 title => "Help Browser",
1502 has_close_button => 1; 1527 has_close_button => 1;
1503 1528
1504 $win->add (my $vbox = new CFPlus::UI::VBox); 1529 $win->add (my $vbox = new CFPlus::UI::VBox);
1505 1530
1531 $vbox->add (new CFPlus::UI::FancyFrame
1532 label => "Navigation",
1506 $vbox->add (my $buttons = new CFPlus::UI::HBox); 1533 child => (my $buttons = new CFPlus::UI::HBox),
1534 );
1507 $vbox->add (my $viewer = new CFPlus::UI::TextScroller 1535 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1508 expand => 1, fontsize => 0.8, padding_x => 4); 1536 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1509 1537
1510 my @history; 1538 my @history;
1511 my @future; 1539 my @future;
1512 my $node; 1540 my $curnode;
1513 1541
1514 my $load_node; $load_node = sub { 1542 my $load_node; $load_node = sub {
1515 my ($node) = @_; 1543 my ($node, $para) = @_;
1516 1544
1517 $buttons->clear; 1545 $buttons->clear;
1518 1546
1547 $buttons->add (new CFPlus::UI::Button
1548 text => "⇤",
1549 tooltip => "back to the starting page",
1550 on_activate => sub {
1551 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1552 unshift @future, @history;
1553 @history = ();
1554 $load_node->(@{shift @future});
1555 },
1556 );
1557
1519 if (@history) { 1558 if (@history) {
1520 $buttons->add (new CFPlus::UI::Button label => "&lt;", on_activate => sub { 1559 $buttons->add (new CFPlus::UI::Button
1521 unshift @future, $node if $node; 1560 text => "⋘",
1561 tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
1562 on_activate => sub {
1563 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1522 $node = pop @history; 1564 $load_node->(@{pop @history});
1523 1565 },
1524 }); 1566 );
1525 } 1567 }
1568
1569 if (@future) {
1570 $buttons->add (new CFPlus::UI::Button
1571 text => "⋙",
1572 tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
1573 on_activate => sub {
1574 push @history, [$curnode, $viewer->current_paragraph];
1575 $load_node->(@{shift @future});
1576 },
1577 );
1578 }
1579
1580 $buttons->add (new CFPlus::UI::Label text => " ");
1581
1582 my @path = CFPlus::Pod::full_path_of $node;
1583 pop @path; # drop current node
1584
1585 for my $node (@path) {
1586 $buttons->add (new CFPlus::UI::Button
1587 text => $node->{kw}[0],
1588 tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
1589 on_activate => sub {
1590 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1591 $load_node->($node);
1592 },
1593 );
1594 $buttons->add (new CFPlus::UI::Label text => "/");
1595 }
1596
1597 $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);
1598
1599 $curnode = $node;
1600
1526 $viewer->clear; 1601 $viewer->clear;
1527 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $node); 1602 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
1528 $viewer->set_offset (0); 1603 $viewer->scroll_to ($para);
1529 }; 1604 };
1530 1605
1531 $load_node->(CFPlus::Pod::find pod => "mainpage"); 1606 $load_node->(CFPlus::Pod::find pod => "mainpage");
1532 1607
1533 $CFPlus::Pod::on_link = sub { 1608 $CFPlus::Pod::goto_document = sub {
1534 my (@path) = @_; 1609 my (@path) = @_;
1535 1610
1536 push @history, $node if $node; 1611 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1537 @future = ();
1538 1612
1539 $load_node->(CFPlus::Pod::find @path); 1613 $load_node->((CFPlus::Pod::find @path)[0]);
1540 $win->show; 1614 $win->show;
1541 }; 1615 };
1542 1616
1543 $win 1617 $win
1618}
1619
1620sub open_string_query {
1621 my ($title, $cb, $txt, $tooltip) = @_;
1622 my $dialog = new CFPlus::UI::Toplevel
1623 x => "center",
1624 y => "center",
1625 z => 50,
1626 force_w => $WIDTH * 4/5,
1627 title => $title;
1628
1629 $dialog->add (
1630 my $e = new CFPlus::UI::Entry
1631 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1632 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1633 tooltip => $tooltip
1634 );
1635
1636 $e->grab_focus;
1637 $e->set_text ($txt) if $txt;
1638 $dialog->show;
1639}
1640
1641sub open_quit_dialog {
1642 unless ($QUIT_DIALOG) {
1643 $QUIT_DIALOG = new CFPlus::UI::Toplevel
1644 x => "center",
1645 y => "center",
1646 z => 50,
1647 title => "Really Quit?",
1648 on_key_down => sub {
1649 my ($dialog, $ev) = @_;
1650 $ev->{sym} == 27 and $dialog->hide;
1651 }
1652 ;
1653
1654 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1655
1656 $vb->add (new CFPlus::UI::Label
1657 text => "You should find a savebed and apply it first!",
1658 max_w => $WIDTH * 0.25,
1659 ellipsize => 0,
1660 );
1661 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1662 $hb->add (new CFPlus::UI::Button
1663 text => "Ok",
1664 expand => 1,
1665 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1666 );
1667 $hb->add (new CFPlus::UI::Button
1668 text => "Quit anyway",
1669 expand => 1,
1670 on_activate => sub { exit },
1671 );
1672 }
1673
1674 $QUIT_DIALOG->show;
1675 $QUIT_DIALOG->grab_focus;
1676}
1677
1678sub show_tip_of_the_day {
1679 # find all tips
1680 my @tod = CFPlus::Pod::find tip_of_the_day => "*";
1681
1682 CFPlus::DB::get state => "tip_of_the_day", sub {
1683 my ($todindex) = @_;
1684 $todindex = 0 if $todindex >= @tod;
1685 CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { };
1686
1687 # create dialog
1688 my $dialog;
1689
1690 my $close = sub {
1691 $dialog->destroy;
1692 };
1693
1694 $dialog = new CFPlus::UI::Toplevel
1695 x => "center",
1696 y => "center",
1697 z => 3,
1698 name => 'tip_of_the_day',
1699 force_w => int $WIDTH * 4/9,
1700 force_h => int $WIDTH * 2/9,
1701 title => "Tip of the day #" . (1 + $todindex),
1702 child => my $vbox = new CFPlus::UI::VBox,
1703 has_close_button => 1,
1704 on_delete => $close,
1705 ;
1706
1707 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1708 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1709 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
1710
1711 $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);
1712
1713 $table->add (0, 0, new CFPlus::UI::Button
1714 text => "Close",
1715 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>.",
1716 on_activate => $close,
1717 );
1718
1719 $table->add (2, 0, new CFPlus::UI::Button
1720 text => "Next",
1721 tooltip => "Show the next <b>Tip of the day</b>.",
1722 on_activate => sub {
1723 $close->();
1724 &show_tip_of_the_day;
1725 },
1726 );
1727
1728 $dialog->show;
1729 };
1544} 1730}
1545 1731
1546sub sdl_init { 1732sub sdl_init {
1547 CFPlus::SDL_Init 1733 CFPlus::SDL_Init
1548 and die "SDL::Init failed!\n"; 1734 and die "SDL::Init failed!\n";
1549} 1735}
1550 1736
1551sub video_init { 1737sub video_init {
1552 sdl_init;
1553
1554 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES; 1738 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1555 1739
1556 my ($old_w, $old_h) = ($WIDTH, $HEIGHT); 1740 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1557 1741
1558 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 1742 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1559 $FULLSCREEN = $CFG->{fullscreen}; 1743 $FULLSCREEN = $CFG->{fullscreen};
1560 $FAST = $CFG->{fast}; 1744 $FAST = $CFG->{fast};
1561 1745
1562 CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN 1746 CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
1563 or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n"; 1747 or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n";
1564 1748
1565 $SDL_ACTIVE = 1; 1749 $SDL_ACTIVE = 1;
1566 $LAST_REFRESH = time - 0.01; 1750 $LAST_REFRESH = time - 0.01;
1567 1751
1583 z => 100, 1767 z => 100,
1584 force_x => "max", 1768 force_x => "max",
1585 force_y => 0; 1769 force_y => 0;
1586 $DEBUG_STATUS->show; 1770 $DEBUG_STATUS->show;
1587 1771
1588 $BIND_EDITOR = new CFPlus::BindingEditor (x => "max", y => 0);
1589
1590 $STATUSBOX = new CFPlus::UI::Statusbox; 1772 $STATUSBOX = new CFPlus::UI::Statusbox;
1591 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]); 1773 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1592 1774
1593 (new CFPlus::UI::Frame 1775 (new CFPlus::UI::Frame
1594 bg => [0, 0, 0, 0.4], 1776 bg => [0, 0, 0, 0.4],
1595 force_x => 0, 1777 force_x => 0,
1596 force_y => "max", 1778 force_y => "max",
1597 child => $STATUSBOX, 1779 child => $STATUSBOX,
1598 )->show; 1780 )->show;
1599 1781
1600 CFPlus::UI::FancyFrame->new ( 1782 CFPlus::UI::Toplevel->new (
1601 title => "Map", 1783 title => "Map",
1602 name => "mapmap", 1784 name => "mapmap",
1603 x => 0, 1785 x => 0,
1604 y => $FONTSIZE + 8, 1786 y => $FONTSIZE + 8,
1605 border_bg => [1, 1, 1, 192/255], 1787 border_bg => [1, 1, 1, 192/255],
1630 font => $FONT_FIXED, 1812 font => $FONT_FIXED,
1631 fontsize => $::CFG->{log_fontsize}, 1813 fontsize => $::CFG->{log_fontsize},
1632 indent => -4, 1814 indent => -4,
1633 can_hover => 1, 1815 can_hover => 1,
1634 can_events => 1, 1816 can_events => 1,
1817 max_par => $CFG->{logview_max_par},
1635 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.", 1818 tooltip => "<b>Server Log</b>. This text viewer contains all recent messages sent by the server.",
1636 ; 1819 ;
1637 1820
1638 $SETUP_DIALOG = new CFPlus::UI::FancyFrame 1821 $SETUP_DIALOG = new CFPlus::UI::Toplevel
1639 title => "Setup", 1822 title => "Setup",
1640 name => "setup_dialog", 1823 name => "setup_dialog",
1641 x => 'center', 1824 x => 'center',
1642 y => 'center', 1825 y => 'center',
1643 z => 2, 1826 z => 2,
1651 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1, 1834 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,
1652 filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); 1835 filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1653 1836
1654 $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup, 1837 $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1655 "Configure the server to play on, your username, password and other server-related options."); 1838 "Configure the server to play on, your username, password and other server-related options.");
1656 $SETUP_NOTEBOOK->add (Pickup => autopickup_setup, 1839 $SETUP_NOTEBOOK->add (Client => client_setup,
1657 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them."); 1840 "Configure various client-specific settings.");
1658 $SETUP_NOTEBOOK->add (Graphics => graphics_setup, 1841 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1659 "Configure the video mode, performance, fonts and other graphical aspects of the game."); 1842 "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1660 $SETUP_NOTEBOOK->add (Audio => audio_setup, 1843 $SETUP_NOTEBOOK->add (Audio => audio_setup,
1661 "Configure the use of audio, sound effects and background music."); 1844 "Configure the use of audio, sound effects and background music.");
1662 $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup, 1845 $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1694 ); 1877 );
1695 1878
1696 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window, 1879 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1697 tooltip => "View Documentation"); 1880 tooltip => "View Documentation");
1698 1881
1882
1699 $BUTTONBAR->add (new CFPlus::UI::Button 1883 $BUTTONBAR->add (new CFPlus::UI::Button
1700 text => "Quit", 1884 text => "Quit",
1701 tooltip => "Terminates the program", 1885 tooltip => "Terminates the program",
1702 on_activate => sub { 1886 on_activate => sub {
1703 if ($CONN) { 1887 if ($CONN) {
1714 } 1898 }
1715 1899
1716 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); 1900 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1717} 1901}
1718 1902
1903sub setup_build_button {
1904 my ($enabled) = @_;
1905 if ($enabled) {
1906 $BUILD_BUTTON->hide if $BUILD_BUTTON;
1907 $BUILD_BUTTON ||= new CFPlus::UI::Button
1908 text => "Build",
1909 tooltip => "Opens the ingame builder",
1910 on_activate => sub {
1911 if ($CONN) {
1912 $CONN->send_ext_req (builder_player_items => sub {
1913 open_ingame_editor ($_[0]) if exists $_[0]->{items};
1914 });
1915 }
1916 0
1917 };
1918 $BUTTONBAR->add ($BUILD_BUTTON);
1919 } else {
1920 $BUILD_BUTTON->hide if $BUILD_BUTTON;
1921 }
1922}
1923
1924sub open_ingame_editor {
1925 my ($msg) = @_;
1926
1927 my $win = new CFPlus::UI::Toplevel
1928 x => 0,
1929 y => 'center',
1930 z => 4,
1931 name => 'builder_window',
1932 force_w => int $WIDTH * 1/4,
1933 force_h => int $HEIGHT * 3/4,
1934 title => "In game builder",
1935 has_close_button => 1;
1936
1937 my $r = new CFPlus::UI::ScrolledWindow (
1938 expand => 1,
1939 scroll_y => 1
1940 );
1941 $r->add (my $vb = new CFPlus::UI::VBox);
1942 $win->add ($r);
1943
1944
1945 $vb->add (
1946 new CFPlus::UI::Button
1947 text => "Disable build mode",
1948 on_activate => sub { $::IN_BUILD_MODE = undef }
1949 );
1950 $vb->add (
1951 new CFPlus::UI::Button
1952 text => "ERASE",
1953 on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } }
1954 );
1955
1956 for my $itemarchname (
1957 sort {
1958 $msg->{items}->{$a}->{build_arch_name}
1959 cmp $msg->{items}->{$b}->{build_arch_name}
1960 } keys %{$msg->{items}}
1961 ) {
1962 my $info = $msg->{items}->{$itemarchname};
1963 $vb->add (
1964 new CFPlus::UI::Button text => $info->{build_arch_name},
1965 on_activate => sub {
1966 $::IN_BUILD_MODE = { item => $itemarchname, info => $info };
1967
1968 if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) {
1969 build_mode_query_arch_info ();
1970 }
1971 }
1972 );
1973 }
1974
1975 $win->show;
1976}
1977
1978sub build_mode_query_arch_info {
1979 my ($iteminfo) = $::IN_BUILD_MODE;
1980 my $itemarchname = $iteminfo->{item};
1981 my $info = $iteminfo->{info};
1982
1983 my $dialog = new CFPlus::UI::Toplevel
1984 x => "center",
1985 y => "center",
1986 z => 50,
1987 force_w => int $WIDTH * 1/2,
1988 title => "Enter information for placement of '$itemarchname'",
1989 has_close_button => 1;
1990
1991 $dialog->add (my $vb = new CFPlus::UI::VBox expand => 1);
1992
1993 $vb->add (my $table = new CFPlus::UI::Table expand => 1);
1994 my $row = 0;
1995 if ($info->{has_name}) {
1996 $table->add (0, $row, new CFPlus::UI::Label text => "Name:");
1997 $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 });
1998 }
1999 if ($info->{has_text}) {
2000 $table->add (0, $row, new CFPlus::UI::Label text => "Text:");
2001 $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 });
2002 }
2003 if ($info->{has_connection}) {
2004 $table->add (0, $row, new CFPlus::UI::Label text => "Connection ID:");
2005 $table->add (1, $row++,
2006 new CFPlus::UI::Entry
2007 expand => 1,
2008 on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 },
2009 tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate"
2010 );
2011 }
2012
2013 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
2014 $hb->add (new CFPlus::UI::Button
2015 text => "Close",
2016 expand => 1,
2017 on_activate => sub { $dialog->hide; 0 },
2018 );
2019 $dialog->show;
2020}
2021
1719sub video_shutdown { 2022sub video_shutdown {
1720 CFPlus::OpenGL::shutdown; 2023 CFPlus::OpenGL::shutdown;
1721 2024
1722 undef $SDL_ACTIVE; 2025 undef $SDL_ACTIVE;
1723} 2026}
1724 2027
1725my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1726my $bgmusic;#TODO#hack#d#
1727
1728sub audio_channel_finished { 2028sub audio_channel_finished {
1729 my ($channel) = @_; 2029 my ($channel) = @_;
1730 2030
1731 #warn "channel $channel finished\n";#d# 2031 #warn "channel $channel finished\n";#d#
1732} 2032}
1733 2033
2034sub audio_music_set {
2035 my ($songs) = @_;
2036
2037 my @want =
2038 grep $_,
2039 map $CONN->{music_meta}{$_},
2040 @$songs;
2041
2042 if (@want) {
2043 @MUSIC_WANT = @want;
2044 &audio_music_changed ();
2045 }
2046}
2047
2048sub audio_music_start {
2049 my $path = $MUSIC_PLAYING->{path}
2050 or return;
2051
2052 CFPlus::DB::prefetch_file $path, 1024_000, sub {
2053 # music might have changed...
2054 $path eq $MUSIC_PLAYING->{path}
2055 or return &audio_music_start ();
2056
2057 $MUSIC_PLAYER = new_from_file CFPlus::MixMusic $path;
2058
2059 my $NOW = time;
2060
2061 if ($MUSIC_PLAYING->{stop_time} > $NOW - $MUSIC_RESUME) {
2062 my $pos = $MUSIC_PLAYING->{stop_pos};
2063 $MUSIC_PLAYER->fade_in_pos (0, 1000, $pos);
2064 $MUSIC_START = time - $pos;
2065 } else {
2066 $MUSIC_PLAYER->play (0);
2067 $MUSIC_START = time;
2068 }
2069
2070 delete $MUSIC_PLAYING->{stop_time};
2071 delete $MUSIC_PLAYING->{stop_pos};
2072 }
2073}
2074
2075sub audio_music_changed {
2076 return unless $CFG->{bgm_enable};
2077
2078 # default MUSIC_WANT == MUSIC_DEFAULT
2079 @MUSIC_WANT = { path => CFPlus::find_rcfile "music/$MUSIC_DEFAULT" } unless @MUSIC_WANT;
2080
2081 # if the currently playing song is acceptable, let it continue
2082 return if $MUSIC_PLAYING
2083 && grep $MUSIC_PLAYING->{path} eq $_->{path}, @MUSIC_WANT;
2084
2085 my $NOW = time;
2086
2087 if ($MUSIC_PLAYING) {
2088 $MUSIC_PLAYING->{stop_time} = $NOW;
2089 $MUSIC_PLAYING->{stop_pos} = $NOW - $MUSIC_START;
2090 CFPlus::MixMusic::fade_out 1000;
2091 } else {
2092 # sort by stop time, oldest first
2093 @MUSIC_WANT = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_WANT;
2094
2095 # if the most recently-played piece played very recently,
2096 # resume it, else choose the oldest piece for rotation.
2097 $MUSIC_PLAYING =
2098 $MUSIC_WANT[-1]{stop_time} > $NOW - $MUSIC_RESUME
2099 ? $MUSIC_WANT[-1]
2100 : $MUSIC_WANT[0];
2101
2102 audio_music_start;
2103 }
2104}
2105
1734sub audio_music_finished { 2106sub audio_music_finished {
1735 return unless $CFG->{bgm_enable}; 2107 $MUSIC_PLAYING = undef;
2108 undef $MUSIC_PLAYER;
1736 2109
1737 # TODO: hack, do play loop and mood music 2110 audio_music_changed;
1738 $bgmusic = new_from_file CFPlus::MixMusic CFPlus::find_rcfile "music/$bgmusic[0]";
1739 $bgmusic->play (0);
1740
1741 push @bgmusic, shift @bgmusic;
1742} 2111}
1743 2112
1744sub audio_init { 2113sub audio_init {
1745 if ($CFG->{audio_enable}) { 2114 if ($CFG->{audio_enable}) {
1746 if (open my $fh, "<", CFPlus::find_rcfile "sounds/config") { 2115 if (open my $fh, "<", CFPlus::find_rcfile "sounds/config") {
1754 CFPlus::Mix_AllocateChannels 8; 2123 CFPlus::Mix_AllocateChannels 8;
1755 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128; 2124 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
1756 2125
1757 audio_music_finished; 2126 audio_music_finished;
1758 2127
2128 local $_;
1759 while (<$fh>) { 2129 while (<$fh>) {
1760 next if /^\s*#/; 2130 next if /^\s*#/;
1761 next if /^\s*$/; 2131 next if /^\s*$/;
1762 2132
1763 my ($file, $volume, $event) = split /\s+/, $_, 3; 2133 my ($file, $volume, $event) = split /\s+/, $_, 3;
1805 2175
1806my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub { 2176my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1807 $NOW = time; 2177 $NOW = time;
1808 2178
1809 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 2179 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1810 for CFPlus::SDL_PollEvent; 2180 for CFPlus::poll_events;
1811 2181
1812 if (%animate_object) { 2182 if (%animate_object) {
1813 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 2183 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
1814 $WANT_REFRESH++; 2184 $WANT_REFRESH++;
1815 } 2185 }
1840 if $CONN; 2210 if $CONN;
1841}); 2211});
1842 2212
1843%SDL_CB = ( 2213%SDL_CB = (
1844 CFPlus::SDL_QUIT => sub { 2214 CFPlus::SDL_QUIT => sub {
1845 Event::unloop -1; 2215 exit;
1846 }, 2216 },
1847 CFPlus::SDL_VIDEORESIZE => sub { 2217 CFPlus::SDL_VIDEORESIZE => sub {
1848 }, 2218 },
1849 CFPlus::SDL_VIDEOEXPOSE => sub { 2219 CFPlus::SDL_VIDEOEXPOSE => sub {
1850 CFPlus::UI::full_refresh; 2220 CFPlus::UI::full_refresh;
1851 }, 2221 },
1852 CFPlus::SDL_ACTIVEEVENT => sub { 2222 CFPlus::SDL_ACTIVEEVENT => sub {
1853# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 2223# not useful, as APPACTIVE include sonly iconified state, not unmapped
2224# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, CFPlus::SDL_GetAppState;#d#
2225# printf "a %x\n", CFPlus::SDL_GetAppState & CFPlus::SDL_APPACTIVE;#d#
2226# printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
2227# printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
2228# printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
1854 }, 2229 },
1855 CFPlus::SDL_KEYDOWN => sub { 2230 CFPlus::SDL_KEYDOWN => sub {
1856 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) { 2231 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
1857 # alt-enter 2232 # alt-enter
1858 $FULLSCREEN_ENABLE->toggle; 2233 $FULLSCREEN_ENABLE->toggle;
1879 2254
1880$SIG{INT} = $SIG{TERM} = sub { exit }; 2255$SIG{INT} = $SIG{TERM} = sub { exit };
1881 2256
1882{ 2257{
1883 CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc"; 2258 CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";
2259 CFPlus::DB::Server::run;
2260
1884 CFPlus::UI::set_layout ($::CFG->{layout}); 2261 CFPlus::UI::set_layout ($::CFG->{layout});
1885 2262
1886 my %DEF_CFG = ( 2263 my %DEF_CFG = (
1887 sdl_mode => 0, 2264 sdl_mode => 0,
1888 width => 640, 2265 width => 640,
1889 height => 480, 2266 height => 480,
1890 fullscreen => 0, 2267 fullscreen => 0,
1891 fast => 0, 2268 fast => 0,
1892 map_scale => 1, 2269 map_scale => 1,
1893 fow_enable => 1, 2270 fow_enable => 1,
1894 fow_intensity => 0.45, 2271 fow_intensity => 0.45,
1895 fow_smooth => 0, 2272 fow_smooth => 0,
2273 map_smoothing => 1,
1896 gui_fontsize => 1, 2274 gui_fontsize => 1,
1897 log_fontsize => 0.7, 2275 log_fontsize => 0.7,
1898 gauge_fontsize => 1, 2276 gauge_fontsize => 1,
1899 gauge_size => 0.35, 2277 gauge_size => 0.35,
1900 stat_fontsize => 0.7, 2278 stat_fontsize => 0.7,
1901 mapsize => 100, 2279 mapsize => 100,
1902 say_command => 'say', 2280 say_command => 'chat',
1903 audio_enable => 1, 2281 audio_enable => 1,
1904 bgm_enable => 1, 2282 bgm_enable => 1,
1905 bgm_volume => 0.25, 2283 bgm_volume => 0.25,
1906 face_prefetch => 0, 2284 face_prefetch => 0,
1907 output_sync => 1, 2285 output_sync => 1,
1908 output_count => 1, 2286 output_count => 1,
2287 output_rate => "",
1909 pickup => 0, 2288 pickup => 0,
1910 inv_sort => "mtime", 2289 inv_sort => "mtime",
1911 default => "profile", # default profile 2290 default => "profile", # default profile
2291 show_tips => 1,
2292 logview_max_par => 1000,
1912 ); 2293 );
1913 2294
1914 while (my ($k, $v) = each %DEF_CFG) { 2295 while (my ($k, $v) = each %DEF_CFG) {
1915 $CFG->{$k} = $v unless exists $CFG->{$k}; 2296 $CFG->{$k} = $v unless exists $CFG->{$k};
1916 } 2297 }
1917 2298
1918 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de"; 2299 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
2300 $PROFILE = $CFG->{profile}{default};
2301
2302 # convert old bindings (only default profile matters)
2303 if (my $bindings = delete $PROFILE->{bindings}) {
2304 while (my ($mod, $syms) = each %$bindings) {
2305 while (my ($sym, $cmds) = each %$syms) {
2306 push @{ $PROFILE->{macro} }, {
2307 accelkey => [$mod*1, $sym*1],
2308 action => $cmds,
2309 };
2310 }
2311 }
2312 }
1919 2313
1920 sdl_init; 2314 sdl_init;
1921 2315
1922 @SDL_MODES = reverse 2316 @SDL_MODES = CFPlus::SDL_ListModes 8, 8;
1923 grep $_->[0] >= 640 && $_->[1] >= 480, 2317 @SDL_MODES = CFPlus::SDL_ListModes 5, 0 unless @SDL_MODES;
1924 CFPlus::SDL_ListModes;
1925
1926 @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; 2318 @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1927 2319
1928 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; 2320 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1929 2321
1930 { 2322 {
1960# } 2352# }
1961# my $t2 = Time::HiRes::time; 2353# my $t2 = Time::HiRes::time;
1962# warn $t2-$t1; 2354# warn $t2-$t1;
1963# } 2355# }
1964 2356
2357 $startup_done->();
2358
1965 video_init; 2359 video_init;
1966 audio_init; 2360 audio_init;
1967} 2361}
2362
2363show_tip_of_the_day if $CFG->{show_tips};
1968 2364
1969Event::loop; 2365Event::loop;
1970#CFPlus::SDL_Quit; 2366#CFPlus::SDL_Quit;
1971#CFPlus::_exit 0; 2367#CFPlus::_exit 0;
1972 2368
2369END {
1973END { CFPlus::SDL_Quit } 2370 CFPlus::SDL_Quit;
2371 CFPlus::DB::Server::stop;
2372}
1974 2373
1975=head1 NAME 2374=head1 NAME
1976 2375
1977cfplus - A Crossfire+ and Crossfire game client 2376cfplus - A Crossfire+ and Crossfire game client
1978 2377

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines