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

Diff Legend

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