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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.198 by root, Fri May 5 19:10:16 2006 UTC vs.
Revision 1.223 by elmex, Wed May 17 14:55:15 2006 UTC

… …
37use CFClient; 37use CFClient;
38use CFClient::UI; 38use CFClient::UI;
39use CFClient::MapWidget; 39use CFClient::MapWidget;
40 40
41$Event::DIED = sub { 41$Event::DIED = sub {
42 # TODO: display dialog box or so
42 CFClient::error $_[1]; 43 CFClient::error $_[1];
43}; 44};
44 45
45#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d# 46#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
46 47
… …
59our $NOW; 60our $NOW;
60 61
61our $CFG; 62our $CFG;
62our $CONN; 63our $CONN;
63our $FAST; # fast, low-quality mode, possibly useful for software-rendering 64our $FAST; # fast, low-quality mode, possibly useful for software-rendering
65
66our $WANT_REFRESH;
67our $CAN_REFRESH;
64 68
65our @SDL_MODES; 69our @SDL_MODES;
66our $WIDTH; 70our $WIDTH;
67our $HEIGHT; 71our $HEIGHT;
68our $FULLSCREEN; 72our $FULLSCREEN;
… …
76our $MAPWIDGET; 80our $MAPWIDGET;
77our $BUTTONBAR; 81our $BUTTONBAR;
78our $LOGVIEW; 82our $LOGVIEW;
79our $CONSOLE; 83our $CONSOLE;
80our $METASERVER; 84our $METASERVER;
85our $LOGIN_BUTTON;
81 86
82our $FLOORBOX; 87our $FLOORBOX;
83our $GAUGES; 88our $GAUGES;
84our $STATWIDS; 89our $STATWIDS;
85 90
… …
89our $SDL_MIXER; 94our $SDL_MIXER;
90our @SOUNDS; # event => file mapping 95our @SOUNDS; # event => file mapping
91our %AUDIO_CHUNKS; # audio files 96our %AUDIO_CHUNKS; # audio files
92 97
93our $ALT_ENTER_MESSAGE; 98our $ALT_ENTER_MESSAGE;
94our $STATUS_LINE; 99our $STATUSBOX;
95our $DEBUG_STATUS; 100our $DEBUG_STATUS;
96 101
97our $INVWIN; 102our $INVWIN;
98our $INV; 103our $INV;
104our $INVR;
105our $INVR_LBL;
106our $OPENCONT;
99 107
100sub status { 108sub status {
101 $STATUS_LINE->set_text ($_[0]); 109 $STATUSBOX->add ($_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
102 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
103} 110}
104 111
105sub debug { 112sub debug {
106 $DEBUG_STATUS->set_text ($_[0]); 113 $DEBUG_STATUS->set_text ($_[0]);
107 $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h}); 114 my ($w, $h) = $DEBUG_STATUS->size_request;
115 $DEBUG_STATUS->move ($WIDTH - $w, 0);
108} 116}
109 117
110sub start_game { 118sub start_game {
111 status "logging in..."; 119 status "logging in...";
112 120
113 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 121 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
114 122
115 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; 123 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
116
117 $MAP = new CFClient::Map $mapsize, $mapsize; 124 $MAP = new CFClient::Map $mapsize, $mapsize;
118 125
119 my ($host, $port) = split /:/, $CFG->{host}; 126 my ($host, $port) = split /:/, $CFG->{host};
120 127
121 $CONN = eval { 128 $CONN = eval {
… …
128 maph => $mapsize, 135 maph => $mapsize,
129 ; 136 ;
130 }; 137 };
131 138
132 if ($CONN) { 139 if ($CONN) {
140 $LOGIN_BUTTON->set_text ("Logout");
141
133 status "login successful"; 142 status "login successful";
134 143
135 CFClient::lowdelay fileno $CONN->{fh}; 144 CFClient::lowdelay fileno $CONN->{fh};
136 } else { 145 } else {
137 status "unable to connect"; 146 status "unable to connect";
147 stop_game();
138 } 148 }
139} 149}
140 150
141sub stop_game { 151sub stop_game {
152 return unless $CONN;
153
154 status "connection closed";
155 $LOGIN_BUTTON->set_text ("Login");
156 $CONN->destroy;
157 $CONN = 0; # false, does not autovivify
158
159 undef $MAPCACHE;
142 undef $CONN; 160 undef $MAP;
143} 161}
144 162
145sub client_setup { 163sub client_setup {
146 my $dialog = new CFClient::UI::FancyFrame 164 my $dialog = new CFClient::UI::FancyFrame
147 title => "Client Setup", 165 title => "Client Setup",
… …
149 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 167 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
150 168
151 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); 169 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
152 $table->add (1, 0, my $hbox = new CFClient::UI::HBox); 170 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
153 171
154 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]); 172 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 1, 1]);
155 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999"); 173 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
156 174
157 $mode_slider->connect (changed => sub { 175 $mode_slider->connect (changed => sub {
158 my ($self, $value) = @_; 176 my ($self, $value) = @_;
159 177
… …
184 } 202 }
185 ); 203 );
186 204
187 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale"); 205 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
188 $table->add (1, $row++, new CFClient::UI::Slider 206 $table->add (1, $row++, new CFClient::UI::Slider
189 range => [$CFG->{map_scale}, 0.25, 2, 0.05], 207 range => [$CFG->{map_scale}, 0.25, 2, 0.05, 0.05],
190 tooltip => "Enlarge or shrink the displayed map", 208 tooltip => "Enlarge or shrink the displayed map",
191 connect_changed => sub { 209 connect_changed => sub {
192 my ($self, $value) = @_; 210 my ($self, $value) = @_;
193 $CFG->{map_scale} = 0.05 * int $value / 0.05; 211 $CFG->{map_scale} = $value;
194 } 212 }
195 ); 213 );
196 214
197 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 215 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
198 $table->add (1, $row++, new CFClient::UI::CheckBox 216 $table->add (1, $row++, new CFClient::UI::CheckBox
… …
225 } 243 }
226 ); 244 );
227 245
228 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 246 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
229 $table->add (1, $row++, new CFClient::UI::Slider 247 $table->add (1, $row++, new CFClient::UI::Slider
230 range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1], 248 range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1, 0.1],
231 tooltip => "The font size used by most GUI elements", 249 tooltip => "The font size used by most GUI elements",
232 connect_changed => sub { 250 connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },
233 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
234# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
235 }
236 ); 251 );
237 252
238 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize"); 253 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
239 $table->add (1, $row++, new CFClient::UI::Slider 254 $table->add (1, $row++, new CFClient::UI::Slider
240 range => [$CFG->{log_fontsize}, 0.5, 2, 0.1], 255 range => [$CFG->{log_fontsize}, 0.5, 2, 0.1, 0.1],
241 tooltip => "The font size used by the server log window only", 256 tooltip => "The font size used by the server log window only",
242 connect_changed => sub { 257 connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
243 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
244 }
245 ); 258 );
246 259
247 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize"); 260 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
248 261
249 $table->add (1, $row++, new CFClient::UI::Slider 262 $table->add (1, $row++, new CFClient::UI::Slider
250 range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1], 263 range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1, 0.1],
251 tooltip => "The font size used by the statistics window only", 264 tooltip => "The font size used by the statistics window only",
252 connect_changed => sub { 265 connect_changed => sub {
253 $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10; 266 $CFG->{stat_fontsize} = $_[1];
254 &set_stats_window_fontsize; 267 &set_stats_window_fontsize;
255 } 268 }
256 ); 269 );
257 270
258 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size"); 271 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
259 $table->add (1, $row++, new CFClient::UI::Slider 272 $table->add (1, $row++, new CFClient::UI::Slider
260 range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02], 273 range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
261 tooltip => "Adjust the size of the stats gauges at the bottom right", 274 tooltip => "Adjust the size of the stats gauges at the bottom right",
262 connect_changed => sub { 275 connect_changed => sub {
263 $CFG->{gauge_size} = $_[1]; 276 $CFG->{gauge_size} = $_[1];
264 my $h = int $HEIGHT * $CFG->{gauge_size}; 277 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
265 $GAUGES->{win}->set_size ($WIDTH, $h);
266 $GAUGES->{win}->move (0, $HEIGHT - $h);
267 } 278 }
268 ); 279 );
269 280
270 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); 281 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
271 $table->add (1, $row++, new CFClient::UI::Slider 282 $table->add (1, $row++, new CFClient::UI::Slider
272 range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1], 283 range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1, 0.1],
273 tooltip => "Adjusts the fontsize of the gauges at the bottom right", 284 tooltip => "Adjusts the fontsize of the gauges at the bottom right",
274 connect_changed => sub { 285 connect_changed => sub {
275 $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10; 286 $CFG->{gauge_fontsize} = $_[1];
276 &set_gauge_window_fontsize; 287 &set_gauge_window_fontsize;
277 } 288 }
278 ); 289 );
279 290
280 $table->add (1, $row++, new CFClient::UI::Button 291 $table->add (1, $row++, new CFClient::UI::Button
… …
354# local $GAUGES->{win}{parent};#d# 365# local $GAUGES->{win}{parent};#d#
355# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D; 366# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
356} 367}
357 368
358sub make_gauge_window { 369sub make_gauge_window {
359 my $gh = int ($HEIGHT * $CFG->{gauge_size}); 370 my $gh = int $HEIGHT * $CFG->{gauge_size};
360# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
361 371
362 my $win = new CFClient::UI::Frame ( 372 my $win = new CFClient::UI::Frame (
363 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh 373 req_y => -1,
374 user_w => $WIDTH,
375 user_h => $gh,
364 ); 376 );
377
365 $win->add (my $hbox = new CFClient::UI::HBox 378 $win->add (my $hbox = new CFClient::UI::HBox
366 children => [ 379 children => [
367 (new CFClient::UI::HBox expand => 1), 380 (new CFClient::UI::HBox expand => 1),
368 ($FLOORBOX = new CFClient::UI::VBox), 381 (new CFClient::UI::VBox children => [
382 (new CFClient::UI::Empty expand => 1),
383 (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),
384 ]),
369 (my $vbox = new CFClient::UI::VBox), 385 (my $vbox = new CFClient::UI::VBox),
370 ], 386 ],
371 ); 387 );
372 388
373 $vbox->add (new CFClient::UI::HBox 389 $vbox->add (new CFClient::UI::HBox
… …
571 587
572} 588}
573 589
574sub metaserver_dialog { 590sub metaserver_dialog {
575 my $dialog = new CFClient::UI::FancyFrame 591 my $dialog = new CFClient::UI::FancyFrame
576 title => "Metaserver", 592 title => "Server List",
577 child => (my $vbox = new CFClient::UI::VBox); 593 child => (my $vbox = new CFClient::UI::VBox);
578 594
579 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 595 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
580 596
581 $dialog 597 $dialog
… …
683 699
684 $METASERVER = metaserver_dialog; 700 $METASERVER = metaserver_dialog;
685 701
686 $vbox->add (new CFClient::UI::Flopper 702 $vbox->add (new CFClient::UI::Flopper
687 expand => 1, 703 expand => 1,
688 text => "Metaserver", 704 text => "Server List",
689 other => $METASERVER, 705 other => $METASERVER,
690 tooltip => "Show a list of avaible crossfire servers", 706 tooltip => "Show a list of available crossfire servers",
691 connect_open => sub { 707 connect_open => sub {
692 update_metaserver $HOST; 708 update_metaserver $HOST;
693 } 709 }
694 ); 710 );
695 } 711 }
… …
716 ); 732 );
717 733
718 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 734 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
719 $table->add (1, 7, new CFClient::UI::Slider 735 $table->add (1, 7, new CFClient::UI::Slider
720 req_w => 100, 736 req_w => 100,
721 range => [$CFG->{mapsize}, 10, 100 + 1, 1], 737 range => [$CFG->{mapsize}, 10, 100 + 1, 1, 1],
722 tooltip => "This is the size of the portion of the map update the server sends you. " 738 tooltip => "This is the size of the portion of the map update the server sends you. "
723 ."If you set this to a high value you will be able to see further for example.", 739 ."If you set this to a high value you will be able to see further for example.",
724 connect_changed => sub { 740 connect_changed => sub {
725 my ($self, $value) = @_; 741 my ($self, $value) = @_;
726 742
727 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 743 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
728 }, 744 },
729 ); 745 );
730 746
731 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { 747 $table->add (1, 8, $LOGIN_BUTTON = new CFClient::UI::Button
748 expand => 1,
749 align => 0,
750 text => "Login",
751 connect_activate => sub {
752 $CONN ? stop_game
732 start_game; 753 : start_game;
754 },
733 }); 755 );
734 756
735 $dialog 757 $dialog
736} 758}
737 759
738sub message_window { 760sub message_window {
… …
788 810
789 $window 811 $window
790} 812}
791 813
792sub make_inventory_window { 814sub make_inventory_window {
793 my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory"; 815 my $invwin = new CFClient::UI::FancyFrame
816 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory";
817
818 $invwin->add (my $hb = new CFClient::UI::HBox);
819
820 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
821 $vb1->add (my $lbl = new CFClient::UI::Label);
822 $lbl->set_text ("Player");
794 $invwin->add ($INV = new CFClient::UI::Inventory expand => 1); 823 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
824
825 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
826 $vb2->add ($INVR_LBL = new CFClient::UI::Label);
827 $INVR_LBL->set_text ("Floor");
828 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
829
795 $invwin 830 $invwin
796} 831}
797 832
798sub sdl_init { 833sub sdl_init {
799 CFClient::SDL_Init 834 CFClient::SDL_Init
… …
811 846
812 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN 847 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
813 or die "SDL_SetVideoMode failed!\n"; 848 or die "SDL_SetVideoMode failed!\n";
814 849
815 $SDL_ACTIVE = 1; 850 $SDL_ACTIVE = 1;
816
817 $LAST_REFRESH = time - 0.01; 851 $LAST_REFRESH = time - 0.01;
818 852
819 CFClient::gl_init; 853 CFClient::gl_init;
820 854
821 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 855 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
822 856
857 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
858
823 ############################################################################# 859 #############################################################################
824 860
861 unless ($DEBUG_STATUS) {
862 # create the widgets
863
825 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 864 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
826 $DEBUG_STATUS->show; 865 $DEBUG_STATUS->show;
827 866
828 $STATUS_LINE = new CFClient::UI::Label 867 $STATUSBOX = new CFClient::UI::Statusbox;
829 padding => 0, 868 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
830 y => $HEIGHT - $FONTSIZE * 1.8;
831 $STATUS_LINE->show;
832 869
833 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 870 (new CFClient::UI::Frame
834 padding => 0, 871 bg => [0, 0, 0, 0.4],
835 fontsize => 0.8, 872 req_y => -1,
836 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 873 child => $STATUSBOX,
837 $ALT_ENTER_MESSAGE->show; 874 )->show;
838 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
839 875
840 CFClient::UI::FancyFrame->new ( 876 CFClient::UI::FancyFrame->new (
841 border_bg => [1, 1, 1, 192/255], 877 border_bg => [1, 1, 1, 192/255],
842 bg => [1, 1, 1, 0], 878 bg => [1, 1, 1, 0],
843 child => ($MAPMAP = new CFClient::MapWidget::MapMap), 879 child => ($MAPMAP = new CFClient::MapWidget::MapMap),
844 )->show; 880 )->show;
845 881
846 $MAPWIDGET = new CFClient::MapWidget; 882 $MAPWIDGET = new CFClient::MapWidget;
847 $MAPWIDGET->connect (activate_console => sub { 883 $MAPWIDGET->connect (activate_console => sub {
848 my ($mapwidget, $preset) = @_; 884 my ($mapwidget, $preset) = @_;
849 885
850 if ($CONSOLE) { 886 if ($CONSOLE) {
851 $CONSOLE->{input}->{auto_activated} = 1; 887 $CONSOLE->{input}->{auto_activated} = 1;
852 $CONSOLE->{input}->focus_in; 888 $CONSOLE->{input}->focus_in;
853 889
854 if ($preset && $CONSOLE->{input}->get_text eq '') { 890 if ($preset && $CONSOLE->{input}->get_text eq '') {
855 $CONSOLE->{input}->set_text ($preset); 891 $CONSOLE->{input}->set_text ($preset);
892 }
856 } 893 }
857 } 894 });
858 });
859 $MAPWIDGET->show; 895 $MAPWIDGET->show;
860 $MAPWIDGET->focus_in; 896 $MAPWIDGET->focus_in;
861 897
862 $BUTTONBAR = new CFClient::UI::HBox; 898 $BUTTONBAR = new CFClient::UI::HBox;
863 899
864 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 900 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
865 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 901 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
866 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 902 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
867 903
868 make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D 904 make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
869 905
870 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window); 906 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
871 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window); 907 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);
872 908
873 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 909 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
874 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 910 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
875 status "Configuration Saved"; 911 status "Configuration Saved";
876 }); 912 });
877 913
878 $BUTTONBAR->show; 914 $BUTTONBAR->show;
879 915
916 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
917
918 # delay till geometry is constant
919 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
880 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 920 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
921 my $widget = $GAUGES->{win};
922 $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
923 });
924 force_refresh ();
925 }
881} 926}
882 927
883sub video_shutdown { 928sub video_shutdown {
884 $CFClient::UI::ROOT->{children} = [];
885 undef $CFClient::UI::GRAB;
886 undef $CFClient::UI::HOVER;
887 undef $SDL_ACTIVE; 929 undef $SDL_ACTIVE;
888} 930}
889 931
890my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d# 932my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
891my $bgmusic;#TODO#hack#d# 933my $bgmusic;#TODO#hack#d#
… …
943} 985}
944 986
945my %animate_object; 987my %animate_object;
946my $animate_timer; 988my $animate_timer;
947 989
948my $want_refresh;
949my $can_refresh;
950
951my $fps = 9; 990my $fps = 9;
952 991
953sub force_refresh { 992sub force_refresh {
954 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; 993 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
955 debug sprintf "%3.2f", $fps; 994 debug sprintf "%3.2f", $fps;
956 995
957 $want_refresh = 0;
958 $can_refresh = 0;
959
960 $CFClient::UI::ROOT->draw; 996 $CFClient::UI::ROOT->draw;
961
962 CFClient::SDL_GL_SwapBuffers; 997 CFClient::SDL_GL_SwapBuffers;
963 998
999 $WANT_REFRESH = 0;
1000 $CAN_REFRESH = 0;
964 $LAST_REFRESH = $NOW; 1001 $LAST_REFRESH = $NOW;
965} 1002}
966 1003
967my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { 1004my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
968 $NOW = time; 1005 $NOW = time;
… …
970 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 1007 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
971 for CFClient::SDL_PollEvent; 1008 for CFClient::SDL_PollEvent;
972 1009
973 if (%animate_object) { 1010 if (%animate_object) {
974 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 1011 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
975 $want_refresh++; 1012 $WANT_REFRESH++;
976 } 1013 }
977 1014
978 if ($want_refresh) { 1015 if ($WANT_REFRESH) {
979 force_refresh; 1016 force_refresh;
980 } else { 1017 } else {
981 $can_refresh = 1; 1018 $CAN_REFRESH = 1;
982 } 1019 }
983}); 1020});
984
985sub refresh {
986 $want_refresh++;
987}
988 1021
989sub animation_start { 1022sub animation_start {
990 my ($widget) = @_; 1023 my ($widget) = @_;
991 $animate_object{$widget} = $widget; 1024 $animate_object{$widget} = $widget;
992} 1025}
… …
1304 [0.55, 0.41, 0.13], 1337 [0.55, 0.41, 0.13],
1305 [0.99, 0.77, 0.26], 1338 [0.99, 0.77, 0.26],
1306 [0.74, 0.65, 0.41], 1339 [0.74, 0.65, 0.41],
1307 ); 1340 );
1308 1341
1342 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1343
1344 $text = CFClient::UI::Label::escape $text;
1345 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1346 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1347
1309 $LOGVIEW->add_paragraph ($color[$color], $text); 1348 $LOGVIEW->add_paragraph ($color[$color],
1349 join "\n", map "$time $_", split /\n/, $text);
1350
1351 $STATUSBOX->add ($text,
1352 group => $text,
1353 fg => $color[$color],
1354 timeout => 60,
1355 tooltip_font => $::FONT_FIXED,
1356 );
1357}
1358
1359sub conn::drawextinfo {
1360 my ($self, $color, $type, $subtype, $message) = @_;
1361
1362 $self->drawinfo ($color, $message);
1310} 1363}
1311 1364
1312sub conn::spell_add { 1365sub conn::spell_add {
1313 my ($self, $spell) = @_; 1366 my ($self, $spell) = @_;
1314 1367
… …
1323} 1376}
1324 1377
1325sub conn::addme_success { 1378sub conn::addme_success {
1326 my ($self) = @_; 1379 my ($self) = @_;
1327 1380
1381 $MAPWIDGET->clr_commands;
1382
1328 for my $skill (values %{$self->{skill_info}}) { 1383 for my $skill (values %{$self->{skill_info}}) {
1329 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1384 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1330 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'"); 1385 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1331 } 1386 }
1387
1388 $MAPWIDGET->add_command ("petmode defend", "Tell pets to stay close to you and defend you");
1389 $MAPWIDGET->add_command ("petmode arena", "Same as petmode sad, but also attack other players");
1390 $MAPWIDGET->add_command ("petmode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies");
1391 $MAPWIDGET->add_command ("killpets", "Kill your pets");
1392 $MAPWIDGET->add_command ("chat", "chat TEXT\nChat with all other players");
1393 $MAPWIDGET->add_command ("shout", "shout TEXT\nShout loudly, used for emergencies");
1394 $MAPWIDGET->add_command ("tell", "tell USERNAME TEXT\nPrivately tell a specific player");
1395
1396 # TODO: add documentation on these
1397 for (qw(
1398 afk
1399 apply
1400 body
1401 bowmode
1402 brace
1403 build
1404 disarm
1405 dm
1406 dmhide
1407 drop
1408 dropall
1409 examine
1410 get
1411 gsay
1412 help
1413 hiscore
1414 inventory
1415 invoke
1416 killpets
1417 listen
1418 logs
1419 mapinfo
1420 maps
1421 mark
1422 motd
1423 output-count
1424 output-sync
1425 party
1426 peaceful
1427 petmode
1428 pickup
1429 players
1430 prepare
1431 quests
1432 rename
1433 resistances
1434 rotateshoottype
1435 save
1436 say
1437 search
1438 search-items
1439 showpets
1440 skills
1441 sound
1442 take
1443 throw
1444 time
1445 title
1446 usekeys
1447 version
1448 weather
1449 whereabouts
1450 whereami
1451 who
1452 wimpy
1453 )) {
1454 $MAPWIDGET->add_command ($_, "$_: no help available (yet)");
1455 }
1456
1457 #TODO: add " and ' "aliases" etc.
1458}
1459
1460sub conn::eof {
1461 $MAPWIDGET->clr_commands;
1462
1463 stop_game;
1332} 1464}
1333 1465
1334sub update_floorbox { 1466sub update_floorbox {
1335 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { 1467 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1468 return unless $CONN;
1469
1336 $FLOORBOX->clear; 1470 $FLOORBOX->clear;
1337 $FLOORBOX->add (new CFClient::UI::Empty expand => 1); 1471 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1338 1472
1339 # we basically have to use the same sorting as everybody else 1473 my $count = 4;
1340 for my $item (@{ $CONN->{container}{0} }) { 1474 for (@{ $CONN->{container}{0} }) {
1475 if (--$count) {
1341 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $item); 1476 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1477 } else {
1478 $FLOORBOX->add (new CFClient::UI::Label text => "More...");
1479 last;
1480 }
1342 } 1481 }
1343 }); 1482 });
1344 refresh; 1483
1484 $WANT_REFRESH++;
1345} 1485}
1346 1486
1347sub conn::container_add { 1487sub conn::container_add {
1348 my ($self, $id, $items) = @_; 1488 my ($self, $tag, $items) = @_;
1349 1489
1350 update_floorbox if $id == 0; 1490 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1491
1492 if ($tag == 0) {
1493 update_floorbox;
1494 $OPENCONT = 0;
1495 $INVR_LBL->set_text ("Floor");
1496 $INVR->set_items ($self->{container}{0});
1351 if ($self->{player}{tag} == $id) { 1497 } elsif ($tag == $self->{player}{tag}) {
1498 $INVR_LBL->set_text ("Player");
1352 $INV->set_items ($self->{container}{$self->{player}{tag}}); 1499 $INV->set_items ($self->{container}{$self->{player}{tag}})
1500 } else {
1501 $OPENCONT = $tag;
1502 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1503 $INVR->set_items ($self->{container}{$tag});
1353 } 1504 }
1505
1354 # $self-<{player}{tag} => player inv 1506 # $self-<{player}{tag} => player inv
1355 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1507 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1356} 1508}
1357 1509
1358sub conn::container_clear { 1510sub conn::container_clear {
1359 my ($self, $id) = @_; 1511 my ($self, $tag) = @_;
1360 1512
1361 update_floorbox if $id == 0; 1513 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1362 if ($self->{player}{tag} == $id) { 1514
1515 if ($tag == 0) {
1516 update_floorbox;
1517 $OPENCONT = 0;
1518 $INVR_LBL->set_text ("Floor");
1363 $INV->set_items ($self->{container}{$id}); 1519 $INVR->set_items ($self->{container}{0});
1520 } elsif ($tag == $self->{player}{tag}) {
1521 $INVR_LBL->set_text ("Player");
1522 $INV->set_items ($self->{container}{$tag})
1523 } else {
1524 $OPENCONT = $tag;
1525 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1526 $INVR->set_items ($self->{container}{$tag});
1364 } 1527 }
1365 1528
1366# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1529# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1367} 1530}
1368 1531
1369sub conn::item_delete { 1532sub conn::item_delete {
1370 my ($self, @items) = @_; 1533 my ($self, @items) = @_;
1371 1534
1372 for (@items) { 1535 for (@items) {
1373 update_floorbox if $_->{container} == 0; 1536 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1374 if ($self->{player}{tag} == $_->{container}) { 1537
1538 if ($_->{container} == 0) {
1539 update_floorbox;
1540 $OPENCONT = 0;
1541 $INVR_LBL->set_text ("Floor");
1542 $INVR->set_items ($self->{container}{0});
1543 } elsif ($_->{container} == $self->{player}{tag}) {
1544 $INVR_LBL->set_text ("Player");
1545 $INV->set_items ($self->{container}{$self->{player}{tag}})
1546 } else {
1547 $OPENCONT = $_->{container};
1548 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1375 $INV->set_items ($self->{container}{$_->{container}}); 1549 $INVR->set_items ($self->{container}{$_->{container}});
1376 } 1550 }
1377 } 1551 }
1378} 1552}
1379 1553
1380sub conn::item_update { 1554sub conn::item_update {
1381 my ($self, $item) = @_; 1555 my ($self, $item) = @_;
1382 1556
1383 update_floorbox if $item->{container} == 0; 1557 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1384 if ($self->{player}{tag} == $item->{container}) { 1558
1559 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1560 $OPENCONT = 0;
1561 $INVR_LBL->set_text ("Floor");
1562 $INVR->set_items ($self->{container}{0});
1563
1564 $item->{widget}->update_item
1565 if $item->{widget};
1566 } else {
1567 if ($item->{container} == 0) {
1568 update_floorbox;
1569 $OPENCONT = 0;
1570 $INVR_LBL->set_text ("Floor");
1571 $INVR->set_items ($self->{container}{0});
1572 } elsif ($item->{container} == $self->{player}{tag}) {
1385 $INV->set_items ($self->{container}{$item->{container}}); 1573 $INV->set_items ($self->{container}{$item->{container}})
1574 }
1386 } 1575 }
1387} 1576}
1388 1577
1389%SDL_CB = ( 1578%SDL_CB = (
1390 CFClient::SDL_QUIT => sub { 1579 CFClient::SDL_QUIT => sub {
1391 Event::unloop -1; 1580 Event::unloop -1;
1392 }, 1581 },
1393 CFClient::SDL_VIDEORESIZE => sub { 1582 CFClient::SDL_VIDEORESIZE => sub {
1394 }, 1583 },
1395 CFClient::SDL_VIDEOEXPOSE => \&refresh, 1584 CFClient::SDL_VIDEOEXPOSE => sub {
1585 $WANT_REFRESH++;
1586 },
1396 CFClient::SDL_ACTIVEEVENT => sub { 1587 CFClient::SDL_ACTIVEEVENT => sub {
1397# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 1588# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1398 }, 1589 },
1399 CFClient::SDL_KEYDOWN => sub { 1590 CFClient::SDL_KEYDOWN => sub {
1400 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1591 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
… …
1421 1612
1422############################################################################# 1613#############################################################################
1423 1614
1424$SIG{INT} = $SIG{TERM} = sub { exit }; 1615$SIG{INT} = $SIG{TERM} = sub { exit };
1425 1616
1426CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1427
1428$TILECACHE = CFClient::db_table "tilecache";
1429$FACEMAP = CFClient::db_table "facemap";
1430
1431my %DEF_CFG = (
1432 sdl_mode => 0,
1433 width => 640,
1434 height => 480,
1435 fullscreen => 0,
1436 fast => 0,
1437 map_scale => 0.5,
1438 fow_enable => 1,
1439 fow_intensity => 0.45,
1440 fow_smooth => 0,
1441 gui_fontsize => 1,
1442 log_fontsize => 1,
1443 gauge_fontsize => 1,
1444 gauge_size => 0.35,
1445 stat_fontsize => 1,
1446 mapsize => 100,
1447 host => "crossfire.schmorp.de",
1448 say_command => 'say',
1449 audio_enable => 1,
1450 bgm_enable => 1,
1451 bgm_volume => 0.25,
1452);
1453
1454while (my ($k, $v) = each %DEF_CFG) {
1455 $CFG->{$k} = $v unless exists $CFG->{$k};
1456}
1457
1458sdl_init;
1459
1460@SDL_MODES = reverse
1461 grep $_->[0] >= 640 && $_->[1] >= 480,
1462 CFClient::SDL_ListModes;
1463
1464@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1465
1466$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1467
1468{ 1617{
1618 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1619
1620 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1621
1622 $TILECACHE = CFClient::db_table "tilecache";
1623 $FACEMAP = CFClient::db_table "facemap";
1624
1625 my %DEF_CFG = (
1626 sdl_mode => 0,
1627 width => 640,
1628 height => 480,
1629 fullscreen => 0,
1630 fast => 0,
1631 map_scale => 0.5,
1632 fow_enable => 1,
1633 fow_intensity => 0.45,
1634 fow_smooth => 0,
1635 gui_fontsize => 1,
1636 log_fontsize => 1,
1637 gauge_fontsize=> 1,
1638 gauge_size => 0.35,
1639 stat_fontsize => 1,
1640 mapsize => 100,
1641 host => "crossfire.schmorp.de",
1642 say_command => 'say',
1643 audio_enable => 1,
1644 bgm_enable => 1,
1645 bgm_volume => 0.25,
1646 );
1647
1648 while (my ($k, $v) = each %DEF_CFG) {
1649 $CFG->{$k} = $v unless exists $CFG->{$k};
1650 }
1651
1652 sdl_init;
1653
1654 @SDL_MODES = reverse
1655 grep $_->[0] >= 640 && $_->[1] >= 480,
1656 CFClient::SDL_ListModes;
1657
1658 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1659
1660 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1661
1662 {
1469 my @fonts = map CFClient::find_rcfile "fonts/$_", qw( 1663 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1470 DejaVuSans.ttf 1664 DejaVuSans.ttf
1471 DejaVuSansMono.ttf 1665 DejaVuSansMono.ttf
1472 DejaVuSans-Bold.ttf 1666 DejaVuSans-Bold.ttf
1473 DejaVuSansMono-Bold.ttf 1667 DejaVuSansMono-Bold.ttf
1474 DejaVuSans-Oblique.ttf 1668 DejaVuSans-Oblique.ttf
1475 DejaVuSansMono-Oblique.ttf 1669 DejaVuSansMono-Oblique.ttf
1476 DejaVuSans-BoldOblique.ttf 1670 DejaVuSans-BoldOblique.ttf
1477 DejaVuSansMono-BoldOblique.ttf 1671 DejaVuSansMono-BoldOblique.ttf
1478 ); 1672 );
1479 1673
1480 CFClient::add_font $_ for @fonts; 1674 CFClient::add_font $_ for @fonts;
1481 1675
1676 CFClient::pango_init;
1677
1482 $FONT_PROP = new_from_file CFClient::Font $fonts[0]; 1678 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1483 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1679 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1484 1680
1485 $FONT_PROP->make_default; 1681 $FONT_PROP->make_default;
1486} 1682 }
1487 1683
1684# compare mono (ft) vs. rgba (cairo)
1685# ft - 1.8s, cairo 3s, even in alpha-only mode
1686# for my $rgba (0..1) {
1687# my $t1 = Time::HiRes::time;
1688# for (1..1000) {
1689# my $layout = CFClient::Layout->new ($rgba);
1690# $layout->set_text ("hallo" x 100);
1691# $layout->render;
1692# }
1693# my $t2 = Time::HiRes::time;
1694# warn $t2-$t1;
1695# }
1696
1488video_init; 1697 video_init;
1489audio_init; 1698 audio_init;
1699}
1490 1700
1491Event::loop; 1701Event::loop;
1492 1702
1493END { CFClient::SDL_Quit } 1703END { CFClient::SDL_Quit }
1494 1704

Diff Legend

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