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.187 by root, Tue Apr 25 12:56:34 2006 UTC vs.
Revision 1.247 by root, Thu May 25 00:26:20 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3use strict; 3use strict;
4use utf8; 4use utf8;
5 5
6# do things only needed for single-binary version (par)
6BEGIN { 7BEGIN {
7 if (%PAR::LibCache) { 8 if (%PAR::LibCache) {
8 @INC = grep ref, @INC; # weed out all paths except pars loader refs 9 @INC = grep ref, @INC; # weed out all paths except pars loader refs
9 10
10 while (my ($filename, $zip) = each %PAR::LibCache) { 11 while (my ($filename, $zip) = each %PAR::LibCache) {
13 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") 14 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
14 unless -e "$ENV{PAR_TEMP}/$1"; 15 unless -e "$ENV{PAR_TEMP}/$1";
15 } 16 }
16 } 17 }
17 18
19 # TODO: pango-rc file, anybody?
20
18 unshift @INC, $ENV{PAR_TEMP}; 21 unshift @INC, $ENV{PAR_TEMP};
19
20 if ($^O eq "MSWin32") {
21 $ENV{GTK_RC_FILES} = "$ENV{PAR_TEMP}/share/themes/MS-Windows/gtk-2.0/gtkrc";
22 }
23 } 22 }
24} 23}
25 24
26# need to do it again because that pile of garbage called PAR nukes it before main 25# need to do it again because that pile of garbage called PAR nukes it before main
27unshift @INC, $ENV{PAR_TEMP}; 26unshift @INC, $ENV{PAR_TEMP}
27 if %PAR::LibCache;
28 28
29use Time::HiRes 'time'; 29use Time::HiRes 'time';
30use Pod::POM;
30use Event; 31use Event;
31 32
32use Crossfire; 33use Crossfire;
33use Crossfire::Protocol; 34use Crossfire::Protocol;
34 35
37use CFClient; 38use CFClient;
38use CFClient::UI; 39use CFClient::UI;
39use CFClient::MapWidget; 40use CFClient::MapWidget;
40 41
41$Event::DIED = sub { 42$Event::DIED = sub {
43 # TODO: display dialog box or so
42 CFClient::error $_[1]; 44 CFClient::error $_[1];
43}; 45};
44 46
45#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d# 47#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
46 48
59our $NOW; 61our $NOW;
60 62
61our $CFG; 63our $CFG;
62our $CONN; 64our $CONN;
63our $FAST; # fast, low-quality mode, possibly useful for software-rendering 65our $FAST; # fast, low-quality mode, possibly useful for software-rendering
66
67our $WANT_REFRESH;
68our $CAN_REFRESH;
64 69
65our @SDL_MODES; 70our @SDL_MODES;
66our $WIDTH; 71our $WIDTH;
67our $HEIGHT; 72our $HEIGHT;
68our $FULLSCREEN; 73our $FULLSCREEN;
76our $MAPWIDGET; 81our $MAPWIDGET;
77our $BUTTONBAR; 82our $BUTTONBAR;
78our $LOGVIEW; 83our $LOGVIEW;
79our $CONSOLE; 84our $CONSOLE;
80our $METASERVER; 85our $METASERVER;
86our $LOGIN_BUTTON;
87our $QUIT_DIALOG;
81 88
82our $FLOORBOX; 89our $FLOORBOX;
83our $GAUGES; 90our $GAUGES;
84our $STATWIDS; 91our $STATWIDS;
85 92
89our $SDL_MIXER; 96our $SDL_MIXER;
90our @SOUNDS; # event => file mapping 97our @SOUNDS; # event => file mapping
91our %AUDIO_CHUNKS; # audio files 98our %AUDIO_CHUNKS; # audio files
92 99
93our $ALT_ENTER_MESSAGE; 100our $ALT_ENTER_MESSAGE;
94our $STATUS_LINE; 101our $STATUSBOX;
95our $DEBUG_STATUS; 102our $DEBUG_STATUS;
96 103
104our $INVWIN;
105our $INV;
106our $INVR;
107our $INVR_LBL;
108our $OPENCONT;
109
97sub status { 110sub status {
98 $STATUS_LINE->set_text ($_[0]); 111 $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
99 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
100} 112}
101 113
102sub debug { 114sub debug {
103 $DEBUG_STATUS->set_text ($_[0]); 115 $DEBUG_STATUS->set_text ($_[0]);
104 $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h}); 116 my ($w, $h) = $DEBUG_STATUS->size_request;
117 $DEBUG_STATUS->move ($WIDTH - $w, 0);
105} 118}
106 119
107sub start_game { 120sub start_game {
108 status "logging in..."; 121 status "logging in...";
109 122
110 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 123 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
111 124
112 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; 125 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
113
114 $MAP = new CFClient::Map $mapsize, $mapsize; 126 $MAP = new CFClient::Map $mapsize, $mapsize;
115 127
116 my ($host, $port) = split /:/, $CFG->{host}; 128 my ($host, $port) = split /:/, $CFG->{host};
117 129
118 $CONN = new conn 130 $CONN = eval {
131 new conn
119 host => $host, 132 host => $host,
120 port => $port || 13327, 133 port => $port || 13327,
121 user => $CFG->{user}, 134 user => $CFG->{user},
122 pass => $CFG->{password}, 135 pass => $CFG->{password},
123 mapw => $mapsize, 136 mapw => $mapsize,
124 maph => $mapsize, 137 maph => $mapsize,
138 ;
125 ; 139 };
126 140
127 status "login successful"; 141 if ($CONN) {
128
129 CFClient::lowdelay fileno $CONN->{fh}; 142 CFClient::lowdelay fileno $CONN->{fh};
143
144 $LOGIN_BUTTON->set_text ("Logout");
145 status "login successful";
146
147 $BUTTONBAR->{children}[1]->emit ("activate")
148 if $BUTTONBAR->{children}[1]->{state};
149
150 } else {
151 status "unable to connect";
152 stop_game();
153 }
130} 154}
131 155
132sub stop_game { 156sub stop_game {
157 return unless $CONN;
158
159 status "connection closed";
160 $LOGIN_BUTTON->set_text ("Login");
161 $CONN->destroy;
162 $CONN = 0; # false, does not autovivify
163
164 $BUTTONBAR->{children}[1]->emit ("activate")
165 unless $BUTTONBAR->{children}[1]->{state};
166
167 undef $MAPCACHE;
133 undef $CONN; 168 undef $MAP;
134} 169}
135 170
136sub client_setup { 171sub client_setup {
137 my $dialog = new CFClient::UI::FancyFrame 172 my $dialog = new CFClient::UI::FancyFrame
138 title => "Client Setup", 173 title => "Client Setup",
140 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 175 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
141 176
142 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); 177 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
143 $table->add (1, 0, my $hbox = new CFClient::UI::HBox); 178 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
144 179
145 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]); 180 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
146 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999"); 181 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
147 182
148 $mode_slider->connect (changed => sub { 183 $mode_slider->connect (changed => sub {
149 my ($self, $value) = @_; 184 my ($self, $value) = @_;
150 185
175 } 210 }
176 ); 211 );
177 212
178 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale"); 213 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
179 $table->add (1, $row++, new CFClient::UI::Slider 214 $table->add (1, $row++, new CFClient::UI::Slider
180 range => [$CFG->{map_scale}, 0.25, 2, 0.05], 215 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
181 tooltip => "Enlarge or shrink the displayed map", 216 tooltip => "Enlarge or shrink the displayed map",
182 connect_changed => sub { 217 connect_changed => sub {
183 my ($self, $value) = @_; 218 my ($self, $value) = @_;
184 $CFG->{map_scale} = 0.05 * int $value / 0.05; 219 $CFG->{map_scale} = 2 ** $value;
185 } 220 }
186 ); 221 );
187 222
188 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 223 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
189 $table->add (1, $row++, new CFClient::UI::CheckBox 224 $table->add (1, $row++, new CFClient::UI::CheckBox
195 } 230 }
196 ); 231 );
197 232
198 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 233 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
199 $table->add (1, $row++, new CFClient::UI::Slider 234 $table->add (1, $row++, new CFClient::UI::Slider
200 range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], 235 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
201 tooltip => "The higher the intensity, the lighter the Fog-of-War color", 236 tooltip => "The higher the intensity, the lighter the Fog-of-War color",
202 connect_changed => sub { 237 connect_changed => sub {
203 my ($self, $value) = @_; 238 my ($self, $value) = @_;
204 $CFG->{fow_intensity} = $value; 239 $CFG->{fow_intensity} = $value;
205 } 240 }
216 } 251 }
217 ); 252 );
218 253
219 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 254 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
220 $table->add (1, $row++, new CFClient::UI::Slider 255 $table->add (1, $row++, new CFClient::UI::Slider
221 range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1], 256 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
222 tooltip => "The font size used by most GUI elements", 257 tooltip => "The font size used by most GUI elements",
223 connect_changed => sub { 258 connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },
224 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
225# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
226 }
227 ); 259 );
228 260
229 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize"); 261 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
230 $table->add (1, $row++, new CFClient::UI::Slider 262 $table->add (1, $row++, new CFClient::UI::Slider
231 range => [$CFG->{log_fontsize}, 0.5, 2, 0.1], 263 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
232 tooltip => "The font size used by the server log window only", 264 tooltip => "The font size used by the server log window only",
233 connect_changed => sub { 265 connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
234 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
235 }
236 ); 266 );
237 267
238 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize"); 268 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
239 269
240 $table->add (1, $row++, new CFClient::UI::Slider 270 $table->add (1, $row++, new CFClient::UI::Slider
241 range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1], 271 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
242 tooltip => "The font size used by the statistics window only", 272 tooltip => "The font size used by the statistics window only",
243 connect_changed => sub { 273 connect_changed => sub {
244 $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10; 274 $CFG->{stat_fontsize} = $_[1];
245 &set_stats_window_fontsize; 275 &set_stats_window_fontsize;
276 }
277 );
278
279 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280 $table->add (1, $row++, new CFClient::UI::Slider
281 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
282 tooltip => "Adjusts the fontsize of the gauges at the bottom right",
283 connect_changed => sub {
284 $CFG->{gauge_fontsize} = $_[1];
285 &set_gauge_window_fontsize;
246 } 286 }
247 ); 287 );
248 288
249 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size"); 289 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
250 $table->add (1, $row++, new CFClient::UI::Slider 290 $table->add (1, $row++, new CFClient::UI::Slider
251 range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02], 291 range => [$CFG->{gauge_size}, 0.2, 0.8],
252 tooltip => "Adjust the size of the stats gauges at the bottom right", 292 tooltip => "Adjust the size of the stats gauges at the bottom right",
253 connect_changed => sub { 293 connect_changed => sub {
254 $CFG->{gauge_size} = $_[1]; 294 $CFG->{gauge_size} = $_[1];
255 my $h = int $HEIGHT * $CFG->{gauge_size}; 295 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
256 $GAUGES->{win}->set_size ($WIDTH, $h);
257 $GAUGES->{win}->move (0, $HEIGHT - $h);
258 }
259 );
260
261 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
262 $table->add (1, $row++, new CFClient::UI::Slider
263 range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
264 tooltip => "Adjusts the fontsize of the gauges at the bottom right",
265 connect_changed => sub {
266 $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
267 &set_gauge_window_fontsize;
268 } 296 }
269 ); 297 );
270 298
271 $table->add (1, $row++, new CFClient::UI::Button 299 $table->add (1, $row++, new CFClient::UI::Button
272 expand => 1, align => 0, text => "Apply", 300 expand => 1, align => 0, text => "Apply",
297 connect_changed => sub { 325 connect_changed => sub {
298 $CFG->{bgm_enable} = $_[1]; 326 $CFG->{bgm_enable} = $_[1];
299 } 327 }
300 ); 328 );
301 $hbox->add (new CFClient::UI::Slider 329 $hbox->add (new CFClient::UI::Slider
302 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], 330 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
303 tooltip => "The volume of the background music", 331 tooltip => "The volume of the background music",
304 connect_changed => sub { 332 connect_changed => sub {
305 $CFG->{bgm_volume} = $_[1]; 333 $CFG->{bgm_volume} = $_[1];
306 CFClient::MixMusic::volume $_[1] * 128; 334 CFClient::MixMusic::volume $_[1] * 128;
307 } 335 }
314 audio_shutdown (); 342 audio_shutdown ();
315 audio_init (); 343 audio_init ();
316 } 344 }
317 ); 345 );
318 346
347 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
348 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349 text => $CFG->{say_command},
350 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. "
351 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
352 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
353 connect_changed => sub {
354 my ($self, $value) = @_;
355 $CFG->{say_command} = $value;
356 }
357 );
358
319 $dialog 359 $dialog
320} 360}
321 361
322sub set_stats_window_fontsize { 362sub set_stats_window_fontsize {
323 for (values %{$STATWIDS}) { 363 for (values %{$STATWIDS}) {
327 367
328sub set_gauge_window_fontsize { 368sub set_gauge_window_fontsize {
329 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) { 369 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
330 $_->set_fontsize ($::CFG->{gauge_fontsize}); 370 $_->set_fontsize ($::CFG->{gauge_fontsize});
331 } 371 }
332
333# local $GAUGES->{win}{parent};#d#
334# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
335} 372}
336 373
337sub make_gauge_window { 374sub make_gauge_window {
338 my $gh = int ($HEIGHT * $CFG->{gauge_size}); 375 my $gh = int $HEIGHT * $CFG->{gauge_size};
339# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
340 376
341 my $win = new CFClient::UI::Frame ( 377 my $win = new CFClient::UI::Frame (
342 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh 378 req_y => -1,
379 user_w => $WIDTH,
380 user_h => $gh,
343 ); 381 );
382
344 $win->add (my $hbox = new CFClient::UI::HBox 383 $win->add (my $hbox = new CFClient::UI::HBox
345 children => [ 384 children => [
346 (new CFClient::UI::HBox expand => 1), 385 (new CFClient::UI::HBox expand => 1),
347 ($FLOORBOX = new CFClient::UI::VBox), 386 (new CFClient::UI::VBox children => [
387 (new CFClient::UI::Empty expand => 1),
388 (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),
389 ]),
348 (my $vbox = new CFClient::UI::VBox), 390 (my $vbox = new CFClient::UI::VBox),
349 ], 391 ],
350 ); 392 );
351 393
352 $vbox->add (new CFClient::UI::HBox 394 $vbox->add (new CFClient::UI::HBox
356 (my $hb = new CFClient::UI::HBox), 398 (my $hb = new CFClient::UI::HBox),
357 ], 399 ],
358 ); 400 );
359 401
360 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp', 402 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
361 tooltip => "Health points. Measures of how much damage you can take before dying. Hit points are determined from your level and are influenced by the value of your Con. Hp value may range between 1 to beyond 500 and higher values indicate a greater ability to withstand punishment."); 403 tooltip => "<b>Health points</b>. Measures of how much damage you can take before dying. Hit points are determined from your level and are influenced by the value of your Con. Hp value may range between 1 to beyond 500 and higher values indicate a greater ability to withstand punishment.");
362 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana', 404 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
363 tooltip => "Spell points. Measures of how much \"fuel\" you have for casting spells and incantations. Mana is calculated from your level and your Pow. Mana values can range between 1 to beyond 500 (glowing crystals can increase the current spell points beyond your normal maximum). Higher values indicate greater amounts of mana."); 405 tooltip => "<b>Spell points</b>. Measures of how much \"fuel\" you have for casting spells and incantations. Mana is calculated from your level and your Pow. Mana values can range between 1 to beyond 500 (glowing crystals can increase the current spell points beyond your normal maximum). Higher values indicate greater amounts of mana.");
364 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace', 406 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
365 tooltip => "Grace points - how favored you are by your god. In game terms, how much divine magic you can cast. Your level, Wis and Pow effect what the value of grace is. Prayong on an altar of your god can increase this value beyond your normal maximum. Grace can take on large positive and negative values. Positive values indicate favor by the gods."); 407 tooltip => "<b>Grace points</b> - how favored you are by your god. In game terms, how much divine magic you can cast. Your level, Wis and Pow effect what the value of grace is. Prayong on an altar of your god can increase this value beyond your normal maximum. Grace can take on large positive and negative values. Positive values indicate favor by the gods.");
366 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food', 408 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
367 tooltip => "Food. Ranges between 0 (starving) and 999 (satiated). At a value of 0 the character begins to die. Some magic can speed up or slow down the character digestion. Healing wounds will speed up digestion too."); 409 tooltip => "<b>Food</b>. Ranges between 0 (starving) and 999 (satiated). At a value of 0 the character begins to die. Some magic can speed up or slow down the character digestion. Healing wounds will speed up digestion too.");
368 410
369 $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, 411 $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
370 tooltip => "Experience points and overall level - experience is increased as a reward for appropriate action (such as killing monsters) and may decrease as a result of a magical attack or dying. Level is directly derived from the experience value. As the level of the character increases, the character becomes able to succeed at more difficult tasks. A character's level starts at a value of 0 and may range up beyond 100."); 412 tooltip => "<b>Experience points and overall level</b> - experience is increased as a reward for appropriate action (such as killing monsters) and may decrease as a result of a magical attack or dying. Level is directly derived from the experience value. As the level of the character increases, the character becomes able to succeed at more difficult tasks. A character's level starts at a value of 0 and may range up beyond 100.");
371 $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, 413 $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
372 tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)"); 414 tooltip => "<b>Ranged attack</b> - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
373 415
374 $GAUGES = { 416 $GAUGES = {
375 exp => $exp, win => $win, range => $rng, 417 exp => $exp, win => $win, range => $rng,
376 food => $fg, mana => $mg, hp => $hg, grace => $gg 418 food => $fg, mana => $mg, hp => $hg, grace => $gg
377 }; 419 };
380 422
381 $win 423 $win
382} 424}
383 425
384sub make_stats_window { 426sub make_stats_window {
385 my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats"; 427 my $tgw = new CFClient::UI::FancyFrame title => "Stats";
386 428
387 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox); 429 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
388 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1); 430 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431 can_hover => 1, can_events => 1,
432 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
389 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1); 433 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434 can_hover => 1, can_events => 1,
435 tooltip => "The map you are currently on (if supported by the server).");
390 436
391 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 437 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
392
393 $hb->add (my $tbl = new CFClient::UI::Table expand => 1); 438 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
394 439
395 my $black = [0, 0, 0]; 440 my $color2 = [1, 1, 0];
396 441
397 for ( 442 for (
398 [0, 0, st_str => "Str", 30, "Physical Strength, determines damage dealt with weapons, how much you can carry, and how often you can attack"], 443 [0, 0, st_str => "Str", 30, "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
399 [0, 1, st_dex => "Dex", 30, "Dexterity, your physical agility. Determines chance of being hit and affects armor class and speed"], 444 [0, 1, st_dex => "Dex", 30, "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed"],
400 [0, 2, st_con => "Con", 30, "Constitution, physical health and toughness. Determines how many healthpoints you can have"], 445 [0, 2, st_con => "Con", 30, "<b>Constitution</b>, physical health and toughness. Determines how many healthpoints you can have"],
401 [0, 3, st_int => "Int", 30, "Intelligence, your ability to learn and use skills and incantations (both prayers and magic) and determines how much spell points you can have"], 446 [0, 3, st_int => "Int", 30, "<b>Intelligence</b>, your ability to learn and use skills and incantations (both prayers and magic) and determines how much spell points you can have"],
402 [0, 4, st_wis => "Wis", 30, "Wisdom, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"], 447 [0, 4, st_wis => "Wis", 30, "<b>Wisdom</b>, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
403 [0, 5, st_pow => "Pow", 30, "Power, your magical potential. Influences the strength of spell effects, and also how much your spell and grace points increase when leveling up"], 448 [0, 5, st_pow => "Pow", 30, "<b>Power</b>, your magical potential. Influences the strength of spell effects, and also how much your spell and grace points increase when leveling up"],
404 [0, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."], 449 [0, 6, st_cha => "Cha", 30, "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops."],
405 450
406 [2, 0, st_wc => "Wc", -120, "Weapon Class, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."], 451 [2, 0, st_wc => "Wc", -120, "<b>Weapon Class</b>, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."],
407 [2, 1, st_ac => "Ac", -120, "Armour Class, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."], 452 [2, 1, st_ac => "Ac", -120, "<b>Armour Class</b>, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."],
408 [2, 2, st_dam => "Dam", 120, "Damage, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."], 453 [2, 2, st_dam => "Dam", 120, "<b>Damage</b>, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."],
409 [2, 3, st_arm => "Arm", 120, "Armour, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value."], 454 [2, 3, st_arm => "Arm", 120, "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value."],
410 [2, 4, st_spd => "Spd", 10.54, "Speed, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."], 455 [2, 4, st_spd => "Spd", 10.54, "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."],
411 [2, 5, st_wspd => "WSp", 10.54, "Weapon Speed, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."], 456 [2, 5, st_wspd => "WSp", 10.54, "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."],
412 ) { 457 ) {
413 my ($col, $row, $id, $label, $template, $tooltip) = @$_; 458 my ($col, $row, $id, $label, $template, $tooltip) = @$_;
414 459
415 $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label 460 $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
416 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip); 461 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
417 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label 462 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
418 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $black, valign => 0, align => -1, text => $label, tooltip => $tooltip); 463 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, align => -1, text => $label, tooltip => $tooltip);
419 } 464 }
420 465
421 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1); 466 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
422 467
423 my $row = 0; 468 my $row = 0;
424 my $col = 0; 469 my $col = 0;
425 470
426 my %resist_names = ( 471 my %resist_names = (
427 slow => "Slow", 472 slow => "<b>Slow</b> (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)",
428 holyw => "Holy Word", 473 holyw => "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
429 conf => "Confusion", 474 conf => "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)",
430 fire => "Fire", 475 fire => "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
431 depl => "Depletion (some monsters and other effects can cause stats depletion)", 476 depl => "<b>Depletion</b> (some monsters and other effects can cause stats depletion)",
432 magic => "Magic", 477 magic => "<b>Magic</b> (resistance to magic spells like magic missile or similar)",
433 drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)", 478 drain => "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)",
434 acid => "Acid", 479 acid => "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
435 pois => "Poison", 480 pois => "<b>Poison</b> (resistance to getting poisoned)",
436 para => "Paralysation", 481 para => "<b>Paralysation</b> (this resistance affects the chance you get paralysed)",
437 deat => "Death (resistance against death spells)", 482 deat => "<b>Death</b> (resistance against death spells)",
438 phys => "Physical", 483 phys => "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
439 blind => "Blind", 484 blind => "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)",
440 fear => "Fear", 485 fear => "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)",
441 tund => "Turn undead", 486 tund => "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...",
442 elec => "Electricity", 487 elec => "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)",
443 cold => "Cold", 488 cold => "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)",
444 ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)", 489 ghit => "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)",
445 ); 490 );
446 for (qw/slow holyw conf fire depl magic 491 for (qw/slow holyw conf fire depl magic
447 drain acid pois para deat phys 492 drain acid pois para deat phys
448 blind fear tund elec cold ghit/) 493 blind fear tund elec cold ghit/)
449 { 494 {
550 595
551} 596}
552 597
553sub metaserver_dialog { 598sub metaserver_dialog {
554 my $dialog = new CFClient::UI::FancyFrame 599 my $dialog = new CFClient::UI::FancyFrame
555 title => "Metaserver", 600 title => "Server List",
556 child => (my $vbox = new CFClient::UI::VBox); 601 child => (my $vbox = new CFClient::UI::VBox);
557 602
558 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 603 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
559 604
560 $dialog 605 $dialog
629 $HOST->set_text ($CFG->{host} = $host); 674 $HOST->set_text ($CFG->{host} = $host);
630 }), 675 }),
631 (new CFClient::UI::Empty expand => 1), 676 (new CFClient::UI::Empty expand => 1),
632 ]); 677 ]);
633 678
634 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8) 679 $table->add ($_ + 1, $y, new CFClient::UI::Label
680 ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
635 for 0 .. $#$m; 681 for 0 .. $#$m;
636 } 682 }
637 } 683 }
638 }); 684 });
639} 685}
662 708
663 $METASERVER = metaserver_dialog; 709 $METASERVER = metaserver_dialog;
664 710
665 $vbox->add (new CFClient::UI::Flopper 711 $vbox->add (new CFClient::UI::Flopper
666 expand => 1, 712 expand => 1,
667 text => "Metaserver", 713 text => "Server List",
668 other => $METASERVER, 714 other => $METASERVER,
669 tooltip => "Show a list of avaible crossfire servers", 715 tooltip => "Show a list of available crossfire servers",
670 connect_open => sub { 716 connect_open => sub {
671 update_metaserver $HOST; 717 update_metaserver $HOST;
672 } 718 }
673 ); 719 );
674 } 720 }
692 my ($self, $value) = @_; 738 my ($self, $value) = @_;
693 $CFG->{password} = $value; 739 $CFG->{password} = $value;
694 } 740 }
695 ); 741 );
696 742
697 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
698 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry
699 text => $CFG->{say_command},
700 tooltip => "This is the command that will be used if you write a line in the message window entry. "
701 ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
702 ."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
703 connect_changed => sub {
704 my ($self, $value) = @_;
705 $CFG->{say_command} = $value;
706 }
707 );
708
709 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 743 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
710 $table->add (1, 7, new CFClient::UI::Slider 744 $table->add (1, 7, new CFClient::UI::Slider
711 req_w => 100, 745 req_w => 100,
712 range => [$CFG->{mapsize}, 10, 100 + 1, 1], 746 range => [$CFG->{mapsize}, 10, 100, 0, 1],
713 tooltip => "This is the size of the portion of the map update the server sends you. " 747 tooltip => "This is the size of the portion of the map update the server sends you. "
714 ."If you set this to a high value you will be able to see further for example.", 748 . "If you set this to a high value you will be able to see further for example.",
715 connect_changed => sub { 749 connect_changed => sub {
716 my ($self, $value) = @_; 750 my ($self, $value) = @_;
717 751
718 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 752 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
719 }, 753 },
720 ); 754 );
721 755
722 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { 756 $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
723 start_game; 757 $table->add (1, 8, new CFClient::UI::Entry
758 text => $CFG->{output_count},
759 tooltip => "Should be set to 1 unless you know what you are doing",
760 connect_changed => sub { $CFG->{output_count} = $_[1] },
724 }); 761 );
762
763 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
764 $table->add (1, 9, new CFClient::UI::Entry
765 text => $CFG->{output_sync},
766 tooltip => "Should be set to 1 unless you know what you are doing",
767 connect_changed => sub { $CFG->{output_sync} = $_[1] },
768 );
769
770 $table->add (1, 10, $LOGIN_BUTTON = new CFClient::UI::Button
771 expand => 1,
772 align => 0,
773 text => "Login",
774 connect_activate => sub {
775 $CONN ? stop_game
776 : start_game;
777 },
778 );
725 779
726 $dialog 780 $dialog
727} 781}
728 782
729sub message_window { 783sub message_window {
730 my $window = new CFClient::UI::FancyFrame 784 my $window = new CFClient::UI::FancyFrame
731 title => "Messages", 785 title => "Messages",
732 border_bg => [1, 1, 1, 1], 786 border_bg => [1, 1, 1, 1],
733 bg => [0, 0, 0, 0.5], 787 bg => [0, 0, 0, 0.75],
734 user_w => int $::WIDTH / 3, 788 user_w => int $::WIDTH / 3,
735 user_h => int $::HEIGHT / 5, 789 user_h => int $::HEIGHT / 5,
736 child => (my $vbox = new CFClient::UI::VBox); 790 child => (my $vbox = new CFClient::UI::VBox);
737 791
738 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 792 $vbox->add ($LOGVIEW);
739 expand => 1,
740 font => $FONT_FIXED,
741 fontsize => $::CFG->{log_fontsize},
742 );
743 793
744 $vbox->add (my $input = new CFClient::UI::Entry 794 $vbox->add (my $input = new CFClient::UI::Entry
795 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
796 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
797 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
798 . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
745 connect_focus_in => sub { 799 connect_focus_in => sub {
746 my ($input, $prev_focus) = @_; 800 my ($input, $prev_focus) = @_;
747 801
748 delete $input->{refocus_map}; 802 delete $input->{refocus_map};
749 803
778 }; 832 };
779 833
780 $window 834 $window
781} 835}
782 836
837sub open_quit_dialog {
838 unless ($QUIT_DIALOG) {
839
840 $QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";
841
842 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
843
844 $vb->add (new CFClient::UI::Label
845 text => "You should find a savebed and apply it first!",
846 max_w => $WIDTH * 0.25,
847 ellipsize => 0,
848 );
849 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
850 $hb->add (new CFClient::UI::Button
851 text => "Ok",
852 expand => 1,
853 connect_activate => sub { $QUIT_DIALOG->hide },
854 );
855 $hb->add (new CFClient::UI::Button
856 text => "Quit anyway",
857 expand => 1,
858 connect_activate => sub { exit },
859 );
860
861 $QUIT_DIALOG->show_centered;
862 } else {
863 $QUIT_DIALOG->show_centered;
864 }
865}
866
867sub make_inventory_window {
868 my $invwin = new CFClient::UI::FancyFrame
869 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";
870
871 $invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
872
873 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
874 $vb1->add (my $lbl = new CFClient::UI::Label);
875 $lbl->set_text ("Player");
876 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
877
878 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
879 $vb2->add ($INVR_LBL = new CFClient::UI::Label);
880 $INVR_LBL->set_text ("Floor");
881 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
882
883 $invwin
884}
885
886sub make_help_window {
887 my $win = new CFClient::UI::FancyFrame
888 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";
889
890 $win->add (my $vbox = new CFClient::UI::VBox);
891
892 $vbox->add (my $buttons = new CFClient::UI::HBox);
893 $vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
894
895 for (
896 [intro => "Introduction"],
897 [command_help => "Commands"],
898 [skill_help => "Skills"],
899 ) {
900 my ($pod, $label) = @$_;
901
902 $buttons->add (new CFClient::UI::Button
903 text => $label,
904 connect_activate => sub {
905 my $parser = new Pod::POM;
906 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
907
908 $viewer->clear;
909
910 $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
911 for @{ CFClient::pod_to_pango_list $pom };
912
913 $viewer->set_offset (0);
914 },
915 );
916 }
917
918 $viewer->add_paragraph ([1, 1, 0, 1], "<big>Use one of the buttons above to display a document.</big>");
919
920 $win
921}
922
783sub sdl_init { 923sub sdl_init {
784 CFClient::SDL_Init 924 CFClient::SDL_Init
785 and die "SDL::Init failed!\n"; 925 and die "SDL::Init failed!\n";
786} 926}
787 927
788sub video_init { 928sub video_init {
789 sdl_init; 929 sdl_init;
790 930
931 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
932
933 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
934
791 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 935 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
792 $FULLSCREEN = $CFG->{fullscreen}; 936 $FULLSCREEN = $CFG->{fullscreen};
793 $FAST = $CFG->{fast}; 937 $FAST = $CFG->{fast};
794 938
795 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN 939 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
796 or die "SDL_SetVideoMode failed!\n"; 940 or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
797 941
798 $SDL_ACTIVE = 1; 942 $SDL_ACTIVE = 1;
799
800 $LAST_REFRESH = time - 0.01; 943 $LAST_REFRESH = time - 0.01;
801 944
802 CFClient::gl_init; 945 CFClient::gl_init;
803 946
804 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 947 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
805 948
949 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
950
806 ############################################################################# 951 #############################################################################
807 952
953 if ($DEBUG_STATUS) {
954 CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
955 } else {
956 # create the widgets
957
808 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 958 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
809 $DEBUG_STATUS->show; 959 $DEBUG_STATUS->show;
810 960
811 $STATUS_LINE = new CFClient::UI::Label 961 $STATUSBOX = new CFClient::UI::Statusbox;
812 padding => 0, 962 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
813 y => $HEIGHT - $FONTSIZE * 1.8;
814 $STATUS_LINE->show;
815 963
816 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 964 (new CFClient::UI::Frame
817 padding => 0, 965 bg => [0, 0, 0, 0.4],
818 fontsize => 0.8, 966 req_y => -1,
819 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 967 child => $STATUSBOX,
820 $ALT_ENTER_MESSAGE->show; 968 )->show;
821 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
822 969
823 CFClient::UI::FancyFrame->new ( 970 CFClient::UI::FancyFrame->new (
824 border_bg => [1, 1, 1, 192/255], 971 border_bg => [1, 1, 1, 192/255],
825 bg => [1, 1, 1, 0], 972 bg => [1, 1, 1, 0],
826 child => $MAPMAP = new CFClient::MapWidget::MapMap 973 child => ($MAPMAP = new CFClient::MapWidget::MapMap
974 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
975 ),
827 )->show; 976 )->show;
828 977
829 $MAPWIDGET = new CFClient::MapWidget; 978 $MAPWIDGET = new CFClient::MapWidget;
830 $MAPWIDGET->connect (activate_console => sub { 979 $MAPWIDGET->connect (activate_console => sub {
831 my ($mapwidget, $preset) = @_; 980 my ($mapwidget, $preset) = @_;
832 981
833 if ($CONSOLE) { 982 if ($CONSOLE) {
834 $CONSOLE->{input}->{auto_activated} = 1; 983 $CONSOLE->{input}->{auto_activated} = 1;
835 $CONSOLE->{input}->focus_in; 984 $CONSOLE->{input}->focus_in;
836 985
837 if ($preset && $CONSOLE->{input}->get_text eq '') { 986 if ($preset && $CONSOLE->{input}->get_text eq '') {
838 $CONSOLE->{input}->set_text ($preset); 987 $CONSOLE->{input}->set_text ($preset);
988 }
839 } 989 }
840 } 990 });
841 });
842 $MAPWIDGET->show; 991 $MAPWIDGET->show;
843 $MAPWIDGET->focus_in; 992 $MAPWIDGET->focus_in;
844 993
994 $LOGVIEW = new CFClient::UI::TextView
995 expand => 1,
996 font => $FONT_FIXED,
997 fontsize => $::CFG->{log_fontsize},
998 can_hover => 1,
999 can_events => 1,
1000 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1001 ;
1002
845 $BUTTONBAR = new CFClient::UI::HBox; 1003 $BUTTONBAR = new CFClient::UI::HBox;
846 1004
847 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 1005 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,
1006 tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options.");
848 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 1007 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,
1008 tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
849 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 1009 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
1010 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
850 1011
851 $CFClient::UI::ROOT->add (make_gauge_window); # 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 1012 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
1013
852 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window); 1014 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
1015 tooltip => "Toggles the statistics window, where all your Stats and Resistances are beign displaye at all times.");
1016 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
1017 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
853 1018
854 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 1019 $BUTTONBAR->add (new CFClient::UI::Button
1020 text => "Save Config",
1021 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1022 connect_activate => sub {
855 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 1023 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
856 status "Configuration Saved"; 1024 status "Configuration Saved";
857 }); 1025 },
1026 );
858 1027
1028 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1029 tooltip => "View Documentation");
1030
1031 $BUTTONBAR->add (new CFClient::UI::Button
1032 text => "Quit",
1033 tooltip => "Terminates the program",
1034 connect_activate => sub {
1035 if ($CONN) {
1036 open_quit_dialog;
1037 } else {
1038 exit;
1039 }
1040 },
1041 );
1042
859 $BUTTONBAR->show; 1043 $BUTTONBAR->show;
860 1044
1045 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1046
1047 # delay till geometry is constant
1048 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
861 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 1049 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
1050 my $widget = $GAUGES->{win};
1051 $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
1052 });
1053 force_refresh ();
1054 }
862} 1055}
863 1056
864sub video_shutdown { 1057sub video_shutdown {
865 $CFClient::UI::ROOT->{children} = [];
866 undef $CFClient::UI::GRAB;
867 undef $CFClient::UI::HOVER;
868 undef $SDL_ACTIVE; 1058 undef $SDL_ACTIVE;
869} 1059}
870 1060
871my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d# 1061my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
872my $bgmusic;#TODO#hack#d# 1062my $bgmusic;#TODO#hack#d#
1063
1064sub audio_channel_finished {
1065 my ($channel) = @_;
1066
1067 #warn "channel $channel finished\n";#d#
1068}
873 1069
874sub audio_music_finished { 1070sub audio_music_finished {
875 return unless $CFG->{bgm_enable}; 1071 return unless $CFG->{bgm_enable};
876 1072
877 # TODO: hack, do play loop and mood music 1073 # TODO: hack, do play loop and mood music
881 push @bgmusic, shift @bgmusic; 1077 push @bgmusic, shift @bgmusic;
882} 1078}
883 1079
884sub audio_init { 1080sub audio_init {
885 if ($CFG->{audio_enable}) { 1081 if ($CFG->{audio_enable}) {
886 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { 1082 if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
887 $SDL_MIXER = !CFClient::Mix_OpenAudio; 1083 $SDL_MIXER = !CFClient::Mix_OpenAudio;
1084
1085 unless ($SDL_MIXER) {
1086 status "Unable to open sound device: there will be no sound";
1087 return;
1088 }
1089
888 CFClient::Mix_AllocateChannels 8; 1090 CFClient::Mix_AllocateChannels 8;
889 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; 1091 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
890 1092
891 audio_music_finished; 1093 audio_music_finished;
892 1094
918} 1120}
919 1121
920my %animate_object; 1122my %animate_object;
921my $animate_timer; 1123my $animate_timer;
922 1124
923my $want_refresh;
924my $can_refresh;
925
926my $fps = 9; 1125my $fps = 9;
927 1126
1127my %demo;#d#
1128
928sub force_refresh { 1129sub force_refresh {
929 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; 1130 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
930 debug sprintf "%3.2f", $fps; 1131 debug sprintf "%3.2f", $fps;
931 1132
932 $want_refresh = 0;
933 $can_refresh = 0;
934
935 $CFClient::UI::ROOT->draw; 1133 $CFClient::UI::ROOT->draw;
936 1134
1135 $WANT_REFRESH = 0;
1136 $CAN_REFRESH = 0;
1137 $LAST_REFRESH = $NOW;
1138
11390 && do {
1140 # some weird model-drawing code, just a joke right now
1141 use CFClient::OpenGL;
1142
1143 $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1144 $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1145 $demo{r} ||= do {
1146 my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1147 $mod->{v} = pack "f*", @{$mod->{v}};
1148 $_ = [scalar @$_, pack "S!*", @$_]
1149 for values %{$mod->{g}};
1150 $mod
1151 };
1152
1153 my $r = $demo{r} or die;
1154
1155 glDepthMask 1;
1156 glClear GL_DEPTH_BUFFER_BIT;
1157 glEnable GL_TEXTURE_2D;
1158 glEnable GL_DEPTH_TEST;
1159 glEnable GL_CULL_FACE;
1160 glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1161
1162 glMatrixMode GL_PROJECTION;
1163 glLoadIdentity;
1164 glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1165 #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1166 glMatrixMode GL_MODELVIEW;
1167 glLoadIdentity;
1168
1169 glPushMatrix;
1170 glTranslate 0, 0, -800;
1171 glScale 1, -1, 1;
1172 glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1173 glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1174 glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1175 glScale 50, 50, 50;
1176
1177 glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1178 while (my ($k, $v) = each %{$r->{g}}) {
1179 glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1180 glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1181 }
1182
1183 glPopMatrix;
1184
1185 glShadeModel GL_FLAT;
1186 glDisable GL_DEPTH_TEST;
1187 glDisable GL_TEXTURE_2D;
1188 glDepthMask 0;
1189
1190 $WANT_REFRESH++;
1191};
1192
937 CFClient::SDL_GL_SwapBuffers; 1193 CFClient::SDL_GL_SwapBuffers;
938
939 $LAST_REFRESH = $NOW;
940} 1194}
941 1195
942my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { 1196my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
943 $NOW = time; 1197 $NOW = time;
944 1198
945 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 1199 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
946 for CFClient::SDL_PollEvent; 1200 for CFClient::SDL_PollEvent;
947 1201
948 if (%animate_object) { 1202 if (%animate_object) {
949 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 1203 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
950 $want_refresh++; 1204 $WANT_REFRESH++;
951 } 1205 }
952 1206
953 if ($want_refresh) { 1207 if ($WANT_REFRESH) {
954 force_refresh; 1208 force_refresh;
955 } else { 1209 } else {
956 $can_refresh = 1; 1210 $CAN_REFRESH = 1;
957 } 1211 }
958}); 1212});
959
960sub refresh {
961 $want_refresh++;
962}
963 1213
964sub animation_start { 1214sub animation_start {
965 my ($widget) = @_; 1215 my ($widget) = @_;
966 $animate_object{$widget} = $widget; 1216 $animate_object{$widget} = $widget;
967} 1217}
971 delete $animate_object{$widget}; 1221 delete $animate_object{$widget};
972} 1222}
973 1223
974@conn::ISA = Crossfire::Protocol::; 1224@conn::ISA = Crossfire::Protocol::;
975 1225
1226sub conn::new {
1227 my $class = shift;
1228
1229 my $self = $class->Crossfire::Protocol::new (@_);
1230
1231 $MAPWIDGET->clr_commands;
1232
1233 my $parser = new Pod::POM;
1234 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1235
1236 for my $head2 ($pod->head2) {
1237 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1238 or next;
1239
1240 my $cmd = $1;
1241 my @args = split /\|/, $2;
1242 @args = (".*") unless @args;
1243
1244 my $text = CFClient::pod_to_pango $head2->content;
1245
1246 for my $arg (@args) {
1247 $arg = $arg eq ".*" ? "" : " $arg";
1248
1249 $MAPWIDGET->add_command ("$cmd$arg", $text);
1250 }
1251 }
1252
1253 $self->{noface} = new_from_file CFClient::Texture
1254 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1255
1256 $self
1257}
1258
976sub conn::stats_update { 1259sub conn::stats_update {
977 my ($self, $stats) = @_; 1260 my ($self, $stats) = @_;
1261
1262 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1263 my $diff = $exp - $self->{prev_exp};
1264 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1265 if exists $self->{prev_exp} && $diff;
1266 $self->{prev_exp} = $exp;
1267 }
978 1268
979 update_stats_window ($stats); 1269 update_stats_window ($stats);
980} 1270}
981 1271
982sub conn::user_send { 1272sub conn::user_send {
1037 $self->set_texture ($id => $data); 1327 $self->set_texture ($id => $data);
1038 } 1328 }
1039 } 1329 }
1040} 1330}
1041 1331
1332# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1333# (server resource,s latency, bandwidth), so this hack is warranted.
1334# the right fix is to make real tiled maps with an overview file
1335sub conn::send_mapinfo {
1336 my ($self, $data, $cb) = @_;
1337
1338 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1339 my ($wx, $wy) = ($1, $2);
1340
1341 if ($data =~ /^spatial ([1-4]+)$/) {
1342 my @dx = (0, 0, 1, 0, -1);
1343 my @dy = (0, -1, 0, 1, 0);
1344 my ($dx, $dy);
1345
1346 for (split //, $1) {
1347 $dx += $dx[$_];
1348 $dy += $dy[$_];
1349 }
1350
1351 $cb->(spatial => 15,
1352 $self->{map_info}[1] - $MAP->ox + $dx * 50,
1353 $self->{map_info}[2] - $MAP->oy + $dy * 50,
1354 50, 50,
1355 sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1356 );
1357
1358 return;
1359 }
1360 }
1361
1362 $self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1363}
1364
1042# this method does a "flood fill" into every tile direction 1365# this method does a "flood fill" into every tile direction
1043# it assumes that tiles are arranged in a rectangular grid, 1366# it assumes that tiles are arranged in a rectangular grid,
1044# i.e. a map is the same as the left of the right map etc. 1367# i.e. a map is the same as the left of the right map etc.
1045# failure to comply are harmless and result in display errors 1368# failure to comply are harmless and result in display errors
1046# at worst. 1369# at worst.
1047sub conn::flood_fill { 1370sub conn::flood_fill {
1048 my ($self, $gx, $gy, $path, $hash, $flags) = @_; 1371 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1049 1372
1050 # the server does not allow map paths > 6 1373 # the server does not allow map paths > 6
1051 return if 7 <= length $path; 1374 return if 7 <= length $path;
1052 1375
1053 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; 1376 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1054 1377
1055 for ( 1378 for (
1056 [1, 0, -1], 1379 [1, 3, 0, -1],
1057 [2, 1, 0], 1380 [2, 4, 1, 0],
1058 [3, 0, 1], 1381 [3, 1, 0, 1],
1059 [4, -1, 0], 1382 [4, 2, -1, 0],
1060 ) { 1383 ) {
1061 my ($tile, $dx, $dy) = @$_; 1384 my ($tile, $tile2, $dx, $dy) = @$_;
1385
1386 next if $block & (1 << $tile);
1387 my $block = $block | (1 << $tile2);
1062 1388
1063 my $gx = $gx + $dx; 1389 my $gx = $gx + $dx;
1064 my $gy = $gy + $dy; 1390 my $gy = $gy + $dy;
1065 1391
1066 next unless $flags & (1 << ($tile - 1)); 1392 next unless $flags & (1 << ($tile - 1));
1068 1394
1069 my $neigh = $self->{neigh_map}{$hash} ||= []; 1395 my $neigh = $self->{neigh_map}{$hash} ||= [];
1070 if (my $info = $neigh->[$tile]) { 1396 if (my $info = $neigh->[$tile]) {
1071 my ($flags, $x, $y, $w, $h, $hash) = @$info; 1397 my ($flags, $x, $y, $w, $h, $hash) = @$info;
1072 1398
1073 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) 1399 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1074 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; 1400 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1075 1401
1076 } else { 1402 } else {
1077 $self->send_mapinfo ("spatial $path$tile", sub { 1403 $self->send_mapinfo ("spatial $path$tile", sub {
1078 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_; 1404 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1079 1405
1080 return if $mode ne "spatial"; 1406 return if $mode ne "spatial";
1081 1407
1082 $x += $MAP->ox; 1408 $x += $MAP->ox;
1083 $y += $MAP->oy; 1409 $y += $MAP->oy;
1084 1410
1085 $self->load_map ($hash, $x, $y) 1411 $self->load_map ($hash, $x, $y)
1086 unless $self->{neigh_map}{$hash}[5]++;#d# 1412 unless $self->{neigh_map}{$hash}[5]++;#d#
1087 1413
1088 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash]; 1414 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1089 1415
1090 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) 1416 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1091 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; 1417 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1092 }); 1418 });
1093 } 1419 }
1094 } 1420 }
1095} 1421}
1108 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5, 1434 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1109 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h, 1435 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1110 ]; 1436 ];
1111 1437
1112 delete $self->{neigh_grid}; 1438 delete $self->{neigh_grid};
1113 $self->flood_fill (0, 0, "", $hash, $flags);
1114 1439
1115 $x += $ox; 1440 $x += $ox;
1116 $y += $oy; 1441 $y += $oy;
1117 1442
1118 $self->{map_info} = [$hash, $x, $y, $w, $h]; 1443 $self->{map_info} = [$hash, $x, $y, $w, $h];
1119 1444
1120 my $map = $self->{map_info}[0];
1121 $map =~ s/^.*?\/([^\/]+)$/\1/; 1445 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1122 $STATWIDS->{map}->set_text ("Map: " . $map); 1446 $STATWIDS->{map}->set_text ("Map: " . $map);
1123 1447
1124 $self->load_map ($hash, $x, $y); 1448 $self->load_map ($hash, $x, $y);
1449 $self->flood_fill (0, 0, 0, "", $hash, $flags);
1125} 1450}
1126 1451
1127sub conn::face_find { 1452sub conn::face_find {
1128 my ($self, $facenum, $face) = @_; 1453 my ($self, $facenum, $face) = @_;
1129 1454
1131 1456
1132 my $id = $FACEMAP->get ($hash); 1457 my $id = $FACEMAP->get ($hash);
1133 1458
1134 unless ($id) { 1459 unless ($id) {
1135 # create new id for face 1460 # create new id for face
1136 # i love transactions 1461 # I love transactions
1137 for (1..100) { 1462 for (1..100) {
1138 my $txn = $CFClient::DB_ENV->txn_begin; 1463 my $txn = $CFClient::DB_ENV->txn_begin;
1139 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW); 1464 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1140 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) { 1465 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1141 $id++; 1466 $id = ($id || 16) + 1;
1142 if ($FACEMAP->put (id => $id) == 0 1467 if ($FACEMAP->put (id => $id) == 0
1143 && $FACEMAP->put ($hash => $id) == 0) { 1468 && $FACEMAP->put ($hash => $id) == 0) {
1144 $txn->txn_commit; 1469 $txn->txn_commit;
1145 1470
1146 goto gotid; 1471 goto gotid;
1154 1479
1155gotid: 1480gotid:
1156 $face->{id} = $id; 1481 $face->{id} = $id;
1157 $MAP->set_face ($facenum => $id); 1482 $MAP->set_face ($facenum => $id);
1158 $self->{faceid}[$facenum] = $id;#d# 1483 $self->{faceid}[$facenum] = $id;#d#
1484
1159 $TILECACHE->get ($id) 1485 $TILECACHE->get ($id) || do {
1486 my $tex = $self->{noface};
1487 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1488 undef
1489 };
1160} 1490}
1161 1491
1162sub conn::face_update { 1492sub conn::face_update {
1163 my ($self, $facenum, $face) = @_; 1493 my ($self, $facenum, $face) = @_;
1164 1494
1257 ); 1587 );
1258 1588
1259 $entry->focus_in; 1589 $entry->focus_in;
1260 } 1590 }
1261 1591
1262 $dialog->show; 1592 $dialog->show_centered;
1263} 1593}
1264 1594
1265sub conn::drawinfo { 1595sub conn::drawinfo {
1266 my ($self, $color, $text) = @_; 1596 my ($self, $color, $text) = @_;
1267 1597
1279 [0.55, 0.41, 0.13], 1609 [0.55, 0.41, 0.13],
1280 [0.99, 0.77, 0.26], 1610 [0.99, 0.77, 0.26],
1281 [0.74, 0.65, 0.41], 1611 [0.74, 0.65, 0.41],
1282 ); 1612 );
1283 1613
1614 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1615
1616 $text = CFClient::UI::Label::escape $text;
1617 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1618 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1619
1284 $LOGVIEW->add_paragraph ($color[$color], $text); 1620 $LOGVIEW->add_paragraph ($color[$color],
1621 join "\n", map "$time $_", split /\n/, $text);
1622
1623 $STATUSBOX->add ($text,
1624 group => $text,
1625 fg => $color[$color],
1626 timeout => 60,
1627 tooltip_font => $::FONT_FIXED,
1628 );
1629}
1630
1631sub conn::drawextinfo {
1632 my ($self, $color, $type, $subtype, $message) = @_;
1633
1634 $self->drawinfo ($color, $message);
1285} 1635}
1286 1636
1287sub conn::spell_add { 1637sub conn::spell_add {
1288 my ($self, $spell) = @_; 1638 my ($self, $spell) = @_;
1289 1639
1290 # TODO 1640 # TODO
1291 # create a widget dynamically, using spell face (CF::Protocol downloads them) 1641 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1292 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}); 1642 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1293 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}); 1643 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1294} 1644}
1295 1645
1296sub conn::spell_delete { 1646sub conn::spell_delete {
1297 my ($self, $spell) = @_; 1647 my ($self, $spell) = @_;
1298} 1648}
1299 1649
1300sub conn::addme_success { 1650sub conn::addme_success {
1301 my ($self) = @_; 1651 my ($self) = @_;
1302 1652
1653 $self->send ("command output-sync $CFG->{output_sync}");
1654 $self->send ("command output-count $CFG->{output_count}");
1655
1656 my $parser = new Pod::POM;
1657 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1658
1659 my %skill_tooltip;
1660
1661 for my $head2 ($pod->head2) {
1662 $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1663 }
1664
1303 for my $skill (values %{$self->{skill_info}}) { 1665 for my $skill (values %{$self->{skill_info}}) {
1304 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1666 $MAPWIDGET->add_command ("ready_skill $skill",
1305 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'"); 1667 (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1668 . $skill_tooltip{$skill});
1669 $MAPWIDGET->add_command ("use_skill $skill",
1670 (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1671 . $skill_tooltip{$skill});
1306 } 1672 }
1673}
1674
1675sub conn::eof {
1676 $MAPWIDGET->clr_commands;
1677
1678 stop_game;
1307} 1679}
1308 1680
1309sub update_floorbox { 1681sub update_floorbox {
1310 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { 1682 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1683 return unless $CONN;
1684
1311 $FLOORBOX->clear; 1685 $FLOORBOX->clear;
1312 $FLOORBOX->add (new CFClient::UI::Empty expand => 1); 1686 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1313 1687
1314 my @items = values %{ $CONN->{container}{0} }; 1688 my $count = 7;
1315 1689 for (@{ $CONN->{container}{0} }) {
1316 # we basically have to use the same sorting as everybody else 1690 if (--$count) {
1317 @items = sort { $a->{type} <=> $b->{type} } @items; 1691 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1318 1692 } else {
1319 for my $item (reverse @items) { 1693 $FLOORBOX->add (new CFClient::UI::Label text => "More...");
1320 my $desc = $item->{nrof} < 2
1321 ? $item->{name}
1322 : "$item->{nrof} $item->{name_pl}";
1323 # todo: animation widget, face widget, weight(?) etc.
1324 $FLOORBOX->add (my $hbox = new CFClient::UI::HBox
1325 tooltip => (CFClient::UI::Label->escape ($desc)
1326 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
1327 can_hover => 1,
1328 can_events => 1,
1329 connect_button_down => sub {
1330 my ($self, $ev, $x, $y) = @_;
1331
1332 # todo: maybe put examine on 1? but should just be a tooltip :(
1333 if ($ev->{button} == 1) {
1334 $CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
1335 } elsif ($ev->{button} == 2) {
1336 $CONN->send ("apply $item->{tag}");
1337 } elsif ($ev->{button} == 3) {
1338 # examine, lock, mark, maybe other things
1339 warn "MENU not implemented yet\n";
1340 }
1341
1342 1
1343 }, 1694 last;
1344 );
1345
1346 $hbox->add (new CFClient::UI::Face
1347 can_events => 0,
1348 face => $item->{face},
1349 anim => $item->{anim},
1350 animspeed => $item->{animspeed},
1351 );
1352 1695 }
1353 $hbox->add (new CFClient::UI::Label
1354 can_events => 0,
1355 text => $desc,
1356 );
1357 } 1696 }
1358 }); 1697 });
1359 refresh; 1698
1699 $WANT_REFRESH++;
1360} 1700}
1361 1701
1362sub conn::container_add { 1702sub conn::container_add {
1363 my ($self, $id, $items) = @_; 1703 my ($self, $tag, $items) = @_;
1364 1704
1365 update_floorbox if $id == 0; 1705 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1706
1707 if ($tag == 0) {
1708 update_floorbox;
1709 $OPENCONT = 0;
1710 $INVR_LBL->set_text ("Floor");
1711 $INVR->set_items ($self->{container}{0});
1712 } elsif ($tag == $self->{player}{tag}) {
1713 $INVR_LBL->set_text ("Player");
1714 $INV->set_items ($self->{container}{$self->{player}{tag}})
1715 } else {
1716 $OPENCONT = $tag;
1717 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1718 $INVR->set_items ($self->{container}{$tag});
1719 }
1720
1366 # $self-<{player}{tag} => player inv 1721 # $self-<{player}{tag} => player inv
1367 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1722 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1368} 1723}
1369 1724
1370sub conn::container_clear { 1725sub conn::container_clear {
1371 my ($self, $id) = @_; 1726 my ($self, $tag) = @_;
1372 1727
1373 update_floorbox if $id == 0; 1728 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1729
1730 if ($tag == 0) {
1731 update_floorbox;
1732 $OPENCONT = 0;
1733 $INVR_LBL->set_text ("Floor");
1734 $INVR->set_items ($self->{container}{0});
1735 } elsif ($tag == $self->{player}{tag}) {
1736 $INVR_LBL->set_text ("Player");
1737 $INV->set_items ($self->{container}{$tag})
1738 } else {
1739 $OPENCONT = $tag;
1740 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1741 $INVR->set_items ($self->{container}{$tag});
1742 }
1743
1374# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1744# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1375} 1745}
1376 1746
1377sub conn::item_delete { 1747sub conn::item_delete {
1378 my ($self, @items) = @_; 1748 my ($self, @items) = @_;
1379 1749
1380 for (@items) { 1750 for (@items) {
1381 update_floorbox if $_->{container} == 0; 1751 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1752
1753 if ($_->{container} == 0) {
1754 update_floorbox;
1755 $OPENCONT = 0;
1756 $INVR_LBL->set_text ("Floor");
1757 $INVR->set_items ($self->{container}{0});
1758 } elsif ($_->{container} == $self->{player}{tag}) {
1759 $INVR_LBL->set_text ("Player");
1760 $INV->set_items ($self->{container}{$self->{player}{tag}})
1761 } else {
1762 $OPENCONT = $_->{container};
1763 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1764 $INVR->set_items ($self->{container}{$_->{container}});
1765 }
1382 } 1766 }
1383} 1767}
1384 1768
1385sub conn::item_update { 1769sub conn::item_update {
1386 my ($self, $item) = @_; 1770 my ($self, $item) = @_;
1387 1771
1388 update_floorbox if $item->{container} == 0; 1772 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1773
1774 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1775 $OPENCONT = 0;
1776 $INVR_LBL->set_text ("Floor");
1777 $INVR->set_items ($self->{container}{0});
1778
1779 $item->{widget}->update_item
1780 if $item->{widget};
1781 } else {
1782 if ($item->{container} == 0) {
1783 update_floorbox;
1784 $OPENCONT = 0;
1785 $INVR_LBL->set_text ("Floor");
1786 $INVR->set_items ($self->{container}{0});
1787 } elsif ($item->{container} == $self->{player}{tag}) {
1788 $INV->set_items ($self->{container}{$item->{container}})
1789 }
1790 }
1389} 1791}
1390 1792
1391%SDL_CB = ( 1793%SDL_CB = (
1392 CFClient::SDL_QUIT => sub { 1794 CFClient::SDL_QUIT => sub {
1393 Event::unloop -1; 1795 Event::unloop -1;
1394 }, 1796 },
1395 CFClient::SDL_VIDEORESIZE => sub { 1797 CFClient::SDL_VIDEORESIZE => sub {
1396 }, 1798 },
1397 CFClient::SDL_VIDEOEXPOSE => \&refresh, 1799 CFClient::SDL_VIDEOEXPOSE => sub {
1800 CFClient::UI::full_refresh;
1801 },
1398 CFClient::SDL_ACTIVEEVENT => sub { 1802 CFClient::SDL_ACTIVEEVENT => sub {
1399# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 1803# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1400 }, 1804 },
1401 CFClient::SDL_KEYDOWN => sub { 1805 CFClient::SDL_KEYDOWN => sub {
1402 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1806 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1406 video_init; 1810 video_init;
1407 } else { 1811 } else {
1408 CFClient::UI::feed_sdl_key_down_event ($_[0]); 1812 CFClient::UI::feed_sdl_key_down_event ($_[0]);
1409 } 1813 }
1410 }, 1814 },
1411 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event, 1815 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1412 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event, 1816 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1413 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event, 1817 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1414 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event, 1818 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1415 CFClient::SDL_USEREVENT => \&audio_music_finished, 1819 CFClient::SDL_USEREVENT => sub {
1820 if ($_[0]{code} == 1) {
1821 audio_channel_finished $_[0]{data1};
1822 } elsif ($_[0]{code} == 0) {
1823 audio_music_finished;
1824 }
1825 },
1416); 1826);
1417 1827
1418############################################################################# 1828#############################################################################
1419 1829
1420$SIG{INT} = $SIG{TERM} = sub { exit }; 1830$SIG{INT} = $SIG{TERM} = sub { exit };
1421 1831
1422$TILECACHE = CFClient::db_table "tilecache";
1423$FACEMAP = CFClient::db_table "facemap";
1424
1425CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1426
1427my %DEF_CFG = (
1428 sdl_mode => 0,
1429 width => 640,
1430 height => 480,
1431 fullscreen => 0,
1432 fast => 0,
1433 map_scale => 0.5,
1434 fow_enable => 1,
1435 fow_intensity => 0.45,
1436 fow_smooth => 0,
1437 gui_fontsize => 1,
1438 log_fontsize => 1,
1439 gauge_fontsize => 1,
1440 gauge_size => 0.35,
1441 stat_fontsize => 1,
1442 mapsize => 100,
1443 host => "crossfire.schmorp.de",
1444 say_command => 'say',
1445 audio_enable => 1,
1446 bgm_enable => 1,
1447 bgm_volume => 0.25,
1448);
1449
1450while (my ($k, $v) = each %DEF_CFG) {
1451 $CFG->{$k} = $v unless exists $CFG->{$k};
1452}
1453
1454sdl_init;
1455
1456@SDL_MODES = reverse
1457 grep $_->[0] >= 640 && $_->[1] >= 480,
1458 CFClient::SDL_ListModes;
1459
1460@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1461
1462$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1463
1464{ 1832{
1833 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1834
1835 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1836
1837 $TILECACHE = CFClient::db_table "tilecache";
1838 $FACEMAP = CFClient::db_table "facemap";
1839
1840 my %DEF_CFG = (
1841 sdl_mode => 0,
1842 width => 640,
1843 height => 480,
1844 fullscreen => 0,
1845 fast => 0,
1846 map_scale => 1,
1847 fow_enable => 1,
1848 fow_intensity => 0.45,
1849 fow_smooth => 0,
1850 gui_fontsize => 1,
1851 log_fontsize => 1,
1852 gauge_fontsize=> 1,
1853 gauge_size => 0.35,
1854 stat_fontsize => 1,
1855 mapsize => 100,
1856 host => "crossfire.schmorp.de",
1857 say_command => 'say',
1858 audio_enable => 1,
1859 bgm_enable => 1,
1860 bgm_volume => 0.25,
1861 output_sync => 1,
1862 output_count => 1,
1863 );
1864
1865 while (my ($k, $v) = each %DEF_CFG) {
1866 $CFG->{$k} = $v unless exists $CFG->{$k};
1867 }
1868
1869 sdl_init;
1870
1871 @SDL_MODES = reverse
1872 grep $_->[0] >= 640 && $_->[1] >= 480,
1873 CFClient::SDL_ListModes;
1874
1875 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1876
1877 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1878
1879 {
1465 my @fonts = map CFClient::find_rcfile "fonts/$_", qw( 1880 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1466 DejaVuSans.ttf 1881 DejaVuSans.ttf
1467 DejaVuSansMono.ttf 1882 DejaVuSansMono.ttf
1468 DejaVuSans-Bold.ttf 1883 DejaVuSans-Bold.ttf
1469 DejaVuSansMono-Bold.ttf 1884 DejaVuSansMono-Bold.ttf
1470 DejaVuSans-Oblique.ttf 1885 DejaVuSans-Oblique.ttf
1471 DejaVuSansMono-Oblique.ttf 1886 DejaVuSansMono-Oblique.ttf
1472 DejaVuSans-BoldOblique.ttf 1887 DejaVuSans-BoldOblique.ttf
1473 DejaVuSansMono-BoldOblique.ttf 1888 DejaVuSansMono-BoldOblique.ttf
1474 ); 1889 );
1475 1890
1476 CFClient::add_font $_ for @fonts; 1891 CFClient::add_font $_ for @fonts;
1477 1892
1893 CFClient::pango_init;
1894
1478 $FONT_PROP = new_from_file CFClient::Font $fonts[0]; 1895 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1479 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1896 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1480 1897
1481 $FONT_PROP->make_default; 1898 $FONT_PROP->make_default;
1482} 1899 }
1483 1900
1901# compare mono (ft) vs. rgba (cairo)
1902# ft - 1.8s, cairo 3s, even in alpha-only mode
1903# for my $rgba (0..1) {
1904# my $t1 = Time::HiRes::time;
1905# for (1..1000) {
1906# my $layout = CFClient::Layout->new ($rgba);
1907# $layout->set_text ("hallo" x 100);
1908# $layout->render;
1909# }
1910# my $t2 = Time::HiRes::time;
1911# warn $t2-$t1;
1912# }
1913
1484video_init; 1914 video_init;
1485audio_init; 1915 audio_init;
1916}
1486 1917
1487Event::loop; 1918Event::loop;
1488 1919
1489END { CFClient::SDL_Quit } 1920END { CFClient::SDL_Quit }
1490 1921
1922=head1 NAME
1923
1491=head1 pclient - Crossfire+ and Crossfire game client 1924pclient - A Crossfire+ and Crossfire game client
1492 1925
1493Pclient is a Crossfire+ and Crossfire game client. 1926=head1 SYNOPSIS
1494 1927
1495=head2 Features 1928Just run it - no commandline arguments are supported.
1496
1497=over 4
1498
1499=item Fullscreen Map
1500
1501PClient can uses a fullscreen map, which greatly enhances how much of the
1502game world you can see.
1503
1504=item Persistent Map Cache (Crossfire+ only)
1505
1506PClient can persistently cache all map data it received from the
1507server. This not only allows it to display an overview map, but also
1508ensures that once-explored areas will be available the next time you want
1509to explore more.
1510
1511=item Hardware acceleration
1512
1513Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
1514acceleration. Most modern graphics cards have difficulties with 2D
1515acceleration, while 3D graphics is accelerated well.
1516
1517=item No arbitrary limits
1518
1519Unlike other Crossfire clients, pclient does not suffer from arbitrary
1520limits (like a fixed amount of face numbers). There are still limits, but
1521they are not arbitrarily low :)
1522
1523=back
1524 1929
1525=head1 USAGE 1930=head1 USAGE
1526 1931
1527=head2 The Map 1932Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used
1528 1933fullscreen and interactively.
1529The map is always displayed in the background, behind all other windows and UI elements.
1530
1531#TODO# middle-click scrolls
1532#
1533# keys:
1534#
1535# a apply
1536# keypad moves, kp_5 applies ranged attack to self
1537
1538Starting to type enters the I<completion mode>. In that mode, you can type
1539abbreviations or commands and have them executed as soon as they match a
1540valid command. This is best explained by a few examples:
1541
1542Typing B<climb> will display a list of commands with I<climb> in their
1543name, such as I<ready_skill climbing> and I<use_skill climbing>.
1544
1545You can abbreviate commands by typing only the first character of every
1546word. For example, typing I<iwor> will likely select I<invoke word of
1547recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
1548will likely select I<ready_skill climbing> and I<usl> will give you
1549I<use_skill levitation>.
1550
1551=head2 The map overview
1552
1553#TODO#
1554
1555=head2 The Status area in the lower right corner
1556
1557#TODO#
1558
1559=head2 The I<Statistics>/I>Stats> window
1560
1561#TODO#
1562
1563=head1 FAQ
1564
1565=over 4
1566
1567=item The client is very sluggish and slow, what can I do about this?
1568
1569Most likely, you don't have accelerated OpenGL support. Try to find a
1570newer driver, or a driver from your hardware vendor, that features OpenGL
1571support.
1572
1573If this is not an option, the following Setup options reduce the load and
1574will likely make the client playable with sofwtare rendering (it will
1575still be slow, though):
1576
1577=over 4
1578
1579=item B<Video Mode> should be set as low as possible (e.g. 640x480)
1580
1581=item Enable B<Fast & Ugly> mode
1582
1583=item Disable B<Fog of War>
1584
1585=item Increase B<Map Scale>
1586
1587=back
1588
1589=back
1590 1934
1591=head1 AUTHOR 1935=head1 AUTHOR
1592 1936
1593Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org> 1937Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1594 1938

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines