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.149 by root, Thu Apr 20 02:43:01 2006 UTC vs.
Revision 1.187 by root, Tue Apr 25 12:56:34 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;
48 81
82our $FLOORBOX;
49our $GAUGES; 83our $GAUGES;
84our $STATWIDS;
50 85
51our $SDL_ACTIVE; 86our $SDL_ACTIVE;
52our %SDL_CB; 87our %SDL_CB;
53 88
54our $SDL_MIXER; 89our $SDL_MIXER;
… …
98 undef $CONN; 133 undef $CONN;
99} 134}
100 135
101sub client_setup { 136sub client_setup {
102 my $dialog = new CFClient::UI::FancyFrame 137 my $dialog = new CFClient::UI::FancyFrame
138 title => "Client Setup",
103 child => (my $vbox = new CFClient::UI::VBox); 139 child => (my $vbox = new CFClient::UI::VBox);
104 $vbox->add (new CFClient::UI::Label valign => 0, align => 0, text => "Client Setup");
105 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 140 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
106 141
107 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); 142 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
108 $table->add (1, 0, my $hbox = new CFClient::UI::HBox); 143 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
109 144
110 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]); 145 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
111 $hbox->add (my $mode_label = new CFClient::UI::Label valign => 0, height => 0.8); 146 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
112 147
113 $mode_slider->connect (changed => sub { 148 $mode_slider->connect (changed => sub {
114 my ($self, $value) = @_; 149 my ($self, $value) = @_;
115 150
116 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 151 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
117 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); 152 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
118 }); 153 });
119 $mode_slider->emit (changed => $mode_slider->{range}[0]); 154 $mode_slider->emit (changed => $mode_slider->{range}[0]);
120 155
156 my $row = 1;
157
121 $table->add (0, 1, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); 158 $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 { 159 $table->add (1, $row++, new CFClient::UI::CheckBox
160 state => $CFG->{fullscreen},
161 tooltip => "Bring the client into fullscreen mode",
162 connect_changed => sub {
123 my ($self, $value) = @_; 163 my ($self, $value) = @_;
124 $CFG->{fullscreen} = $value; 164 $CFG->{fullscreen} = $value;
165 }
125 }); 166 );
126 167
127 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 168 $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 { 169 $table->add (1, $row++, new CFClient::UI::CheckBox
170 state => $CFG->{fast},
171 tooltip => "Lower the visual quality considerably to speed up rendering.",
172 connect_changed => sub {
129 my ($self, $value) = @_; 173 my ($self, $value) = @_;
130 $CFG->{fast} = $value; 174 $CFG->{fast} = $value;
175 }
131 }); 176 );
132 177
178 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
179 $table->add (1, $row++, new CFClient::UI::Slider
180 range => [$CFG->{map_scale}, 0.25, 2, 0.05],
181 tooltip => "Enlarge or shrink the displayed map",
182 connect_changed => sub {
183 my ($self, $value) = @_;
184 $CFG->{map_scale} = 0.05 * int $value / 0.05;
185 }
186 );
187
133 $table->add (0, 3, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 188 $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 { 189 $table->add (1, $row++, new CFClient::UI::CheckBox
190 state => $CFG->{fow_enable},
191 tooltip => "Fog-of-War marks areas that cannot be seen by the player",
192 connect_changed => sub {
135 my ($self, $value) = @_; 193 my ($self, $value) = @_;
136 $CFG->{fow_enable} = $value; 194 $CFG->{fow_enable} = $value;
195 }
137 }); 196 );
138 197
139 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 198 $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 { 199 $table->add (1, $row++, new CFClient::UI::Slider
200 range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
201 tooltip => "The higher the intensity, the lighter the Fog-of-War color",
202 connect_changed => sub {
141 my ($self, $value) = @_; 203 my ($self, $value) = @_;
142 $CFG->{fow_intensity} = $value; 204 $CFG->{fow_intensity} = $value;
205 }
143 }); 206 );
144 207
145 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); 208 $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 { 209 $table->add (1, $row++, new CFClient::UI::CheckBox
210 state => $CFG->{fow_smooth},
211 tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
212 connect_changed => sub {
147 my ($self, $value) = @_; 213 my ($self, $value) = @_;
148 $CFG->{fow_smooth} = $value; 214 $CFG->{fow_smooth} = $value;
149 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2; 215 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
216 }
150 }); 217 );
151 218
152 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 219 $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 { 220 $table->add (1, $row++, new CFClient::UI::Slider
221 range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
222 tooltip => "The font size used by most GUI elements",
223 connect_changed => sub {
154 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10; 224 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
155# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 225# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
226 }
156 }); 227 );
157 228
158 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize"); 229 $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 { 230 $table->add (1, $row++, new CFClient::UI::Slider
231 range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
232 tooltip => "The font size used by the server log window only",
233 connect_changed => sub {
160 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10); 234 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
235 }
161 }); 236 );
162 237
163 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 238 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
239
240 $table->add (1, $row++, new CFClient::UI::Slider
241 range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
242 tooltip => "The font size used by the statistics window only",
243 connect_changed => sub {
244 $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
245 &set_stats_window_fontsize;
246 }
247 );
248
249 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
250 $table->add (1, $row++, new CFClient::UI::Slider
251 range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
252 tooltip => "Adjust the size of the stats gauges at the bottom right",
253 connect_changed => sub {
254 $CFG->{gauge_size} = $_[1];
255 my $h = 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 }
269 );
270
271 $table->add (1, $row++, new CFClient::UI::Button
272 expand => 1, align => 0, text => "Apply",
273 tooltip => "Apply the video settings",
274 connect_activate => sub {
164 video_shutdown (); 275 video_shutdown ();
165 video_init (); 276 video_init ();
277 }
166 }); 278 );
167 279
168 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); 280 $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 { 281 $table->add (1, $row++, new CFClient::UI::CheckBox
282 state => $CFG->{audio_enable},
283 tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
284 connect_changed => sub {
170 $CFG->{audio_enable} = $_[1]; 285 $CFG->{audio_enable} = $_[1];
286 }
171 }); 287 );
172# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); 288# $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 { 289# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
174# $CFG->{effects_volume} = $_[1]; 290# $CFG->{effects_volume} = $_[1];
175# }); 291# });
176 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); 292 $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); 293 $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 { 294 $hbox->add (new CFClient::UI::CheckBox
295 expand => 1, state => $CFG->{bgm_enable},
296 tooltip => "Enable background music playing",
297 connect_changed => sub {
179 $CFG->{bgm_enable} = $_[1]; 298 $CFG->{bgm_enable} = $_[1];
299 }
180 }); 300 );
181 $hbox->add (new CFClient::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], connect_changed => sub { 301 $hbox->add (new CFClient::UI::Slider
302 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
303 tooltip => "The volume of the background music",
304 connect_changed => sub {
182 $CFG->{bgm_volume} = $_[1]; 305 $CFG->{bgm_volume} = $_[1];
183 CFClient::MixMusic::volume $_[1] * 128; 306 CFClient::MixMusic::volume $_[1] * 128;
307 }
184 }); 308 );
185 309
186 $table->add (1, 11, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 310 $table->add (1, $row++, new CFClient::UI::Button
311 expand => 1, align => 0, text => "Apply",
312 tooltip => "Apply the audio settings",
313 connect_activate => sub {
187 audio_shutdown (); 314 audio_shutdown ();
188 audio_init (); 315 audio_init ();
316 }
189 }); 317 );
190 318
191 $dialog 319 $dialog
320}
321
322sub set_stats_window_fontsize {
323 for (values %{$STATWIDS}) {
324 $_->set_fontsize ($::CFG->{stat_fontsize});
325 }
326}
327
328sub set_gauge_window_fontsize {
329 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
330 $_->set_fontsize ($::CFG->{gauge_fontsize});
331 }
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}
336
337sub make_gauge_window {
338 my $gh = int ($HEIGHT * $CFG->{gauge_size});
339# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
340
341 my $win = new CFClient::UI::Frame (
342 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
343 );
344 $win->add (my $hbox = new CFClient::UI::HBox
345 children => [
346 (new CFClient::UI::HBox expand => 1),
347 ($FLOORBOX = new CFClient::UI::VBox),
348 (my $vbox = new CFClient::UI::VBox),
349 ],
350 );
351
352 $vbox->add (new CFClient::UI::HBox
353 expand => 1,
354 children => [
355 (new CFClient::UI::Empty expand => 1),
356 (my $hb = new CFClient::UI::HBox),
357 ],
358 );
359
360 $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.");
362 $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.");
364 $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.");
366 $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.");
368
369 $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.");
371 $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.)");
373
374 $GAUGES = {
375 exp => $exp, win => $win, range => $rng,
376 food => $fg, mana => $mg, hp => $hg, grace => $gg
377 };
378
379 &set_gauge_window_fontsize;
380
381 $win
382}
383
384sub make_stats_window {
385 my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";
386
387 $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);
389 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
390
391 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
392
393 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
394
395 my $black = [0, 0, 0];
396
397 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"],
399 [0, 1, st_dex => "Dex", 30, "Dexterity, 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"],
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"],
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"],
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"],
404 [0, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."],
405
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."],
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."],
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."],
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."],
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."],
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."],
412 ) {
413 my ($col, $row, $id, $label, $template, $tooltip) = @$_;
414
415 $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);
417 $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);
419 }
420
421 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
422
423 my $row = 0;
424 my $col = 0;
425
426 my %resist_names = (
427 slow => "Slow",
428 holyw => "Holy Word",
429 conf => "Confusion",
430 fire => "Fire",
431 depl => "Depletion (some monsters and other effects can cause stats depletion)",
432 magic => "Magic",
433 drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",
434 acid => "Acid",
435 pois => "Poison",
436 para => "Paralysation",
437 deat => "Death (resistance against death spells)",
438 phys => "Physical",
439 blind => "Blind",
440 fear => "Fear",
441 tund => "Turn undead",
442 elec => "Electricity",
443 cold => "Cold",
444 ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",
445 );
446 for (qw/slow holyw conf fire depl magic
447 drain acid pois para deat phys
448 blind fear tund elec cold ghit/)
449 {
450 $tbl2->add ($col, $row,
451 $STATWIDS->{"res_$_"} =
452 new CFClient::UI::Label
453 font => $FONT_FIXED,
454 template => "-100%",
455 align => +1,
456 valign => 0,
457 can_events => 1,
458 can_hover => 1,
459 tooltip => $resist_names{$_},
460 );
461 $tbl2->add ($col + 1, $row, new CFClient::UI::Image
462 font => $FONT_FIXED,
463 can_hover => 1,
464 can_events => 1,
465 image => "ui/resist/resist_$_.png",
466 tooltip => $resist_names{$_},
467 );
468
469 $row++;
470 if ($row % 6 == 0) {
471 $col += 2;
472 $row = 0;
473 }
474 }
475
476 &set_stats_window_fontsize;
477 update_stats_window ({});
478
479 $tgw
480}
481
482sub formsep {
483 reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
484}
485
486sub update_stats_window {
487 my ($stats) = @_;
488
489 # i love text protocols!!!
490 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
491 my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
492 my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
493 my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
494 my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
495 my $fo_m = 999;
496 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
497 my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
498
499 $GAUGES->{hp} ->set_value ($hp, $hp_m);
500 $GAUGES->{mana} ->set_value ($sp, $sp_m);
501 $GAUGES->{food} ->set_value ($fo, $fo_m);
502 $GAUGES->{grace} ->set_value ($gr, $gr_m);
503 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
504 . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
505 my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
506 $rng =~ s/^Range: //; # thank you so much dear server
507 $GAUGES->{range} ->set_text ("Rng: " . $rng);
508 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
509 $title =~ s/^Player: //;
510 $STATWIDS->{title} ->set_text ("Title: " . $title);
511
512 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
513 $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
514 $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
515 $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
516 $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
517 $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
518 $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
519 $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
520 $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
521 $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
522 $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
523 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
524 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
525
526 my %tbl = (
527 phys => 100,
528 magic => 101,
529 fire => 102,
530 elec => 103,
531 cold => 104,
532 conf => 105,
533 acid => 106,
534 drain => 107,
535 ghit => 108,
536 pois => 109,
537 slow => 110,
538 para => 111,
539 tund => 112,
540 fear => 113,
541 depl => 113,
542 deat => 115,
543 holyw => 116,
544 blind => 117
545 );
546
547 for (keys %tbl) {
548 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
549 }
550
192} 551}
193 552
194sub metaserver_dialog { 553sub metaserver_dialog {
195 my $dialog = new CFClient::UI::FancyFrame 554 my $dialog = new CFClient::UI::FancyFrame
555 title => "Metaserver",
196 child => (my $vbox = new CFClient::UI::VBox); 556 child => (my $vbox = new CFClient::UI::VBox);
197 557
198 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 558 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
199 559
200 $dialog 560 $dialog
201} 561}
562
563my $METASERVER_ATIME;
202 564
203sub update_metaserver { 565sub update_metaserver {
204 my ($HOST) = @_; 566 my ($HOST) = @_;
205 567
206 status "fetching metaserver list..."; 568 return if $METASERVER_ATIME > time;
569 $METASERVER_ATIME = time + 60;
570
571 my $table = $METASERVER->{table};
572 $table->clear;
573 $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
207 574
208 my $buf; 575 my $buf;
209 576
210 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 577 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
578
579 unless ($fh) {
580 $label->set_text ("unable to contact metaserver: $!");
581 return;
582 }
211 583
212 Event->io (fd => $fh, poll => 'r', cb => sub { 584 Event->io (fd => $fh, poll => 'r', cb => sub {
213 my $res = sysread $fh, $buf, 8192, length $buf; 585 my $res = sysread $fh, $buf, 8192, length $buf;
214 586
215 if (!defined $res) { 587 if (!defined $res) {
216 $_[0]->w->cancel; 588 $_[0]->w->cancel;
217 status "metaserver: $!"; 589 $label->set_text ("error while retrieving server list: $!");
218 } elsif ($res == 0) { 590 } elsif ($res == 0) {
219 $_[0]->w->cancel; 591 $_[0]->w->cancel;
220 status "server list retrieved"; 592 status "server list retrieved";
221 593
222 my $table = $METASERVER->{table}; 594 utf8::decode $buf if utf8::valid $buf;
223 595
224 $table->clear; 596 $table->clear;
225 597
226 my @col = qw(Use #Users Host Uptime Version Description); 598 my @col = qw(Use #Users Host Uptime Version Description);
227 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_]) 599 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
… …
251 $m = [$users, $host, $uptime, $version, $desc]; 623 $m = [$users, $host, $uptime, $version, $desc];
252 624
253 $y++; 625 $y++;
254 626
255 $table->add (0, $y, new CFClient::UI::VBox children => [ 627 $table->add (0, $y, new CFClient::UI::VBox children => [
256 (new CFClient::UI::Button text => " ", connect_activate => sub { 628 (new CFClient::UI::Button text => "Use", connect_activate => sub {
257 $HOST->set_text ($CFG->{host} = $host); 629 $HOST->set_text ($CFG->{host} = $host);
258 }), 630 }),
259 (new CFClient::UI::Empty expand => 1), 631 (new CFClient::UI::Empty expand => 1),
260 ]); 632 ]);
261 633
… …
266 }); 638 });
267} 639}
268 640
269sub server_setup { 641sub server_setup {
270 my $dialog = new CFClient::UI::FancyFrame 642 my $dialog = new CFClient::UI::FancyFrame
643 title => "Server Setup",
271 child => (my $vbox = new CFClient::UI::VBox); 644 child => (my $vbox = new CFClient::UI::VBox);
272 645
273 $vbox->add (new CFClient::UI::Label valign => 0, align => 0, text => "Server Setup");
274 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 646 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
275 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); 647 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
276 648
277 { 649 {
278 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 650 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
279 651
280 $vbox->add (my $HOST = new CFClient::UI::Entry expand => 1, text => $CFG->{host}, connect_changed => sub { 652 $vbox->add (
653 my $HOST = new CFClient::UI::Entry
654 expand => 1,
655 text => $CFG->{host},
656 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
657 connect_changed => sub {
658 my ($self, $value) = @_;
659 $CFG->{host} = $value;
660 }
661 );
662
663 $METASERVER = metaserver_dialog;
664
665 $vbox->add (new CFClient::UI::Flopper
666 expand => 1,
667 text => "Metaserver",
668 other => $METASERVER,
669 tooltip => "Show a list of avaible crossfire servers",
670 connect_open => sub {
671 update_metaserver $HOST;
672 }
673 );
674 }
675
676 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
677 $table->add (1, 4, new CFClient::UI::Entry
678 text => $CFG->{user},
679 tooltip => "The name of your character on the server",
680 connect_changed => sub {
281 my ($self, $value) = @_; 681 my ($self, $value) = @_;
282 $CFG->{host} = $value;
283 });
284
285 $METASERVER = metaserver_dialog;
286
287 $vbox->add (new CFClient::UI::Flopper expand => 1, text => "Metaserver", other => $METASERVER, connect_open => sub {
288 update_metaserver $HOST;
289 });
290 }
291
292 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
293 $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
294 my ($self, $value) = @_;
295 $CFG->{user} = $value; 682 $CFG->{user} = $value;
683 }
296 }); 684 );
297 685
298 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); 686 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
299 $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub { 687 $table->add (1, 5, new CFClient::UI::Entry
688 text => $CFG->{password},
689 hidden => 1,
690 tooltip => "The password for your character",
691 connect_changed => sub {
300 my ($self, $value) = @_; 692 my ($self, $value) = @_;
301 $CFG->{password} = $value; 693 $CFG->{password} = $value;
694 }
302 }); 695 );
303 696
304 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd"); 697 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
305 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub { 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 {
306 my ($self, $value) = @_; 704 my ($self, $value) = @_;
307 $CFG->{say_command} = $value; 705 $CFG->{say_command} = $value;
706 }
308 }); 707 );
309 708
310 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 709 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
311 $table->add (1, 7, new CFClient::UI::Slider 710 $table->add (1, 7, new CFClient::UI::Slider
312 req_w => 100, 711 req_w => 100,
313 range => [$CFG->{mapsize}, 10, 100 + 1, 1], 712 range => [$CFG->{mapsize}, 10, 100 + 1, 1],
713 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.",
314 connect_changed => sub { 715 connect_changed => sub {
315 my ($self, $value) = @_; 716 my ($self, $value) = @_;
316 717
317 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 718 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
318 }, 719 },
… …
325 $dialog 726 $dialog
326} 727}
327 728
328sub message_window { 729sub message_window {
329 my $window = new CFClient::UI::FancyFrame 730 my $window = new CFClient::UI::FancyFrame
731 title => "Messages",
330 border_bg => [1, 1, 1, 0.5], 732 border_bg => [1, 1, 1, 1],
331 bg => [0.3, 0.3, 0.3, 0.8], 733 bg => [0, 0, 0, 0.5],
332 user_w => int $::WIDTH / 3, 734 user_w => int $::WIDTH / 3,
333 user_h => int $::HEIGHT / 5, 735 user_h => int $::HEIGHT / 5,
334 child => (my $vbox = new CFClient::UI::VBox); 736 child => (my $vbox = new CFClient::UI::VBox);
335 737
336 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 738 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
337 expand => 1, 739 expand => 1,
740 font => $FONT_FIXED,
338 fontsize => $::CFG->{log_fontsize}, 741 fontsize => $::CFG->{log_fontsize},
339 ); 742 );
340 743
341 $vbox->add (my $input = new CFClient::UI::Entry 744 $vbox->add (my $input = new CFClient::UI::Entry
342 connect_focus_in => sub { 745 connect_focus_in => sub {
… …
415 fontsize => 0.8, 818 fontsize => 0.8,
416 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 819 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
417 $ALT_ENTER_MESSAGE->show; 820 $ALT_ENTER_MESSAGE->show;
418 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h}); 821 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
419 822
420 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget); 823 CFClient::UI::FancyFrame->new (
421 $MAPWIDGET->focus_in; 824 border_bg => [1, 1, 1, 192/255],
825 bg => [1, 1, 1, 0],
826 child => $MAPMAP = new CFClient::MapWidget::MapMap
827 )->show;
828
829 $MAPWIDGET = new CFClient::MapWidget;
422 $MAPWIDGET->connect (activate_console => sub { 830 $MAPWIDGET->connect (activate_console => sub {
423 my ($mapwidget, $preset) = @_; 831 my ($mapwidget, $preset) = @_;
424 832
425 if ($CONSOLE) { 833 if ($CONSOLE) {
426 $CONSOLE->{input}->{auto_activated} = 1; 834 $CONSOLE->{input}->{auto_activated} = 1;
… …
429 if ($preset && $CONSOLE->{input}->get_text eq '') { 837 if ($preset && $CONSOLE->{input}->get_text eq '') {
430 $CONSOLE->{input}->set_text ($preset); 838 $CONSOLE->{input}->set_text ($preset);
431 } 839 }
432 } 840 }
433 }); 841 });
842 $MAPWIDGET->show;
843 $MAPWIDGET->focus_in;
434 844
435 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox); 845 $BUTTONBAR = new CFClient::UI::HBox;
436 846
437 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 847 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
438 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 848 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
439 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 849 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
850
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
852 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
440 853
441 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 854 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
442 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 855 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
443 status "Configuration Saved"; 856 status "Configuration Saved";
444 }); 857 });
445 858
859 $BUTTONBAR->show;
860
446 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 861 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
447
448 my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH - 300, y => 0);
449 $tgw->add (my $hbox = new CFClient::UI::HBox ());
450
451 $hbox->add (my $hg = new CFClient::UI::VGauge (gauge => 'hp'));
452 $hbox->add (my $mg = new CFClient::UI::VGauge (gauge => 'mana'));
453 $hbox->add (my $gg = new CFClient::UI::VGauge (gauge => 'grace'));
454 $hbox->add (my $fg = new CFClient::UI::VGauge (gauge => 'food'));
455
456 $GAUGES = { food => $fg, mana => $mg, hp => $hg, grace => $gg };
457 $CFClient::UI::ROOT->add ($tgw);
458} 862}
459 863
460sub video_shutdown { 864sub video_shutdown {
461 $CFClient::UI::ROOT->{children} = []; 865 $CFClient::UI::ROOT->{children} = [];
866 undef $CFClient::UI::GRAB;
867 undef $CFClient::UI::HOVER;
462 undef $SDL_ACTIVE; 868 undef $SDL_ACTIVE;
463} 869}
464 870
871my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
465my $bgmusic;#TODO#hack#d# 872my $bgmusic;#TODO#hack#d#
873
874sub audio_music_finished {
875 return unless $CFG->{bgm_enable};
876
877 # TODO: hack, do play loop and mood music
878 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
879 $bgmusic->play (0);
880
881 push @bgmusic, shift @bgmusic;
882}
466 883
467sub audio_init { 884sub audio_init {
468 if ($CFG->{audio_enable}) { 885 if ($CFG->{audio_enable}) {
469 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { 886 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
470
471 $SDL_MIXER = !CFClient::Mix_OpenAudio; 887 $SDL_MIXER = !CFClient::Mix_OpenAudio;
472 CFClient::Mix_AllocateChannels 8; 888 CFClient::Mix_AllocateChannels 8;
473 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; 889 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
474 890
475 # TODO: hack, do play loop and mood music 891 audio_music_finished;
476 if ($CFG->{bgm_enable}) {
477 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/game3.ogg";
478 $bgmusic->play;
479 }
480 892
481 while (<$fh>) { 893 while (<$fh>) {
482 next if /^\s*#/; 894 next if /^\s*#/;
483 next if /^\s*$/; 895 next if /^\s*$/;
484 896
… …
562@conn::ISA = Crossfire::Protocol::; 974@conn::ISA = Crossfire::Protocol::;
563 975
564sub conn::stats_update { 976sub conn::stats_update {
565 my ($self, $stats) = @_; 977 my ($self, $stats) = @_;
566 978
567 # i love text protocols!!! 979 update_stats_window ($stats);
568 # FIXME: the stats are somehow weird
569 my $hp = $stats->{1};
570 my $hp_m = $stats->{2};
571 my $sp = $stats->{3};
572 my $sp_m = $stats->{4};
573 my $fo = $stats->{18};
574 my $fo_m = 1000;
575 my $gr = $stats->{23};
576 my $gr_m = $stats->{24};
577
578 #d# warn "DATA $hp $hp_m $sp $sp_m $fo $fo_m $gr $gr_m\n";
579 $GAUGES->{hp}->set_value ($hp, $hp_m);
580 $GAUGES->{mana}->set_value ($sp, $sp_m);
581 $GAUGES->{food}->set_value ($fo, $fo_m);
582 $GAUGES->{grace}->set_value ($gr, $gr_m);
583} 980}
584 981
585sub conn::user_send { 982sub conn::user_send {
586 my ($self, $command) = @_; 983 my ($self, $command) = @_;
587 984
… …
612 1009
613 my ($hash, $x, $y, $w, $h) = @$map_info; 1010 my ($hash, $x, $y, $w, $h) = @$map_info;
614 1011
615 my $data = $MAP->get_rect ($x, $y, $w, $h); 1012 my $data = $MAP->get_rect ($x, $y, $w, $h);
616 $MAPCACHE->put ($hash => Compress::LZF::compress $data); 1013 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
617
618 warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d# 1014 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
619
620} 1015}
621 1016
622sub conn::map_clear { 1017sub conn::map_clear {
623 my ($self) = @_; 1018 my ($self) = @_;
624 1019
625 $self->flush_map; 1020 $self->flush_map;
626 delete $self->{neigh}; 1021 delete $self->{neigh_map};
627 1022
628 $MAP->clear; 1023 $MAP->clear;
629} 1024}
630 1025
631 1026
632sub conn::load_map($$$) { 1027sub conn::load_map($$$) {
633 my ($self, $hash, $x, $y) = @_; 1028 my ($self, $hash, $x, $y) = @_;
634 1029
635 if (defined (my $data = $MAPCACHE->get ($hash))) { 1030 if (defined (my $data = $MAPCACHE->get ($hash))) {
636 $data = Compress::LZF::decompress $data; 1031 $data = Compress::LZF::decompress $data;
637 warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d# 1032 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
638 for my $id ($MAP->set_rect ($x, $y, $data)) { 1033 for my $id ($MAP->set_rect ($x, $y, $data)) {
639 my $data = $TILECACHE->get ($id) 1034 my $data = $TILECACHE->get ($id)
640 or next; 1035 or next;
641 1036
642 $self->set_texture ($id => $data); 1037 $self->set_texture ($id => $data);
643 } 1038 }
644 } 1039 }
645} 1040}
646 1041
1042# this method does a "flood fill" into every tile direction
1043# 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.
1045# failure to comply are harmless and result in display errors
1046# at worst.
647sub conn::flood_fill { 1047sub conn::flood_fill {
648 my ($self, $path, $hash, $flags, $x0, $y0, $x1, $y1) = @_; 1048 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
649 1049
650 # the server does not allow map paths > 6 1050 # the server does not allow map paths > 6
651 return if 6 <= length $path; 1051 return if 7 <= length $path;
652 1052
653 for my $tile (1..4) { 1053 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
654 next if $self->{neigh}{$hash}[$tile]; 1054
1055 for (
1056 [1, 0, -1],
1057 [2, 1, 0],
1058 [3, 0, 1],
1059 [4, -1, 0],
1060 ) {
1061 my ($tile, $dx, $dy) = @$_;
1062
1063 my $gx = $gx + $dx;
1064 my $gy = $gy + $dy;
1065
655 next unless $flags & (1 << ($tile - 1)); 1066 next unless $flags & (1 << ($tile - 1));
1067 next if $self->{neigh_grid}{$gx, $gy}++;
656 1068
657 my $neigh = $self->{neigh}{$hash} ||= []; 1069 my $neigh = $self->{neigh_map}{$hash} ||= [];
658 1070 if (my $info = $neigh->[$tile]) {
659 $self->send_mapinfo ("spatial $path$tile", sub {
660 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_; 1071 my ($flags, $x, $y, $w, $h, $hash) = @$info;
661 1072
662 #warn "map<$path>_$tile=<$mode,$x,$y,$w,$h,$hash>\n";#d#
663 return if $mode ne "spatial";
664
665 $x += $MAP->ox;
666 $y += $MAP->oy;
667
668 $self->load_map ($hash, $x, $y)
669 unless $self->{neigh}{$hash}[5]++;#d#
670
671 $neigh->[$tile] = [$x, $y, $w, $h];
672
673 $self->flood_fill ("$path$tile", $hash, $flags, $x0, $y0, $x1, $y1) 1073 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
674 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; 1074 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1075
1076 } else {
1077 $self->send_mapinfo ("spatial $path$tile", sub {
1078 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1079
1080 return if $mode ne "spatial";
1081
1082 $x += $MAP->ox;
1083 $y += $MAP->oy;
1084
1085 $self->load_map ($hash, $x, $y)
1086 unless $self->{neigh_map}{$hash}[5]++;#d#
1087
1088 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1089
1090 $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
1091 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1092 });
675 }); 1093 }
676 } 1094 }
677} 1095}
678 1096
679sub conn::map_change { 1097sub conn::map_change {
680 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_; 1098 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
681 1099
682 $self->flush_map; 1100 $self->flush_map;
683 1101
684 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy); 1102 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
685 1103
686 my $mapmapw = 250; 1104 my $mapmapw = $MAPMAP->{w};
687 my $mapmaph = 250; 1105 my $mapmaph = $MAPMAP->{h};
1106
1107 $self->{neigh_rect} = [
1108 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1109 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1110 ];
688 1111
1112 delete $self->{neigh_grid};
689 $self->flood_fill ("", $hash, $flags, 1113 $self->flood_fill (0, 0, "", $hash, $flags);
690 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
691 $ox + $mapmapw * 0.5, $oy + $mapmapw * 0.5);
692 1114
693 $x += $ox; 1115 $x += $ox;
694 $y += $oy; 1116 $y += $oy;
695 1117
696 $self->{map_info} = [$hash, $x, $y, $w, $h]; 1118 $self->{map_info} = [$hash, $x, $y, $w, $h];
1119
1120 my $map = $self->{map_info}[0];
1121 $map =~ s/^.*?\/([^\/]+)$/\1/;
1122 $STATWIDS->{map}->set_text ("Map: " . $map);
697 1123
698 $self->load_map ($hash, $x, $y); 1124 $self->load_map ($hash, $x, $y);
699} 1125}
700 1126
701sub conn::face_find { 1127sub conn::face_find {
… …
727 } 1153 }
728 1154
729gotid: 1155gotid:
730 $face->{id} = $id; 1156 $face->{id} = $id;
731 $MAP->set_face ($facenum => $id); 1157 $MAP->set_face ($facenum => $id);
1158 $self->{faceid}[$facenum] = $id;#d#
732 $TILECACHE->get ($id) 1159 $TILECACHE->get ($id)
733} 1160}
734 1161
735sub conn::face_update { 1162sub conn::face_update {
736 my ($self, $facenum, $face) = @_; 1163 my ($self, $facenum, $face) = @_;
… …
744 my ($self, $id, $data) = @_; 1171 my ($self, $id, $data) = @_;
745 1172
746 $self->{texture}[$id] ||= do { 1173 $self->{texture}[$id] ||= do {
747 my $tex = 1174 my $tex =
748 new_from_image CFClient::Texture 1175 new_from_image CFClient::Texture
749 $data, minify => 1; 1176 $data, minify => 1, mipmap => 1;
750 1177
751 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 1178 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
752 $MAPWIDGET->update; 1179 $MAPWIDGET->update;
753 1180
754 $tex 1181 $tex
… …
766 1193
767 $chunk->play; 1194 $chunk->play;
768# warn "sound $x,$y,$soundnum,$type\n";#d# 1195# warn "sound $x,$y,$soundnum,$type\n";#d#
769} 1196}
770 1197
1198my $LAST_QUERY; # server is stupid, stupid, stupid
1199
771sub conn::query { 1200sub conn::query {
772 my ($self, $flags, $prompt) = @_; 1201 my ($self, $flags, $prompt) = @_;
773 1202
774 #TODO, display dialog with relevant information 1203 $prompt = $LAST_QUERY unless length $prompt;
775 warn "<<<<QUERY:$flags:$prompt>>>\n";#d# 1204 $LAST_QUERY = $prompt;
1205
1206 my $dialog = new CFClient::UI::FancyFrame
1207 title => "Query",
1208 child => my $vbox = new CFClient::UI::VBox;
1209
1210 $vbox->add (new CFClient::UI::Label
1211 max_w => $::WIDTH * 0.4,
1212 text => $prompt);
1213
1214 if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1215 $vbox->add (my $hbox = new CFClient::HBox);
1216 $hbox->add (new CFClient::Button
1217 text => "No",
1218 connect_activate => sub {
1219 $self->send ("reply n");
1220 $dialog->destroy;
1221 $MAPWIDGET->focus_in;
1222 }
1223 );
1224 $hbox->add (new CFClient::Button
1225 text => "Yes",
1226 connect_activate => sub {
1227 $self->send ("reply y");
1228 $dialog->destroy;
1229 $MAPWIDGET->focus_in;
1230 },
1231 );
1232
1233 $dialog->focus_in;
1234
1235 } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1236 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1237 $vbox->add (my $entry = new CFClient::UI::Entry
1238 connect_changed => sub {
1239 $self->send ("reply $_[1]");
1240 $dialog->destroy;
1241 $MAPWIDGET->focus_in;
1242 },
1243 );
1244
1245 $entry->focus_in;
1246
1247 } else {
1248 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1249
1250 $vbox->add (my $entry = new CFClient::UI::Entry
1251 $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1252 connect_activate => sub {
1253 $self->send ("reply $_[1]");
1254 $dialog->destroy;
1255 $MAPWIDGET->focus_in;
1256 },
1257 );
1258
1259 $entry->focus_in;
1260 }
1261
1262 $dialog->show;
776} 1263}
777 1264
778sub conn::drawinfo { 1265sub conn::drawinfo {
779 my ($self, $color, $text) = @_; 1266 my ($self, $color, $text) = @_;
780 1267
… …
798} 1285}
799 1286
800sub conn::spell_add { 1287sub conn::spell_add {
801 my ($self, $spell) = @_; 1288 my ($self, $spell) = @_;
802 1289
1290 # TODO
1291 # create a widget dynamically, using spell face (CF::Protocol downloads them)
803 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}, sub { 1292 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
804 });
805 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}, sub { 1293 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
806 });
807} 1294}
808 1295
809sub conn::spell_delete { 1296sub conn::spell_delete {
810 my ($self, $spell) = @_; 1297 my ($self, $spell) = @_;
811} 1298}
812 1299
813sub conn::addme_success { 1300sub conn::addme_success {
814 my ($self) = @_; 1301 my ($self) = @_;
815 1302
816 for my $skill (values %{$self->{skill_info}}) { 1303 for my $skill (values %{$self->{skill_info}}) {
817 $MAPWIDGET->add_command ("ready_skill $skill", "", sub { 1304 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1305 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1306 }
1307}
1308
1309sub update_floorbox {
1310 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1311 $FLOORBOX->clear;
1312 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1313
1314 my @items = values %{ $CONN->{container}{0} };
1315
1316 # we basically have to use the same sorting as everybody else
1317 @items = sort { $a->{type} <=> $b->{type} } @items;
1318
1319 for my $item (reverse @items) {
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 },
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
1353 $hbox->add (new CFClient::UI::Label
1354 can_events => 0,
1355 text => $desc,
1356 );
818 }); 1357 }
819 $MAPWIDGET->add_command ("use_skill $skill", "", sub {
820 }); 1358 });
1359 refresh;
1360}
1361
1362sub conn::container_add {
1363 my ($self, $id, $items) = @_;
1364
1365 update_floorbox if $id == 0;
1366 # $self-<{player}{tag} => player inv
1367 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1368}
1369
1370sub conn::container_clear {
1371 my ($self, $id) = @_;
1372
1373 update_floorbox if $id == 0;
1374# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1375}
1376
1377sub conn::item_delete {
1378 my ($self, @items) = @_;
1379
1380 for (@items) {
1381 update_floorbox if $_->{container} == 0;
821 } 1382 }
1383}
1384
1385sub conn::item_update {
1386 my ($self, $item) = @_;
1387
1388 update_floorbox if $item->{container} == 0;
822} 1389}
823 1390
824%SDL_CB = ( 1391%SDL_CB = (
825 CFClient::SDL_QUIT => sub { 1392 CFClient::SDL_QUIT => sub {
826 Event::unloop -1; 1393 Event::unloop -1;
827 }, 1394 },
828 CFClient::SDL_VIDEORESIZE => sub { 1395 CFClient::SDL_VIDEORESIZE => sub {
829 }, 1396 },
830 CFClient::SDL_VIDEOEXPOSE => sub { 1397 CFClient::SDL_VIDEOEXPOSE => \&refresh,
831 refresh; 1398 CFClient::SDL_ACTIVEEVENT => sub {
1399# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
832 }, 1400 },
833 CFClient::SDL_KEYDOWN => sub { 1401 CFClient::SDL_KEYDOWN => sub {
834 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1402 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
835 # alt-enter 1403 # alt-enter
836 video_shutdown; 1404 video_shutdown;
… …
838 video_init; 1406 video_init;
839 } else { 1407 } else {
840 CFClient::UI::feed_sdl_key_down_event ($_[0]); 1408 CFClient::UI::feed_sdl_key_down_event ($_[0]);
841 } 1409 }
842 }, 1410 },
843 CFClient::SDL_KEYUP => sub { 1411 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
844 CFClient::UI::feed_sdl_key_up_event ($_[0]); 1412 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
845 }, 1413 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
846 CFClient::SDL_MOUSEMOTION => sub { 1414 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
847 CFClient::UI::feed_sdl_motion_event ($_[0]); 1415 CFClient::SDL_USEREVENT => \&audio_music_finished,
848 },
849 CFClient::SDL_MOUSEBUTTONDOWN => sub {
850 CFClient::UI::feed_sdl_button_down_event ($_[0]);
851 },
852 CFClient::SDL_MOUSEBUTTONUP => sub {
853 CFClient::UI::feed_sdl_button_up_event ($_[0]);
854 },
855 CFClient::SDL_ACTIVEEVENT => sub {
856# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
857 },
858); 1416);
859 1417
860############################################################################# 1418#############################################################################
861 1419
862$SIG{INT} = $SIG{TERM} = sub { exit }; 1420$SIG{INT} = $SIG{TERM} = sub { exit };
… …
870 sdl_mode => 0, 1428 sdl_mode => 0,
871 width => 640, 1429 width => 640,
872 height => 480, 1430 height => 480,
873 fullscreen => 0, 1431 fullscreen => 0,
874 fast => 0, 1432 fast => 0,
1433 map_scale => 0.5,
875 fow_enable => 1, 1434 fow_enable => 1,
876 fow_intensity => 0.45, 1435 fow_intensity => 0.45,
877 fow_smooth => 0, 1436 fow_smooth => 0,
878 gui_fontsize => 1, 1437 gui_fontsize => 1,
879 log_fontsize => 14, 1438 log_fontsize => 1,
1439 gauge_fontsize => 1,
1440 gauge_size => 0.35,
1441 stat_fontsize => 1,
880 mapsize => 100, 1442 mapsize => 100,
881 host => "crossfire.schmorp.de", 1443 host => "crossfire.schmorp.de",
882 say_command => 'say', 1444 say_command => 'say',
883 audio_enable => 1, 1445 audio_enable => 1,
884 bgm_enable => 1, 1446 bgm_enable => 1,
… …
898@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; 1460@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
899 1461
900$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; 1462$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
901 1463
902{ 1464{
903 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf); 1465 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1466 DejaVuSans.ttf
1467 DejaVuSansMono.ttf
1468 DejaVuSans-Bold.ttf
1469 DejaVuSansMono-Bold.ttf
1470 DejaVuSans-Oblique.ttf
1471 DejaVuSansMono-Oblique.ttf
1472 DejaVuSans-BoldOblique.ttf
1473 DejaVuSansMono-BoldOblique.ttf
1474 );
904 1475
905 CFClient::add_font $_ for @fonts; 1476 CFClient::add_font $_ for @fonts;
906 CFClient::set_font $fonts[0]; 1477
1478 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1479 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1480
1481 $FONT_PROP->make_default;
907} 1482}
908 1483
909video_init; 1484video_init;
910audio_init; 1485audio_init;
911 1486
912Event::loop; 1487Event::loop;
913 1488
914END { CFClient::SDL_Quit } 1489END { CFClient::SDL_Quit }
915 1490
1491=head1 pclient - Crossfire+ and Crossfire game client
916 1492
1493Pclient is a Crossfire+ and Crossfire game client.
1494
1495=head2 Features
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
1525=head1 USAGE
1526
1527=head2 The Map
1528
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
1591=head1 AUTHOR
1592
1593Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1594
1595
1596

Diff Legend

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