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.105 by root, Fri Apr 14 20:27:36 2006 UTC vs.
Revision 1.214 by root, Sun May 14 22:24:17 2006 UTC

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

Diff Legend

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