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.114 by root, Sat Apr 15 21:16:51 2006 UTC vs.
Revision 1.232 by root, Sun May 21 00:35:00 2006 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines