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.152 by root, Thu Apr 20 08:11:57 2006 UTC vs.
Revision 1.202 by root, Mon May 8 20:39:35 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3use strict; 3use strict;
4use utf8; 4use utf8;
5
6BEGIN {
7 if (%PAR::LibCache) {
8 @INC = grep ref, @INC; # weed out all paths except pars loader refs
9
10 while (my ($filename, $zip) = each %PAR::LibCache) {
11 for ($zip->memberNames) {
12 next unless /^\/root\/(.*)/;
13 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
14 unless -e "$ENV{PAR_TEMP}/$1";
15 }
16 }
17
18 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 }
24}
25
26# need to do it again because that pile of garbage called PAR nukes it before main
27unshift @INC, $ENV{PAR_TEMP};
5 28
6use Time::HiRes 'time'; 29use Time::HiRes 'time';
7use Event; 30use Event;
8 31
9use Crossfire; 32use Crossfire;
12use Compress::LZF; 35use Compress::LZF;
13 36
14use CFClient; 37use CFClient;
15use CFClient::UI; 38use CFClient::UI;
16use CFClient::MapWidget; 39use CFClient::MapWidget;
40
41$Event::DIED = sub {
42 CFClient::error $_[1];
43};
44
45#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
17 46
18our $VERSION = '0.1'; 47our $VERSION = '0.1';
19 48
20my $MAX_FPS = 60; 49my $MAX_FPS = 60;
21my $MIN_FPS = 5; # unused as of yet 50my $MIN_FPS = 5; # unused as of yet
37our $WIDTH; 66our $WIDTH;
38our $HEIGHT; 67our $HEIGHT;
39our $FULLSCREEN; 68our $FULLSCREEN;
40our $FONTSIZE; 69our $FONTSIZE;
41 70
71our $FONT_PROP;
72our $FONT_FIXED;
73
42our $MAP; 74our $MAP;
75our $MAPMAP;
43our $MAPWIDGET; 76our $MAPWIDGET;
44our $BUTTONBAR; 77our $BUTTONBAR;
45our $LOGVIEW; 78our $LOGVIEW;
46our $CONSOLE; 79our $CONSOLE;
47our $METASERVER; 80our $METASERVER;
81our $LOGIN_BUTTON;
48 82
83our $FLOORBOX;
49our $GAUGES; 84our $GAUGES;
85our $STATWIDS;
50 86
51our $SDL_ACTIVE; 87our $SDL_ACTIVE;
52our %SDL_CB; 88our %SDL_CB;
53 89
54our $SDL_MIXER; 90our $SDL_MIXER;
57 93
58our $ALT_ENTER_MESSAGE; 94our $ALT_ENTER_MESSAGE;
59our $STATUS_LINE; 95our $STATUS_LINE;
60our $DEBUG_STATUS; 96our $DEBUG_STATUS;
61 97
98our $INVWIN;
99our $INV;
100
62sub status { 101sub status {
63 $STATUS_LINE->set_text ($_[0]); 102 $STATUS_LINE->set_text ($_[0]);
64 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h}); 103 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
65} 104}
66 105
73 status "logging in..."; 112 status "logging in...";
74 113
75 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 114 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
76 115
77 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; 116 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
78
79 $MAP = new CFClient::Map $mapsize, $mapsize; 117 $MAP = new CFClient::Map $mapsize, $mapsize;
80 118
81 my ($host, $port) = split /:/, $CFG->{host}; 119 my ($host, $port) = split /:/, $CFG->{host};
82 120
83 $CONN = new conn 121 $CONN = eval {
122 new conn
84 host => $host, 123 host => $host,
85 port => $port || 13327, 124 port => $port || 13327,
86 user => $CFG->{user}, 125 user => $CFG->{user},
87 pass => $CFG->{password}, 126 pass => $CFG->{password},
88 mapw => $mapsize, 127 mapw => $mapsize,
89 maph => $mapsize, 128 maph => $mapsize,
129 ;
90 ; 130 };
91 131
132 if ($CONN) {
133 $LOGIN_BUTTON->set_text ("Logout");
134
92 status "login successful"; 135 status "login successful";
93 136
94 CFClient::lowdelay fileno $CONN->{fh}; 137 CFClient::lowdelay fileno $CONN->{fh};
138 } else {
139 status "unable to connect";
140 stop_game();
141 }
95} 142}
96 143
97sub stop_game { 144sub stop_game {
145 return unless $CONN;
146
147 status "connection closed";
148 $LOGIN_BUTTON->set_text ("Login");
149 $CONN->destroy;
150 $CONN = 0; # false, does not autovivify
151
152 undef $MAPCACHE;
98 undef $CONN; 153 undef $MAP;
99} 154}
100 155
101sub client_setup { 156sub client_setup {
102 my $dialog = new CFClient::UI::FancyFrame 157 my $dialog = new CFClient::UI::FancyFrame
103 title => "Client Setup", 158 title => "Client Setup",
116 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 171 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
117 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); 172 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
118 }); 173 });
119 $mode_slider->emit (changed => $mode_slider->{range}[0]); 174 $mode_slider->emit (changed => $mode_slider->{range}[0]);
120 175
176 my $row = 1;
177
121 $table->add (0, 1, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); 178 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
122 $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub { 179 $table->add (1, $row++, new CFClient::UI::CheckBox
180 state => $CFG->{fullscreen},
181 tooltip => "Bring the client into fullscreen mode",
182 connect_changed => sub {
123 my ($self, $value) = @_; 183 my ($self, $value) = @_;
124 $CFG->{fullscreen} = $value; 184 $CFG->{fullscreen} = $value;
185 }
125 }); 186 );
126 187
127 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 188 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
128 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub { 189 $table->add (1, $row++, new CFClient::UI::CheckBox
190 state => $CFG->{fast},
191 tooltip => "Lower the visual quality considerably to speed up rendering.",
192 connect_changed => sub {
129 my ($self, $value) = @_; 193 my ($self, $value) = @_;
130 $CFG->{fast} = $value; 194 $CFG->{fast} = $value;
195 }
131 }); 196 );
132 197
198 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
199 $table->add (1, $row++, new CFClient::UI::Slider
200 range => [$CFG->{map_scale}, 0.25, 2, 0.05],
201 tooltip => "Enlarge or shrink the displayed map",
202 connect_changed => sub {
203 my ($self, $value) = @_;
204 $CFG->{map_scale} = 0.05 * int $value / 0.05;
205 }
206 );
207
133 $table->add (0, 3, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 208 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
134 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub { 209 $table->add (1, $row++, new CFClient::UI::CheckBox
210 state => $CFG->{fow_enable},
211 tooltip => "Fog-of-War marks areas that cannot be seen by the player",
212 connect_changed => sub {
135 my ($self, $value) = @_; 213 my ($self, $value) = @_;
136 $CFG->{fow_enable} = $value; 214 $CFG->{fow_enable} = $value;
215 }
137 }); 216 );
138 217
139 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 218 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
140 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub { 219 $table->add (1, $row++, new CFClient::UI::Slider
220 range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
221 tooltip => "The higher the intensity, the lighter the Fog-of-War color",
222 connect_changed => sub {
141 my ($self, $value) = @_; 223 my ($self, $value) = @_;
142 $CFG->{fow_intensity} = $value; 224 $CFG->{fow_intensity} = $value;
225 }
143 }); 226 );
144 227
145 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); 228 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
146 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub { 229 $table->add (1, $row++, new CFClient::UI::CheckBox
230 state => $CFG->{fow_smooth},
231 tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
232 connect_changed => sub {
147 my ($self, $value) = @_; 233 my ($self, $value) = @_;
148 $CFG->{fow_smooth} = $value; 234 $CFG->{fow_smooth} = $value;
149 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2; 235 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
236 }
150 }); 237 );
151 238
152 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 239 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
153 $table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{gui_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub { 240 $table->add (1, $row++, new CFClient::UI::Slider
241 range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
242 tooltip => "The font size used by most GUI elements",
243 connect_changed => sub {
154 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10; 244 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
155# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 245# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
246 }
156 }); 247 );
157 248
158 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize"); 249 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
159 $table->add (1, 7, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub { 250 $table->add (1, $row++, new CFClient::UI::Slider
251 range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
252 tooltip => "The font size used by the server log window only",
253 connect_changed => sub {
160 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10); 254 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
255 }
161 }); 256 );
162 257
163 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 258 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
259
260 $table->add (1, $row++, new CFClient::UI::Slider
261 range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
262 tooltip => "The font size used by the statistics window only",
263 connect_changed => sub {
264 $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
265 &set_stats_window_fontsize;
266 }
267 );
268
269 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
270 $table->add (1, $row++, new CFClient::UI::Slider
271 range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
272 tooltip => "Adjust the size of the stats gauges at the bottom right",
273 connect_changed => sub {
274 $CFG->{gauge_size} = $_[1];
275 my $h = int $HEIGHT * $CFG->{gauge_size};
276 $GAUGES->{win}->set_size ($WIDTH, $h);
277 $GAUGES->{win}->move (0, $HEIGHT - $h);
278 }
279 );
280
281 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
282 $table->add (1, $row++, new CFClient::UI::Slider
283 range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
284 tooltip => "Adjusts the fontsize of the gauges at the bottom right",
285 connect_changed => sub {
286 $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
287 &set_gauge_window_fontsize;
288 }
289 );
290
291 $table->add (1, $row++, new CFClient::UI::Button
292 expand => 1, align => 0, text => "Apply",
293 tooltip => "Apply the video settings",
294 connect_activate => sub {
164 video_shutdown (); 295 video_shutdown ();
165 video_init (); 296 video_init ();
297 }
166 }); 298 );
167 299
168 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); 300 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
169 $table->add (1, 9, new CFClient::UI::CheckBox state => $CFG->{audio_enable}, connect_changed => sub { 301 $table->add (1, $row++, new CFClient::UI::CheckBox
302 state => $CFG->{audio_enable},
303 tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
304 connect_changed => sub {
170 $CFG->{audio_enable} = $_[1]; 305 $CFG->{audio_enable} = $_[1];
306 }
171 }); 307 );
172# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); 308# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
173# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub { 309# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
174# $CFG->{effects_volume} = $_[1]; 310# $CFG->{effects_volume} = $_[1];
175# }); 311# });
176 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); 312 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
177 $table->add (1, 10, my $hbox = new CFClient::UI::HBox); 313 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
178 $hbox->add (new CFClient::UI::CheckBox expand => 1, state => $CFG->{bgm_enable}, connect_changed => sub { 314 $hbox->add (new CFClient::UI::CheckBox
315 expand => 1, state => $CFG->{bgm_enable},
316 tooltip => "Enable background music playing",
317 connect_changed => sub {
179 $CFG->{bgm_enable} = $_[1]; 318 $CFG->{bgm_enable} = $_[1];
319 }
180 }); 320 );
181 $hbox->add (new CFClient::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], connect_changed => sub { 321 $hbox->add (new CFClient::UI::Slider
322 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
323 tooltip => "The volume of the background music",
324 connect_changed => sub {
182 $CFG->{bgm_volume} = $_[1]; 325 $CFG->{bgm_volume} = $_[1];
183 CFClient::MixMusic::volume $_[1] * 128; 326 CFClient::MixMusic::volume $_[1] * 128;
327 }
184 }); 328 );
185 329
186 $table->add (1, 11, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 330 $table->add (1, $row++, new CFClient::UI::Button
331 expand => 1, align => 0, text => "Apply",
332 tooltip => "Apply the audio settings",
333 connect_activate => sub {
187 audio_shutdown (); 334 audio_shutdown ();
188 audio_init (); 335 audio_init ();
336 }
189 }); 337 );
338
339 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");
340 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
341 text => $CFG->{say_command},
342 tooltip => "This is the command that will be used if you write a line in the message window entry. "
343 ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
344 ."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
345 connect_changed => sub {
346 my ($self, $value) = @_;
347 $CFG->{say_command} = $value;
348 }
349 );
190 350
191 $dialog 351 $dialog
352}
353
354sub set_stats_window_fontsize {
355 for (values %{$STATWIDS}) {
356 $_->set_fontsize ($::CFG->{stat_fontsize});
357 }
358}
359
360sub set_gauge_window_fontsize {
361 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
362 $_->set_fontsize ($::CFG->{gauge_fontsize});
363 }
364
365# local $GAUGES->{win}{parent};#d#
366# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
367}
368
369sub make_gauge_window {
370 my $gh = int ($HEIGHT * $CFG->{gauge_size});
371# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
372
373 my $win = new CFClient::UI::Frame (
374 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
375 );
376 $win->add (my $hbox = new CFClient::UI::HBox
377 children => [
378 (new CFClient::UI::HBox expand => 1),
379 ($FLOORBOX = new CFClient::UI::VBox),
380 (my $vbox = new CFClient::UI::VBox),
381 ],
382 );
383
384 $vbox->add (new CFClient::UI::HBox
385 expand => 1,
386 children => [
387 (new CFClient::UI::Empty expand => 1),
388 (my $hb = new CFClient::UI::HBox),
389 ],
390 );
391
392 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
393 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.");
394 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
395 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.");
396 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
397 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.");
398 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
399 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.");
400
401 $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
402 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.");
403 $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
404 tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
405
406 $GAUGES = {
407 exp => $exp, win => $win, range => $rng,
408 food => $fg, mana => $mg, hp => $hg, grace => $gg
409 };
410
411 &set_gauge_window_fontsize;
412
413 $win
414}
415
416sub make_stats_window {
417 my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";
418
419 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
420 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
421 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
422
423 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
424
425 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
426
427 my $black = [0, 0, 0];
428
429 for (
430 [0, 0, st_str => "Str", 30, "Physical Strength, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
431 [0, 1, st_dex => "Dex", 30, "Dexterity, your physical agility. Determines chance of being hit and affects armor class and speed"],
432 [0, 2, st_con => "Con", 30, "Constitution, physical health and toughness. Determines how many healthpoints you can have"],
433 [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"],
434 [0, 4, st_wis => "Wis", 30, "Wisdom, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
435 [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"],
436 [0, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."],
437
438 [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."],
439 [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."],
440 [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."],
441 [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."],
442 [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."],
443 [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."],
444 ) {
445 my ($col, $row, $id, $label, $template, $tooltip) = @$_;
446
447 $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
448 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
449 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
450 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $black, valign => 0, align => -1, text => $label, tooltip => $tooltip);
451 }
452
453 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
454
455 my $row = 0;
456 my $col = 0;
457
458 my %resist_names = (
459 slow => "Slow (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.)",
460 holyw => "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
461 conf => "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)",
462 fire => "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
463 depl => "Depletion (some monsters and other effects can cause stats depletion)",
464 magic => "Magic (resistance to magic spells like magic missile or similar)",
465 drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",
466 acid => "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
467 pois => "Poison (resistance to getting poisoned)",
468 para => "Paralysation (this resistance affects the chance you get paralysed)",
469 deat => "Death (resistance against death spells)",
470 phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
471 blind => "Blind (blind resistance affects the chance of a successful blinding attack)",
472 fear => "Fear (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)",
473 tund => "Turn undead",
474 elec => "Electricity (resistance againt electricity, spells like large lightning, small lightning, ...)",
475 cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)",
476 ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",
477 );
478 for (qw/slow holyw conf fire depl magic
479 drain acid pois para deat phys
480 blind fear tund elec cold ghit/)
481 {
482 $tbl2->add ($col, $row,
483 $STATWIDS->{"res_$_"} =
484 new CFClient::UI::Label
485 font => $FONT_FIXED,
486 template => "-100%",
487 align => +1,
488 valign => 0,
489 can_events => 1,
490 can_hover => 1,
491 tooltip => $resist_names{$_},
492 );
493 $tbl2->add ($col + 1, $row, new CFClient::UI::Image
494 font => $FONT_FIXED,
495 can_hover => 1,
496 can_events => 1,
497 image => "ui/resist/resist_$_.png",
498 tooltip => $resist_names{$_},
499 );
500
501 $row++;
502 if ($row % 6 == 0) {
503 $col += 2;
504 $row = 0;
505 }
506 }
507
508 &set_stats_window_fontsize;
509 update_stats_window ({});
510
511 $tgw
512}
513
514sub formsep {
515 reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
516}
517
518sub update_stats_window {
519 my ($stats) = @_;
520
521 # i love text protocols!!!
522 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
523 my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
524 my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
525 my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
526 my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
527 my $fo_m = 999;
528 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
529 my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
530
531 $GAUGES->{hp} ->set_value ($hp, $hp_m);
532 $GAUGES->{mana} ->set_value ($sp, $sp_m);
533 $GAUGES->{food} ->set_value ($fo, $fo_m);
534 $GAUGES->{grace} ->set_value ($gr, $gr_m);
535 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
536 . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
537 my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
538 $rng =~ s/^Range: //; # thank you so much dear server
539 $GAUGES->{range} ->set_text ("Rng: " . $rng);
540 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
541 $title =~ s/^Player: //;
542 $STATWIDS->{title} ->set_text ("Title: " . $title);
543
544 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
545 $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
546 $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
547 $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
548 $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
549 $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
550 $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
551 $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
552 $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
553 $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
554 $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
555 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
556 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
557
558 my %tbl = (
559 phys => 100,
560 magic => 101,
561 fire => 102,
562 elec => 103,
563 cold => 104,
564 conf => 105,
565 acid => 106,
566 drain => 107,
567 ghit => 108,
568 pois => 109,
569 slow => 110,
570 para => 111,
571 tund => 112,
572 fear => 113,
573 depl => 113,
574 deat => 115,
575 holyw => 116,
576 blind => 117
577 );
578
579 for (keys %tbl) {
580 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
581 }
582
192} 583}
193 584
194sub metaserver_dialog { 585sub metaserver_dialog {
195 my $dialog = new CFClient::UI::FancyFrame 586 my $dialog = new CFClient::UI::FancyFrame
196 title => "Metaserver", 587 title => "Server List",
197 child => (my $vbox = new CFClient::UI::VBox); 588 child => (my $vbox = new CFClient::UI::VBox);
198 589
199 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 590 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
200 591
201 $dialog 592 $dialog
202} 593}
594
595my $METASERVER_ATIME;
203 596
204sub update_metaserver { 597sub update_metaserver {
205 my ($HOST) = @_; 598 my ($HOST) = @_;
206 599
207 status "fetching metaserver list..."; 600 return if $METASERVER_ATIME > time;
601 $METASERVER_ATIME = time + 60;
602
603 my $table = $METASERVER->{table};
604 $table->clear;
605 $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
208 606
209 my $buf; 607 my $buf;
210 608
211 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 609 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
610
611 unless ($fh) {
612 $label->set_text ("unable to contact metaserver: $!");
613 return;
614 }
212 615
213 Event->io (fd => $fh, poll => 'r', cb => sub { 616 Event->io (fd => $fh, poll => 'r', cb => sub {
214 my $res = sysread $fh, $buf, 8192, length $buf; 617 my $res = sysread $fh, $buf, 8192, length $buf;
215 618
216 if (!defined $res) { 619 if (!defined $res) {
217 $_[0]->w->cancel; 620 $_[0]->w->cancel;
218 status "metaserver: $!"; 621 $label->set_text ("error while retrieving server list: $!");
219 } elsif ($res == 0) { 622 } elsif ($res == 0) {
220 $_[0]->w->cancel; 623 $_[0]->w->cancel;
221 status "server list retrieved"; 624 status "server list retrieved";
222 625
223 my $table = $METASERVER->{table}; 626 utf8::decode $buf if utf8::valid $buf;
224 627
225 $table->clear; 628 $table->clear;
226 629
227 my @col = qw(Use #Users Host Uptime Version Description); 630 my @col = qw(Use #Users Host Uptime Version Description);
228 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_]) 631 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
252 $m = [$users, $host, $uptime, $version, $desc]; 655 $m = [$users, $host, $uptime, $version, $desc];
253 656
254 $y++; 657 $y++;
255 658
256 $table->add (0, $y, new CFClient::UI::VBox children => [ 659 $table->add (0, $y, new CFClient::UI::VBox children => [
257 (new CFClient::UI::Button text => " ", connect_activate => sub { 660 (new CFClient::UI::Button text => "Use", connect_activate => sub {
258 $HOST->set_text ($CFG->{host} = $host); 661 $HOST->set_text ($CFG->{host} = $host);
259 }), 662 }),
260 (new CFClient::UI::Empty expand => 1), 663 (new CFClient::UI::Empty expand => 1),
261 ]); 664 ]);
262 665
276 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); 679 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
277 680
278 { 681 {
279 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 682 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
280 683
281 $vbox->add (my $HOST = new CFClient::UI::Entry expand => 1, text => $CFG->{host}, connect_changed => sub { 684 $vbox->add (
685 my $HOST = new CFClient::UI::Entry
686 expand => 1,
687 text => $CFG->{host},
688 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
689 connect_changed => sub {
690 my ($self, $value) = @_;
691 $CFG->{host} = $value;
692 }
693 );
694
695 $METASERVER = metaserver_dialog;
696
697 $vbox->add (new CFClient::UI::Flopper
698 expand => 1,
699 text => "Server List",
700 other => $METASERVER,
701 tooltip => "Show a list of available crossfire servers",
702 connect_open => sub {
703 update_metaserver $HOST;
704 }
705 );
706 }
707
708 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
709 $table->add (1, 4, new CFClient::UI::Entry
710 text => $CFG->{user},
711 tooltip => "The name of your character on the server",
712 connect_changed => sub {
282 my ($self, $value) = @_; 713 my ($self, $value) = @_;
283 $CFG->{host} = $value;
284 });
285
286 $METASERVER = metaserver_dialog;
287
288 $vbox->add (new CFClient::UI::Flopper expand => 1, text => "Metaserver", other => $METASERVER, connect_open => sub {
289 update_metaserver $HOST;
290 });
291 }
292
293 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
294 $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
295 my ($self, $value) = @_;
296 $CFG->{user} = $value; 714 $CFG->{user} = $value;
715 }
297 }); 716 );
298 717
299 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); 718 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
300 $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub { 719 $table->add (1, 5, new CFClient::UI::Entry
720 text => $CFG->{password},
721 hidden => 1,
722 tooltip => "The password for your character",
723 connect_changed => sub {
301 my ($self, $value) = @_; 724 my ($self, $value) = @_;
302 $CFG->{password} = $value; 725 $CFG->{password} = $value;
726 }
303 }); 727 );
304
305 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
306 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
307 my ($self, $value) = @_;
308 $CFG->{say_command} = $value;
309 });
310 728
311 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 729 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
312 $table->add (1, 7, new CFClient::UI::Slider 730 $table->add (1, 7, new CFClient::UI::Slider
313 req_w => 100, 731 req_w => 100,
314 range => [$CFG->{mapsize}, 10, 100 + 1, 1], 732 range => [$CFG->{mapsize}, 10, 100 + 1, 1],
733 tooltip => "This is the size of the portion of the map update the server sends you. "
734 ."If you set this to a high value you will be able to see further for example.",
315 connect_changed => sub { 735 connect_changed => sub {
316 my ($self, $value) = @_; 736 my ($self, $value) = @_;
317 737
318 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 738 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
319 }, 739 },
320 ); 740 );
321 741
322 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { 742 $table->add (1, 8, $LOGIN_BUTTON = new CFClient::UI::Button
743 expand => 1,
744 align => 0,
745 text => "Login",
746 connect_activate => sub {
747 $CONN ? stop_game
323 start_game; 748 : start_game;
749 },
324 }); 750 );
325 751
326 $dialog 752 $dialog
327} 753}
328 754
329sub message_window { 755sub message_window {
330 my $window = new CFClient::UI::FancyFrame 756 my $window = new CFClient::UI::FancyFrame
331 title => "Messages", 757 title => "Messages",
332 border_bg => [1, 1, 1, 0.5], 758 border_bg => [1, 1, 1, 1],
333 bg => [0.3, 0.3, 0.3, 0.8], 759 bg => [0, 0, 0, 0.5],
334 user_w => int $::WIDTH / 3, 760 user_w => int $::WIDTH / 3,
335 user_h => int $::HEIGHT / 5, 761 user_h => int $::HEIGHT / 5,
336 child => (my $vbox = new CFClient::UI::VBox); 762 child => (my $vbox = new CFClient::UI::VBox);
337 763
338 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 764 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
339 expand => 1, 765 expand => 1,
766 font => $FONT_FIXED,
340 fontsize => $::CFG->{log_fontsize}, 767 fontsize => $::CFG->{log_fontsize},
341 ); 768 );
342 769
343 $vbox->add (my $input = new CFClient::UI::Entry 770 $vbox->add (my $input = new CFClient::UI::Entry
344 connect_focus_in => sub { 771 connect_focus_in => sub {
377 }; 804 };
378 805
379 $window 806 $window
380} 807}
381 808
809sub make_inventory_window {
810 my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory";
811 $invwin->add ($INV = new CFClient::UI::Inventory expand => 1);
812 $invwin
813}
814
382sub sdl_init { 815sub sdl_init {
383 CFClient::SDL_Init 816 CFClient::SDL_Init
384 and die "SDL::Init failed!\n"; 817 and die "SDL::Init failed!\n";
385} 818}
386 819
387sub video_init { 820sub video_init {
388 sdl_init; 821 sdl_init;
389 822
823 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
824
390 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 825 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
391 $FULLSCREEN = $CFG->{fullscreen}; 826 $FULLSCREEN = $CFG->{fullscreen};
392 $FAST = $CFG->{fast}; 827 $FAST = $CFG->{fast};
393 828
394 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN 829 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
395 or die "SDL_SetVideoMode failed!\n"; 830 or die "SDL_SetVideoMode failed!\n";
396 831
397 $SDL_ACTIVE = 1; 832 $SDL_ACTIVE = 1;
398
399 $LAST_REFRESH = time - 0.01; 833 $LAST_REFRESH = time - 0.01;
400 834
401 CFClient::gl_init; 835 CFClient::gl_init;
402 836
403 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 837 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
404 838
839 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
840
405 ############################################################################# 841 #############################################################################
406 842
843 if ($DEBUG_STATUS) {
844 # reconfigure all widgets
845 $CFClient::UI::ROOT->reconfigure;
846
847 } else {
848 # create the widgets
849
407 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 850 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
408 $DEBUG_STATUS->show; 851 $DEBUG_STATUS->show;
409 852
410 $STATUS_LINE = new CFClient::UI::Label 853 $STATUS_LINE = new CFClient::UI::Label
411 padding => 0, 854 padding => 0,
412 y => $HEIGHT - $FONTSIZE * 1.8; 855 y => $HEIGHT - $FONTSIZE * 1.8;
413 $STATUS_LINE->show; 856 $STATUS_LINE->show;
414 857
415 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 858 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
416 padding => 0, 859 padding => 0,
417 fontsize => 0.8, 860 fontsize => 0.8,
418 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 861 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
419 $ALT_ENTER_MESSAGE->show; 862 $ALT_ENTER_MESSAGE->show;
420 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h}); 863 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
421 864
422 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget); 865 CFClient::UI::FancyFrame->new (
423 $MAPWIDGET->focus_in; 866 border_bg => [1, 1, 1, 192/255],
867 bg => [1, 1, 1, 0],
868 child => ($MAPMAP = new CFClient::MapWidget::MapMap),
869 )->show;
870
871 $MAPWIDGET = new CFClient::MapWidget;
424 $MAPWIDGET->connect (activate_console => sub { 872 $MAPWIDGET->connect (activate_console => sub {
425 my ($mapwidget, $preset) = @_; 873 my ($mapwidget, $preset) = @_;
426 874
427 if ($CONSOLE) { 875 if ($CONSOLE) {
428 $CONSOLE->{input}->{auto_activated} = 1; 876 $CONSOLE->{input}->{auto_activated} = 1;
429 $CONSOLE->{input}->focus_in; 877 $CONSOLE->{input}->focus_in;
430 878
431 if ($preset && $CONSOLE->{input}->get_text eq '') { 879 if ($preset && $CONSOLE->{input}->get_text eq '') {
432 $CONSOLE->{input}->set_text ($preset); 880 $CONSOLE->{input}->set_text ($preset);
881 }
433 } 882 }
434 } 883 });
435 }); 884 $MAPWIDGET->show;
885 $MAPWIDGET->focus_in;
436 886
437 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox); 887 $BUTTONBAR = new CFClient::UI::HBox;
438 888
439 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 889 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
440 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 890 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
441 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 891 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
442 892
893 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
894
895 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
896 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);
897
443 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 898 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
444 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 899 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
445 status "Configuration Saved"; 900 status "Configuration Saved";
446 }); 901 });
447 902
903 $BUTTONBAR->show;
904
448 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 905 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
449 906 }
450 my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH - 300, y => 0, title => "Stats");
451 $tgw->add (my $hbox = new CFClient::UI::HBox ());
452
453 $hbox->add (my $hg = new CFClient::UI::Gauge (type => 'hp'));
454 $hbox->add (my $mg = new CFClient::UI::Gauge (type => 'mana'));
455 $hbox->add (my $gg = new CFClient::UI::Gauge (type => 'grace'));
456 $hbox->add (my $fg = new CFClient::UI::Gauge (type => 'food'));
457
458 $GAUGES = { food => $fg, mana => $mg, hp => $hg, grace => $gg };
459 $CFClient::UI::ROOT->add ($tgw);
460} 907}
461 908
462sub video_shutdown { 909sub video_shutdown {
463 $CFClient::UI::ROOT->{children} = [];
464 undef $SDL_ACTIVE; 910 undef $SDL_ACTIVE;
465} 911}
466 912
913my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
467my $bgmusic;#TODO#hack#d# 914my $bgmusic;#TODO#hack#d#
915
916sub audio_channel_finished {
917 my ($channel) = @_;
918
919 warn "channel $channel finished\n";#d#
920}
921
922sub audio_music_finished {
923 return unless $CFG->{bgm_enable};
924
925 # TODO: hack, do play loop and mood music
926 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
927 $bgmusic->play (0);
928
929 push @bgmusic, shift @bgmusic;
930}
468 931
469sub audio_init { 932sub audio_init {
470 if ($CFG->{audio_enable}) { 933 if ($CFG->{audio_enable}) {
471 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { 934 if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
472
473 $SDL_MIXER = !CFClient::Mix_OpenAudio; 935 $SDL_MIXER = !CFClient::Mix_OpenAudio;
474 CFClient::Mix_AllocateChannels 8; 936 CFClient::Mix_AllocateChannels 8;
475 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; 937 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
476 938
477 # TODO: hack, do play loop and mood music 939 audio_music_finished;
478 if ($CFG->{bgm_enable}) {
479 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/game3.ogg";
480 $bgmusic->play;
481 }
482 940
483 while (<$fh>) { 941 while (<$fh>) {
484 next if /^\s*#/; 942 next if /^\s*#/;
485 next if /^\s*$/; 943 next if /^\s*$/;
486 944
564@conn::ISA = Crossfire::Protocol::; 1022@conn::ISA = Crossfire::Protocol::;
565 1023
566sub conn::stats_update { 1024sub conn::stats_update {
567 my ($self, $stats) = @_; 1025 my ($self, $stats) = @_;
568 1026
569 # i love text protocols!!! 1027 update_stats_window ($stats);
570 # FIXME: the stats are somehow weird
571 my $hp = $stats->{1};
572 my $hp_m = $stats->{2};
573 my $sp = $stats->{3};
574 my $sp_m = $stats->{4};
575 my $fo = $stats->{18};
576 my $fo_m = 999;
577 my $gr = $stats->{23};
578 my $gr_m = $stats->{24};
579
580 #d# warn "DATA $hp $hp_m $sp $sp_m $fo $fo_m $gr $gr_m\n";
581 $GAUGES->{hp} ->set_value ($hp, $hp_m);
582 $GAUGES->{mana} ->set_value ($sp, $sp_m);
583 $GAUGES->{food} ->set_value ($fo, $fo_m);
584 $GAUGES->{grace}->set_value ($gr, $gr_m);
585} 1028}
586 1029
587sub conn::user_send { 1030sub conn::user_send {
588 my ($self, $command) = @_; 1031 my ($self, $command) = @_;
589 1032
651# at worst. 1094# at worst.
652sub conn::flood_fill { 1095sub conn::flood_fill {
653 my ($self, $gx, $gy, $path, $hash, $flags) = @_; 1096 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
654 1097
655 # the server does not allow map paths > 6 1098 # the server does not allow map paths > 6
656 return if 6 <= length $path; 1099 return if 7 <= length $path;
657 1100
658 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; 1101 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
659 1102
660 for ( 1103 for (
661 [1, 0, -1], 1104 [1, 0, -1],
704 1147
705 $self->flush_map; 1148 $self->flush_map;
706 1149
707 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy); 1150 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
708 1151
709 my $mapmapw = 250; 1152 my $mapmapw = $MAPMAP->{w};
710 my $mapmaph = 250; 1153 my $mapmaph = $MAPMAP->{h};
711 1154
712 $self->{neigh_rect} = [ 1155 $self->{neigh_rect} = [
713 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5, 1156 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
714 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h, 1157 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
715 ]; 1158 ];
719 1162
720 $x += $ox; 1163 $x += $ox;
721 $y += $oy; 1164 $y += $oy;
722 1165
723 $self->{map_info} = [$hash, $x, $y, $w, $h]; 1166 $self->{map_info} = [$hash, $x, $y, $w, $h];
1167
1168 my $map = $self->{map_info}[0];
1169 $map =~ s/^.*?\/([^\/]+)$/\1/;
1170 $STATWIDS->{map}->set_text ("Map: " . $map);
724 1171
725 $self->load_map ($hash, $x, $y); 1172 $self->load_map ($hash, $x, $y);
726} 1173}
727 1174
728sub conn::face_find { 1175sub conn::face_find {
754 } 1201 }
755 1202
756gotid: 1203gotid:
757 $face->{id} = $id; 1204 $face->{id} = $id;
758 $MAP->set_face ($facenum => $id); 1205 $MAP->set_face ($facenum => $id);
1206 $self->{faceid}[$facenum] = $id;#d#
759 $TILECACHE->get ($id) 1207 $TILECACHE->get ($id)
760} 1208}
761 1209
762sub conn::face_update { 1210sub conn::face_update {
763 my ($self, $facenum, $face) = @_; 1211 my ($self, $facenum, $face) = @_;
771 my ($self, $id, $data) = @_; 1219 my ($self, $id, $data) = @_;
772 1220
773 $self->{texture}[$id] ||= do { 1221 $self->{texture}[$id] ||= do {
774 my $tex = 1222 my $tex =
775 new_from_image CFClient::Texture 1223 new_from_image CFClient::Texture
776 $data, minify => 1; 1224 $data, minify => 1, mipmap => 1;
777 1225
778 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 1226 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
779 $MAPWIDGET->update; 1227 $MAPWIDGET->update;
780 1228
781 $tex 1229 $tex
793 1241
794 $chunk->play; 1242 $chunk->play;
795# warn "sound $x,$y,$soundnum,$type\n";#d# 1243# warn "sound $x,$y,$soundnum,$type\n";#d#
796} 1244}
797 1245
1246my $LAST_QUERY; # server is stupid, stupid, stupid
1247
798sub conn::query { 1248sub conn::query {
799 my ($self, $flags, $prompt) = @_; 1249 my ($self, $flags, $prompt) = @_;
800 1250
801 #TODO, display dialog with relevant information 1251 $prompt = $LAST_QUERY unless length $prompt;
802 warn "<<<<QUERY:$flags:$prompt>>>\n";#d# 1252 $LAST_QUERY = $prompt;
1253
1254 my $dialog = new CFClient::UI::FancyFrame
1255 title => "Query",
1256 child => my $vbox = new CFClient::UI::VBox;
1257
1258 $vbox->add (new CFClient::UI::Label
1259 max_w => $::WIDTH * 0.4,
1260 text => $prompt);
1261
1262 if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1263 $vbox->add (my $hbox = new CFClient::HBox);
1264 $hbox->add (new CFClient::Button
1265 text => "No",
1266 connect_activate => sub {
1267 $self->send ("reply n");
1268 $dialog->destroy;
1269 $MAPWIDGET->focus_in;
1270 }
1271 );
1272 $hbox->add (new CFClient::Button
1273 text => "Yes",
1274 connect_activate => sub {
1275 $self->send ("reply y");
1276 $dialog->destroy;
1277 $MAPWIDGET->focus_in;
1278 },
1279 );
1280
1281 $dialog->focus_in;
1282
1283 } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1284 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1285 $vbox->add (my $entry = new CFClient::UI::Entry
1286 connect_changed => sub {
1287 $self->send ("reply $_[1]");
1288 $dialog->destroy;
1289 $MAPWIDGET->focus_in;
1290 },
1291 );
1292
1293 $entry->focus_in;
1294
1295 } else {
1296 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1297
1298 $vbox->add (my $entry = new CFClient::UI::Entry
1299 $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1300 connect_activate => sub {
1301 $self->send ("reply $_[1]");
1302 $dialog->destroy;
1303 $MAPWIDGET->focus_in;
1304 },
1305 );
1306
1307 $entry->focus_in;
1308 }
1309
1310 $dialog->show;
803} 1311}
804 1312
805sub conn::drawinfo { 1313sub conn::drawinfo {
806 my ($self, $color, $text) = @_; 1314 my ($self, $color, $text) = @_;
807 1315
825} 1333}
826 1334
827sub conn::spell_add { 1335sub conn::spell_add {
828 my ($self, $spell) = @_; 1336 my ($self, $spell) = @_;
829 1337
1338 # TODO
1339 # create a widget dynamically, using spell face (CF::Protocol downloads them)
830 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}, sub { 1340 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
831 });
832 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}, sub { 1341 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
833 });
834} 1342}
835 1343
836sub conn::spell_delete { 1344sub conn::spell_delete {
837 my ($self, $spell) = @_; 1345 my ($self, $spell) = @_;
838} 1346}
839 1347
840sub conn::addme_success { 1348sub conn::addme_success {
841 my ($self) = @_; 1349 my ($self) = @_;
842 1350
843 for my $skill (values %{$self->{skill_info}}) { 1351 for my $skill (values %{$self->{skill_info}}) {
844 $MAPWIDGET->add_command ("ready_skill $skill", "", sub { 1352 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1353 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1354 }
1355
1356 $MAPWIDGET->add_command ("pet\\_mode defend", "Tell pets to stay close to you and defend you");
1357 $MAPWIDGET->add_command ("pet\\_mode arena", "Same as petmode attack, but also attack other players");
1358 $MAPWIDGET->add_command ("pet\\_mode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies");
1359 $MAPWIDGET->add_command ("kill\\_pets", "kill your pets");
1360}
1361
1362sub conn::eof {
1363 stop_game;
1364}
1365
1366sub update_floorbox {
1367 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1368 return unless $CONN;
1369
1370 $FLOORBOX->clear;
1371 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1372
1373 # we basically have to use the same sorting as everybody else
1374 for my $item (@{ $CONN->{container}{0} }) {
1375 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $item);
845 }); 1376 }
846 $MAPWIDGET->add_command ("use_skill $skill", "", sub { 1377 });
1378 refresh;
1379}
1380
1381sub conn::container_add {
1382 my ($self, $id, $items) = @_;
1383
1384 update_floorbox if $id == 0;
1385 if ($self->{player}{tag} == $id) {
1386 $INV->set_items ($self->{container}{$self->{player}{tag}});
1387 }
1388 # $self-<{player}{tag} => player inv
1389 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1390}
1391
1392sub conn::container_clear {
1393 my ($self, $id) = @_;
1394
1395 update_floorbox if $id == 0;
1396 if ($self->{player}{tag} == $id) {
1397 $INV->set_items ($self->{container}{$id});
1398 }
1399
1400# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1401}
1402
1403sub conn::item_delete {
1404 my ($self, @items) = @_;
1405
1406 for (@items) {
1407 update_floorbox if $_->{container} == 0;
1408 if ($self->{player}{tag} == $_->{container}) {
1409 $INV->set_items ($self->{container}{$_->{container}});
847 }); 1410 }
1411 }
1412}
1413
1414sub conn::item_update {
1415 my ($self, $item) = @_;
1416
1417 update_floorbox if $item->{container} == 0;
1418 if ($self->{player}{tag} == $item->{container}) {
1419 $INV->set_items ($self->{container}{$item->{container}});
848 } 1420 }
849} 1421}
850 1422
851%SDL_CB = ( 1423%SDL_CB = (
852 CFClient::SDL_QUIT => sub { 1424 CFClient::SDL_QUIT => sub {
853 Event::unloop -1; 1425 Event::unloop -1;
854 }, 1426 },
855 CFClient::SDL_VIDEORESIZE => sub { 1427 CFClient::SDL_VIDEORESIZE => sub {
856 }, 1428 },
857 CFClient::SDL_VIDEOEXPOSE => sub { 1429 CFClient::SDL_VIDEOEXPOSE => \&refresh,
858 refresh; 1430 CFClient::SDL_ACTIVEEVENT => sub {
1431# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
859 }, 1432 },
860 CFClient::SDL_KEYDOWN => sub { 1433 CFClient::SDL_KEYDOWN => sub {
861 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1434 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
862 # alt-enter 1435 # alt-enter
863 video_shutdown; 1436 video_shutdown;
865 video_init; 1438 video_init;
866 } else { 1439 } else {
867 CFClient::UI::feed_sdl_key_down_event ($_[0]); 1440 CFClient::UI::feed_sdl_key_down_event ($_[0]);
868 } 1441 }
869 }, 1442 },
870 CFClient::SDL_KEYUP => sub { 1443 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
871 CFClient::UI::feed_sdl_key_up_event ($_[0]); 1444 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
872 }, 1445 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
873 CFClient::SDL_MOUSEMOTION => sub { 1446 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
874 CFClient::UI::feed_sdl_motion_event ($_[0]);
875 },
876 CFClient::SDL_MOUSEBUTTONDOWN => sub {
877 CFClient::UI::feed_sdl_button_down_event ($_[0]);
878 },
879 CFClient::SDL_MOUSEBUTTONUP => sub {
880 CFClient::UI::feed_sdl_button_up_event ($_[0]);
881 },
882 CFClient::SDL_ACTIVEEVENT => sub { 1447 CFClient::SDL_USEREVENT => sub {
883# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 1448 if ($_[0]{code} == 1) {
1449 audio_channel_finished $_[0]{data1};
1450 } elsif ($_[0]{code} == 0) {
1451 audio_music_finished;
1452 }
884 }, 1453 },
885); 1454);
886 1455
887############################################################################# 1456#############################################################################
888 1457
889$SIG{INT} = $SIG{TERM} = sub { exit }; 1458$SIG{INT} = $SIG{TERM} = sub { exit };
890 1459
1460CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1461
891$TILECACHE = CFClient::db_table "tilecache"; 1462$TILECACHE = CFClient::db_table "tilecache";
892$FACEMAP = CFClient::db_table "facemap"; 1463$FACEMAP = CFClient::db_table "facemap";
893
894CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
895 1464
896my %DEF_CFG = ( 1465my %DEF_CFG = (
897 sdl_mode => 0, 1466 sdl_mode => 0,
898 width => 640, 1467 width => 640,
899 height => 480, 1468 height => 480,
900 fullscreen => 0, 1469 fullscreen => 0,
901 fast => 0, 1470 fast => 0,
1471 map_scale => 0.5,
902 fow_enable => 1, 1472 fow_enable => 1,
903 fow_intensity => 0.45, 1473 fow_intensity => 0.45,
904 fow_smooth => 0, 1474 fow_smooth => 0,
905 gui_fontsize => 1, 1475 gui_fontsize => 1,
906 log_fontsize => 14, 1476 log_fontsize => 1,
1477 gauge_fontsize => 1,
1478 gauge_size => 0.35,
1479 stat_fontsize => 1,
907 mapsize => 100, 1480 mapsize => 100,
908 host => "crossfire.schmorp.de", 1481 host => "crossfire.schmorp.de",
909 say_command => 'say', 1482 say_command => 'say',
910 audio_enable => 1, 1483 audio_enable => 1,
911 bgm_enable => 1, 1484 bgm_enable => 1,
925@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; 1498@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
926 1499
927$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; 1500$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
928 1501
929{ 1502{
930 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf); 1503 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1504 DejaVuSans.ttf
1505 DejaVuSansMono.ttf
1506 DejaVuSans-Bold.ttf
1507 DejaVuSansMono-Bold.ttf
1508 DejaVuSans-Oblique.ttf
1509 DejaVuSansMono-Oblique.ttf
1510 DejaVuSans-BoldOblique.ttf
1511 DejaVuSansMono-BoldOblique.ttf
1512 );
931 1513
932 CFClient::add_font $_ for @fonts; 1514 CFClient::add_font $_ for @fonts;
933 CFClient::set_font $fonts[0]; 1515
1516 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1517 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1518
1519 $FONT_PROP->make_default;
934} 1520}
935 1521
936video_init; 1522video_init;
937audio_init; 1523audio_init;
938 1524
939Event::loop; 1525Event::loop;
940 1526
941END { CFClient::SDL_Quit } 1527END { CFClient::SDL_Quit }
942 1528
1529=head1 pclient - Crossfire+ and Crossfire game client
943 1530
1531Pclient is a Crossfire+ and Crossfire game client.
1532
1533=head2 Features
1534
1535=over 4
1536
1537=item Fullscreen Map
1538
1539PClient can uses a fullscreen map, which greatly enhances how much of the
1540game world you can see.
1541
1542=item Persistent Map Cache (Crossfire+ only)
1543
1544PClient can persistently cache all map data it received from the
1545server. This not only allows it to display an overview map, but also
1546ensures that once-explored areas will be available the next time you want
1547to explore more.
1548
1549=item Hardware acceleration
1550
1551Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
1552acceleration. Most modern graphics cards have difficulties with 2D
1553acceleration, while 3D graphics is accelerated well.
1554
1555=item No arbitrary limits
1556
1557Unlike other Crossfire clients, pclient does not suffer from arbitrary
1558limits (like a fixed amount of face numbers). There are still limits, but
1559they are not arbitrarily low :)
1560
1561=back
1562
1563=head1 USAGE
1564
1565=head2 The Map
1566
1567The map is always displayed in the background, behind all other windows and UI elements.
1568
1569#TODO# middle-click scrolls
1570#
1571# keys:
1572#
1573# a apply
1574# keypad moves, kp_5 applies ranged attack to self
1575
1576Starting to type enters the I<completion mode>. In that mode, you can type
1577abbreviations or commands and have them executed as soon as they match a
1578valid command. This is best explained by a few examples:
1579
1580Typing B<climb> will display a list of commands with I<climb> in their
1581name, such as I<ready_skill climbing> and I<use_skill climbing>.
1582
1583You can abbreviate commands by typing only the first character of every
1584word. For example, typing I<iwor> will likely select I<invoke word of
1585recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
1586will likely select I<ready_skill climbing> and I<usl> will give you
1587I<use_skill levitation>.
1588
1589=head2 The map overview
1590
1591#TODO#
1592
1593=head2 The Status area in the lower right corner
1594
1595#TODO#
1596
1597=head2 The I<Statistics>/I>Stats> window
1598
1599#TODO#
1600
1601=head1 FAQ
1602
1603=over 4
1604
1605=item The client is very sluggish and slow, what can I do about this?
1606
1607Most likely, you don't have accelerated OpenGL support. Try to find a
1608newer driver, or a driver from your hardware vendor, that features OpenGL
1609support.
1610
1611If this is not an option, the following Setup options reduce the load and
1612will likely make the client playable with sofwtare rendering (it will
1613still be slow, though):
1614
1615=over 4
1616
1617=item B<Video Mode> should be set as low as possible (e.g. 640x480)
1618
1619=item Enable B<Fast & Ugly> mode
1620
1621=item Disable B<Fog of War>
1622
1623=item Increase B<Map Scale>
1624
1625=back
1626
1627=back
1628
1629=head1 AUTHOR
1630
1631Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1632
1633
1634

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines