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.248 by root, Thu May 25 01:26:54 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 [manual => "Manual"],
898 [command_help => "Commands"],
899 [skill_help => "Skills"],
900 ) {
901 my ($pod, $label) = @$_;
902
903 $buttons->add (new CFClient::UI::Button
904 text => $label,
905 connect_activate => sub {
906 my $parser = new Pod::POM;
907 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
908
909 $viewer->clear;
910
911 $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
912 for @{ CFClient::pod_to_pango_list $pom };
913
914 $viewer->set_offset (0);
915 },
916 );
917 }
918
919 $viewer->add_paragraph ([1, 1, 0, 1], "<big>Use one of the buttons above to display a document.</big>");
920
921 $win
922}
923
783sub sdl_init { 924sub sdl_init {
784 CFClient::SDL_Init 925 CFClient::SDL_Init
785 and die "SDL::Init failed!\n"; 926 and die "SDL::Init failed!\n";
786} 927}
787 928
788sub video_init { 929sub video_init {
789 sdl_init; 930 sdl_init;
790 931
932 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
933
934 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
935
791 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 936 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
792 $FULLSCREEN = $CFG->{fullscreen}; 937 $FULLSCREEN = $CFG->{fullscreen};
793 $FAST = $CFG->{fast}; 938 $FAST = $CFG->{fast};
794 939
795 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN 940 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
796 or die "SDL_SetVideoMode failed!\n"; 941 or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
797 942
798 $SDL_ACTIVE = 1; 943 $SDL_ACTIVE = 1;
799
800 $LAST_REFRESH = time - 0.01; 944 $LAST_REFRESH = time - 0.01;
801 945
802 CFClient::gl_init; 946 CFClient::gl_init;
803 947
804 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 948 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
805 949
950 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
951
806 ############################################################################# 952 #############################################################################
807 953
954 if ($DEBUG_STATUS) {
955 CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
956 } else {
957 # create the widgets
958
808 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 959 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
809 $DEBUG_STATUS->show; 960 $DEBUG_STATUS->show;
810 961
811 $STATUS_LINE = new CFClient::UI::Label 962 $STATUSBOX = new CFClient::UI::Statusbox;
812 padding => 0, 963 $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 964
816 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 965 (new CFClient::UI::Frame
817 padding => 0, 966 bg => [0, 0, 0, 0.4],
818 fontsize => 0.8, 967 req_y => -1,
819 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 968 child => $STATUSBOX,
820 $ALT_ENTER_MESSAGE->show; 969 )->show;
821 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
822 970
823 CFClient::UI::FancyFrame->new ( 971 CFClient::UI::FancyFrame->new (
824 border_bg => [1, 1, 1, 192/255], 972 border_bg => [1, 1, 1, 192/255],
825 bg => [1, 1, 1, 0], 973 bg => [1, 1, 1, 0],
826 child => $MAPMAP = new CFClient::MapWidget::MapMap 974 child => ($MAPMAP = new CFClient::MapWidget::MapMap
975 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
976 ),
827 )->show; 977 )->show;
828 978
829 $MAPWIDGET = new CFClient::MapWidget; 979 $MAPWIDGET = new CFClient::MapWidget;
830 $MAPWIDGET->connect (activate_console => sub { 980 $MAPWIDGET->connect (activate_console => sub {
831 my ($mapwidget, $preset) = @_; 981 my ($mapwidget, $preset) = @_;
832 982
833 if ($CONSOLE) { 983 if ($CONSOLE) {
834 $CONSOLE->{input}->{auto_activated} = 1; 984 $CONSOLE->{input}->{auto_activated} = 1;
835 $CONSOLE->{input}->focus_in; 985 $CONSOLE->{input}->focus_in;
836 986
837 if ($preset && $CONSOLE->{input}->get_text eq '') { 987 if ($preset && $CONSOLE->{input}->get_text eq '') {
838 $CONSOLE->{input}->set_text ($preset); 988 $CONSOLE->{input}->set_text ($preset);
989 }
839 } 990 }
840 } 991 });
841 });
842 $MAPWIDGET->show; 992 $MAPWIDGET->show;
843 $MAPWIDGET->focus_in; 993 $MAPWIDGET->focus_in;
844 994
995 $LOGVIEW = new CFClient::UI::TextView
996 expand => 1,
997 font => $FONT_FIXED,
998 fontsize => $::CFG->{log_fontsize},
999 can_hover => 1,
1000 can_events => 1,
1001 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1002 ;
1003
845 $BUTTONBAR = new CFClient::UI::HBox; 1004 $BUTTONBAR = new CFClient::UI::HBox;
846 1005
847 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 1006 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,
1007 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); 1008 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,
1009 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); 1010 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
1011 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
850 1012
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 1013 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
1014
852 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window); 1015 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
1016 tooltip => "Toggles the statistics window, where all your Stats and Resistances are beign displaye at all times.");
1017 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
1018 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
853 1019
854 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 1020 $BUTTONBAR->add (new CFClient::UI::Button
1021 text => "Save Config",
1022 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1023 connect_activate => sub {
855 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 1024 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
856 status "Configuration Saved"; 1025 status "Configuration Saved";
857 }); 1026 },
1027 );
858 1028
1029 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1030 tooltip => "View Documentation");
1031
1032 $BUTTONBAR->add (new CFClient::UI::Button
1033 text => "Quit",
1034 tooltip => "Terminates the program",
1035 connect_activate => sub {
1036 if ($CONN) {
1037 open_quit_dialog;
1038 } else {
1039 exit;
1040 }
1041 },
1042 );
1043
859 $BUTTONBAR->show; 1044 $BUTTONBAR->show;
860 1045
1046 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1047
1048 # delay till geometry is constant
1049 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
861 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 1050 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
1051 my $widget = $GAUGES->{win};
1052 $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
1053 });
1054 force_refresh ();
1055 }
862} 1056}
863 1057
864sub video_shutdown { 1058sub video_shutdown {
865 $CFClient::UI::ROOT->{children} = [];
866 undef $CFClient::UI::GRAB;
867 undef $CFClient::UI::HOVER;
868 undef $SDL_ACTIVE; 1059 undef $SDL_ACTIVE;
869} 1060}
870 1061
871my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d# 1062my @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# 1063my $bgmusic;#TODO#hack#d#
1064
1065sub audio_channel_finished {
1066 my ($channel) = @_;
1067
1068 #warn "channel $channel finished\n";#d#
1069}
873 1070
874sub audio_music_finished { 1071sub audio_music_finished {
875 return unless $CFG->{bgm_enable}; 1072 return unless $CFG->{bgm_enable};
876 1073
877 # TODO: hack, do play loop and mood music 1074 # TODO: hack, do play loop and mood music
881 push @bgmusic, shift @bgmusic; 1078 push @bgmusic, shift @bgmusic;
882} 1079}
883 1080
884sub audio_init { 1081sub audio_init {
885 if ($CFG->{audio_enable}) { 1082 if ($CFG->{audio_enable}) {
886 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { 1083 if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
887 $SDL_MIXER = !CFClient::Mix_OpenAudio; 1084 $SDL_MIXER = !CFClient::Mix_OpenAudio;
1085
1086 unless ($SDL_MIXER) {
1087 status "Unable to open sound device: there will be no sound";
1088 return;
1089 }
1090
888 CFClient::Mix_AllocateChannels 8; 1091 CFClient::Mix_AllocateChannels 8;
889 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; 1092 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
890 1093
891 audio_music_finished; 1094 audio_music_finished;
892 1095
918} 1121}
919 1122
920my %animate_object; 1123my %animate_object;
921my $animate_timer; 1124my $animate_timer;
922 1125
923my $want_refresh;
924my $can_refresh;
925
926my $fps = 9; 1126my $fps = 9;
927 1127
1128my %demo;#d#
1129
928sub force_refresh { 1130sub force_refresh {
929 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; 1131 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
930 debug sprintf "%3.2f", $fps; 1132 debug sprintf "%3.2f", $fps;
931 1133
932 $want_refresh = 0;
933 $can_refresh = 0;
934
935 $CFClient::UI::ROOT->draw; 1134 $CFClient::UI::ROOT->draw;
936 1135
1136 $WANT_REFRESH = 0;
1137 $CAN_REFRESH = 0;
1138 $LAST_REFRESH = $NOW;
1139
11400 && do {
1141 # some weird model-drawing code, just a joke right now
1142 use CFClient::OpenGL;
1143
1144 $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1145 $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1146 $demo{r} ||= do {
1147 my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1148 $mod->{v} = pack "f*", @{$mod->{v}};
1149 $_ = [scalar @$_, pack "S!*", @$_]
1150 for values %{$mod->{g}};
1151 $mod
1152 };
1153
1154 my $r = $demo{r} or die;
1155
1156 glDepthMask 1;
1157 glClear GL_DEPTH_BUFFER_BIT;
1158 glEnable GL_TEXTURE_2D;
1159 glEnable GL_DEPTH_TEST;
1160 glEnable GL_CULL_FACE;
1161 glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1162
1163 glMatrixMode GL_PROJECTION;
1164 glLoadIdentity;
1165 glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1166 #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1167 glMatrixMode GL_MODELVIEW;
1168 glLoadIdentity;
1169
1170 glPushMatrix;
1171 glTranslate 0, 0, -800;
1172 glScale 1, -1, 1;
1173 glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1174 glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1175 glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1176 glScale 50, 50, 50;
1177
1178 glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1179 while (my ($k, $v) = each %{$r->{g}}) {
1180 glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1181 glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1182 }
1183
1184 glPopMatrix;
1185
1186 glShadeModel GL_FLAT;
1187 glDisable GL_DEPTH_TEST;
1188 glDisable GL_TEXTURE_2D;
1189 glDepthMask 0;
1190
1191 $WANT_REFRESH++;
1192};
1193
937 CFClient::SDL_GL_SwapBuffers; 1194 CFClient::SDL_GL_SwapBuffers;
938
939 $LAST_REFRESH = $NOW;
940} 1195}
941 1196
942my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { 1197my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
943 $NOW = time; 1198 $NOW = time;
944 1199
945 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 1200 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
946 for CFClient::SDL_PollEvent; 1201 for CFClient::SDL_PollEvent;
947 1202
948 if (%animate_object) { 1203 if (%animate_object) {
949 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 1204 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
950 $want_refresh++; 1205 $WANT_REFRESH++;
951 } 1206 }
952 1207
953 if ($want_refresh) { 1208 if ($WANT_REFRESH) {
954 force_refresh; 1209 force_refresh;
955 } else { 1210 } else {
956 $can_refresh = 1; 1211 $CAN_REFRESH = 1;
957 } 1212 }
958}); 1213});
959
960sub refresh {
961 $want_refresh++;
962}
963 1214
964sub animation_start { 1215sub animation_start {
965 my ($widget) = @_; 1216 my ($widget) = @_;
966 $animate_object{$widget} = $widget; 1217 $animate_object{$widget} = $widget;
967} 1218}
971 delete $animate_object{$widget}; 1222 delete $animate_object{$widget};
972} 1223}
973 1224
974@conn::ISA = Crossfire::Protocol::; 1225@conn::ISA = Crossfire::Protocol::;
975 1226
1227sub conn::new {
1228 my $class = shift;
1229
1230 my $self = $class->Crossfire::Protocol::new (@_);
1231
1232 $MAPWIDGET->clr_commands;
1233
1234 my $parser = new Pod::POM;
1235 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1236
1237 for my $head2 ($pod->head2) {
1238 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1239 or next;
1240
1241 my $cmd = $1;
1242 my @args = split /\|/, $2;
1243 @args = (".*") unless @args;
1244
1245 my $text = CFClient::pod_to_pango $head2->content;
1246
1247 for my $arg (@args) {
1248 $arg = $arg eq ".*" ? "" : " $arg";
1249
1250 $MAPWIDGET->add_command ("$cmd$arg", $text);
1251 }
1252 }
1253
1254 $self->{noface} = new_from_file CFClient::Texture
1255 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1256
1257 $self
1258}
1259
976sub conn::stats_update { 1260sub conn::stats_update {
977 my ($self, $stats) = @_; 1261 my ($self, $stats) = @_;
1262
1263 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1264 my $diff = $exp - $self->{prev_exp};
1265 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1266 if exists $self->{prev_exp} && $diff;
1267 $self->{prev_exp} = $exp;
1268 }
978 1269
979 update_stats_window ($stats); 1270 update_stats_window ($stats);
980} 1271}
981 1272
982sub conn::user_send { 1273sub conn::user_send {
1037 $self->set_texture ($id => $data); 1328 $self->set_texture ($id => $data);
1038 } 1329 }
1039 } 1330 }
1040} 1331}
1041 1332
1333# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1334# (server resource,s latency, bandwidth), so this hack is warranted.
1335# the right fix is to make real tiled maps with an overview file
1336sub conn::send_mapinfo {
1337 my ($self, $data, $cb) = @_;
1338
1339 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1340 my ($wx, $wy) = ($1, $2);
1341
1342 if ($data =~ /^spatial ([1-4]+)$/) {
1343 my @dx = (0, 0, 1, 0, -1);
1344 my @dy = (0, -1, 0, 1, 0);
1345 my ($dx, $dy);
1346
1347 for (split //, $1) {
1348 $dx += $dx[$_];
1349 $dy += $dy[$_];
1350 }
1351
1352 $cb->(spatial => 15,
1353 $self->{map_info}[1] - $MAP->ox + $dx * 50,
1354 $self->{map_info}[2] - $MAP->oy + $dy * 50,
1355 50, 50,
1356 sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1357 );
1358
1359 return;
1360 }
1361 }
1362
1363 $self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1364}
1365
1042# this method does a "flood fill" into every tile direction 1366# this method does a "flood fill" into every tile direction
1043# it assumes that tiles are arranged in a rectangular grid, 1367# 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. 1368# 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 1369# failure to comply are harmless and result in display errors
1046# at worst. 1370# at worst.
1047sub conn::flood_fill { 1371sub conn::flood_fill {
1048 my ($self, $gx, $gy, $path, $hash, $flags) = @_; 1372 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1049 1373
1050 # the server does not allow map paths > 6 1374 # the server does not allow map paths > 6
1051 return if 7 <= length $path; 1375 return if 7 <= length $path;
1052 1376
1053 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; 1377 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1054 1378
1055 for ( 1379 for (
1056 [1, 0, -1], 1380 [1, 3, 0, -1],
1057 [2, 1, 0], 1381 [2, 4, 1, 0],
1058 [3, 0, 1], 1382 [3, 1, 0, 1],
1059 [4, -1, 0], 1383 [4, 2, -1, 0],
1060 ) { 1384 ) {
1061 my ($tile, $dx, $dy) = @$_; 1385 my ($tile, $tile2, $dx, $dy) = @$_;
1386
1387 next if $block & (1 << $tile);
1388 my $block = $block | (1 << $tile2);
1062 1389
1063 my $gx = $gx + $dx; 1390 my $gx = $gx + $dx;
1064 my $gy = $gy + $dy; 1391 my $gy = $gy + $dy;
1065 1392
1066 next unless $flags & (1 << ($tile - 1)); 1393 next unless $flags & (1 << ($tile - 1));
1068 1395
1069 my $neigh = $self->{neigh_map}{$hash} ||= []; 1396 my $neigh = $self->{neigh_map}{$hash} ||= [];
1070 if (my $info = $neigh->[$tile]) { 1397 if (my $info = $neigh->[$tile]) {
1071 my ($flags, $x, $y, $w, $h, $hash) = @$info; 1398 my ($flags, $x, $y, $w, $h, $hash) = @$info;
1072 1399
1073 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) 1400 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1074 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; 1401 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1075 1402
1076 } else { 1403 } else {
1077 $self->send_mapinfo ("spatial $path$tile", sub { 1404 $self->send_mapinfo ("spatial $path$tile", sub {
1078 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_; 1405 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1079 1406
1080 return if $mode ne "spatial"; 1407 return if $mode ne "spatial";
1081 1408
1082 $x += $MAP->ox; 1409 $x += $MAP->ox;
1083 $y += $MAP->oy; 1410 $y += $MAP->oy;
1084 1411
1085 $self->load_map ($hash, $x, $y) 1412 $self->load_map ($hash, $x, $y)
1086 unless $self->{neigh_map}{$hash}[5]++;#d# 1413 unless $self->{neigh_map}{$hash}[5]++;#d#
1087 1414
1088 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash]; 1415 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1089 1416
1090 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) 1417 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1091 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; 1418 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1092 }); 1419 });
1093 } 1420 }
1094 } 1421 }
1095} 1422}
1108 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5, 1435 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1109 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h, 1436 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1110 ]; 1437 ];
1111 1438
1112 delete $self->{neigh_grid}; 1439 delete $self->{neigh_grid};
1113 $self->flood_fill (0, 0, "", $hash, $flags);
1114 1440
1115 $x += $ox; 1441 $x += $ox;
1116 $y += $oy; 1442 $y += $oy;
1117 1443
1118 $self->{map_info} = [$hash, $x, $y, $w, $h]; 1444 $self->{map_info} = [$hash, $x, $y, $w, $h];
1119 1445
1120 my $map = $self->{map_info}[0];
1121 $map =~ s/^.*?\/([^\/]+)$/\1/; 1446 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1122 $STATWIDS->{map}->set_text ("Map: " . $map); 1447 $STATWIDS->{map}->set_text ("Map: " . $map);
1123 1448
1124 $self->load_map ($hash, $x, $y); 1449 $self->load_map ($hash, $x, $y);
1450 $self->flood_fill (0, 0, 0, "", $hash, $flags);
1125} 1451}
1126 1452
1127sub conn::face_find { 1453sub conn::face_find {
1128 my ($self, $facenum, $face) = @_; 1454 my ($self, $facenum, $face) = @_;
1129 1455
1131 1457
1132 my $id = $FACEMAP->get ($hash); 1458 my $id = $FACEMAP->get ($hash);
1133 1459
1134 unless ($id) { 1460 unless ($id) {
1135 # create new id for face 1461 # create new id for face
1136 # i love transactions 1462 # I love transactions
1137 for (1..100) { 1463 for (1..100) {
1138 my $txn = $CFClient::DB_ENV->txn_begin; 1464 my $txn = $CFClient::DB_ENV->txn_begin;
1139 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW); 1465 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1140 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) { 1466 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1141 $id++; 1467 $id = ($id || 16) + 1;
1142 if ($FACEMAP->put (id => $id) == 0 1468 if ($FACEMAP->put (id => $id) == 0
1143 && $FACEMAP->put ($hash => $id) == 0) { 1469 && $FACEMAP->put ($hash => $id) == 0) {
1144 $txn->txn_commit; 1470 $txn->txn_commit;
1145 1471
1146 goto gotid; 1472 goto gotid;
1154 1480
1155gotid: 1481gotid:
1156 $face->{id} = $id; 1482 $face->{id} = $id;
1157 $MAP->set_face ($facenum => $id); 1483 $MAP->set_face ($facenum => $id);
1158 $self->{faceid}[$facenum] = $id;#d# 1484 $self->{faceid}[$facenum] = $id;#d#
1485
1159 $TILECACHE->get ($id) 1486 $TILECACHE->get ($id) || do {
1487 my $tex = $self->{noface};
1488 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1489 undef
1490 };
1160} 1491}
1161 1492
1162sub conn::face_update { 1493sub conn::face_update {
1163 my ($self, $facenum, $face) = @_; 1494 my ($self, $facenum, $face) = @_;
1164 1495
1257 ); 1588 );
1258 1589
1259 $entry->focus_in; 1590 $entry->focus_in;
1260 } 1591 }
1261 1592
1262 $dialog->show; 1593 $dialog->show_centered;
1263} 1594}
1264 1595
1265sub conn::drawinfo { 1596sub conn::drawinfo {
1266 my ($self, $color, $text) = @_; 1597 my ($self, $color, $text) = @_;
1267 1598
1279 [0.55, 0.41, 0.13], 1610 [0.55, 0.41, 0.13],
1280 [0.99, 0.77, 0.26], 1611 [0.99, 0.77, 0.26],
1281 [0.74, 0.65, 0.41], 1612 [0.74, 0.65, 0.41],
1282 ); 1613 );
1283 1614
1615 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1616
1617 $text = CFClient::UI::Label::escape $text;
1618 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1619 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1620
1284 $LOGVIEW->add_paragraph ($color[$color], $text); 1621 $LOGVIEW->add_paragraph ($color[$color],
1622 join "\n", map "$time $_", split /\n/, $text);
1623
1624 $STATUSBOX->add ($text,
1625 group => $text,
1626 fg => $color[$color],
1627 timeout => 60,
1628 tooltip_font => $::FONT_FIXED,
1629 );
1630}
1631
1632sub conn::drawextinfo {
1633 my ($self, $color, $type, $subtype, $message) = @_;
1634
1635 $self->drawinfo ($color, $message);
1285} 1636}
1286 1637
1287sub conn::spell_add { 1638sub conn::spell_add {
1288 my ($self, $spell) = @_; 1639 my ($self, $spell) = @_;
1289 1640
1290 # TODO 1641 # TODO
1291 # create a widget dynamically, using spell face (CF::Protocol downloads them) 1642 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1292 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}); 1643 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1293 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}); 1644 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1294} 1645}
1295 1646
1296sub conn::spell_delete { 1647sub conn::spell_delete {
1297 my ($self, $spell) = @_; 1648 my ($self, $spell) = @_;
1298} 1649}
1299 1650
1300sub conn::addme_success { 1651sub conn::addme_success {
1301 my ($self) = @_; 1652 my ($self) = @_;
1302 1653
1654 $self->send ("command output-sync $CFG->{output_sync}");
1655 $self->send ("command output-count $CFG->{output_count}");
1656
1657 my $parser = new Pod::POM;
1658 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1659
1660 my %skill_tooltip;
1661
1662 for my $head2 ($pod->head2) {
1663 $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1664 }
1665
1303 for my $skill (values %{$self->{skill_info}}) { 1666 for my $skill (values %{$self->{skill_info}}) {
1304 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1667 $MAPWIDGET->add_command ("ready_skill $skill",
1305 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'"); 1668 (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1669 . $skill_tooltip{$skill});
1670 $MAPWIDGET->add_command ("use_skill $skill",
1671 (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1672 . $skill_tooltip{$skill});
1306 } 1673 }
1674}
1675
1676sub conn::eof {
1677 $MAPWIDGET->clr_commands;
1678
1679 stop_game;
1307} 1680}
1308 1681
1309sub update_floorbox { 1682sub update_floorbox {
1310 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { 1683 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1684 return unless $CONN;
1685
1311 $FLOORBOX->clear; 1686 $FLOORBOX->clear;
1312 $FLOORBOX->add (new CFClient::UI::Empty expand => 1); 1687 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1313 1688
1314 my @items = values %{ $CONN->{container}{0} }; 1689 my $count = 7;
1315 1690 for (@{ $CONN->{container}{0} }) {
1316 # we basically have to use the same sorting as everybody else 1691 if (--$count) {
1317 @items = sort { $a->{type} <=> $b->{type} } @items; 1692 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1318 1693 } else {
1319 for my $item (reverse @items) { 1694 $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 }, 1695 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 1696 }
1353 $hbox->add (new CFClient::UI::Label
1354 can_events => 0,
1355 text => $desc,
1356 );
1357 } 1697 }
1358 }); 1698 });
1359 refresh; 1699
1700 $WANT_REFRESH++;
1360} 1701}
1361 1702
1362sub conn::container_add { 1703sub conn::container_add {
1363 my ($self, $id, $items) = @_; 1704 my ($self, $tag, $items) = @_;
1364 1705
1365 update_floorbox if $id == 0; 1706 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1707
1708 if ($tag == 0) {
1709 update_floorbox;
1710 $OPENCONT = 0;
1711 $INVR_LBL->set_text ("Floor");
1712 $INVR->set_items ($self->{container}{0});
1713 } elsif ($tag == $self->{player}{tag}) {
1714 $INVR_LBL->set_text ("Player");
1715 $INV->set_items ($self->{container}{$self->{player}{tag}})
1716 } else {
1717 $OPENCONT = $tag;
1718 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1719 $INVR->set_items ($self->{container}{$tag});
1720 }
1721
1366 # $self-<{player}{tag} => player inv 1722 # $self-<{player}{tag} => player inv
1367 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1723 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1368} 1724}
1369 1725
1370sub conn::container_clear { 1726sub conn::container_clear {
1371 my ($self, $id) = @_; 1727 my ($self, $tag) = @_;
1372 1728
1373 update_floorbox if $id == 0; 1729 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1730
1731 if ($tag == 0) {
1732 update_floorbox;
1733 $OPENCONT = 0;
1734 $INVR_LBL->set_text ("Floor");
1735 $INVR->set_items ($self->{container}{0});
1736 } elsif ($tag == $self->{player}{tag}) {
1737 $INVR_LBL->set_text ("Player");
1738 $INV->set_items ($self->{container}{$tag})
1739 } else {
1740 $OPENCONT = $tag;
1741 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1742 $INVR->set_items ($self->{container}{$tag});
1743 }
1744
1374# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1745# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1375} 1746}
1376 1747
1377sub conn::item_delete { 1748sub conn::item_delete {
1378 my ($self, @items) = @_; 1749 my ($self, @items) = @_;
1379 1750
1380 for (@items) { 1751 for (@items) {
1381 update_floorbox if $_->{container} == 0; 1752 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1753
1754 if ($_->{container} == 0) {
1755 update_floorbox;
1756 $OPENCONT = 0;
1757 $INVR_LBL->set_text ("Floor");
1758 $INVR->set_items ($self->{container}{0});
1759 } elsif ($_->{container} == $self->{player}{tag}) {
1760 $INVR_LBL->set_text ("Player");
1761 $INV->set_items ($self->{container}{$self->{player}{tag}})
1762 } else {
1763 $OPENCONT = $_->{container};
1764 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1765 $INVR->set_items ($self->{container}{$_->{container}});
1766 }
1382 } 1767 }
1383} 1768}
1384 1769
1385sub conn::item_update { 1770sub conn::item_update {
1386 my ($self, $item) = @_; 1771 my ($self, $item) = @_;
1387 1772
1388 update_floorbox if $item->{container} == 0; 1773 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1774
1775 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1776 $OPENCONT = 0;
1777 $INVR_LBL->set_text ("Floor");
1778 $INVR->set_items ($self->{container}{0});
1779
1780 $item->{widget}->update_item
1781 if $item->{widget};
1782 } else {
1783 if ($item->{container} == 0) {
1784 update_floorbox;
1785 $OPENCONT = 0;
1786 $INVR_LBL->set_text ("Floor");
1787 $INVR->set_items ($self->{container}{0});
1788 } elsif ($item->{container} == $self->{player}{tag}) {
1789 $INV->set_items ($self->{container}{$item->{container}})
1790 }
1791 }
1389} 1792}
1390 1793
1391%SDL_CB = ( 1794%SDL_CB = (
1392 CFClient::SDL_QUIT => sub { 1795 CFClient::SDL_QUIT => sub {
1393 Event::unloop -1; 1796 Event::unloop -1;
1394 }, 1797 },
1395 CFClient::SDL_VIDEORESIZE => sub { 1798 CFClient::SDL_VIDEORESIZE => sub {
1396 }, 1799 },
1397 CFClient::SDL_VIDEOEXPOSE => \&refresh, 1800 CFClient::SDL_VIDEOEXPOSE => sub {
1801 CFClient::UI::full_refresh;
1802 },
1398 CFClient::SDL_ACTIVEEVENT => sub { 1803 CFClient::SDL_ACTIVEEVENT => sub {
1399# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 1804# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1400 }, 1805 },
1401 CFClient::SDL_KEYDOWN => sub { 1806 CFClient::SDL_KEYDOWN => sub {
1402 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1807 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1406 video_init; 1811 video_init;
1407 } else { 1812 } else {
1408 CFClient::UI::feed_sdl_key_down_event ($_[0]); 1813 CFClient::UI::feed_sdl_key_down_event ($_[0]);
1409 } 1814 }
1410 }, 1815 },
1411 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event, 1816 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1412 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event, 1817 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1413 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event, 1818 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1414 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event, 1819 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1415 CFClient::SDL_USEREVENT => \&audio_music_finished, 1820 CFClient::SDL_USEREVENT => sub {
1821 if ($_[0]{code} == 1) {
1822 audio_channel_finished $_[0]{data1};
1823 } elsif ($_[0]{code} == 0) {
1824 audio_music_finished;
1825 }
1826 },
1416); 1827);
1417 1828
1418############################################################################# 1829#############################################################################
1419 1830
1420$SIG{INT} = $SIG{TERM} = sub { exit }; 1831$SIG{INT} = $SIG{TERM} = sub { exit };
1421 1832
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{ 1833{
1834 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1835
1836 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1837
1838 $TILECACHE = CFClient::db_table "tilecache";
1839 $FACEMAP = CFClient::db_table "facemap";
1840
1841 my %DEF_CFG = (
1842 sdl_mode => 0,
1843 width => 640,
1844 height => 480,
1845 fullscreen => 0,
1846 fast => 0,
1847 map_scale => 1,
1848 fow_enable => 1,
1849 fow_intensity => 0.45,
1850 fow_smooth => 0,
1851 gui_fontsize => 1,
1852 log_fontsize => 1,
1853 gauge_fontsize=> 1,
1854 gauge_size => 0.35,
1855 stat_fontsize => 1,
1856 mapsize => 100,
1857 host => "crossfire.schmorp.de",
1858 say_command => 'say',
1859 audio_enable => 1,
1860 bgm_enable => 1,
1861 bgm_volume => 0.25,
1862 output_sync => 1,
1863 output_count => 1,
1864 );
1865
1866 while (my ($k, $v) = each %DEF_CFG) {
1867 $CFG->{$k} = $v unless exists $CFG->{$k};
1868 }
1869
1870 sdl_init;
1871
1872 @SDL_MODES = reverse
1873 grep $_->[0] >= 640 && $_->[1] >= 480,
1874 CFClient::SDL_ListModes;
1875
1876 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1877
1878 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1879
1880 {
1465 my @fonts = map CFClient::find_rcfile "fonts/$_", qw( 1881 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1466 DejaVuSans.ttf 1882 DejaVuSans.ttf
1467 DejaVuSansMono.ttf 1883 DejaVuSansMono.ttf
1468 DejaVuSans-Bold.ttf 1884 DejaVuSans-Bold.ttf
1469 DejaVuSansMono-Bold.ttf 1885 DejaVuSansMono-Bold.ttf
1470 DejaVuSans-Oblique.ttf 1886 DejaVuSans-Oblique.ttf
1471 DejaVuSansMono-Oblique.ttf 1887 DejaVuSansMono-Oblique.ttf
1472 DejaVuSans-BoldOblique.ttf 1888 DejaVuSans-BoldOblique.ttf
1473 DejaVuSansMono-BoldOblique.ttf 1889 DejaVuSansMono-BoldOblique.ttf
1474 ); 1890 );
1475 1891
1476 CFClient::add_font $_ for @fonts; 1892 CFClient::add_font $_ for @fonts;
1477 1893
1894 CFClient::pango_init;
1895
1478 $FONT_PROP = new_from_file CFClient::Font $fonts[0]; 1896 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1479 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1897 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1480 1898
1481 $FONT_PROP->make_default; 1899 $FONT_PROP->make_default;
1482} 1900 }
1483 1901
1902# compare mono (ft) vs. rgba (cairo)
1903# ft - 1.8s, cairo 3s, even in alpha-only mode
1904# for my $rgba (0..1) {
1905# my $t1 = Time::HiRes::time;
1906# for (1..1000) {
1907# my $layout = CFClient::Layout->new ($rgba);
1908# $layout->set_text ("hallo" x 100);
1909# $layout->render;
1910# }
1911# my $t2 = Time::HiRes::time;
1912# warn $t2-$t1;
1913# }
1914
1484video_init; 1915 video_init;
1485audio_init; 1916 audio_init;
1917}
1486 1918
1487Event::loop; 1919Event::loop;
1488 1920
1489END { CFClient::SDL_Quit } 1921END { CFClient::SDL_Quit }
1490 1922
1923=head1 NAME
1924
1491=head1 pclient - Crossfire+ and Crossfire game client 1925pclient - A Crossfire+ and Crossfire game client
1492 1926
1493Pclient is a Crossfire+ and Crossfire game client. 1927=head1 SYNOPSIS
1494 1928
1495=head2 Features 1929Just 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 1930
1525=head1 USAGE 1931=head1 USAGE
1526 1932
1527=head2 The Map 1933Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used
1528 1934fullscreen 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 1935
1591=head1 AUTHOR 1936=head1 AUTHOR
1592 1937
1593Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org> 1938Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1594 1939

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines