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.119 by root, Fri Sep 29 00:56:06 2006 UTC vs.
Revision 1.143 by root, Fri Mar 16 02:33:50 2007 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;
26
27use Carp 'verbose';
5 28
6# do things only needed for single-binary version (par) 29# do things only needed for single-binary version (par)
7BEGIN { 30BEGIN {
8 if (%PAR::LibCache) { 31 if (%PAR::LibCache) {
9 @INC = grep ref, @INC; # weed out all paths except pars loader refs 32 @INC = grep ref, @INC; # weed out all paths except pars loader refs
10 33
11 while (my ($filename, $zip) = each %PAR::LibCache) { 34 while (my ($filename, $zip) = each %PAR::LibCache) {
12 for ($zip->memberNames) { 35 for ($zip->memberNames) {
13 next unless /^\/root\/(.*)/; 36 next unless /^root\/(.*)/;
14 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") 37 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
15 unless -e "$ENV{PAR_TEMP}/$1"; 38 unless -e "$ENV{PAR_TEMP}/$1";
16 } 39 }
17 } 40 }
18 41
… …
36 59
37use CFPlus; 60use CFPlus;
38use CFPlus::OpenGL (); 61use CFPlus::OpenGL ();
39use CFPlus::Protocol; 62use CFPlus::Protocol;
40use CFPlus::UI; 63use CFPlus::UI;
64use CFPlus::UI::Inventory;
65use CFPlus::UI::SpellList;
41use CFPlus::Pod; 66use CFPlus::Pod;
42use CFPlus::BindingEditor;
43use CFPlus::MapWidget; 67use CFPlus::MapWidget;
68use CFPlus::Macro;
44 69
45$SIG{QUIT} = sub { Carp::cluck "QUIT" }; 70$SIG{QUIT} = sub { Carp::cluck "QUIT" };
46$SIG{PIPE} = 'IGNORE'; 71$SIG{PIPE} = 'IGNORE';
47 72
48$Event::Eval = 0; 73$Event::Eval = 1;
49$Event::DIED = sub { 74$Event::DIED = sub {
50 # TODO: display dialog box or so 75 CFPlus::fatal Carp::longmess $_[1]
51 Carp::cluck $_[1];#d#TODO: remove when stable
52 return;#d#
53 CFPlus::fatal ($_[1]);
54}; 76};
55
56our $VERSION = '0.9';
57 77
58my $MAX_FPS = 60; 78my $MAX_FPS = 60;
59my $MIN_FPS = 5; # unused as of yet 79my $MIN_FPS = 5; # unused as of yet
60 80
61our $META_SERVER = "crossfire.real-time.com:13326"; 81our $META_SERVER = "http://metaserver.schmorp.de/current.json";
62 82
63our $LAST_REFRESH; 83our $LAST_REFRESH;
64our $NOW; 84our $NOW;
65 85
66our $CFG; 86our $CFG;
67our $CONN; 87our $CONN;
88our $PROFILE; # current profile
68our $FAST; # fast, low-quality mode, possibly useful for software-rendering 89our $FAST; # fast, low-quality mode, possibly useful for software-rendering
69 90
70our $WANT_REFRESH; 91our $WANT_REFRESH;
71our $CAN_REFRESH; 92our $CAN_REFRESH;
72 93
… …
103 124
104our $INVENTORY_PAGE; 125our $INVENTORY_PAGE;
105our $STATS_PAGE; 126our $STATS_PAGE;
106our $SKILL_PAGE; 127our $SKILL_PAGE;
107our $SPELL_PAGE; 128our $SPELL_PAGE;
129our $SPELL_LIST;
108 130
109our $HELP_WINDOW; 131our $HELP_WINDOW;
110our $MESSAGE_WINDOW; 132our $MESSAGE_WINDOW;
111our $FLOORBOX; 133our $FLOORBOX;
112our $GAUGES; 134our $GAUGES;
… …
125 147
126our $INV; 148our $INV;
127our $INVR; 149our $INVR;
128our $INV_RIGHT_HB; 150our $INV_RIGHT_HB;
129 151
130our $BIND_EDITOR;
131our $BIND_UPD_CB;
132
133our $PICKUP_CFG; 152our $PICKUP_CFG;
153
154our $IN_BUILD_MODE;
155our $BUILD_BUTTON;
134 156
135sub status { 157sub status {
136 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 158 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
137} 159}
138 160
139sub debug { 161sub debug {
140 $DEBUG_STATUS->set_text ($_[0]); 162 $DEBUG_STATUS->set_text ($_[0]);
163}
164
165sub message {
166 my ($para) = @_;
167
168 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
169
170 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
171
172 $LOGVIEW->add_paragraph ($para);
173 $LOGVIEW->scroll_to_bottom;
141} 174}
142 175
143sub destroy_query_dialog { 176sub destroy_query_dialog {
144 (delete $_[0]{query_dialog})->destroy 177 (delete $_[0]{query_dialog})->destroy
145 if $_[0]{query_dialog}; 178 if $_[0]{query_dialog};
146} 179}
147 180
181# FIXME: a very ugly hack to wait for stat update look below! #d#
182our $QUERY_TIMER; #d#
183
148# server query dialog 184# server query dialog
149sub server_query { 185sub server_query {
150 my ($conn, $flags, $prompt) = @_; 186 my ($conn, $flags, $prompt) = @_;
187
188 # FIXME: a very ugly hack to wait for stat update #d#
189 if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
190 unless ($QUERY_TIMER) {
191 $QUERY_TIMER =
192 Event->timer (
193 after => 1,
194 cb => sub {
195 server_query ($conn, $flags, $prompt, 1);
196 $QUERY_TIMER = undef
197 }
198 );
199 return;
200 }
201 }
151 202
152 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel 203 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
153 x => "center", 204 x => "center",
154 y => "center", 205 y => "center",
155 title => "Server Query", 206 title => "Server Query",
… …
346 $LOGIN_BUTTON->set_text ("Logout"); 397 $LOGIN_BUTTON->set_text ("Logout");
347 $SETUP_DIALOG->hide; 398 $SETUP_DIALOG->hide;
348 399
349 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 400 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
350 401
351 my ($host, $port) = split /:/, $CFG->{profile}{default}{host}; 402 my ($host, $port) = split /:/, $PROFILE->{host};
352 403
353 $MAP = new CFPlus::Map $mapsize, $mapsize; 404 $MAP = new CFPlus::Map;
354 405
355 $CONN = eval { 406 $CONN = eval {
356 new CFPlus::Protocol 407 new CFPlus::Protocol
357 host => $host, 408 host => $host,
358 port => $port || 13327, 409 port => $port || 13327,
359 user => $CFG->{profile}{default}{user}, 410 user => $PROFILE->{user},
360 pass => $CFG->{profile}{default}{password}, 411 pass => $PROFILE->{password},
361 mapw => $mapsize, 412 mapw => $mapsize,
362 maph => $mapsize, 413 maph => $mapsize,
363 414
364 client => "cfplus $VERSION $] $^O", 415 client => "cfplus $CFPlus::VERSION $] $^O",
365 416
366 map_widget => $MAPWIDGET, 417 map_widget => $MAPWIDGET,
367 logview => $LOGVIEW, 418 logview => $LOGVIEW,
368 statusbox => $STATUSBOX, 419 statusbox => $STATUSBOX,
369 map => $MAP, 420 map => $MAP,
… …
396sub stop_game { 447sub stop_game {
397 $LOGIN_BUTTON->set_text ("Login"); 448 $LOGIN_BUTTON->set_text ("Login");
398 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER); 449 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
399 $SETUP_DIALOG->show; 450 $SETUP_DIALOG->show;
400 $PL_WINDOW->hide; 451 $PL_WINDOW->hide;
401 $SPELL_PAGE->clear_spells; 452 $SPELL_LIST->clear_spells;
402 453
403 return unless $CONN; 454 return unless $CONN;
404 455
405 status "connection closed"; 456 status "connection closed";
406 457
… …
633 $table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 }); 684 $table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
634 $table->add (0, 2, new CFPlus::UI::Label text => "Show FPS"); 685 $table->add (0, 2, new CFPlus::UI::Label text => "Show FPS");
635 $table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 }); 686 $table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
636 $table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips"); 687 $table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
637 $table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 }); 688 $table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
689 $table->add (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { die "violator" } );
638 690
639 my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05); 691 my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);
640 692
641 for my $x (0..2) { 693 for my $x (0..2) {
642 for my $y (0 .. 2) { 694 for my $y (0 .. 2) {
… …
646 on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 }, 698 on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 },
647 ); 699 );
648 } 700 }
649 } 701 }
650 702
703 $table->add (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#
651 704
652 $table 705 $table
653} 706}
654 707
655sub stats_window { 708sub stats_window {
… …
824 877
825 my $table = $METASERVER->{table}; 878 my $table = $METASERVER->{table};
826 $table->clear; 879 $table->clear;
827 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); 880 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
828 881
829 my $buf; 882 my $ok = 0;
830 883
831 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 884 CFPlus::background {
885 my $ua = CFPlus::lwp_useragent;
832 886
833 unless ($fh) { 887 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
834 $label->set_text ("unable to contact metaserver: $!"); 888 } sub {
835 return; 889 my ($msg) = @_;
836 } 890 if ($msg) {
837
838 Event->io (fd => $fh, poll => 'r', cb => sub {
839 my $res = sysread $fh, $buf, 8192, length $buf;
840
841 if (!defined $res) {
842 $_[0]->w->cancel;
843 $label->set_text ("error while retrieving server list: $!");
844 } elsif ($res == 0) {
845 $_[0]->w->cancel;
846 status "server list retrieved";
847
848 utf8::decode $buf if utf8::valid $buf;
849
850 $table->clear; 891 $table->clear;
851 892
852 my @tip = ( 893 my @tip = (
853 "The current number of users logged in on the server.", 894 "The current number of users logged in on the server.",
854 "The hostname of the server.", 895 "The hostname of the server.",
… …
864 for 0 .. $#col; 905 for 0 .. $#col;
865 906
866 my @align = qw(1 0 1 1 -1); 907 my @align = qw(1 0 1 1 -1);
867 908
868 my $y = 0; 909 my $y = 0;
869 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) { 910 for my $m (@{ $msg->{servers} }) {
870 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; 911 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
912 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
871 913
872 for ($desc) { 914 for ($desc) {
873 s/<br>/\n/gi; 915 s/<br>/\n/gi;
874 s/<li>/\n· /gi; 916 s/<li>/\n· /gi;
875 s/<.*?>//sgi; 917 s/<.*?>//sgi;
876 s/&/&amp;/g; 918 s/&amp;/&/g;
877 s/</&lt;/g; 919 s/&lt;/</g;
878 s/>/&gt;/g; 920 s/&gt;/>/g;
879 } 921 }
880 922
881 $uptime = sprintf "%dd %02d:%02d:%02d", 923 $uptime = sprintf "%dd %02d:%02d:%02d",
882 (int $m->[8] / 86400), 924 (int $uptime / 86400),
883 (int $m->[8] / 3600) % 24, 925 (int $uptime / 3600) % 24,
884 (int $m->[8] / 60) % 60, 926 (int $uptime / 60) % 60,
885 $m->[8] % 60; 927 $uptime % 60;
886 928
887 $m = [$users, $host, $uptime, $version, $desc]; 929 $m = [$users, $host, $uptime, $version, $desc];
888 930
889 $y++; 931 $y++;
890 932
… …
900 ), 942 ),
901 (new CFPlus::UI::Empty expand => 1), 943 (new CFPlus::UI::Empty expand => 1),
902 ]); 944 ]);
903 945
904 $table->add ($_, $y, new CFPlus::UI::Label 946 $table->add ($_, $y, new CFPlus::UI::Label
947 max_w => $::WIDTH * 0.4,
905 ellipsise => 0, 948 ellipsise => 0,
906 align => $align[$_], 949 align => $align[$_],
907 text => $m->[$_], 950 text => $m->[$_],
908 tooltip => $tip[$_], 951 tooltip => $tip[$_],
952 fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
909 can_hover => 1, 953 can_hover => 1,
910 can_events => 1, 954 can_events => 1,
911 fontsize => 0.8) 955 fontsize => 0.8)
912 for 0 .. $#$m; 956 for 0 .. $#$m;
913 } 957 }
958 } else {
959 $ok or $label->set_text ("error while contacting metaserver");
914 } 960 }
915 }); 961 };
962
916} 963}
917 964
918sub metaserver_dialog { 965sub metaserver_dialog {
919 my $vbox = new CFPlus::UI::VBox; 966 my $vbox = new CFPlus::UI::VBox;
920 my $table = new CFPlus::UI::Table; 967 my $table = new CFPlus::UI::Table;
… …
924 title => "Server List", 971 title => "Server List",
925 name => 'metaserver_dialog', 972 name => 'metaserver_dialog',
926 x => 'center', 973 x => 'center',
927 y => 'center', 974 y => 'center',
928 z => 3, 975 z => 3,
976 force_w => $::WIDTH * 0.9,
929 force_h => $::HEIGHT * 0.4, 977 force_h => $::HEIGHT * 0.7,
930 child => $vbox, 978 child => $vbox,
931 has_close_button => 1, 979 has_close_button => 1,
932 table => $table, 980 table => $table,
933 on_visibility_change => sub { 981 on_visibility_change => sub {
934 update_metaserver ($_[0]) if $_[1]; 982 update_metaserver ($_[0]) if $_[1];
… …
1010 . "so only set it if you really need to prefetch images. " 1058 . "so only set it if you really need to prefetch images. "
1011 . "This option can be set and unset any time.", 1059 . "This option can be set and unset any time.",
1012 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 }, 1060 on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1013 ); 1061 );
1014 1062
1015 $table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count"); 1063 $table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
1016 $table->add (1, 9, new CFPlus::UI::Entry 1064 $table->add (1, 9, new CFPlus::UI::Entry
1065 text => $CFG->{output_rate},
1066 tooltip => "The approximate bandwidth in bytes per second that the server should not exceed "
1067 . "when sending images, to ensure interactiveness. When 0 or unset, the server "
1068 . "default will be used, which is usually around 100kb/s.",
1069 on_changed => sub { $CFG->{output_rate} = $_[1]; 0 },
1070 );
1071
1072 $table->add (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
1073 $table->add (1, 10, new CFPlus::UI::Entry
1017 text => $CFG->{output_count}, 1074 text => $CFG->{output_count},
1018 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 1075 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1019 on_changed => sub { $CFG->{output_count} = $_[1]; 0 }, 1076 on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1020 ); 1077 );
1021 1078
1022 $table->add (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync"); 1079 $table->add (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
1023 $table->add (1, 10, new CFPlus::UI::Entry 1080 $table->add (1, 11, new CFPlus::UI::Entry
1024 text => $CFG->{output_sync}, 1081 text => $CFG->{output_sync},
1025 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 1082 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1026 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 }, 1083 on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1027 ); 1084 );
1028 1085
1029 $table->add (1, 11, $LOGIN_BUTTON = new CFPlus::UI::Button 1086 $table->add (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button
1030 expand => 1, 1087 expand => 1,
1031 align => 0, 1088 align => 0,
1032 text => "Login", 1089 text => "Login",
1033 on_activate => sub { 1090 on_activate => sub {
1034 $CONN ? stop_game 1091 $CONN ? stop_game
1035 : start_game; 1092 : start_game;
1036 0 1093 0
1037 }, 1094 },
1038 ); 1095 );
1039 1096
1040 $table->add (0, 12, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command"); 1097 $table->add (0, 13, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
1041 $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry 1098 $table->add (1, 13, my $saycmd = new CFPlus::UI::Entry
1042 text => $CFG->{say_command}, 1099 text => $CFG->{say_command},
1043 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. " 1100 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. "
1044 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. " 1101 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1045 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.", 1102 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1046 on_changed => sub { 1103 on_changed => sub {
… …
1048 $CFG->{say_command} = $value; 1105 $CFG->{say_command} = $value;
1049 0 1106 0
1050 } 1107 }
1051 ); 1108 );
1052 1109
1053 $table->add (0, 13, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day"); 1110 $table->add (0, 14, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
1054 $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox 1111 $table->add (1, 14, my $saycmd = new CFPlus::UI::CheckBox
1055 state => $CFG->{show_tips}, 1112 state => $CFG->{show_tips},
1056 tooltip => "Show the <b>Tip of the day</b> window at startup?", 1113 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1057 on_changed => sub { 1114 on_changed => sub {
1058 my ($self, $value) = @_; 1115 my ($self, $value) = @_;
1059 $CFG->{shop_tips} = $value; 1116 $CFG->{show_tips} = $value;
1060 0 1117 0
1061 } 1118 }
1062 ); 1119 );
1063 1120
1064 $vbox->add (new CFPlus::UI::FancyFrame 1121 $vbox->add (new CFPlus::UI::FancyFrame
… …
1155 ["Boots" => PICKUP_BOOTS], 1212 ["Boots" => PICKUP_BOOTS],
1156 ["Gloves" => PICKUP_GLOVES], 1213 ["Gloves" => PICKUP_GLOVES],
1157 ["Cloaks" => PICKUP_CLOAK], 1214 ["Cloaks" => PICKUP_CLOAK],
1158 ], 1215 ],
1159 1216
1160 ["Readables", 2, 2, 1217 ["Readables", 2, 0,
1161 ["Spellbooks" => PICKUP_SPELLBOOK], 1218 ["Spellbooks" => PICKUP_SPELLBOOK],
1162 ["Skillscrolls" => PICKUP_SKILLSCROLL], 1219 ["Skillscrolls" => PICKUP_SKILLSCROLL],
1163 ["Normal Books/Scrolls" => PICKUP_READABLES], 1220 ["Normal Books/Scrolls" => PICKUP_READABLES],
1164 ], 1221 ],
1165 ["Misc", 2, 7, 1222 ["Misc", 2, 5,
1166 ["Food" => PICKUP_FOOD], 1223 ["Food" => PICKUP_FOOD],
1167 ["Drinks" => PICKUP_DRINK], 1224 ["Drinks" => PICKUP_DRINK],
1168 ["Valuables (Money, Gems)" => PICKUP_VALUABLES], 1225 ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1169 ["Keys" => PICKUP_KEY], 1226 ["Keys" => PICKUP_KEY],
1170 ["Magical Items" => PICKUP_MAGICAL], 1227 ["Magical Items" => PICKUP_MAGICAL],
1171 ["Potions" => PICKUP_POTION], 1228 ["Potions" => PICKUP_POTION],
1172 ["Magic Devices" => PICKUP_MAGIC_DEVICE], 1229 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1173 ["Ignore cursed" => PICKUP_NOT_CURSED], 1230 ["Ignore cursed" => PICKUP_NOT_CURSED],
1174 ["Jewelery" => PICKUP_JEWELS], 1231 ["Jewelery" => PICKUP_JEWELS],
1232 ["Flesh" => PICKUP_FLESH],
1175 ], 1233 ],
1176 ["Weight/Value ratio", 2, 17] 1234 ["Weight/Value ratio", 2, 17]
1177 ) 1235 )
1178 { 1236 {
1179 my ($title, $x, $y, @bits) = @$_; 1237 my ($title, $x, $y, @bits) = @$_;
… …
1229 $table 1287 $table
1230} 1288}
1231 1289
1232my %SORT_ORDER = ( 1290my %SORT_ORDER = (
1233 type => undef, 1291 type => undef,
1234 mtime => sub { sort { 1292 mtime => sub {
1293 my $NOW = time;
1294 sort {
1295 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1296 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1297
1235 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) 1298 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1236 or $b->{mtime} <=> $a->{mtime} 1299 or $btime <=> $atime
1237 or $a->{type} <=> $b->{type} 1300 or $a->{type} <=> $b->{type}
1301 } @_
1238 } @_ }, 1302 },
1239 weight => sub { sort { 1303 weight => sub { sort {
1240 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1) 1304 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1241 or $a->{type} <=> $b->{type} 1305 or $a->{type} <=> $b->{type}
1242 } @_ }, 1306 } @_ },
1243); 1307);
… …
1268 #TODO# update to weigh/maxweight 1332 #TODO# update to weigh/maxweight
1269 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); 1333 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1270 1334
1271 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); 1335 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1272 $sw1->add ($INV = new CFPlus::UI::Inventory); 1336 $sw1->add ($INV = new CFPlus::UI::Inventory);
1337 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1273 1338
1274 $hb->add (my $vb2 = new CFPlus::UI::VBox); 1339 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1275 1340
1276 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); 1341 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1277 1342
… …
1317 $ntb->add ( 1382 $ntb->add (
1318 "Skills (F3)" => $SKILL_PAGE = skill_window, 1383 "Skills (F3)" => $SKILL_PAGE = skill_window,
1319 "Shows all your Skills." 1384 "Shows all your Skills."
1320 ); 1385 );
1321 1386
1322 my $spellsw = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1); 1387 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1323 $spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList); 1388 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1324 $ntb->add ( 1389 $ntb->add (
1325 "Spellbook (F4)" => $spellsw, 1390 "Spellbook (F4)" => $spellsw,
1326 "Displays all spells you have and lets you edit keyboard shortcuts for them." 1391 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1327 ); 1392 );
1328 $ntb->add ( 1393 $ntb->add (
… …
1335 1400
1336 $plwin->add ($ntb); 1401 $plwin->add ($ntb);
1337 $plwin 1402 $plwin
1338} 1403}
1339 1404
1340sub update_bindings {
1341 $BIND_UPD_CB->() if $BIND_UPD_CB;
1342}
1343
1344sub keyboard_setup { 1405sub keyboard_setup {
1345 my $binding_list = new CFPlus::UI::VBox; 1406 CFPlus::Macro::keyboard_setup
1346
1347 my $refresh;
1348 $refresh = $BIND_UPD_CB = sub {
1349 $binding_list->clear ();
1350
1351 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1352 for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1353 my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1354 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1355
1356 my $lbl = join "; ", @$cmds;
1357 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym);
1358 $binding_list->add (my $hb = new CFPlus::UI::HBox);
1359 $hb->add (new CFPlus::UI::Button
1360 text => "delete",
1361 tooltip => "Deletes the binding",
1362 on_activate => sub {
1363 $binding_list->remove ($hb);
1364 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1365 0
1366 });
1367
1368 $hb->add (new CFPlus::UI::Button
1369 text => "edit",
1370 tooltip => "Edits the binding",
1371 on_activate => sub {
1372 $::BIND_EDITOR->set_binding (
1373 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1374 sub {
1375 my ($nmod, $nsym, $ncmds) = @_;
1376 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1377 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1378 $refresh->();
1379 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1380 $SETUP_DIALOG->show;
1381 },
1382 sub {
1383 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1384 $SETUP_DIALOG->show;
1385 });
1386 $::BIND_EDITOR->show;
1387 $SETUP_DIALOG->hide;
1388 0
1389 });
1390
1391 $hb->add (new CFPlus::UI::Label text => "(Key: $nam)");
1392 $hb->add (new CFPlus::UI::Label text => $lbl, expand => 1);
1393 }
1394 }
1395 };
1396
1397 my $vb = new CFPlus::UI::VBox;
1398 $vb->add (new CFPlus::UI::FancyFrame
1399 label => "Options",
1400 child => (my $hb = new CFPlus::UI::HBox),
1401 );
1402 $hb->add (new CFPlus::UI::Label text => "only shift-up stops fire");
1403 $hb->add (new CFPlus::UI::CheckBox
1404 expand => 1,
1405 state => $CFG->{shift_fire_stop},
1406 tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1407 on_changed => sub {
1408 my ($cbox, $value) = @_;
1409 $CFG->{shift_fire_stop} = $value;
1410 0
1411 });
1412
1413 $vb->add (new CFPlus::UI::FancyFrame
1414 label => "Bindings",
1415 child => $binding_list);
1416 $vb->add (my $hb = new CFPlus::UI::HBox);
1417
1418 $hb->add (new CFPlus::UI::Button
1419 text => "record new",
1420 expand => 1,
1421 tooltip => "This button opens the binding editor with an empty binding.",
1422 on_activate => sub {
1423 $::BIND_EDITOR->set_binding (undef, undef, [],
1424 sub {
1425 my ($mod, $sym, $cmds) = @_;
1426 $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1427 $refresh->();
1428 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1429 $SETUP_DIALOG->show;
1430 },
1431 sub {
1432 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1433 $SETUP_DIALOG->show;
1434 },
1435 );
1436 $SETUP_DIALOG->hide;
1437 $::BIND_EDITOR->show;
1438 0
1439 },
1440 );
1441
1442 $hb->add (new CFPlus::UI::Button
1443 text => "close",
1444 tooltip => "Closes the binding window",
1445 expand => 1,
1446 on_activate => sub {
1447 $SETUP_DIALOG->hide;
1448 0
1449 }
1450 );
1451
1452 $refresh->();
1453
1454 $vb
1455} 1407}
1456 1408
1457sub help_window { 1409sub help_window {
1458 my $win = new CFPlus::UI::Toplevel 1410 my $win = new CFPlus::UI::Toplevel
1459 x => 'center', 1411 x => 'center',
… …
1644 1596
1645 $vbox->add (my $viewer = new CFPlus::UI::TextScroller 1597 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1646 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4); 1598 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1647 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]); 1599 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
1648 1600
1649 $vbox->add (my $table = new CFPlus::UI::Table); 1601 $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);
1650 1602
1651 $table->add (0, 0, new CFPlus::UI::Button 1603 $table->add (0, 0, new CFPlus::UI::Button
1652 text => "Close", 1604 text => "Close",
1653 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>.", 1605 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>.",
1654 on_activate => $close, 1606 on_activate => $close,
1655 ); 1607 );
1656 1608
1657 $table->add (2, 0, new CFPlus::UI::Button 1609 $table->add (2, 0, new CFPlus::UI::Button
1658 text => "Next", 1610 text => "Next",
1659 tooltip => "Show the next <b>Tip of the day</b>.", 1611 tooltip => "Show the next <b>Tip of the day</b>.",
1660 on_activate => sub { 1612 on_activate => sub {
1661 $close->(); 1613 $close->();
1662 &show_tip_of_the_day; 1614 &show_tip_of_the_day;
1663 }, 1615 },
… …
1705 padding => 0, 1657 padding => 0,
1706 z => 100, 1658 z => 100,
1707 force_x => "max", 1659 force_x => "max",
1708 force_y => 0; 1660 force_y => 0;
1709 $DEBUG_STATUS->show; 1661 $DEBUG_STATUS->show;
1710
1711 $BIND_EDITOR = new CFPlus::BindingEditor (x => "max", y => 0);
1712 1662
1713 $STATUSBOX = new CFPlus::UI::Statusbox; 1663 $STATUSBOX = new CFPlus::UI::Statusbox;
1714 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]); 1664 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1715 1665
1716 (new CFPlus::UI::Frame 1666 (new CFPlus::UI::Frame
… …
1817 ); 1767 );
1818 1768
1819 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window, 1769 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1820 tooltip => "View Documentation"); 1770 tooltip => "View Documentation");
1821 1771
1772
1822 $BUTTONBAR->add (new CFPlus::UI::Button 1773 $BUTTONBAR->add (new CFPlus::UI::Button
1823 text => "Quit", 1774 text => "Quit",
1824 tooltip => "Terminates the program", 1775 tooltip => "Terminates the program",
1825 on_activate => sub { 1776 on_activate => sub {
1826 if ($CONN) { 1777 if ($CONN) {
… …
1837 } 1788 }
1838 1789
1839 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); 1790 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1840} 1791}
1841 1792
1793sub setup_build_button {
1794 my ($enabled) = @_;
1795 if ($enabled) {
1796 $BUILD_BUTTON->hide if $BUILD_BUTTON;
1797 $BUILD_BUTTON ||= new CFPlus::UI::Button
1798 text => "Build",
1799 tooltip => "Opens the ingame builder",
1800 on_activate => sub {
1801 if ($CONN) {
1802 $CONN->send_ext_req (builder_player_items => sub {
1803 open_ingame_editor ($_[0]) if exists $_[0]->{items};
1804 });
1805 }
1806 0
1807 };
1808 $BUTTONBAR->add ($BUILD_BUTTON);
1809 } else {
1810 $BUILD_BUTTON->hide if $BUILD_BUTTON;
1811 }
1812}
1813
1814sub open_ingame_editor {
1815 my ($msg) = @_;
1816
1817 my $win = new CFPlus::UI::Toplevel
1818 x => 0,
1819 y => 'center',
1820 z => 4,
1821 name => 'builder_window',
1822 force_w => int $WIDTH * 1/4,
1823 force_h => int $HEIGHT * 3/4,
1824 title => "In game builder",
1825 has_close_button => 1;
1826
1827 my $r = new CFPlus::UI::ScrolledWindow (
1828 expand => 1,
1829 scroll_y => 1
1830 );
1831 $r->add (my $vb = new CFPlus::UI::VBox);
1832 $win->add ($r);
1833
1834
1835 $vb->add (
1836 new CFPlus::UI::Button
1837 text => "Disable build mode",
1838 on_activate => sub { $::IN_BUILD_MODE = undef }
1839 );
1840 $vb->add (
1841 new CFPlus::UI::Button
1842 text => "ERASE",
1843 on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } }
1844 );
1845
1846 for my $itemarchname (
1847 sort {
1848 $msg->{items}->{$a}->{build_arch_name}
1849 cmp $msg->{items}->{$b}->{build_arch_name}
1850 } keys %{$msg->{items}}
1851 ) {
1852 my $info = $msg->{items}->{$itemarchname};
1853 $vb->add (
1854 new CFPlus::UI::Button text => $info->{build_arch_name},
1855 on_activate => sub {
1856 $::IN_BUILD_MODE = { item => $itemarchname, info => $info };
1857
1858 if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) {
1859 build_mode_query_arch_info ();
1860 }
1861 }
1862 );
1863 }
1864
1865 $win->show;
1866}
1867
1868sub build_mode_query_arch_info {
1869 my ($iteminfo) = $::IN_BUILD_MODE;
1870 my $itemarchname = $iteminfo->{item};
1871 my $info = $iteminfo->{info};
1872
1873 my $dialog = new CFPlus::UI::Toplevel
1874 x => "center",
1875 y => "center",
1876 z => 50,
1877 force_w => int $WIDTH * 1/2,
1878 title => "Enter information for placement of '$itemarchname'",
1879 has_close_button => 1;
1880
1881 $dialog->add (my $vb = new CFPlus::UI::VBox expand => 1);
1882
1883 $vb->add (my $table = new CFPlus::UI::Table expand => 1);
1884 my $row = 0;
1885 if ($info->{has_name}) {
1886 $table->add (0, $row, new CFPlus::UI::Label text => "Name:");
1887 $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 });
1888 }
1889 if ($info->{has_text}) {
1890 $table->add (0, $row, new CFPlus::UI::Label text => "Text:");
1891 $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 });
1892 }
1893 if ($info->{has_connection}) {
1894 $table->add (0, $row, new CFPlus::UI::Label text => "Connection ID:");
1895 $table->add (1, $row++,
1896 new CFPlus::UI::Entry
1897 expand => 1,
1898 on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 },
1899 tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate"
1900 );
1901 }
1902
1903 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1904 $hb->add (new CFPlus::UI::Button
1905 text => "Close",
1906 expand => 1,
1907 on_activate => sub { $dialog->hide; 0 },
1908 );
1909 $dialog->show;
1910}
1911
1842sub video_shutdown { 1912sub video_shutdown {
1843 CFPlus::OpenGL::shutdown; 1913 CFPlus::OpenGL::shutdown;
1844 1914
1845 undef $SDL_ACTIVE; 1915 undef $SDL_ACTIVE;
1846} 1916}
… …
1877 CFPlus::Mix_AllocateChannels 8; 1947 CFPlus::Mix_AllocateChannels 8;
1878 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128; 1948 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
1879 1949
1880 audio_music_finished; 1950 audio_music_finished;
1881 1951
1952 local $_;
1882 while (<$fh>) { 1953 while (<$fh>) {
1883 next if /^\s*#/; 1954 next if /^\s*#/;
1884 next if /^\s*$/; 1955 next if /^\s*$/;
1885 1956
1886 my ($file, $volume, $event) = split /\s+/, $_, 3; 1957 my ($file, $volume, $event) = split /\s+/, $_, 3;
… …
1971 }, 2042 },
1972 CFPlus::SDL_VIDEOEXPOSE => sub { 2043 CFPlus::SDL_VIDEOEXPOSE => sub {
1973 CFPlus::UI::full_refresh; 2044 CFPlus::UI::full_refresh;
1974 }, 2045 },
1975 CFPlus::SDL_ACTIVEEVENT => sub { 2046 CFPlus::SDL_ACTIVEEVENT => sub {
1976# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 2047# not useful, as APPACTIVE include sonly iconified state, not unmapped
2048# printf "active %x %x\n", $_[0]{gain}, $_[0]{state};#d#
2049# printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
2050# printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
2051# printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
1977 }, 2052 },
1978 CFPlus::SDL_KEYDOWN => sub { 2053 CFPlus::SDL_KEYDOWN => sub {
1979 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) { 2054 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
1980 # alt-enter 2055 # alt-enter
1981 $FULLSCREEN_ENABLE->toggle; 2056 $FULLSCREEN_ENABLE->toggle;
… …
2020 log_fontsize => 0.7, 2095 log_fontsize => 0.7,
2021 gauge_fontsize => 1, 2096 gauge_fontsize => 1,
2022 gauge_size => 0.35, 2097 gauge_size => 0.35,
2023 stat_fontsize => 0.7, 2098 stat_fontsize => 0.7,
2024 mapsize => 100, 2099 mapsize => 100,
2025 say_command => 'say', 2100 say_command => 'chat',
2026 audio_enable => 1, 2101 audio_enable => 1,
2027 bgm_enable => 1, 2102 bgm_enable => 1,
2028 bgm_volume => 0.25, 2103 bgm_volume => 0.25,
2029 face_prefetch => 0, 2104 face_prefetch => 0,
2030 output_sync => 1, 2105 output_sync => 1,
2031 output_count => 1, 2106 output_count => 1,
2107 output_rate => "",
2032 pickup => 0, 2108 pickup => 0,
2033 inv_sort => "mtime", 2109 inv_sort => "mtime",
2034 default => "profile", # default profile 2110 default => "profile", # default profile
2035 show_tips => 1, 2111 show_tips => 1,
2036 ); 2112 );
… …
2038 while (my ($k, $v) = each %DEF_CFG) { 2114 while (my ($k, $v) = each %DEF_CFG) {
2039 $CFG->{$k} = $v unless exists $CFG->{$k}; 2115 $CFG->{$k} = $v unless exists $CFG->{$k};
2040 } 2116 }
2041 2117
2042 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de"; 2118 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
2119 $PROFILE = $CFG->{profile}{default};
2120
2121 # convert old bindings (only default profile matters)
2122 if (my $bindings = delete $PROFILE->{bindings}) {
2123 while (my ($mod, $syms) = each %$bindings) {
2124 while (my ($sym, $cmds) = each %$syms) {
2125 push @{ $PROFILE->{macro} }, {
2126 accelkey => [$mod*1, $sym*1],
2127 action => $cmds,
2128 };
2129 }
2130 }
2131 }
2043 2132
2044 sdl_init; 2133 sdl_init;
2045 2134
2046 @SDL_MODES = reverse 2135 @SDL_MODES = reverse
2047 grep $_->[0] >= 640 && $_->[1] >= 480, 2136 grep $_->[0] >= 640 && $_->[1] >= 480,
… …
2084# } 2173# }
2085# my $t2 = Time::HiRes::time; 2174# my $t2 = Time::HiRes::time;
2086# warn $t2-$t1; 2175# warn $t2-$t1;
2087# } 2176# }
2088 2177
2178 $startup_done->();
2179
2089 video_init; 2180 video_init;
2090 audio_init; 2181 audio_init;
2091} 2182}
2092 2183
2093show_tip_of_the_day if $CFG->{show_tips}; 2184show_tip_of_the_day if $CFG->{show_tips};

Diff Legend

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