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.118 by root, Tue Aug 22 06:37:30 2006 UTC vs.
Revision 1.131 by root, Sun Nov 19 20:31:29 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2
3my $startup_done = sub { };
4
5# do splash-screen thingy on win32
6BEGIN {
7 if (%PAR::LibCache && $^O eq "MSWin32") {
8 while (my ($filename, $zip) = each %PAR::LibCache) {
9 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
10 }
11
12 require Win32::GUI::SplashScreen;
13
14 Win32::GUI::SplashScreen::Show (
15 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
16 );
17
18 $startup_done = sub {
19 Win32::GUI::SplashScreen::Done (1);
20 };
21 }
22}
2 23
3use strict; 24use strict;
4use utf8; 25use utf8;
5 26
6# do things only needed for single-binary version (par) 27# do things only needed for single-binary version (par)
… …
8 if (%PAR::LibCache) { 29 if (%PAR::LibCache) {
9 @INC = grep ref, @INC; # weed out all paths except pars loader refs 30 @INC = grep ref, @INC; # weed out all paths except pars loader refs
10 31
11 while (my ($filename, $zip) = each %PAR::LibCache) { 32 while (my ($filename, $zip) = each %PAR::LibCache) {
12 for ($zip->memberNames) { 33 for ($zip->memberNames) {
13 next unless /^\/root\/(.*)/; 34 next unless /^root\/(.*)/;
14 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") 35 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
15 unless -e "$ENV{PAR_TEMP}/$1"; 36 unless -e "$ENV{PAR_TEMP}/$1";
16 } 37 }
17 } 38 }
18 39
… …
47 68
48$Event::Eval = 0; 69$Event::Eval = 0;
49$Event::DIED = sub { 70$Event::DIED = sub {
50 # TODO: display dialog box or so 71 # TODO: display dialog box or so
51 Carp::cluck $_[1];#d#TODO: remove when stable 72 Carp::cluck $_[1];#d#TODO: remove when stable
52 CFPlus::error $_[1]; 73 return;#d#
74 CFPlus::fatal ($_[1]);
53}; 75};
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.9';
65 76
66my $MAX_FPS = 60; 77my $MAX_FPS = 60;
67my $MIN_FPS = 5; # unused as of yet 78my $MIN_FPS = 5; # unused as of yet
68 79
69our $META_SERVER = "crossfire.real-time.com:13326"; 80our $META_SERVER = "http://metaserver.schmorp.de/current.json";
70 81
71our $LAST_REFRESH; 82our $LAST_REFRESH;
72our $NOW; 83our $NOW;
73 84
74our $CFG; 85our $CFG;
75our $CONN; 86our $CONN;
87our $PROFILE; # current profile
76our $FAST; # fast, low-quality mode, possibly useful for software-rendering 88our $FAST; # fast, low-quality mode, possibly useful for software-rendering
77 89
78our $WANT_REFRESH; 90our $WANT_REFRESH;
79our $CAN_REFRESH; 91our $CAN_REFRESH;
80 92
… …
111 123
112our $INVENTORY_PAGE; 124our $INVENTORY_PAGE;
113our $STATS_PAGE; 125our $STATS_PAGE;
114our $SKILL_PAGE; 126our $SKILL_PAGE;
115our $SPELL_PAGE; 127our $SPELL_PAGE;
128our $SPELL_LIST;
116 129
117our $HELP_WINDOW; 130our $HELP_WINDOW;
118our $MESSAGE_WINDOW; 131our $MESSAGE_WINDOW;
119our $FLOORBOX; 132our $FLOORBOX;
120our $GAUGES; 133our $GAUGES;
… …
144 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 157 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
145} 158}
146 159
147sub debug { 160sub debug {
148 $DEBUG_STATUS->set_text ($_[0]); 161 $DEBUG_STATUS->set_text ($_[0]);
162}
163
164sub message {
165 my ($para) = @_;
166
167 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
168
169 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
170
171 $LOGVIEW->add_paragraph ($para);
172 $LOGVIEW->scroll_to_bottom;
149} 173}
150 174
151sub destroy_query_dialog { 175sub destroy_query_dialog {
152 (delete $_[0]{query_dialog})->destroy 176 (delete $_[0]{query_dialog})->destroy
153 if $_[0]{query_dialog}; 177 if $_[0]{query_dialog};
… …
352 status "logging in..."; 376 status "logging in...";
353 377
354 $LOGIN_BUTTON->set_text ("Logout"); 378 $LOGIN_BUTTON->set_text ("Logout");
355 $SETUP_DIALOG->hide; 379 $SETUP_DIALOG->hide;
356 380
381 $PROFILE = $CFG->{profile}{default};
382
357 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 383 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
358 384
359 my ($host, $port) = split /:/, $CFG->{profile}{default}{host}; 385 my ($host, $port) = split /:/, $PROFILE->{host};
360 386
361 $MAP = new CFPlus::Map $mapsize, $mapsize; 387 $MAP = new CFPlus::Map;
362 388
363 $CONN = eval { 389 $CONN = eval {
364 new CFPlus::Protocol 390 new CFPlus::Protocol
365 host => $host, 391 host => $host,
366 port => $port || 13327, 392 port => $port || 13327,
367 user => $CFG->{profile}{default}{user}, 393 user => $PROFILE->{user},
368 pass => $CFG->{profile}{default}{password}, 394 pass => $PROFILE->{password},
369 mapw => $mapsize, 395 mapw => $mapsize,
370 maph => $mapsize, 396 maph => $mapsize,
371 397
372 client => "cfplus $VERSION $] $^O", 398 client => "cfplus $CFPlus::VERSION $] $^O",
373 399
374 map_widget => $MAPWIDGET, 400 map_widget => $MAPWIDGET,
375 logview => $LOGVIEW, 401 logview => $LOGVIEW,
376 statusbox => $STATUSBOX, 402 statusbox => $STATUSBOX,
377 map => $MAP, 403 map => $MAP,
… …
832 858
833 my $table = $METASERVER->{table}; 859 my $table = $METASERVER->{table};
834 $table->clear; 860 $table->clear;
835 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); 861 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
836 862
837 my $buf; 863 my $ok = 0;
838 864
839 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 865 CFPlus::background {
866 my $ua = CFPlus::lwp_useragent;
840 867
841 unless ($fh) { 868 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
842 $label->set_text ("unable to contact metaserver: $!"); 869 } sub {
843 return; 870 my ($msg) = @_;
844 } 871 if ($msg) {
845
846 Event->io (fd => $fh, poll => 'r', cb => sub {
847 my $res = sysread $fh, $buf, 8192, length $buf;
848
849 if (!defined $res) {
850 $_[0]->w->cancel;
851 $label->set_text ("error while retrieving server list: $!");
852 } elsif ($res == 0) {
853 $_[0]->w->cancel;
854 status "server list retrieved";
855
856 utf8::decode $buf if utf8::valid $buf;
857
858 $table->clear; 872 $table->clear;
859 873
860 my @tip = ( 874 my @tip = (
861 "The current number of users logged in on the server.", 875 "The current number of users logged in on the server.",
862 "The hostname of the server.", 876 "The hostname of the server.",
… …
872 for 0 .. $#col; 886 for 0 .. $#col;
873 887
874 my @align = qw(1 0 1 1 -1); 888 my @align = qw(1 0 1 1 -1);
875 889
876 my $y = 0; 890 my $y = 0;
877 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) { 891 for my $m (
892 sort {
893 $b->{version} <=> $a->{version}
894 or $b->{users} <=> $a->{users}
895 }
896 @{ $msg->{servers} }
897 ) {
878 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; 898 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) =
899 @$m{qw(ip age hostname users version description ibytes obytes uptime)};
879 900
880 for ($desc) { 901 for ($desc) {
881 s/<br>/\n/gi; 902 s/<br>/\n/gi;
882 s/<li>/\n· /gi; 903 s/<li>/\n· /gi;
883 s/<.*?>//sgi; 904 s/<.*?>//sgi;
884 s/&/&amp;/g; 905 s/&amp;/&/g;
885 s/</&lt;/g; 906 s/&lt;/</g;
886 s/>/&gt;/g; 907 s/&gt;/>/g;
887 } 908 }
888 909
889 $uptime = sprintf "%dd %02d:%02d:%02d", 910 $uptime = sprintf "%dd %02d:%02d:%02d",
890 (int $m->[8] / 86400), 911 (int $uptime / 86400),
891 (int $m->[8] / 3600) % 24, 912 (int $uptime / 3600) % 24,
892 (int $m->[8] / 60) % 60, 913 (int $uptime / 60) % 60,
893 $m->[8] % 60; 914 $uptime % 60;
894 915
895 $m = [$users, $host, $uptime, $version, $desc]; 916 $m = [$users, $host, $uptime, $version, $desc];
896 917
897 $y++; 918 $y++;
898 919
… …
908 ), 929 ),
909 (new CFPlus::UI::Empty expand => 1), 930 (new CFPlus::UI::Empty expand => 1),
910 ]); 931 ]);
911 932
912 $table->add ($_, $y, new CFPlus::UI::Label 933 $table->add ($_, $y, new CFPlus::UI::Label
934 max_w => $::WIDTH * 0.4,
913 ellipsise => 0, 935 ellipsise => 0,
914 align => $align[$_], 936 align => $align[$_],
915 text => $m->[$_], 937 text => $m->[$_],
916 tooltip => $tip[$_], 938 tooltip => $tip[$_],
939 fg => ($m->[3] =~ /\+$/ ? [1, 1, 1] : [.7, .7, .7]),
917 can_hover => 1, 940 can_hover => 1,
918 can_events => 1, 941 can_events => 1,
919 fontsize => 0.8) 942 fontsize => 0.8)
920 for 0 .. $#$m; 943 for 0 .. $#$m;
921 } 944 }
945 } else {
946 $ok or $label->set_text ("error while contacting metaserver");
922 } 947 }
923 }); 948 };
949
924} 950}
925 951
926sub metaserver_dialog { 952sub metaserver_dialog {
927 my $vbox = new CFPlus::UI::VBox; 953 my $vbox = new CFPlus::UI::VBox;
928 my $table = new CFPlus::UI::Table; 954 my $table = new CFPlus::UI::Table;
… …
932 title => "Server List", 958 title => "Server List",
933 name => 'metaserver_dialog', 959 name => 'metaserver_dialog',
934 x => 'center', 960 x => 'center',
935 y => 'center', 961 y => 'center',
936 z => 3, 962 z => 3,
963 force_w => $::WIDTH * 0.9,
937 force_h => $::HEIGHT * 0.4, 964 force_h => $::HEIGHT * 0.7,
938 child => $vbox, 965 child => $vbox,
939 has_close_button => 1, 966 has_close_button => 1,
940 table => $table, 967 table => $table,
941 on_visibility_change => sub { 968 on_visibility_change => sub {
942 update_metaserver ($_[0]) if $_[1]; 969 update_metaserver ($_[0]) if $_[1];
… …
1045 }, 1072 },
1046 ); 1073 );
1047 1074
1048 $table->add (0, 12, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command"); 1075 $table->add (0, 12, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
1049 $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry 1076 $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry
1050 text => $CFG->{say_command}, 1077 text => $CFG->{say_command},
1051 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. " 1078 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. "
1052 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. " 1079 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1053 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.", 1080 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1054 on_changed => sub { 1081 on_changed => sub {
1055 my ($self, $value) = @_; 1082 my ($self, $value) = @_;
1056 $CFG->{say_command} = $value; 1083 $CFG->{say_command} = $value;
1084 0
1085 }
1086 );
1087
1088 $table->add (0, 13, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
1089 $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox
1090 state => $CFG->{show_tips},
1091 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1092 on_changed => sub {
1093 my ($self, $value) = @_;
1094 $CFG->{show_tips} = $value;
1057 0 1095 0
1058 } 1096 }
1059 ); 1097 );
1060 1098
1061 $vbox->add (new CFPlus::UI::FancyFrame 1099 $vbox->add (new CFPlus::UI::FancyFrame
… …
1125 window => $window, 1163 window => $window,
1126 input => $input, 1164 input => $input,
1127 }; 1165 };
1128 1166
1129 $window 1167 $window
1130}
1131
1132sub open_string_query {
1133 my ($title, $cb, $txt, $tooltip) = @_;
1134 my $dialog = new CFPlus::UI::Toplevel
1135 x => "center",
1136 y => "center",
1137 z => 50,
1138 force_w => $WIDTH * 4/5,
1139 title => $title;
1140
1141 $dialog->add (
1142 my $e = new CFPlus::UI::Entry
1143 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1144 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1145 tooltip => $tooltip
1146 );
1147
1148 $e->grab_focus;
1149 $e->set_text ($txt) if $txt;
1150 $dialog->show;
1151}
1152
1153sub open_quit_dialog {
1154 unless ($QUIT_DIALOG) {
1155 $QUIT_DIALOG = new CFPlus::UI::Toplevel
1156 x => "center",
1157 y => "center",
1158 z => 50,
1159 title => "Really Quit?",
1160 on_key_down => sub {
1161 my ($dialog, $ev) = @_;
1162 $ev->{sym} == 27 and $dialog->hide;
1163 }
1164 ;
1165
1166 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1167
1168 $vb->add (new CFPlus::UI::Label
1169 text => "You should find a savebed and apply it first!",
1170 max_w => $WIDTH * 0.25,
1171 ellipsize => 0,
1172 );
1173 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1174 $hb->add (new CFPlus::UI::Button
1175 text => "Ok",
1176 expand => 1,
1177 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1178 );
1179 $hb->add (new CFPlus::UI::Button
1180 text => "Quit anyway",
1181 expand => 1,
1182 on_activate => sub { exit },
1183 );
1184 }
1185
1186 $QUIT_DIALOG->show;
1187 $QUIT_DIALOG->grab_focus;
1188} 1168}
1189 1169
1190sub autopickup_setup { 1170sub autopickup_setup {
1191 my $table = new CFPlus::UI::Table; 1171 my $table = new CFPlus::UI::Table;
1192 1172
… …
1284 $table 1264 $table
1285} 1265}
1286 1266
1287my %SORT_ORDER = ( 1267my %SORT_ORDER = (
1288 type => undef, 1268 type => undef,
1289 mtime => sub { sort { 1269 mtime => sub {
1270 my $NOW = time;
1271 sort {
1272 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1273 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1274
1290 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) 1275 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1291 or $b->{mtime} <=> $a->{mtime} 1276 or $btime <=> $atime
1292 or $a->{type} <=> $b->{type} 1277 or $a->{type} <=> $b->{type}
1278 } @_
1293 } @_ }, 1279 },
1294 weight => sub { sort { 1280 weight => sub { sort {
1295 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1) 1281 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1296 or $a->{type} <=> $b->{type} 1282 or $a->{type} <=> $b->{type}
1297 } @_ }, 1283 } @_ },
1298); 1284);
… …
1323 #TODO# update to weigh/maxweight 1309 #TODO# update to weigh/maxweight
1324 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); 1310 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1325 1311
1326 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); 1312 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1327 $sw1->add ($INV = new CFPlus::UI::Inventory); 1313 $sw1->add ($INV = new CFPlus::UI::Inventory);
1314 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1328 1315
1329 $hb->add (my $vb2 = new CFPlus::UI::VBox); 1316 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1330 1317
1331 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); 1318 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1332 1319
… …
1372 $ntb->add ( 1359 $ntb->add (
1373 "Skills (F3)" => $SKILL_PAGE = skill_window, 1360 "Skills (F3)" => $SKILL_PAGE = skill_window,
1374 "Shows all your Skills." 1361 "Shows all your Skills."
1375 ); 1362 );
1376 1363
1377 my $spellsw = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1); 1364 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1378 $spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList); 1365 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1379 $ntb->add ( 1366 $ntb->add (
1380 "Spellbook (F4)" => $spellsw, 1367 "Spellbook (F4)" => $spellsw,
1381 "Displays all spells you have and lets you edit keyboard shortcuts for them." 1368 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1382 ); 1369 );
1383 $ntb->add ( 1370 $ntb->add (
… …
1401 1388
1402 my $refresh; 1389 my $refresh;
1403 $refresh = $BIND_UPD_CB = sub { 1390 $refresh = $BIND_UPD_CB = sub {
1404 $binding_list->clear (); 1391 $binding_list->clear ();
1405 1392
1393 return unless $PROFILE;
1394
1406 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) { 1395 for my $mod (keys %{$PROFILE->{bindings}}) {
1407 for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) { 1396 for my $sym (keys %{$PROFILE->{bindings}{$mod}}) {
1408 my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym}; 1397 my $cmds = $PROFILE->{bindings}{$mod}{$sym};
1409 next unless ref $cmds eq 'ARRAY' and @$cmds > 0; 1398 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1410 1399
1411 my $lbl = join "; ", @$cmds; 1400 my $lbl = join "; ", @$cmds;
1412 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym); 1401 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym);
1413 $binding_list->add (my $hb = new CFPlus::UI::HBox); 1402 $binding_list->add (my $hb = new CFPlus::UI::HBox);
1414 $hb->add (new CFPlus::UI::Button 1403 $hb->add (new CFPlus::UI::Button
1415 text => "delete", 1404 text => "delete",
1416 tooltip => "Deletes the binding", 1405 tooltip => "Deletes the binding",
1417 on_activate => sub { 1406 on_activate => sub {
1418 $binding_list->remove ($hb); 1407 $binding_list->remove ($hb);
1419 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym}; 1408 delete $PROFILE->{bindings}{$mod}{$sym};
1420 0 1409 0
1421 }); 1410 });
1422 1411
1423 $hb->add (new CFPlus::UI::Button 1412 $hb->add (new CFPlus::UI::Button
1424 text => "edit", 1413 text => "edit",
1425 tooltip => "Edits the binding", 1414 tooltip => "Edits the binding",
1426 on_activate => sub { 1415 on_activate => sub {
1427 $::BIND_EDITOR->set_binding ( 1416 $::BIND_EDITOR->set_binding (
1428 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym}, 1417 $mod, $sym, $PROFILE->{bindings}{$mod}{$sym},
1429 sub { 1418 sub {
1430 my ($nmod, $nsym, $ncmds) = @_; 1419 my ($nmod, $nsym, $ncmds) = @_;
1431 $::BIND_EDITOR->cfg_unbind ($mod, $sym); 1420 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1432 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds); 1421 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1433 $refresh->(); 1422 $refresh->();
… …
1511 1500
1512sub help_window { 1501sub help_window {
1513 my $win = new CFPlus::UI::Toplevel 1502 my $win = new CFPlus::UI::Toplevel
1514 x => 'center', 1503 x => 'center',
1515 y => 'center', 1504 y => 'center',
1516 z => 2, 1505 z => 4,
1517 name => 'doc_browser', 1506 name => 'doc_browser',
1518 force_w => int $WIDTH * 7/8, 1507 force_w => int $WIDTH * 7/8,
1519 force_h => int $HEIGHT * 7/8, 1508 force_h => int $HEIGHT * 7/8,
1520 title => "Help Browser", 1509 title => "Help Browser",
1521 has_close_button => 1; 1510 has_close_button => 1;
… …
1607 $load_node->((CFPlus::Pod::find @path)[0]); 1596 $load_node->((CFPlus::Pod::find @path)[0]);
1608 $win->show; 1597 $win->show;
1609 }; 1598 };
1610 1599
1611 $win 1600 $win
1601}
1602
1603sub open_string_query {
1604 my ($title, $cb, $txt, $tooltip) = @_;
1605 my $dialog = new CFPlus::UI::Toplevel
1606 x => "center",
1607 y => "center",
1608 z => 50,
1609 force_w => $WIDTH * 4/5,
1610 title => $title;
1611
1612 $dialog->add (
1613 my $e = new CFPlus::UI::Entry
1614 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1615 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1616 tooltip => $tooltip
1617 );
1618
1619 $e->grab_focus;
1620 $e->set_text ($txt) if $txt;
1621 $dialog->show;
1622}
1623
1624sub open_quit_dialog {
1625 unless ($QUIT_DIALOG) {
1626 $QUIT_DIALOG = new CFPlus::UI::Toplevel
1627 x => "center",
1628 y => "center",
1629 z => 50,
1630 title => "Really Quit?",
1631 on_key_down => sub {
1632 my ($dialog, $ev) = @_;
1633 $ev->{sym} == 27 and $dialog->hide;
1634 }
1635 ;
1636
1637 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1638
1639 $vb->add (new CFPlus::UI::Label
1640 text => "You should find a savebed and apply it first!",
1641 max_w => $WIDTH * 0.25,
1642 ellipsize => 0,
1643 );
1644 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1645 $hb->add (new CFPlus::UI::Button
1646 text => "Ok",
1647 expand => 1,
1648 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1649 );
1650 $hb->add (new CFPlus::UI::Button
1651 text => "Quit anyway",
1652 expand => 1,
1653 on_activate => sub { exit },
1654 );
1655 }
1656
1657 $QUIT_DIALOG->show;
1658 $QUIT_DIALOG->grab_focus;
1659}
1660
1661sub show_tip_of_the_day {
1662 # find all tips
1663 my @tod = CFPlus::Pod::find tip_of_the_day => "*";
1664
1665 my $todindex = $CFPlus::DB_STATE->get ("tip_of_the_day");
1666 $todindex = 0 if $todindex >= @tod;
1667 $CFPlus::DB_STATE->put (tip_of_the_day => $todindex + 1);
1668
1669 # create dialog
1670 my $dialog;
1671
1672 my $close = sub {
1673 $dialog->destroy;
1674 };
1675
1676 $dialog = new CFPlus::UI::Toplevel
1677 x => "center",
1678 y => "center",
1679 z => 3,
1680 name => 'tip_of_the_day',
1681 force_w => int $WIDTH * 4/9,
1682 force_h => int $WIDTH * 2/9,
1683 title => "Tip of the day #" . (1 + $todindex),
1684 child => my $vbox = new CFPlus::UI::VBox,
1685 has_close_button => 1,
1686 on_delete => $close,
1687 ;
1688
1689 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1690 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1691 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
1692
1693 $vbox->add (my $table = new CFPlus::UI::Table);
1694
1695 $table->add (0, 0, new CFPlus::UI::Button
1696 text => "Close",
1697 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>.",
1698 on_activate => $close,
1699 );
1700
1701 $table->add (2, 0, new CFPlus::UI::Button
1702 text => "Next",
1703 tooltip => "Show the next <b>Tip of the day</b>.",
1704 on_activate => sub {
1705 $close->();
1706 &show_tip_of_the_day;
1707 },
1708 );
1709
1710 $dialog->show;
1612} 1711}
1613 1712
1614sub sdl_init { 1713sub sdl_init {
1615 CFPlus::SDL_Init 1714 CFPlus::SDL_Init
1616 and die "SDL::Init failed!\n"; 1715 and die "SDL::Init failed!\n";
… …
1822 CFPlus::Mix_AllocateChannels 8; 1921 CFPlus::Mix_AllocateChannels 8;
1823 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128; 1922 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
1824 1923
1825 audio_music_finished; 1924 audio_music_finished;
1826 1925
1926 local $_;
1827 while (<$fh>) { 1927 while (<$fh>) {
1828 next if /^\s*#/; 1928 next if /^\s*#/;
1829 next if /^\s*$/; 1929 next if /^\s*$/;
1830 1930
1831 my ($file, $volume, $event) = split /\s+/, $_, 3; 1931 my ($file, $volume, $event) = split /\s+/, $_, 3;
… …
1965 log_fontsize => 0.7, 2065 log_fontsize => 0.7,
1966 gauge_fontsize => 1, 2066 gauge_fontsize => 1,
1967 gauge_size => 0.35, 2067 gauge_size => 0.35,
1968 stat_fontsize => 0.7, 2068 stat_fontsize => 0.7,
1969 mapsize => 100, 2069 mapsize => 100,
1970 say_command => 'say', 2070 say_command => 'chat',
1971 audio_enable => 1, 2071 audio_enable => 1,
1972 bgm_enable => 1, 2072 bgm_enable => 1,
1973 bgm_volume => 0.25, 2073 bgm_volume => 0.25,
1974 face_prefetch => 0, 2074 face_prefetch => 0,
1975 output_sync => 1, 2075 output_sync => 1,
1976 output_count => 1, 2076 output_count => 1,
1977 pickup => 0, 2077 pickup => 0,
1978 inv_sort => "mtime", 2078 inv_sort => "mtime",
1979 default => "profile", # default profile 2079 default => "profile", # default profile
2080 show_tips => 1,
1980 ); 2081 );
1981 2082
1982 while (my ($k, $v) = each %DEF_CFG) { 2083 while (my ($k, $v) = each %DEF_CFG) {
1983 $CFG->{$k} = $v unless exists $CFG->{$k}; 2084 $CFG->{$k} = $v unless exists $CFG->{$k};
1984 } 2085 }
… …
2028# } 2129# }
2029# my $t2 = Time::HiRes::time; 2130# my $t2 = Time::HiRes::time;
2030# warn $t2-$t1; 2131# warn $t2-$t1;
2031# } 2132# }
2032 2133
2134 $startup_done->();
2135
2033 video_init; 2136 video_init;
2034 audio_init; 2137 audio_init;
2035} 2138}
2139
2140show_tip_of_the_day if $CFG->{show_tips};
2036 2141
2037Event::loop; 2142Event::loop;
2038#CFPlus::SDL_Quit; 2143#CFPlus::SDL_Quit;
2039#CFPlus::_exit 0; 2144#CFPlus::_exit 0;
2040 2145

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines