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.112 by root, Sat Apr 15 13:56:26 2006 UTC vs.
Revision 1.213 by root, Sun May 14 20:51:20 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
26our $META_SERVER = "crossfire.real-time.com:13326"; 53our $META_SERVER = "crossfire.real-time.com:13326";
27 54
55our $FACEMAP;
56our $TILECACHE;
28our $FACECACHE; 57our $MAPCACHE;
29 58
30our $LAST_REFRESH; 59our $LAST_REFRESH;
31our $NOW; 60our $NOW;
32 61
33our $CFG; 62our $CFG;
34our $CONN; 63our $CONN;
35our $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;
36 68
37our @SDL_MODES; 69our @SDL_MODES;
38our $WIDTH; 70our $WIDTH;
39our $HEIGHT; 71our $HEIGHT;
40our $FULLSCREEN; 72our $FULLSCREEN;
41our $FONTSIZE; 73our $FONTSIZE;
42 74
75our $FONT_PROP;
76our $FONT_FIXED;
77
43our $MAP; 78our $MAP;
79our $MAPMAP;
44our $MAPWIDGET; 80our $MAPWIDGET;
45our $BUTTONBAR; 81our $BUTTONBAR;
46our $LOGVIEW; 82our $LOGVIEW;
47our $CONSOLE; 83our $CONSOLE;
48our $METASERVER; 84our $METASERVER;
85our $LOGIN_BUTTON;
86
87our $FLOORBOX;
88our $GAUGES;
89our $STATWIDS;
49 90
50our $SDL_ACTIVE; 91our $SDL_ACTIVE;
51our $SDL_EV;
52our %SDL_CB; 92our %SDL_CB;
53 93
94our $SDL_MIXER;
95our @SOUNDS; # event => file mapping
96our %AUDIO_CHUNKS; # audio files
97
54our $ALT_ENTER_MESSAGE; 98our $ALT_ENTER_MESSAGE;
55our $STATUS_LINE; 99our $STATUSBOX;
56our $DEBUG_STATUS; 100our $DEBUG_STATUS;
57 101
102our $INVWIN;
103our $INV;
104
58sub status { 105sub status {
59 $STATUS_LINE->set_text ($_[0]); 106 $STATUSBOX->add ($_[0], pri => -10, group => "status", timeout => 20, color => [1, 1, 0, 1]);
60 my ($w, $h) = $STATUS_LINE->size_request; 107 $CFClient::UI::ROOT->on_post_alloc (status_line_positioner => sub {
61 $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 });
62} 111}
63 112
64sub debug { 113sub debug {
65 $DEBUG_STATUS->set_text ($_[0]); 114 $DEBUG_STATUS->set_text ($_[0]);
66 my ($w, $h) = $DEBUG_STATUS->size_request; 115 my ($w, $h) = $DEBUG_STATUS->size_request;
67 $DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h); 116 $DEBUG_STATUS->move ($WIDTH - $w, 0);
68} 117}
69 118
70sub start_game { 119sub start_game {
71 status "logging in..."; 120 status "logging in...";
72 121
73 my $mapsize = List::Util::min 32, 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;
74 123
124 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
75 $MAP = new CFClient::Map $mapsize, $mapsize; 125 $MAP = new CFClient::Map $mapsize, $mapsize;
76 126
77 my ($host, $port) = split /:/, $CFG->{host}; 127 my ($host, $port) = split /:/, $CFG->{host};
78 128
79 $CONN = new conn 129 $CONN = eval {
130 new conn
80 host => $host, 131 host => $host,
81 port => $port || 13327, 132 port => $port || 13327,
82 user => $CFG->{user}, 133 user => $CFG->{user},
83 pass => $CFG->{password}, 134 pass => $CFG->{password},
84 mapw => $mapsize, 135 mapw => $mapsize,
85 maph => $mapsize, 136 maph => $mapsize,
137 ;
86 ; 138 };
87 139
140 if ($CONN) {
141 $LOGIN_BUTTON->set_text ("Logout");
142
88 status "login successful"; 143 status "login successful";
89 144
90 CFClient::lowdelay fileno $CONN->{fh}; 145 CFClient::lowdelay fileno $CONN->{fh};
146 } else {
147 status "unable to connect";
148 stop_game();
149 }
91} 150}
92 151
93sub 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;
94 undef $CONN; 161 undef $MAP;
95} 162}
96 163
97sub client_setup { 164sub client_setup {
98 my $dialog = new CFClient::UI::FancyFrame 165 my $dialog = new CFClient::UI::FancyFrame
166 title => "Client Setup",
99 child => (my $vbox = new CFClient::UI::VBox); 167 child => (my $vbox = new CFClient::UI::VBox);
100 $vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
101 $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]);
102 169
103 $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");
104 $table->add (1, 0, my $hbox = new CFClient::UI::HBox); 171 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
105 172
106 $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]);
107 $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");
108 175
109 $mode_slider->connect (changed => sub { 176 $mode_slider->connect (changed => sub {
110 my ($self, $value) = @_; 177 my ($self, $value) = @_;
111 178
112 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 179 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
113 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); 180 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
114 }); 181 });
115 $mode_slider->emit (changed => $mode_slider->{range}[0]); 182 $mode_slider->emit (changed => $mode_slider->{range}[0]);
116 183
184 my $row = 1;
185
117 $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");
118 $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 {
119 my ($self, $value) = @_; 191 my ($self, $value) = @_;
120 $CFG->{fullscreen} = $value; 192 $CFG->{fullscreen} = $value;
193 }
121 }); 194 );
122 195
123 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Fast & Ugly"); 196 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
124 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub { 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 {
125 my ($self, $value) = @_; 201 my ($self, $value) = @_;
126 $CFG->{fast} = $value; 202 $CFG->{fast} = $value;
203 }
127 }); 204 );
128 205
129 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Fog of War"); 206 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
130 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub { 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 {
131 my ($self, $value) = @_; 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) = @_;
132 $CFG->{fow_enable} = $value; 222 $CFG->{fow_enable} = $value;
223 }
133 }); 224 );
134 225
135 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "FoW Intensity"); 226 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
136 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub { 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 {
137 my ($self, $value) = @_; 231 my ($self, $value) = @_;
138 $CFG->{fow_intensity} = $value; 232 $CFG->{fow_intensity} = $value;
233 }
139 }); 234 );
140 235
141 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "FoW Smooth"); 236 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
142 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub { 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 {
143 my ($self, $value) = @_; 241 my ($self, $value) = @_;
144 $CFG->{fow_smooth} = $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];
145 }); 319# });
146
147 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Log Fontsize"); 320 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
148 $table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 8, 30, 1], connect_changed => sub { 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 {
149 my ($self, $value) = @_; 354 my ($self, $value) = @_;
150 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = int $value); 355 $CFG->{say_command} = $value;
356 }
151 }); 357 );
152
153 $table->add (1, 7, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
154 destroy_screen ();
155 init_screen ();
156 });
157 358
158 $dialog 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
159} 594}
160 595
161sub metaserver_dialog { 596sub metaserver_dialog {
162 my $dialog = new CFClient::UI::FancyFrame 597 my $dialog = new CFClient::UI::FancyFrame
598 title => "Server List",
163 child => (my $vbox = new CFClient::UI::VBox); 599 child => (my $vbox = new CFClient::UI::VBox);
164 600
165 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 601 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
166 602
167 $dialog 603 $dialog
168} 604}
169 605
606my $METASERVER_ATIME;
607
170sub update_metaserver { 608sub update_metaserver {
171 status "fetching metaserver list..."; 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...");
172 617
173 my $buf; 618 my $buf;
174 619
175 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 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 }
176 626
177 Event->io (fd => $fh, poll => 'r', cb => sub { 627 Event->io (fd => $fh, poll => 'r', cb => sub {
178 my $res = sysread $fh, $buf, 8192, length $buf; 628 my $res = sysread $fh, $buf, 8192, length $buf;
179 629
180 if (!defined $res) { 630 if (!defined $res) {
181 $_[0]->w->cancel; 631 $_[0]->w->cancel;
182 status "metaserver: $!"; 632 $label->set_text ("error while retrieving server list: $!");
183 } elsif ($res == 0) { 633 } elsif ($res == 0) {
184 $_[0]->w->cancel; 634 $_[0]->w->cancel;
185 status "server list retrieved"; 635 status "server list retrieved";
186 warn $buf; 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 }
187 } 680 }
188 }); 681 });
189} 682}
190 683
191sub server_setup { 684sub server_setup {
192 my $dialog = new CFClient::UI::FancyFrame 685 my $dialog = new CFClient::UI::FancyFrame
686 title => "Server Setup",
193 child => (my $vbox = new CFClient::UI::VBox); 687 child => (my $vbox = new CFClient::UI::VBox);
194 688
195 $vbox->add (new CFClient::UI::Label align => 0, text => "Server Setup");
196 $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]);
197 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host:Port"); 690 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
198 691
199 { 692 {
200 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 693 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
201 694
202 $vbox->add (new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub { 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 {
203 my ($self, $value) = @_; 724 my ($self, $value) = @_;
204 $CFG->{host} = $value; 725 $CFG->{user} = $value;
205 }); 726 }
727 );
206 728
207 $METASERVER = metaserver_dialog;
208
209 $vbox->add (new CFClient::UI::Flopper text => "Metaserver", other => $METASERVER, connect_open => sub {
210 update_metaserver;
211 });
212 }
213
214 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username"); 729 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
215 $table->add (1, 4, my $user = new CFClient::UI::Entry text => $CFG->{user}, 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 {
216 my ($self, $value) = @_; 735 my ($self, $value) = @_;
217 $CFG->{user} = $value;
218 });
219
220 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
221 $table->add (1, 5, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
222 my ($self, $value) = @_;
223 $CFG->{password} = $value; 736 $CFG->{password} = $value;
737 }
224 }); 738 );
225 739
226 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd");
227 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
228 my ($self, $value) = @_;
229 $CFG->{say_command} = $value;
230 });
231
232 $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");
233 $table->add (1, 7, new CFClient::UI::Slider 741 $table->add (1, 7, new CFClient::UI::Slider
234 req_w => 100, 742 req_w => 100,
235 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.",
236 connect_changed => sub { 746 connect_changed => sub {
237 my ($self, $value) = @_; 747 my ($self, $value) = @_;
238 748
239 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 749 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
240 }, 750 },
241 ); 751 );
242 752
243 $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
244 start_game; 759 : start_game;
760 },
245 }); 761 );
246 762
247 $dialog 763 $dialog
248} 764}
249 765
250sub message_window { 766sub message_window {
251 my $window = new CFClient::UI::FancyFrame 767 my $window = new CFClient::UI::FancyFrame
768 title => "Messages",
252 border_bg => [1, 1, 1, 0.5], 769 border_bg => [1, 1, 1, 1],
253 bg => [0.3, 0.3, 0.3, 0.8], 770 bg => [0, 0, 0, 0.5],
254 user_w => $::WIDTH/4, 771 user_w => int $::WIDTH / 3,
255 user_h => $::HEIGHT, 772 user_h => int $::HEIGHT / 5,
256 child => (my $vbox = new CFClient::UI::VBox); 773 child => (my $vbox = new CFClient::UI::VBox);
257 774
258 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 775 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
259 expand => 1, 776 expand => 1,
777 font => $FONT_FIXED,
260 fontsize => $::CFG->{log_fontsize}, 778 fontsize => $::CFG->{log_fontsize},
261 ); 779 );
262 780
263 $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 },
264 $input->connect (activate => sub { 792 connect_activate => sub {
265 my ($input, $text) = @_; 793 my ($input, $text) = @_;
266 $input->set_text (''); 794 $input->set_text ('');
267 795
268 if ($text =~ /^\/(.*)/) { 796 if ($text =~ /^\/(.*)/) {
269 $::CONN->user_send ("command $1"); 797 $::CONN->user_send ($1);
270 } else { 798 } else {
271 my $say_cmd = $::CFG->{say_command} || 'say'; 799 my $say_cmd = $::CFG->{say_command} || 'say';
272 $::CONN->user_send ("command $say_cmd $text"); 800 $::CONN->user_send ("$say_cmd $text");
273 } 801 }
802 if ($input->{refocus_map}) {
803 delete $input->{refocus_map};
804 $MAPWIDGET->focus_in
274 1 805 }
275 }); 806 },
276 $input->connect (escape => sub { 807 connect_escape => sub {
277 $MAPWIDGET->focus_in 808 $MAPWIDGET->focus_in
278 }); 809 },
279 $input->focus_in; 810 );
280 811
281 $CONSOLE = { 812 $CONSOLE = {
282 window => $window, 813 window => $window,
283 input => $input 814 input => $input
284 }; 815 };
285 816
286 $window 817 $window
287} 818}
288 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
289sub sdl_init { 826sub sdl_init {
290 #SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO | SDL_INIT_NOPARACHUTE 827 CFClient::SDL_Init
291 SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO
292 and die "SDL::Init failed!\n"; 828 and die "SDL::Init failed!\n";
293} 829}
294 830
295sub init_screen { 831sub video_init {
296 sdl_init; 832 sdl_init;
833
834 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
297 835
298 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 836 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
299 $FULLSCREEN = $CFG->{fullscreen}; 837 $FULLSCREEN = $CFG->{fullscreen};
300 $FAST = $CFG->{fast}; 838 $FAST = $CFG->{fast};
301 839
302 SDL::GLSetAttribute SDL_GL_RED_SIZE, 5; 840 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
303 SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;
304 SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
305 SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 0;
306
307 SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
308 SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
309 SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
310 SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
311
312 SDL::GLSetAttribute SDL_GL_DOUBLEBUFFER, 1;
313 SDL::GLSetAttribute SDL_GL_BUFFER_SIZE, 15;
314 SDL::GLSetAttribute SDL_GL_DEPTH_SIZE, 0;
315
316 SDL::SetVideoMode $WIDTH, $HEIGHT, 0,
317 SDL_HWSURFACE | SDL_ANYFORMAT | SDL_OPENGL | SDL_DOUBLEBUF
318 | ($FULLSCREEN ? SDL_FULLSCREEN : 0)
319 or die "SDL::SetVideoMode failed!\n"; 841 or die "SDL_SetVideoMode failed!\n";
320
321 SDL::WMSetCaption "Crossfire+ Client", "Crossfire+";
322
323 $SDL_EV = new SDL::Event;
324 $SDL_EV->set_unicode (1);
325 842
326 $SDL_ACTIVE = 1; 843 $SDL_ACTIVE = 1;
327
328 $LAST_REFRESH = time - 0.01; 844 $LAST_REFRESH = time - 0.01;
329 845
330 CFClient::gl_init; 846 CFClient::gl_init;
331 847
332 $FONTSIZE = int $HEIGHT / 40; 848 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
849
850 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
333 851
334 ############################################################################# 852 #############################################################################
335 853
854 unless ($DEBUG_STATUS) {
855 # create the widgets
856
336 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 857 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
337 $CFClient::UI::ROOT->add ($DEBUG_STATUS); 858 $DEBUG_STATUS->show;
338 859
339 $STATUS_LINE = new CFClient::UI::Label 860 $STATUSBOX = new CFClient::UI::Statusbox;
340 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]);
341 y => $HEIGHT * 44 / 45 - $FONTSIZE;
342 $CFClient::UI::ROOT->add ($STATUS_LINE);
343 862
344 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 863 (new CFClient::UI::Frame
345 padding => 0, 864 bg => [0, 0, 0, 0.4],
346 y => $HEIGHT * 44 / 45, 865 child => $STATUSBOX,
347 height => $HEIGHT / 45, 866 )->show;
348 text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
349 $CFClient::UI::ROOT->add ($ALT_ENTER_MESSAGE);
350 867
351 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::UI::MapWidget); 868 CFClient::UI::FancyFrame->new (
352 $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;
353 $MAPWIDGET->connect (activate_console => sub { 875 $MAPWIDGET->connect (activate_console => sub {
354 my ($mapwidget, $preset) = @_; 876 my ($mapwidget, $preset) = @_;
355 877
356 if ($CONSOLE) { 878 if ($CONSOLE) {
879 $CONSOLE->{input}->{auto_activated} = 1;
357 $CONSOLE->{input}->focus_in; 880 $CONSOLE->{input}->focus_in;
358 881
359 if ($preset && $CONSOLE->{input}->get_text eq '') { 882 if ($preset && $CONSOLE->{input}->get_text eq '') {
360 $CONSOLE->{input}->set_text ($preset); 883 $CONSOLE->{input}->set_text ($preset);
884 }
361 } 885 }
362 } 886 });
363 }); 887 $MAPWIDGET->show;
888 $MAPWIDGET->focus_in;
364 889
365 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox); 890 $BUTTONBAR = new CFClient::UI::HBox;
366 891
367 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 892 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
368 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 893 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
369 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 894 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
370 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
371 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 901 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
372 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 902 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
373 status "Configuration Saved"; 903 status "Configuration Saved";
374 }); 904 });
375 905
906 $BUTTONBAR->show;
907
908 # delay till geometry is constant
909 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
376 $BUTTONBAR->{children}[0]->emit ("activate"); 910 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
911 });
912 force_refresh ();
913 }
377} 914}
378 915
379sub destroy_screen { 916sub video_shutdown {
380 $CFClient::UI::ROOT->{children} = [];
381 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;
382 undef $SDL_EV; 970 undef $SDL_MIXER;
383 SDL::Quit; 971 @SOUNDS = ();
972 %AUDIO_CHUNKS = ();
384} 973}
385 974
386my %animate_object; 975my %animate_object;
387my $animate_timer; 976my $animate_timer;
388
389my $want_refresh;
390my $can_refresh;
391 977
392my $fps = 9; 978my $fps = 9;
393 979
394sub force_refresh { 980sub force_refresh {
395 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; 981 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
396 debug sprintf "%3.2f", $fps; 982 debug sprintf "%3.2f", $fps;
397 983
398 $want_refresh = 0;
399 $can_refresh = 0;
400
401 $CFClient::UI::ROOT->draw; 984 $CFClient::UI::ROOT->draw;
985 CFClient::SDL_GL_SwapBuffers;
402 986
403 SDL::GLSwapBuffers; 987 $WANT_REFRESH = 0;
404 988 $CAN_REFRESH = 0;
405 $LAST_REFRESH = $NOW; 989 $LAST_REFRESH = $NOW;
406} 990}
407 991
408my $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 {
409 $NOW = time; 993 $NOW = time;
410 994
411 ($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->() 995 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
412 while $SDL_EV->poll; 996 for CFClient::SDL_PollEvent;
413 997
414 if (%animate_object) { 998 if (%animate_object) {
415 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 999 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
416 $want_refresh++; 1000 $WANT_REFRESH++;
417 } 1001 }
418 1002
419 if ($want_refresh) { 1003 if ($WANT_REFRESH) {
420 force_refresh; 1004 force_refresh;
421 } else { 1005 } else {
422 $can_refresh = 1; 1006 $CAN_REFRESH = 1;
423 } 1007 }
424}); 1008});
425
426sub refresh {
427 $want_refresh++;
428}
429 1009
430sub animation_start { 1010sub animation_start {
431 my ($widget) = @_; 1011 my ($widget) = @_;
432 $animate_object{$widget} = $widget; 1012 $animate_object{$widget} = $widget;
433} 1013}
… …
437 delete $animate_object{$widget}; 1017 delete $animate_object{$widget};
438} 1018}
439 1019
440@conn::ISA = Crossfire::Protocol::; 1020@conn::ISA = Crossfire::Protocol::;
441 1021
1022sub conn::stats_update {
1023 my ($self, $stats) = @_;
1024
1025 update_stats_window ($stats);
1026}
1027
442sub conn::user_send { 1028sub conn::user_send {
443 my ($self, $command) = @_; 1029 my ($self, $command) = @_;
444 1030
445 $self->send ($command); 1031 $self->send_command ($command);
446 status $command; 1032 status $command;
1033}
1034
1035sub conn::map_scroll {
1036 my ($self, $dx, $dy) = @_;
1037
1038 $MAP->scroll ($dx, $dy);
447} 1039}
448 1040
449sub conn::feed_map1a { 1041sub conn::feed_map1a {
450 my ($self, $data) = @_; 1042 my ($self, $data) = @_;
451 1043
452# $self->Crossfire::Protocol::feed_map1a ($data); 1044# $self->Crossfire::Protocol::feed_map1a ($data);
453 1045
454 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y});
455 $MAP->map1a_update ($data); 1046 $MAP->map1a_update ($data);
456 $MAPWIDGET->update; 1047 $MAPWIDGET->update;
457} 1048}
458 1049
459#sub conn::map_update { 1050sub conn::flush_map {
460# my ($self, $dirty) = @_; 1051 my ($self) = @_;
461# 1052
462# $MAPWIDGET->update; 1053 my $map_info = delete $self->{map_info}
463#} 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}
464 1062
465sub conn::map_clear { 1063sub conn::map_clear {
466 my ($self) = @_; 1064 my ($self) = @_;
467 1065
1066 $self->flush_map;
1067 delete $self->{neigh_map};
1068
468 $MAP->clear; 1069 $MAP->clear;
1070}
469 1071
470# 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);
471} 1171}
472 1172
473sub conn::face_find { 1173sub conn::face_find {
474 my ($self, $face) = @_; 1174 my ($self, $facenum, $face) = @_;
475 1175
476 $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)
477} 1206}
478 1207
479sub conn::face_update { 1208sub conn::face_update {
480 my ($self, $facenum, $face) = @_; 1209 my ($self, $facenum, $face) = @_;
481 1210
482 $FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image}; 1211 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
483 1212
484 my $tex = $face->{texture} = 1213 $self->set_texture ($face->{id} => delete $face->{image});
1214}
1215
1216sub conn::set_texture {
1217 my ($self, $id, $data) = @_;
1218
1219 $self->{texture}[$id] ||= do {
1220 my $tex =
485 new_from_image CFClient::Texture 1221 new_from_image CFClient::Texture
486 delete $face->{image}, minify => 1; 1222 $data, minify => 1, mipmap => 1;
487 1223
488 $MAP->set_texture ($facenum, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 1224 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
489 $MAPWIDGET->update; 1225 $MAPWIDGET->update;
1226
1227 $tex
1228 };
490} 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
491 1245
492sub conn::query { 1246sub conn::query {
493 my ($self, $flags, $prompt) = @_; 1247 my ($self, $flags, $prompt) = @_;
494 1248
495 #TODO 1249 $prompt = $LAST_QUERY unless length $prompt;
496 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;
497} 1309}
498 1310
499sub conn::drawinfo { 1311sub conn::drawinfo {
500 my ($self, $color, $text) = @_; 1312 my ($self, $color, $text) = @_;
501 1313
502 my @color = ( 1314 my @color = (
503 [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],
504 [1.00, 1.00, 1.00], 1316 [1.00, 1.00, 1.00],
505 [0.00, 0.00, 0.55], 1317 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
506 [1.00, 0.00, 0.00], 1318 [1.00, 0.00, 0.00],
507 [1.00, 0.54, 0.00], 1319 [1.00, 0.54, 0.00],
508 [0.11, 0.56, 1.00], 1320 [0.11, 0.56, 1.00],
509 [0.93, 0.46, 0.00], 1321 [0.93, 0.46, 0.00],
510 [0.18, 0.54, 0.34], 1322 [0.18, 0.54, 0.34],
… …
513 [0.55, 0.41, 0.13], 1325 [0.55, 0.41, 0.13],
514 [0.99, 0.77, 0.26], 1326 [0.99, 0.77, 0.26],
515 [0.74, 0.65, 0.41], 1327 [0.74, 0.65, 0.41],
516 ); 1328 );
517 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
518 $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};
519} 1446}
520 1447
521%SDL_CB = ( 1448%SDL_CB = (
522 SDL_QUIT() => sub { 1449 CFClient::SDL_QUIT => sub {
523 Event::unloop -1; 1450 Event::unloop -1;
524 }, 1451 },
525 SDL_VIDEORESIZE() => sub { 1452 CFClient::SDL_VIDEORESIZE => sub {
526 }, 1453 },
527 SDL_VIDEOEXPOSE() => sub { 1454 CFClient::SDL_VIDEOEXPOSE => sub {
528 refresh; 1455 $WANT_REFRESH++;
529 }, 1456 },
530 SDL_KEYDOWN() => sub {
531 if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
532 # alt-enter
533 destroy_screen;
534 $CFG->{fullscreen} = !$CFG->{fullscreen};
535 init_screen;
536 } else {
537 CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
538 }
539 },
540 SDL_KEYUP() => sub {
541 CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
542 },
543 SDL_MOUSEMOTION() => sub {
544 CFClient::UI::feed_sdl_motion_event ($SDL_EV);
545 },
546 SDL_MOUSEBUTTONDOWN() => sub {
547 CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
548 },
549 SDL_MOUSEBUTTONUP() => sub {
550 CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
551 },
552 SDL_ACTIVEEVENT() => sub { 1457 CFClient::SDL_ACTIVEEVENT => sub {
553# 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#
554 }, 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 },
555); 1481);
556 1482
557############################################################################# 1483#############################################################################
558 1484
559CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 1485$SIG{INT} = $SIG{TERM} = sub { exit };
560
561my %DEF_CFG = (
562 sdl_mode => 0,
563 width => 640,
564 height => 480,
565 fullscreen => 0,
566 fast => 0,
567 fow_enable => 1,
568 fow_intensity => 0.45,
569 fow_smooth => 0,
570 log_fontsize => 14,
571 mapsize => 100,
572 host => "crossfire.schmorp.de",
573 say_command => 'say',
574);
575
576while (my ($k, $v) = each %DEF_CFG) {
577 $CFG->{$k} = $v unless exists $CFG->{$k};
578}
579
580sdl_init;
581
582@SDL_MODES = reverse
583 grep $_->[0] >= 640 && $_->[1] >= 480,
584 map [SDL::RectW ($_), SDL::RectH ($_)],
585 @{ SDL::ListModes 0, SDL_FULLSCREEN | SDL_HWSURFACE | SDL_OPENGL };
586
587@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
588
589$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
590
591init_screen;
592 1486
593{ 1487{
594 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf); 1488 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
595 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
596 CFClient::add_font $_ for @fonts; 1544 CFClient::add_font $_ for @fonts;
597 CFClient::set_font $fonts[0]; 1545
598} 1546 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1547 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
599 1548
600$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {}; 1549 $FONT_PROP->make_default;
1550 }
1551
1552 video_init;
1553 audio_init;
1554}
601 1555
602Event::loop; 1556Event::loop;
603 1557
604Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces"; 1558END { CFClient::SDL_Quit }
605 1559
1560=head1 pclient - Crossfire+ and Crossfire game client
1561
1562Pclient is a Crossfire+ and Crossfire game client.
1563
1564=head2 Features
1565
1566=over 4
1567
1568=item Fullscreen Map
1569
1570PClient can uses a fullscreen map, which greatly enhances how much of the
1571game world you can see.
1572
1573=item Persistent Map Cache (Crossfire+ only)
1574
1575PClient can persistently cache all map data it received from the
1576server. This not only allows it to display an overview map, but also
1577ensures that once-explored areas will be available the next time you want
1578to explore more.
1579
1580=item Hardware acceleration
1581
1582Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
1583acceleration. Most modern graphics cards have difficulties with 2D
1584acceleration, while 3D graphics is accelerated well.
1585
1586=item No arbitrary limits
1587
1588Unlike other Crossfire clients, pclient does not suffer from arbitrary
1589limits (like a fixed amount of face numbers). There are still limits, but
1590they are not arbitrarily low :)
1591
1592=back
1593
1594=head1 USAGE
1595
1596=head2 The Map
1597
1598The map is always displayed in the background, behind all other windows and UI elements.
1599
1600#TODO# middle-click scrolls
1601#
1602# keys:
1603#
1604# a apply
1605# keypad moves, kp_5 applies ranged attack to self
1606
1607Starting to type enters the I<completion mode>. In that mode, you can type
1608abbreviations or commands and have them executed as soon as they match a
1609valid command. This is best explained by a few examples:
1610
1611Typing B<climb> will display a list of commands with I<climb> in their
1612name, such as I<ready_skill climbing> and I<use_skill climbing>.
1613
1614You can abbreviate commands by typing only the first character of every
1615word. For example, typing I<iwor> will likely select I<invoke word of
1616recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
1617will likely select I<ready_skill climbing> and I<usl> will give you
1618I<use_skill levitation>.
1619
1620=head2 The map overview
1621
1622#TODO#
1623
1624=head2 The Status area in the lower right corner
1625
1626#TODO#
1627
1628=head2 The I<Statistics>/I>Stats> window
1629
1630#TODO#
1631
1632=head1 FAQ
1633
1634=over 4
1635
1636=item The client is very sluggish and slow, what can I do about this?
1637
1638Most likely, you don't have accelerated OpenGL support. Try to find a
1639newer driver, or a driver from your hardware vendor, that features OpenGL
1640support.
1641
1642If this is not an option, the following Setup options reduce the load and
1643will likely make the client playable with sofwtare rendering (it will
1644still be slow, though):
1645
1646=over 4
1647
1648=item B<Video Mode> should be set as low as possible (e.g. 640x480)
1649
1650=item Enable B<Fast & Ugly> mode
1651
1652=item Disable B<Fog of War>
1653
1654=item Increase B<Map Scale>
1655
1656=back
1657
1658=back
1659
1660=head1 AUTHOR
1661
1662Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1663
1664
1665

Diff Legend

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