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.113 by root, Sun Aug 13 21:46:10 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.1';
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;
146 159
147sub debug { 160sub debug {
148 $DEBUG_STATUS->set_text ($_[0]); 161 $DEBUG_STATUS->set_text ($_[0]);
149} 162}
150 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;
173}
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};
154} 178}
155 179
156# server query dialog 180# server query dialog
157sub server_query { 181sub server_query {
158 my ($conn, $flags, $prompt) = @_; 182 my ($conn, $flags, $prompt) = @_;
159 183
160 $conn->{query_dialog} = my $dialog = new CFPlus::UI::FancyFrame 184 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
161 x => "center", 185 x => "center",
162 y => "center", 186 y => "center",
163 title => "Server Query", 187 title => "Server Query",
164 child => my $vbox = new CFPlus::UI::VBox, 188 child => my $vbox = new CFPlus::UI::VBox,
165 ; 189 ;
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,
397
398 client => "cfplus $CFPlus::VERSION $] $^O",
371 399
372 map_widget => $MAPWIDGET, 400 map_widget => $MAPWIDGET,
373 logview => $LOGVIEW, 401 logview => $LOGVIEW,
374 statusbox => $STATUSBOX, 402 statusbox => $STATUSBOX,
375 map => $MAP, 403 map => $MAP,
663 expand => 1, 691 expand => 1,
664 scroll_y => 1 692 scroll_y => 1
665 ); 693 );
666 $r->add (my $vb = new CFPlus::UI::VBox); 694 $r->add (my $vb = new CFPlus::UI::VBox);
667 695
696 $vb->add (new CFPlus::UI::FancyFrame
697 label => "Player",
698 child => (my $pi = new CFPlus::UI::VBox),
699 );
700
668 $vb->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1, 701 $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
669 can_hover => 1, can_events => 1, 702 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."); 703 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, 704 $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
672 can_hover => 1, can_events => 1, 705 can_hover => 1, can_events => 1,
673 tooltip => "The map you are currently on (if supported by the server)."); 706 tooltip => "The map you are currently on (if supported by the server).");
674 707
675 $vb->add (my $hb0 = new CFPlus::UI::HBox); 708 $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, 709 $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
677 can_hover => 1, can_events => 1, 710 can_hover => 1, can_events => 1,
678 tooltip => "The weight of the player including all inventory items."); 711 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, 712 $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, 713 can_hover => 1, can_events => 1,
681 tooltip => "The weight limit: you cannot carry more than this."); 714 tooltip => "The weight limit: you cannot carry more than this.");
682 715
716 $vb->add (new CFPlus::UI::FancyFrame
717 label => "Primary/Secondary Statistics",
683 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1); 718 child => (my $hb = new CFPlus::UI::HBox expand => 1),
719 );
684 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1); 720 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1);
685 721
686 my $color2 = [1, 1, 0]; 722 my $color2 = [1, 1, 0];
687 723
688 for ( 724 for (
709 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label 745 $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, 746 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
711 align => -1, text => $label, tooltip => "#stat_$label"); 747 align => -1, text => $label, tooltip => "#stat_$label");
712 } 748 }
713 749
750 $vb->add (new CFPlus::UI::FancyFrame
751 label => "Resistancies",
714 $vb->add (my $tbl2 = new CFPlus::UI::Table expand => 1); 752 child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
753 );
715 754
716 my $row = 0; 755 my $row = 0;
717 my $col = 0; 756 my $col = 0;
718 757
719 my %resist_names = ( 758 my %resist_names = (
819 858
820 my $table = $METASERVER->{table}; 859 my $table = $METASERVER->{table};
821 $table->clear; 860 $table->clear;
822 $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...");
823 862
824 my $buf; 863 my $ok = 0;
825 864
826 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 865 CFPlus::background {
866 my $ua = CFPlus::lwp_useragent;
827 867
828 unless ($fh) { 868 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
829 $label->set_text ("unable to contact metaserver: $!"); 869 } sub {
830 return; 870 my ($msg) = @_;
831 } 871 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; 872 $table->clear;
846 873
847 my @tip = ( 874 my @tip = (
848 "The current number of users logged in on the server.", 875 "The current number of users logged in on the server.",
849 "The hostname of the server.", 876 "The hostname of the server.",
859 for 0 .. $#col; 886 for 0 .. $#col;
860 887
861 my @align = qw(1 0 1 1 -1); 888 my @align = qw(1 0 1 1 -1);
862 889
863 my $y = 0; 890 my $y = 0;
864 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 ) {
865 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)};
866 900
867 for ($desc) { 901 for ($desc) {
868 s/<br>/\n/gi; 902 s/<br>/\n/gi;
869 s/<li>/\n· /gi; 903 s/<li>/\n· /gi;
870 s/<.*?>//sgi; 904 s/<.*?>//sgi;
871 s/&/&amp;/g; 905 s/&amp;/&/g;
872 s/</&lt;/g; 906 s/&lt;/</g;
873 s/>/&gt;/g; 907 s/&gt;/>/g;
874 } 908 }
875 909
876 $uptime = sprintf "%dd %02d:%02d:%02d", 910 $uptime = sprintf "%dd %02d:%02d:%02d",
877 (int $m->[8] / 86400), 911 (int $uptime / 86400),
878 (int $m->[8] / 3600) % 24, 912 (int $uptime / 3600) % 24,
879 (int $m->[8] / 60) % 60, 913 (int $uptime / 60) % 60,
880 $m->[8] % 60; 914 $uptime % 60;
881 915
882 $m = [$users, $host, $uptime, $version, $desc]; 916 $m = [$users, $host, $uptime, $version, $desc];
883 917
884 $y++; 918 $y++;
885 919
895 ), 929 ),
896 (new CFPlus::UI::Empty expand => 1), 930 (new CFPlus::UI::Empty expand => 1),
897 ]); 931 ]);
898 932
899 $table->add ($_, $y, new CFPlus::UI::Label 933 $table->add ($_, $y, new CFPlus::UI::Label
934 max_w => $::WIDTH * 0.4,
900 ellipsise => 0, 935 ellipsise => 0,
901 align => $align[$_], 936 align => $align[$_],
902 text => $m->[$_], 937 text => $m->[$_],
903 tooltip => $tip[$_], 938 tooltip => $tip[$_],
939 fg => ($m->[3] =~ /\+$/ ? [1, 1, 1] : [.7, .7, .7]),
904 can_hover => 1, 940 can_hover => 1,
905 can_events => 1, 941 can_events => 1,
906 fontsize => 0.8) 942 fontsize => 0.8)
907 for 0 .. $#$m; 943 for 0 .. $#$m;
908 } 944 }
945 } else {
946 $ok or $label->set_text ("error while contacting metaserver");
909 } 947 }
910 }); 948 };
949
911} 950}
912 951
913sub metaserver_dialog { 952sub metaserver_dialog {
914 my $vbox = new CFPlus::UI::VBox; 953 my $vbox = new CFPlus::UI::VBox;
915 my $table = new CFPlus::UI::Table; 954 my $table = new CFPlus::UI::Table;
916 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table); 955 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);
917 956
918 my $dialog = new CFPlus::UI::FancyFrame 957 my $dialog = new CFPlus::UI::Toplevel
919 title => "Server List", 958 title => "Server List",
920 name => 'metaserver_dialog', 959 name => 'metaserver_dialog',
921 x => 'center', 960 x => 'center',
922 y => 'center', 961 y => 'center',
923 z => 3, 962 z => 3,
963 force_w => $::WIDTH * 0.9,
924 force_h => $::HEIGHT * 0.4, 964 force_h => $::HEIGHT * 0.7,
925 child => $vbox, 965 child => $vbox,
926 has_close_button => 1, 966 has_close_button => 1,
927 table => $table, 967 table => $table,
928 on_visibility_change => sub { 968 on_visibility_change => sub {
929 update_metaserver ($_[0]) if $_[1]; 969 update_metaserver ($_[0]) if $_[1];
935} 975}
936 976
937sub server_setup { 977sub server_setup {
938 my $vbox = new CFPlus::UI::VBox; 978 my $vbox = new CFPlus::UI::VBox;
939 979
980 $vbox->add (new CFPlus::UI::FancyFrame
981 label => "Connection Settings",
940 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]); 982 child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
983 );
941 $table->add (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port"); 984 $table->add (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");
942 985
943 { 986 {
944 $table->add (1, 2, my $vbox = new CFPlus::UI::VBox); 987 $table->add (1, 2, my $vbox = new CFPlus::UI::VBox);
945 988
1029 }, 1072 },
1030 ); 1073 );
1031 1074
1032 $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");
1033 $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry 1076 $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry
1034 text => $CFG->{say_command}, 1077 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. " 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. "
1036 . "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. "
1037 . "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.",
1038 on_changed => sub { 1081 on_changed => sub {
1039 my ($self, $value) = @_; 1082 my ($self, $value) = @_;
1040 $CFG->{say_command} = $value; 1083 $CFG->{say_command} = $value;
1041 0 1084 0
1042 } 1085 }
1043 ); 1086 );
1044 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;
1095 0
1096 }
1097 );
1098
1045 $vbox->add (new CFPlus::UI::Label 1099 $vbox->add (new CFPlus::UI::FancyFrame
1046 text => "Server Info", 1100 label => "Server Info",
1047 fontsize => 1.2,
1048 padding_y => 8,
1049 fg => [1, 1, 0, 1],
1050 );
1051
1052 $vbox->add ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0); 1101 child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
1102 );
1053 1103
1054 $vbox 1104 $vbox
1055} 1105}
1056 1106
1057sub message_window { 1107sub message_window {
1058 my $window = new CFPlus::UI::FancyFrame 1108 my $window = new CFPlus::UI::Toplevel
1059 name => "message_window", 1109 name => "message_window",
1060 title => "Messages", 1110 title => "Messages",
1061 border_bg => [1, 1, 1, 1], 1111 border_bg => [1, 1, 1, 1],
1062 x => "max", 1112 x => "max",
1063 y => 0, 1113 y => 0,
1113 window => $window, 1163 window => $window,
1114 input => $input, 1164 input => $input,
1115 }; 1165 };
1116 1166
1117 $window 1167 $window
1118}
1119
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} 1168}
1175 1169
1176sub autopickup_setup { 1170sub autopickup_setup {
1177 my $table = new CFPlus::UI::Table; 1171 my $table = new CFPlus::UI::Table;
1178 1172
1270 $table 1264 $table
1271} 1265}
1272 1266
1273my %SORT_ORDER = ( 1267my %SORT_ORDER = (
1274 type => undef, 1268 type => undef,
1275 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
1276 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) 1275 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1277 or $b->{mtime} <=> $a->{mtime} 1276 or $btime <=> $atime
1278 or $a->{type} <=> $b->{type} 1277 or $a->{type} <=> $b->{type}
1278 } @_
1279 } @_ }, 1279 },
1280 weight => sub { sort { 1280 weight => sub { sort {
1281 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1) 1281 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1282 or $a->{type} <=> $b->{type} 1282 or $a->{type} <=> $b->{type}
1283 } @_ }, 1283 } @_ },
1284); 1284);
1309 #TODO# update to weigh/maxweight 1309 #TODO# update to weigh/maxweight
1310 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); 1310 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1311 1311
1312 $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);
1313 $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}});
1314 1315
1315 $hb->add (my $vb2 = new CFPlus::UI::VBox); 1316 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1316 1317
1317 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); 1318 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1318 1319
1335 $PL_WINDOW->show; 1336 $PL_WINDOW->show;
1336 } 1337 }
1337} 1338}
1338 1339
1339sub player_window { 1340sub player_window {
1340 my $plwin = $PL_WINDOW = new CFPlus::UI::FancyFrame 1341 my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
1341 x => "center", 1342 x => "center",
1342 y => "center", 1343 y => "center",
1343 force_w => $WIDTH * 9/10, 1344 force_w => $WIDTH * 9/10,
1344 force_h => $HEIGHT * 9/10, 1345 force_h => $HEIGHT * 9/10,
1345 title => "Player", 1346 title => "Player",
1358 $ntb->add ( 1359 $ntb->add (
1359 "Skills (F3)" => $SKILL_PAGE = skill_window, 1360 "Skills (F3)" => $SKILL_PAGE = skill_window,
1360 "Shows all your Skills." 1361 "Shows all your Skills."
1361 ); 1362 );
1362 1363
1363 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);
1364 $spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList); 1365 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1365 $ntb->add ( 1366 $ntb->add (
1366 "Spellbook (F4)" => $spellsw, 1367 "Spellbook (F4)" => $spellsw,
1367 "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."
1368 ); 1369 );
1369 $ntb->add ( 1370 $ntb->add (
1387 1388
1388 my $refresh; 1389 my $refresh;
1389 $refresh = $BIND_UPD_CB = sub { 1390 $refresh = $BIND_UPD_CB = sub {
1390 $binding_list->clear (); 1391 $binding_list->clear ();
1391 1392
1393 return unless $PROFILE;
1394
1392 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) { 1395 for my $mod (keys %{$PROFILE->{bindings}}) {
1393 for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) { 1396 for my $sym (keys %{$PROFILE->{bindings}{$mod}}) {
1394 my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym}; 1397 my $cmds = $PROFILE->{bindings}{$mod}{$sym};
1395 next unless ref $cmds eq 'ARRAY' and @$cmds > 0; 1398 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1396 1399
1397 my $lbl = join "; ", @$cmds; 1400 my $lbl = join "; ", @$cmds;
1398 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym); 1401 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym);
1399 $binding_list->add (my $hb = new CFPlus::UI::HBox); 1402 $binding_list->add (my $hb = new CFPlus::UI::HBox);
1400 $hb->add (new CFPlus::UI::Button 1403 $hb->add (new CFPlus::UI::Button
1401 text => "delete", 1404 text => "delete",
1402 tooltip => "Deletes the binding", 1405 tooltip => "Deletes the binding",
1403 on_activate => sub { 1406 on_activate => sub {
1404 $binding_list->remove ($hb); 1407 $binding_list->remove ($hb);
1405 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym}; 1408 delete $PROFILE->{bindings}{$mod}{$sym};
1406 0 1409 0
1407 }); 1410 });
1408 1411
1409 $hb->add (new CFPlus::UI::Button 1412 $hb->add (new CFPlus::UI::Button
1410 text => "edit", 1413 text => "edit",
1411 tooltip => "Edits the binding", 1414 tooltip => "Edits the binding",
1412 on_activate => sub { 1415 on_activate => sub {
1413 $::BIND_EDITOR->set_binding ( 1416 $::BIND_EDITOR->set_binding (
1414 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym}, 1417 $mod, $sym, $PROFILE->{bindings}{$mod}{$sym},
1415 sub { 1418 sub {
1416 my ($nmod, $nsym, $ncmds) = @_; 1419 my ($nmod, $nsym, $ncmds) = @_;
1417 $::BIND_EDITOR->cfg_unbind ($mod, $sym); 1420 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1418 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds); 1421 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1419 $refresh->(); 1422 $refresh->();
1434 } 1437 }
1435 } 1438 }
1436 }; 1439 };
1437 1440
1438 my $vb = new CFPlus::UI::VBox; 1441 my $vb = new CFPlus::UI::VBox;
1442 $vb->add (new CFPlus::UI::FancyFrame
1443 label => "Options",
1439 $vb->add (my $hb = new CFPlus::UI::HBox); 1444 child => (my $hb = new CFPlus::UI::HBox),
1445 );
1440 $hb->add (new CFPlus::UI::Label text => "only shift-up stops fire"); 1446 $hb->add (new CFPlus::UI::Label text => "only shift-up stops fire");
1441 $hb->add (new CFPlus::UI::CheckBox 1447 $hb->add (new CFPlus::UI::CheckBox
1442 expand => 1, 1448 expand => 1,
1443 state => $CFG->{shift_fire_stop}, 1449 state => $CFG->{shift_fire_stop},
1444 tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift", 1450 tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1446 my ($cbox, $value) = @_; 1452 my ($cbox, $value) = @_;
1447 $CFG->{shift_fire_stop} = $value; 1453 $CFG->{shift_fire_stop} = $value;
1448 0 1454 0
1449 }); 1455 });
1450 1456
1451 $vb->add ($binding_list); 1457 $vb->add (new CFPlus::UI::FancyFrame
1458 label => "Bindings",
1459 child => $binding_list);
1452 $vb->add (my $hb = new CFPlus::UI::HBox); 1460 $vb->add (my $hb = new CFPlus::UI::HBox);
1453 1461
1454 $hb->add (new CFPlus::UI::Button 1462 $hb->add (new CFPlus::UI::Button
1455 text => "record new", 1463 text => "record new",
1456 expand => 1, 1464 expand => 1,
1489 1497
1490 $vb 1498 $vb
1491} 1499}
1492 1500
1493sub help_window { 1501sub help_window {
1494 my $win = new CFPlus::UI::FancyFrame 1502 my $win = new CFPlus::UI::Toplevel
1495 x => 'center', 1503 x => 'center',
1496 y => 'center', 1504 y => 'center',
1497 z => 2, 1505 z => 4,
1498 name => 'doc_browser', 1506 name => 'doc_browser',
1499 force_w => int $WIDTH * 7/8, 1507 force_w => int $WIDTH * 7/8,
1500 force_h => int $HEIGHT * 7/8, 1508 force_h => int $HEIGHT * 7/8,
1501 title => "Help Browser", 1509 title => "Help Browser",
1502 has_close_button => 1; 1510 has_close_button => 1;
1503 1511
1504 $win->add (my $vbox = new CFPlus::UI::VBox); 1512 $win->add (my $vbox = new CFPlus::UI::VBox);
1505 1513
1514 $vbox->add (new CFPlus::UI::FancyFrame
1515 label => "Navigation",
1506 $vbox->add (my $buttons = new CFPlus::UI::HBox); 1516 child => (my $buttons = new CFPlus::UI::HBox),
1517 );
1507 $vbox->add (my $viewer = new CFPlus::UI::TextScroller 1518 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1508 expand => 1, fontsize => 0.8, padding_x => 4); 1519 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1509 1520
1510 my @history; 1521 my @history;
1511 my @future; 1522 my @future;
1512 my $curnode; 1523 my $curnode;
1513 1524
1514 my $load_node; $load_node = sub { 1525 my $load_node; $load_node = sub {
1515 my ($node) = @_; 1526 my ($node, $para) = @_;
1516 1527
1517 $buttons->clear; 1528 $buttons->clear;
1529
1530 $buttons->add (new CFPlus::UI::Button
1531 text => "⇤",
1532 tooltip => "back to the starting page",
1533 on_activate => sub {
1534 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1535 unshift @future, @history;
1536 @history = ();
1537 $load_node->(@{shift @future});
1538 },
1539 );
1518 1540
1519 if (@history) { 1541 if (@history) {
1520 $buttons->add (new CFPlus::UI::Button 1542 $buttons->add (new CFPlus::UI::Button
1521 text => "⋘", 1543 text => "⋘",
1522 tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1]) . "</i>", 1544 tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
1523 on_activate => sub { 1545 on_activate => sub {
1524 unshift @future, $curnode if $curnode; 1546 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1525 $load_node->(pop @history); 1547 $load_node->(@{pop @history});
1526 }, 1548 },
1527 ); 1549 );
1528 } 1550 }
1529 1551
1530 if (@future) { 1552 if (@future) {
1531 $buttons->add (new CFPlus::UI::Button 1553 $buttons->add (new CFPlus::UI::Button
1532 text => "⋙", 1554 text => "⋙",
1533 tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0]) . "</i>", 1555 tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
1534 on_activate => sub { 1556 on_activate => sub {
1535 push @history, $curnode; 1557 push @history, [$curnode, $viewer->current_paragraph];
1536 $load_node->(shift @future); 1558 $load_node->(@{shift @future});
1537 }, 1559 },
1538 ); 1560 );
1539 } 1561 }
1540 1562
1541 $buttons->add (new CFPlus::UI::Label text => " "); 1563 $buttons->add (new CFPlus::UI::Label text => " ");
1546 for my $node (@path) { 1568 for my $node (@path) {
1547 $buttons->add (new CFPlus::UI::Button 1569 $buttons->add (new CFPlus::UI::Button
1548 text => $node->{kw}[0], 1570 text => $node->{kw}[0],
1549 tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>", 1571 tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
1550 on_activate => sub { 1572 on_activate => sub {
1551 push @history, $curnode if $curnode; @future = (); 1573 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1552 $load_node->($node); 1574 $load_node->($node);
1553 }, 1575 },
1554 ); 1576 );
1555 $buttons->add (new CFPlus::UI::Label text => "/"); 1577 $buttons->add (new CFPlus::UI::Label text => "/");
1556 } 1578 }
1557 1579
1558 $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0]); 1580 $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);
1559 1581
1560 $curnode = $node; 1582 $curnode = $node;
1561 1583
1562 $viewer->clear; 1584 $viewer->clear;
1563 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode); 1585 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
1564 $viewer->set_offset (0); 1586 $viewer->scroll_to ($para);
1565 }; 1587 };
1566 1588
1567 $load_node->(CFPlus::Pod::find pod => "mainpage"); 1589 $load_node->(CFPlus::Pod::find pod => "mainpage");
1568 1590
1569 $CFPlus::Pod::goto_document = sub { 1591 $CFPlus::Pod::goto_document = sub {
1570 my (@path) = @_; 1592 my (@path) = @_;
1571 1593
1572 push @history, $curnode if $curnode; @future = (); 1594 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1573 1595
1574 $load_node->(CFPlus::Pod::find @path); 1596 $load_node->((CFPlus::Pod::find @path)[0]);
1575 $win->show; 1597 $win->show;
1576 }; 1598 };
1577 1599
1578 $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;
1579} 1711}
1580 1712
1581sub sdl_init { 1713sub sdl_init {
1582 CFPlus::SDL_Init 1714 CFPlus::SDL_Init
1583 and die "SDL::Init failed!\n"; 1715 and die "SDL::Init failed!\n";
1630 force_x => 0, 1762 force_x => 0,
1631 force_y => "max", 1763 force_y => "max",
1632 child => $STATUSBOX, 1764 child => $STATUSBOX,
1633 )->show; 1765 )->show;
1634 1766
1635 CFPlus::UI::FancyFrame->new ( 1767 CFPlus::UI::Toplevel->new (
1636 title => "Map", 1768 title => "Map",
1637 name => "mapmap", 1769 name => "mapmap",
1638 x => 0, 1770 x => 0,
1639 y => $FONTSIZE + 8, 1771 y => $FONTSIZE + 8,
1640 border_bg => [1, 1, 1, 192/255], 1772 border_bg => [1, 1, 1, 192/255],
1668 can_hover => 1, 1800 can_hover => 1,
1669 can_events => 1, 1801 can_events => 1,
1670 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.", 1802 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1671 ; 1803 ;
1672 1804
1673 $SETUP_DIALOG = new CFPlus::UI::FancyFrame 1805 $SETUP_DIALOG = new CFPlus::UI::Toplevel
1674 title => "Setup", 1806 title => "Setup",
1675 name => "setup_dialog", 1807 name => "setup_dialog",
1676 x => 'center', 1808 x => 'center',
1677 y => 'center', 1809 y => 'center',
1678 z => 2, 1810 z => 2,
1789 CFPlus::Mix_AllocateChannels 8; 1921 CFPlus::Mix_AllocateChannels 8;
1790 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128; 1922 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
1791 1923
1792 audio_music_finished; 1924 audio_music_finished;
1793 1925
1926 local $_;
1794 while (<$fh>) { 1927 while (<$fh>) {
1795 next if /^\s*#/; 1928 next if /^\s*#/;
1796 next if /^\s*$/; 1929 next if /^\s*$/;
1797 1930
1798 my ($file, $volume, $event) = split /\s+/, $_, 3; 1931 my ($file, $volume, $event) = split /\s+/, $_, 3;
1932 log_fontsize => 0.7, 2065 log_fontsize => 0.7,
1933 gauge_fontsize => 1, 2066 gauge_fontsize => 1,
1934 gauge_size => 0.35, 2067 gauge_size => 0.35,
1935 stat_fontsize => 0.7, 2068 stat_fontsize => 0.7,
1936 mapsize => 100, 2069 mapsize => 100,
1937 say_command => 'say', 2070 say_command => 'chat',
1938 audio_enable => 1, 2071 audio_enable => 1,
1939 bgm_enable => 1, 2072 bgm_enable => 1,
1940 bgm_volume => 0.25, 2073 bgm_volume => 0.25,
1941 face_prefetch => 0, 2074 face_prefetch => 0,
1942 output_sync => 1, 2075 output_sync => 1,
1943 output_count => 1, 2076 output_count => 1,
1944 pickup => 0, 2077 pickup => 0,
1945 inv_sort => "mtime", 2078 inv_sort => "mtime",
1946 default => "profile", # default profile 2079 default => "profile", # default profile
2080 show_tips => 1,
1947 ); 2081 );
1948 2082
1949 while (my ($k, $v) = each %DEF_CFG) { 2083 while (my ($k, $v) = each %DEF_CFG) {
1950 $CFG->{$k} = $v unless exists $CFG->{$k}; 2084 $CFG->{$k} = $v unless exists $CFG->{$k};
1951 } 2085 }
1995# } 2129# }
1996# my $t2 = Time::HiRes::time; 2130# my $t2 = Time::HiRes::time;
1997# warn $t2-$t1; 2131# warn $t2-$t1;
1998# } 2132# }
1999 2133
2134 $startup_done->();
2135
2000 video_init; 2136 video_init;
2001 audio_init; 2137 audio_init;
2002} 2138}
2139
2140show_tip_of_the_day if $CFG->{show_tips};
2003 2141
2004Event::loop; 2142Event::loop;
2005#CFPlus::SDL_Quit; 2143#CFPlus::SDL_Quit;
2006#CFPlus::_exit 0; 2144#CFPlus::_exit 0;
2007 2145

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines