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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines