ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.1 by root, Thu May 25 16:24:45 2006 UTC vs.
Revision 1.27 by elmex, Mon May 29 20:22:33 2006 UTC

… …
29use Time::HiRes 'time'; 29use Time::HiRes 'time';
30use Pod::POM; 30use Pod::POM;
31use Event; 31use Event;
32 32
33use Crossfire; 33use Crossfire;
34use Crossfire::Protocol; 34use Crossfire::Protocol::Constants;
35 35
36use Compress::LZF; 36use Compress::LZF;
37 37
38use CFClient; 38use CFClient;
39use CFClient::OpenGL ();
40use CFClient::Protocol;
39use CFClient::UI; 41use CFClient::UI;
40use CFClient::MapWidget; 42use CFClient::MapWidget;
41 43
42$Event::DIED = sub { 44$Event::DIED = sub {
43 # TODO: display dialog box or so 45 # TODO: display dialog box or so
… …
50 52
51my $MAX_FPS = 60; 53my $MAX_FPS = 60;
52my $MIN_FPS = 5; # unused as of yet 54my $MIN_FPS = 5; # unused as of yet
53 55
54our $META_SERVER = "crossfire.real-time.com:13326"; 56our $META_SERVER = "crossfire.real-time.com:13326";
55
56our $FACEMAP;
57our $TILECACHE;
58our $MAPCACHE;
59 57
60our $LAST_REFRESH; 58our $LAST_REFRESH;
61our $NOW; 59our $NOW;
62 60
63our $CFG; 61our $CFG;
… …
83our $LOGVIEW; 81our $LOGVIEW;
84our $CONSOLE; 82our $CONSOLE;
85our $METASERVER; 83our $METASERVER;
86our $LOGIN_BUTTON; 84our $LOGIN_BUTTON;
87our $QUIT_DIALOG; 85our $QUIT_DIALOG;
86our $SERVER_SETUP;
88 87
89our $FLOORBOX; 88our $FLOORBOX;
90our $GAUGES; 89our $GAUGES;
91our $STATWIDS; 90our $STATWIDS;
92 91
… …
99 98
100our $ALT_ENTER_MESSAGE; 99our $ALT_ENTER_MESSAGE;
101our $STATUSBOX; 100our $STATUSBOX;
102our $DEBUG_STATUS; 101our $DEBUG_STATUS;
103 102
104our $INVWIN; 103our $INV_WINDOW;
105our $INV; 104our $INV;
106our $INVR; 105our $INVR;
107our $INVR_LBL; 106our $INV_RIGHT_HB;
108our $OPENCONT; 107
108our $BIND_WINDOW;
109 109
110sub status { 110sub status {
111 $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 111 $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112} 112}
113 113
… …
118} 118}
119 119
120sub start_game { 120sub start_game {
121 status "logging in..."; 121 status "logging in...";
122 122
123 $LOGIN_BUTTON->set_text ("Logout");
124 $SERVER_SETUP->hide;
125
123 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 126 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124 127
125 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; 128 my ($host, $port) = split /:/, $CFG->{host};
129
126 $MAP = new CFClient::Map $mapsize, $mapsize; 130 $MAP = new CFClient::Map $mapsize, $mapsize;
127
128 my ($host, $port) = split /:/, $CFG->{host};
129 131
130 $CONN = eval { 132 $CONN = eval {
131 new conn 133 new CFClient::Protocol
132 host => $host, 134 host => $host,
133 port => $port || 13327, 135 port => $port || 13327,
134 user => $CFG->{user}, 136 user => $CFG->{user},
135 pass => $CFG->{password}, 137 pass => $CFG->{password},
136 mapw => $mapsize, 138 mapw => $mapsize,
137 maph => $mapsize, 139 maph => $mapsize,
138 ; 140
141 map_widget => $MAPWIDGET,
142 logview => $LOGVIEW,
143 statusbox => $STATUSBOX,
144 map => $MAP,
145 mapmap => $MAPMAP,
146
147 sound_play => sub {
148 my ($x, $y, $soundnum, $type) = @_;
149
150 $SDL_MIXER
151 or return;
152
153 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
154 or return;
155
156 $chunk->play;
157 },
139 }; 158 };
140 159
141 if ($CONN) { 160 if ($CONN) {
142 CFClient::lowdelay fileno $CONN->{fh}; 161 CFClient::lowdelay fileno $CONN->{fh};
143 162
144 $LOGIN_BUTTON->set_text ("Logout");
145 status "login successful"; 163 status "login successful";
146
147 $BUTTONBAR->{children}[1]->emit ("activate")
148 if $BUTTONBAR->{children}[1]->{state};
149
150 } else { 164 } else {
151 status "unable to connect"; 165 status "unable to connect";
152 stop_game(); 166 stop_game();
153 } 167 }
154} 168}
155 169
156sub stop_game { 170sub stop_game {
171 $LOGIN_BUTTON->set_text ("Login");
172 $SERVER_SETUP->show;
173 $INV_WINDOW->hide;
174 $LOGVIEW->hide;
175
157 return unless $CONN; 176 return unless $CONN;
158 177
159 status "connection closed"; 178 status "connection closed";
160 $LOGIN_BUTTON->set_text ("Login"); 179
161 $CONN->destroy; 180 $CONN->destroy;
162 $CONN = 0; # false, does not autovivify 181 $CONN = 0; # false, does not autovivify
163
164 $BUTTONBAR->{children}[1]->emit ("activate")
165 unless $BUTTONBAR->{children}[1]->{state};
166
167 undef $MAPCACHE;
168 undef $MAP;
169} 182}
170 183
171sub client_setup { 184sub client_setup {
172 my $dialog = new CFClient::UI::FancyFrame 185 my $dialog = new CFClient::UI::FancyFrame
186 req_x => 1,
187 req_y => $HEIGHT * (1/8),
188 name => "client_setup",
173 title => "Client Setup", 189 title => "Client Setup",
174 child => (my $vbox = new CFClient::UI::VBox); 190 child => (my $vbox = new CFClient::UI::VBox);
175 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 191 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176 192
177 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); 193 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
… …
192 208
193 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); 209 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194 $table->add (1, $row++, new CFClient::UI::CheckBox 210 $table->add (1, $row++, new CFClient::UI::CheckBox
195 state => $CFG->{fullscreen}, 211 state => $CFG->{fullscreen},
196 tooltip => "Bring the client into fullscreen mode.", 212 tooltip => "Bring the client into fullscreen mode.",
197 connect_changed => sub { 213 on_changed => sub {
198 my ($self, $value) = @_; 214 my ($self, $value) = @_;
199 $CFG->{fullscreen} = $value; 215 $CFG->{fullscreen} = $value;
200 } 216 }
201 ); 217 );
202 218
203 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 219 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204 $table->add (1, $row++, new CFClient::UI::CheckBox 220 $table->add (1, $row++, new CFClient::UI::CheckBox
205 state => $CFG->{fast}, 221 state => $CFG->{fast},
206 tooltip => "Lower the visual quality considerably to speed up rendering.", 222 tooltip => "Lower the visual quality considerably to speed up rendering.",
207 connect_changed => sub { 223 on_changed => sub {
208 my ($self, $value) = @_; 224 my ($self, $value) = @_;
209 $CFG->{fast} = $value; 225 $CFG->{fast} = $value;
210 } 226 }
211 ); 227 );
212 228
213 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale"); 229 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214 $table->add (1, $row++, new CFClient::UI::Slider 230 $table->add (1, $row++, new CFClient::UI::Slider
215 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], 231 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216 tooltip => "Enlarge or shrink the displayed map. Changes are instant.", 232 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217 connect_changed => sub { 233 on_changed => sub {
218 my ($self, $value) = @_; 234 my ($self, $value) = @_;
219 $CFG->{map_scale} = 2 ** $value; 235 $CFG->{map_scale} = 2 ** $value;
220 } 236 }
221 ); 237 );
222 238
223 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 239 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
224 $table->add (1, $row++, new CFClient::UI::CheckBox 240 $table->add (1, $row++, new CFClient::UI::CheckBox
225 state => $CFG->{fow_enable}, 241 state => $CFG->{fow_enable},
226 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.", 242 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227 connect_changed => sub { 243 on_changed => sub {
228 my ($self, $value) = @_; 244 my ($self, $value) = @_;
229 $CFG->{fow_enable} = $value; 245 $CFG->{fow_enable} = $value;
230 } 246 }
231 ); 247 );
232 248
233 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 249 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234 $table->add (1, $row++, new CFClient::UI::Slider 250 $table->add (1, $row++, new CFClient::UI::Slider
235 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256], 251 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
236 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.", 252 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
237 connect_changed => sub { 253 on_changed => sub {
238 my ($self, $value) = @_; 254 my ($self, $value) = @_;
239 $CFG->{fow_intensity} = $value; 255 $CFG->{fow_intensity} = $value;
240 } 256 }
241 ); 257 );
242 258
243 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); 259 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244 $table->add (1, $row++, new CFClient::UI::CheckBox 260 $table->add (1, $row++, new CFClient::UI::CheckBox
245 state => $CFG->{fow_smooth}, 261 state => $CFG->{fow_smooth},
246 tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.", 262 tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247 connect_changed => sub { 263 on_changed => sub {
248 my ($self, $value) = @_; 264 my ($self, $value) = @_;
249 $CFG->{fow_smooth} = $value; 265 $CFG->{fow_smooth} = $value;
250 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2; 266 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
251 } 267 }
252 ); 268 );
253 269
254 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 270 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255 $table->add (1, $row++, new CFClient::UI::Slider 271 $table->add (1, $row++, new CFClient::UI::Slider
256 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1], 272 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
257 tooltip => "The base font size used by most GUI elements that do not have their own setting.", 273 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
258 connect_changed => sub { $CFG->{gui_fontsize} = $_[1] }, 274 on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
259 ); 275 );
260 276
261 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize"); 277 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262 $table->add (1, $row++, new CFClient::UI::Slider 278 $table->add (1, $row++, new CFClient::UI::Slider
263 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1], 279 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
264 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.", 280 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
265 connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) }, 281 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
266 ); 282 );
267 283
268 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize"); 284 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269 285
270 $table->add (1, $row++, new CFClient::UI::Slider 286 $table->add (1, $row++, new CFClient::UI::Slider
271 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1], 287 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
272 tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.", 288 tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273 connect_changed => sub { 289 on_changed => sub {
274 $CFG->{stat_fontsize} = $_[1]; 290 $CFG->{stat_fontsize} = $_[1];
275 &set_stats_window_fontsize; 291 &set_stats_window_fontsize;
276 } 292 }
277 ); 293 );
278 294
279 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); 295 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280 $table->add (1, $row++, new CFClient::UI::Slider 296 $table->add (1, $row++, new CFClient::UI::Slider
281 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1], 297 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
282 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.", 298 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283 connect_changed => sub { 299 on_changed => sub {
284 $CFG->{gauge_fontsize} = $_[1]; 300 $CFG->{gauge_fontsize} = $_[1];
285 &set_gauge_window_fontsize; 301 &set_gauge_window_fontsize;
286 } 302 }
287 ); 303 );
288 304
289 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size"); 305 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290 $table->add (1, $row++, new CFClient::UI::Slider 306 $table->add (1, $row++, new CFClient::UI::Slider
291 range => [$CFG->{gauge_size}, 0.2, 0.8], 307 range => [$CFG->{gauge_size}, 0.2, 0.8],
292 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.", 308 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293 connect_changed => sub { 309 on_changed => sub {
294 $CFG->{gauge_size} = $_[1]; 310 $CFG->{gauge_size} = $_[1];
295 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); 311 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
296 } 312 }
297 ); 313 );
298 314
299 $table->add (1, $row++, new CFClient::UI::Button 315 $table->add (1, $row++, new CFClient::UI::Button
300 expand => 1, align => 0, text => "Apply", 316 expand => 1, align => 0, text => "Apply",
301 tooltip => "Apply the video settings", 317 tooltip => "Apply the video settings",
302 connect_activate => sub { 318 on_activate => sub {
303 video_shutdown (); 319 video_shutdown ();
304 video_init (); 320 video_init ();
305 } 321 }
306 ); 322 );
307 323
308 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); 324 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309 $table->add (1, $row++, new CFClient::UI::CheckBox 325 $table->add (1, $row++, new CFClient::UI::CheckBox
310 state => $CFG->{audio_enable}, 326 state => $CFG->{audio_enable},
311 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.", 327 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
312 connect_changed => sub { 328 on_changed => sub {
313 $CFG->{audio_enable} = $_[1]; 329 $CFG->{audio_enable} = $_[1];
314 } 330 }
315 ); 331 );
316# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); 332# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
317# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub { 333# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318# $CFG->{effects_volume} = $_[1]; 334# $CFG->{effects_volume} = $_[1];
319# }); 335# });
320 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); 336 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
321 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox); 337 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322 $hbox->add (new CFClient::UI::CheckBox 338 $hbox->add (new CFClient::UI::CheckBox
323 expand => 1, state => $CFG->{bgm_enable}, 339 expand => 1, state => $CFG->{bgm_enable},
324 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.", 340 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325 connect_changed => sub { 341 on_changed => sub {
326 $CFG->{bgm_enable} = $_[1]; 342 $CFG->{bgm_enable} = $_[1];
327 } 343 }
328 ); 344 );
329 $hbox->add (new CFClient::UI::Slider 345 $hbox->add (new CFClient::UI::Slider
330 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128], 346 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331 tooltip => "The volume of the background music. Changes are instant.", 347 tooltip => "The volume of the background music. Changes are instant.",
332 connect_changed => sub { 348 on_changed => sub {
333 $CFG->{bgm_volume} = $_[1]; 349 $CFG->{bgm_volume} = $_[1];
334 CFClient::MixMusic::volume $_[1] * 128; 350 CFClient::MixMusic::volume $_[1] * 128;
335 } 351 }
336 ); 352 );
337 353
338 $table->add (1, $row++, new CFClient::UI::Button 354 $table->add (1, $row++, new CFClient::UI::Button
339 expand => 1, align => 0, text => "Apply", 355 expand => 1, align => 0, text => "Apply",
340 tooltip => "Apply the audio settings", 356 tooltip => "Apply the audio settings",
341 connect_activate => sub { 357 on_activate => sub {
342 audio_shutdown (); 358 audio_shutdown ();
343 audio_init (); 359 audio_init ();
344 } 360 }
345 ); 361 );
346 362
… …
348 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry 364 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349 text => $CFG->{say_command}, 365 text => $CFG->{say_command},
350 tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. " 366 tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
351 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. " 367 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
352 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.", 368 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
353 connect_changed => sub { 369 on_changed => sub {
354 my ($self, $value) = @_; 370 my ($self, $value) = @_;
355 $CFG->{say_command} = $value; 371 $CFG->{say_command} = $value;
356 } 372 }
357 ); 373 );
358 374
… …
373 389
374sub make_gauge_window { 390sub make_gauge_window {
375 my $gh = int $HEIGHT * $CFG->{gauge_size}; 391 my $gh = int $HEIGHT * $CFG->{gauge_size};
376 392
377 my $win = new CFClient::UI::Frame ( 393 my $win = new CFClient::UI::Frame (
394 req_x => 0,
378 req_y => -1, 395 req_y => -1,
379 user_w => $WIDTH, 396 def_w => $WIDTH,
380 user_h => $gh, 397 def_h => $gh,
381 ); 398 );
382 399
383 $win->add (my $hbox = new CFClient::UI::HBox 400 $win->add (my $hbox = new CFClient::UI::HBox
384 children => [ 401 children => [
385 (new CFClient::UI::HBox expand => 1), 402 (new CFClient::UI::HBox expand => 1),
386 (new CFClient::UI::VBox children => [ 403 (new CFClient::UI::VBox children => [
387 (new CFClient::UI::Empty expand => 1), 404 (new CFClient::UI::Empty expand => 1),
388 (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)), 405 (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::Table)),
389 ]), 406 ]),
390 (my $vbox = new CFClient::UI::VBox), 407 (my $vbox = new CFClient::UI::VBox),
391 ], 408 ],
392 ); 409 );
393 410
… …
421 &set_gauge_window_fontsize; 438 &set_gauge_window_fontsize;
422 439
423 $win 440 $win
424} 441}
425 442
443
426sub make_stats_window { 444sub make_stats_window {
427 my $tgw = new CFClient::UI::FancyFrame title => "Stats"; 445 my $tgw = new CFClient::UI::FancyFrame
446 req_y => $HEIGHT * (2/8),
447 req_x => -1,
448 title => "Stats",
449 name => "stats_window";
428 450
429 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox); 451 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
430 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1, 452 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431 can_hover => 1, can_events => 1, 453 can_hover => 1, can_events => 1,
432 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server."); 454 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
433 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1, 455 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434 can_hover => 1, can_events => 1, 456 can_hover => 1, can_events => 1,
435 tooltip => "The map you are currently on (if supported by the server)."); 457 tooltip => "The map you are currently on (if supported by the server).");
458
459 $vb->add (my $hb0 = new CFClient::UI::HBox);
460 $hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
461 can_hover => 1, can_events => 1,
462 tooltip => "The weight of the player including all inventory items.");
463 $hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
464 can_hover => 1, can_events => 1,
465 tooltip => "The weight limit: you cannot carry more than this.");
466
436 467
437 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 468 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
438 $hb->add (my $tbl = new CFClient::UI::Table expand => 1); 469 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
439 470
440 my $color2 = [1, 1, 0]; 471 my $color2 = [1, 1, 0];
… …
529} 560}
530 561
531sub update_stats_window { 562sub update_stats_window {
532 my ($stats) = @_; 563 my ($stats) = @_;
533 564
534 # i love text protocols!!! 565 # I love text protocols...
566
535 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1; 567 my $hp = $stats->{+CS_STAT_HP} * 1;
536 my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1; 568 my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
537 my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1; 569 my $sp = $stats->{+CS_STAT_SP} * 1;
538 my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1; 570 my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
539 my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1; 571 my $fo = $stats->{+CS_STAT_FOOD} * 1;
540 my $fo_m = 999; 572 my $fo_m = 999;
541 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1; 573 my $gr = $stats->{+CS_STAT_GRACE} * 1;
542 my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1; 574 my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
543 575
544 $GAUGES->{hp} ->set_value ($hp, $hp_m); 576 $GAUGES->{hp} ->set_value ($hp, $hp_m);
545 $GAUGES->{mana} ->set_value ($sp, $sp_m); 577 $GAUGES->{mana} ->set_value ($sp, $sp_m);
546 $GAUGES->{food} ->set_value ($fo, $fo_m); 578 $GAUGES->{food} ->set_value ($fo, $fo_m);
547 $GAUGES->{grace} ->set_value ($gr, $gr_m); 579 $GAUGES->{grace} ->set_value ($gr, $gr_m);
548 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64}) 580 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
549 . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")"); 581 . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
550 my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE}; 582 my $rng = $stats->{+CS_STAT_RANGE};
551 $rng =~ s/^Range: //; # thank you so much dear server 583 $rng =~ s/^Range: //; # thank you so much dear server
552 $GAUGES->{range} ->set_text ("Rng: " . $rng); 584 $GAUGES->{range} ->set_text ("Rng: " . $rng);
553 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE}; 585 my $title = $stats->{+CS_STAT_TITLE};
554 $title =~ s/^Player: //; 586 $title =~ s/^Player: //;
555 $STATWIDS->{title} ->set_text ("Title: " . $title); 587 $STATWIDS->{title} ->set_text ("Title: " . $title);
556 588
557 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5}); 589 $STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
558 $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8}); 590 $STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
559 $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9}); 591 $STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
560 $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6}); 592 $STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
561 $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7}); 593 $STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
562 $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22}); 594 $STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
563 $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10}); 595 $STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
564 $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13}); 596 $STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
565 $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14}); 597 $STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
566 $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15}); 598 $STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
567 $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16}); 599 $STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
568 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED}); 600 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
569 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP}); 601 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
570 602
603 $STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
604
605 # TODO: replace by CS_STAT_RES_xxx constants
571 my %tbl = ( 606 my %tbl = (
572 phys => 100, 607 phys => 100,
573 magic => 101, 608 magic => 101,
574 fire => 102, 609 fire => 102,
575 elec => 103, 610 elec => 103,
… …
584 tund => 112, 619 tund => 112,
585 fear => 113, 620 fear => 113,
586 depl => 113, 621 depl => 113,
587 deat => 115, 622 deat => 115,
588 holyw => 116, 623 holyw => 116,
589 blind => 117 624 blind => 117,
590 ); 625 );
591 626
592 for (keys %tbl) {
593 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}}); 627 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
594 } 628 for keys %tbl;
595
596} 629}
597 630
598sub metaserver_dialog { 631sub metaserver_dialog {
599 my $dialog = new CFClient::UI::FancyFrame 632 my $dialog = new CFClient::UI::FancyFrame
600 title => "Server List", 633 title => "Server List",
… …
668 $m = [$users, $host, $uptime, $version, $desc]; 701 $m = [$users, $host, $uptime, $version, $desc];
669 702
670 $y++; 703 $y++;
671 704
672 $table->add (0, $y, new CFClient::UI::VBox children => [ 705 $table->add (0, $y, new CFClient::UI::VBox children => [
673 (new CFClient::UI::Button text => "Use", connect_activate => sub { 706 (new CFClient::UI::Button text => "Use", on_activate => sub {
674 $HOST->set_text ($CFG->{host} = $host); 707 $HOST->set_text ($CFG->{host} = $host);
675 }), 708 }),
676 (new CFClient::UI::Empty expand => 1), 709 (new CFClient::UI::Empty expand => 1),
677 ]); 710 ]);
678 711
… …
683 } 716 }
684 }); 717 });
685} 718}
686 719
687sub server_setup { 720sub server_setup {
688 my $dialog = new CFClient::UI::FancyFrame 721 my $dialog = $SERVER_SETUP = new CFClient::UI::FancyFrame
722 x => $WIDTH * (1/3),
723 y => $HEIGHT * (1/8),
724 name => "server_setup",
689 title => "Server Setup", 725 title => "Server Setup",
690 child => (my $vbox = new CFClient::UI::VBox); 726 child => (my $vbox = new CFClient::UI::VBox),
727 on_visibility_change => sub {
728 my ($self, $visible) = @_;
729 $self->center if $visible;
730 },
691 731 ;
732
692 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 733 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
693 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); 734 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
694 735
695 { 736 {
696 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 737 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
… …
698 $vbox->add ( 739 $vbox->add (
699 my $HOST = new CFClient::UI::Entry 740 my $HOST = new CFClient::UI::Entry
700 expand => 1, 741 expand => 1,
701 text => $CFG->{host}, 742 text => $CFG->{host},
702 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to", 743 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
703 connect_changed => sub { 744 on_changed => sub {
704 my ($self, $value) = @_; 745 my ($self, $value) = @_;
705 $CFG->{host} = $value; 746 $CFG->{host} = $value;
706 } 747 }
707 ); 748 );
708 749
… …
711 $vbox->add (new CFClient::UI::Flopper 752 $vbox->add (new CFClient::UI::Flopper
712 expand => 1, 753 expand => 1,
713 text => "Server List", 754 text => "Server List",
714 other => $METASERVER, 755 other => $METASERVER,
715 tooltip => "Show a list of available crossfire servers", 756 tooltip => "Show a list of available crossfire servers",
716 connect_open => sub { 757 on_open => sub {
717 update_metaserver $HOST; 758 update_metaserver $HOST;
718 } 759 }
719 ); 760 );
720 } 761 }
721 762
722 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username"); 763 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
723 $table->add (1, 4, new CFClient::UI::Entry 764 $table->add (1, 4, new CFClient::UI::Entry
724 text => $CFG->{user}, 765 text => $CFG->{user},
725 tooltip => "The name of your character on the server", 766 tooltip => "The name of your character on the server",
726 connect_changed => sub { 767 on_changed => sub {
727 my ($self, $value) = @_; 768 my ($self, $value) = @_;
728 $CFG->{user} = $value; 769 $CFG->{user} = $value;
729 } 770 }
730 ); 771 );
731 772
732 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); 773 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
733 $table->add (1, 5, new CFClient::UI::Entry 774 $table->add (1, 5, new CFClient::UI::Entry
734 text => $CFG->{password}, 775 text => $CFG->{password},
735 hidden => 1, 776 hidden => 1,
736 tooltip => "The password for your character", 777 tooltip => "The password for your character",
737 connect_changed => sub { 778 on_changed => sub {
738 my ($self, $value) = @_; 779 my ($self, $value) = @_;
739 $CFG->{password} = $value; 780 $CFG->{password} = $value;
740 } 781 }
741 ); 782 );
742 783
… …
746 range => [$CFG->{mapsize}, 10, 100, 0, 1], 787 range => [$CFG->{mapsize}, 10, 100, 0, 1],
747 tooltip => "This is the size of the portion of the map update the server sends you. " 788 tooltip => "This is the size of the portion of the map update the server sends you. "
748 . "If you set this to a high value you will be able to see further, " 789 . "If you set this to a high value you will be able to see further, "
749 . "but you also increase bandwidth requirements and latency. " 790 . "but you also increase bandwidth requirements and latency. "
750 . "This option is only used once at log-in.", 791 . "This option is only used once at log-in.",
751 connect_changed => sub { 792 on_changed => sub {
752 my ($self, $value) = @_; 793 my ($self, $value) = @_;
753 794
754 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 795 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
755 }, 796 },
756 ); 797 );
… …
763 . "This might increase or create lag, but increases the chances " 804 . "This might increase or create lag, but increases the chances "
764 . "of faces being ready for display when you encounter them. " 805 . "of faces being ready for display when you encounter them. "
765 . "It also uses up server bandwidth on every connect, " 806 . "It also uses up server bandwidth on every connect, "
766 . "so only set it if you really need to prefetch images. " 807 . "so only set it if you really need to prefetch images. "
767 . "This option can be set and unset any time.", 808 . "This option can be set and unset any time.",
768 connect_changed => sub { $CFG->{face_prefetch} = $_[1] }, 809 on_changed => sub { $CFG->{face_prefetch} = $_[1] },
769 ); 810 );
770 811
771 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count"); 812 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
772 $table->add (1, 9, new CFClient::UI::Entry 813 $table->add (1, 9, new CFClient::UI::Entry
773 text => $CFG->{output_count}, 814 text => $CFG->{output_count},
774 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 815 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
775 connect_changed => sub { $CFG->{output_count} = $_[1] }, 816 on_changed => sub { $CFG->{output_count} = $_[1] },
776 ); 817 );
777 818
778 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync"); 819 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
779 $table->add (1, 10, new CFClient::UI::Entry 820 $table->add (1, 10, new CFClient::UI::Entry
780 text => $CFG->{output_sync}, 821 text => $CFG->{output_sync},
781 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 822 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
782 connect_changed => sub { $CFG->{output_sync} = $_[1] }, 823 on_changed => sub { $CFG->{output_sync} = $_[1] },
783 ); 824 );
784 825
785 $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button 826 $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
786 expand => 1, 827 expand => 1,
787 align => 0, 828 align => 0,
788 text => "Login", 829 text => "Login",
789 connect_activate => sub { 830 on_activate => sub {
790 $CONN ? stop_game 831 $CONN ? stop_game
791 : start_game; 832 : start_game;
792 }, 833 },
793 ); 834 );
794 835
795 $dialog 836 $dialog
796} 837}
797 838
798sub message_window { 839sub message_window {
799 my $window = new CFClient::UI::FancyFrame 840 my $window = new CFClient::UI::FancyFrame
841 name => "message_window",
800 title => "Messages", 842 title => "Messages",
801 border_bg => [1, 1, 1, 1], 843 border_bg => [1, 1, 1, 1],
802 bg => [0, 0, 0, 0.75], 844 bg => [0, 0, 0, 0.75],
845 req_x => -1,
846 req_y => 0,
803 user_w => int $::WIDTH / 3, 847 def_w => int $::WIDTH / 3,
804 user_h => int $::HEIGHT / 5, 848 def_h => int $::HEIGHT / 5,
805 child => (my $vbox = new CFClient::UI::VBox); 849 child => (my $vbox = new CFClient::UI::VBox);
806 850
807 $vbox->add ($LOGVIEW); 851 $vbox->add ($LOGVIEW);
808 852
809 $vbox->add (my $input = new CFClient::UI::Entry 853 $vbox->add (my $input = new CFClient::UI::Entry
810 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> " 854 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
811 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). " 855 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
812 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). " 856 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
813 . "A better way to submit commands (and the occasional chat command) is often the map command completer.", 857 . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
814 connect_focus_in => sub { 858 on_focus_in => sub {
815 my ($input, $prev_focus) = @_; 859 my ($input, $prev_focus) = @_;
816 860
817 delete $input->{refocus_map}; 861 delete $input->{refocus_map};
818 862
819 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) { 863 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
820 $input->{refocus_map} = 1; 864 $input->{refocus_map} = 1;
821 } 865 }
822 delete $input->{auto_activated}; 866 delete $input->{auto_activated};
823 }, 867 },
824 connect_activate => sub { 868 on_activate => sub {
825 my ($input, $text) = @_; 869 my ($input, $text) = @_;
826 $input->set_text (''); 870 $input->set_text ('');
827 871
872 if ($text =~ /^\/bind\s+(.*)$/) {
873 CFClient::Recorder::open_binding_dialog ([$1]);
828 if ($text =~ /^\/(.*)/) { 874 } elsif ($text =~ /^\/(.*)/) {
829 $::CONN->user_send ($1); 875 $::CONN->user_send ($1);
830 } else { 876 } else {
831 my $say_cmd = $::CFG->{say_command} || 'say'; 877 my $say_cmd = $::CFG->{say_command} || 'say';
832 $::CONN->user_send ("$say_cmd $text"); 878 $::CONN->user_send ("$say_cmd $text");
833 } 879 }
834 if ($input->{refocus_map}) { 880 if ($input->{refocus_map}) {
835 delete $input->{refocus_map}; 881 delete $input->{refocus_map};
836 $MAPWIDGET->focus_in 882 $MAPWIDGET->focus_in
837 } 883 }
838 }, 884 },
839 connect_escape => sub { 885 on_escape => sub {
840 $MAPWIDGET->focus_in 886 $MAPWIDGET->focus_in
841 }, 887 },
842 ); 888 );
843 889
844 $CONSOLE = { 890 $CONSOLE = {
… …
849 $window 895 $window
850} 896}
851 897
852sub open_quit_dialog { 898sub open_quit_dialog {
853 unless ($QUIT_DIALOG) { 899 unless ($QUIT_DIALOG) {
854
855 $QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?"; 900 $QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";
856 901
857 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1); 902 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
858 903
859 $vb->add (new CFClient::UI::Label 904 $vb->add (new CFClient::UI::Label
… …
863 ); 908 );
864 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 909 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
865 $hb->add (new CFClient::UI::Button 910 $hb->add (new CFClient::UI::Button
866 text => "Ok", 911 text => "Ok",
867 expand => 1, 912 expand => 1,
868 connect_activate => sub { $QUIT_DIALOG->hide }, 913 on_activate => sub { $QUIT_DIALOG->hide },
869 ); 914 );
870 $hb->add (new CFClient::UI::Button 915 $hb->add (new CFClient::UI::Button
871 text => "Quit anyway", 916 text => "Quit anyway",
872 expand => 1, 917 expand => 1,
873 connect_activate => sub { exit }, 918 on_activate => sub { exit },
874 ); 919 );
920 }
875 921
922 $QUIT_DIALOG->show;
876 $QUIT_DIALOG->show_centered; 923 $QUIT_DIALOG->center;
877 } else {
878 $QUIT_DIALOG->show_centered;
879 }
880} 924}
881 925
882sub make_inventory_window { 926sub make_inventory_window {
883 my $invwin = new CFClient::UI::FancyFrame 927 my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
884 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory"; 928 def_w => $WIDTH * 7/8,
929 def_h => $HEIGHT * 7/8,
930 title => "Inventory",
931 name => "inventory_window",
932 on_visibility_change => sub {
933 my ($self, $visible) = @_;
934 $self->center if $visible;
935 },
936 ;
885 937
886 $invwin->add (my $hb = new CFClient::UI::HBox expand => 1); 938 $invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
887 939
888 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1); 940 $hb->add (my $vb1 = new CFClient::UI::VBox);
889 $vb1->add (my $lbl = new CFClient::UI::Label); 941 $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
890 $lbl->set_text ("Player");
891 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1); 942 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
892 943
893 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1); 944 $hb->add (my $vb2 = new CFClient::UI::VBox);
945
894 $vb2->add ($INVR_LBL = new CFClient::UI::Label); 946 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
895 $INVR_LBL->set_text ("Floor"); 947
896 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1); 948 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
897 949
950 # XXX: Call after $INVR = ... because set_opencont sets the items
951 CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
952
898 $invwin 953 $invwin
954}
955
956sub make_binding_window {
957 my $binding_list = new CFClient::UI::VBox;
958
959 my $refresh = sub {
960 $binding_list->clear ();
961
962 for my $mod (keys %{$::CFG->{bindings}}) {
963 for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
964 my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
965 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
966
967 my $lbl = join "; ", @$cmds;
968 my $nam = CFClient::Recorder::keycombo_to_name ($mod, $sym);
969 $binding_list->add (my $hb = new CFClient::UI::HBox);
970 $hb->add (new CFClient::UI::Button
971 text => "delete",
972 on_activate => sub {
973 $binding_list->remove ($hb);
974 delete $::CFG->{bindings}->{$mod}->{$sym};
975 });
976 $hb->add (new CFClient::UI::Label text => "($nam)");
977 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
978 }
979 }
980 };
981
982 $BIND_WINDOW = new CFClient::UI::FancyFrame
983 title => "Bindings",
984 def_w => int $WIDTH * 7/8,
985 def_h => int $HEIGHT * 7/8,
986 on_visibility_change => sub {
987 my ($self, $visible) = @_;
988 if ($visible) {
989 $self->center;
990 $refresh->()
991 }
992 };
993
994 $BIND_WINDOW->add ($binding_list);
995 $refresh->();
996 $BIND_WINDOW
899} 997}
900 998
901sub make_help_window { 999sub make_help_window {
902 my $win = new CFClient::UI::FancyFrame 1000 my $win = new CFClient::UI::FancyFrame
903 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation"; 1001 def_w => int $WIDTH * 7/8,
1002 def_h => int $HEIGHT * 7/8,
1003 title => "Documentation";
904 1004
905 $win->add (my $vbox = new CFClient::UI::VBox); 1005 $win->add (my $vbox = new CFClient::UI::VBox);
906 1006
907 $vbox->add (my $buttons = new CFClient::UI::HBox); 1007 $vbox->add (my $buttons = new CFClient::UI::HBox);
908 $vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8); 1008 $vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
… …
915 ) { 1015 ) {
916 my ($pod, $label) = @$_; 1016 my ($pod, $label) = @$_;
917 1017
918 $buttons->add (new CFClient::UI::Button 1018 $buttons->add (new CFClient::UI::Button
919 text => $label, 1019 text => $label,
920 connect_activate => sub { 1020 on_activate => sub {
921 my $parser = new Pod::POM; 1021 my $parser = new Pod::POM;
922 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod"); 1022 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
923 1023
924 $viewer->clear; 1024 $viewer->clear;
925 1025
… …
956 or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n"; 1056 or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
957 1057
958 $SDL_ACTIVE = 1; 1058 $SDL_ACTIVE = 1;
959 $LAST_REFRESH = time - 0.01; 1059 $LAST_REFRESH = time - 0.01;
960 1060
961 CFClient::gl_init; 1061 CFClient::OpenGL::init;
962 1062
963 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 1063 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
964 1064
965 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d# 1065 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
966 1066
… …
1033 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :)."); 1133 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
1034 1134
1035 $BUTTONBAR->add (new CFClient::UI::Button 1135 $BUTTONBAR->add (new CFClient::UI::Button
1036 text => "Save Config", 1136 text => "Save Config",
1037 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.", 1137 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1038 connect_activate => sub { 1138 on_activate => sub {
1139 $::CFG->{layout} = CFClient::UI::get_layout;
1039 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 1140 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
1040 status "Configuration Saved"; 1141 status "Configuration Saved";
1041 }, 1142 },
1042 ); 1143 );
1043 1144
1044 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window, 1145 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1045 tooltip => "View Documentation"); 1146 tooltip => "View Documentation");
1046 1147
1148 $BUTTONBAR->add (new CFClient::UI::Flopper
1149 text => "Bindings",
1150 other => make_binding_window,
1151 tooltip => "Lets you delete bindings you have made with the recorder"
1152 );
1153 $BUTTONBAR->add (new CFClient::UI::Flopper text => "[Rec]", other => CFClient::Recorder::make_window,
1154 tooltip => "This feature lets you record a series of actions (eg. walking a path or ready a skill) and bind them to keys");
1155
1047 $BUTTONBAR->add (new CFClient::UI::Button 1156 $BUTTONBAR->add (new CFClient::UI::Button
1048 text => "Quit", 1157 text => "Quit",
1049 tooltip => "Terminates the program", 1158 tooltip => "Terminates the program",
1050 connect_activate => sub { 1159 on_activate => sub {
1051 if ($CONN) { 1160 if ($CONN) {
1052 open_quit_dialog; 1161 open_quit_dialog;
1053 } else { 1162 } else {
1054 exit; 1163 exit;
1055 } 1164 }
… …
1058 1167
1059 $BUTTONBAR->show; 1168 $BUTTONBAR->show;
1060 1169
1061 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); 1170 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1062 1171
1063 # delay till geometry is constant 1172 $SERVER_SETUP->show;
1064 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
1065 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
1066 my $widget = $GAUGES->{win};
1067 $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
1068 });
1069 force_refresh ();
1070 } 1173 }
1071} 1174}
1072 1175
1073sub video_shutdown { 1176sub video_shutdown {
1074 undef $SDL_ACTIVE; 1177 undef $SDL_ACTIVE;
… …
1235sub animation_stop { 1338sub animation_stop {
1236 my ($widget) = @_; 1339 my ($widget) = @_;
1237 delete $animate_object{$widget}; 1340 delete $animate_object{$widget};
1238} 1341}
1239 1342
1240@conn::ISA = Crossfire::Protocol::;
1241
1242sub conn::new {
1243 my $class = shift;
1244
1245 my $self = $class->Crossfire::Protocol::new (@_);
1246
1247 $MAPWIDGET->clr_commands;
1248
1249 my $parser = new Pod::POM;
1250 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1251
1252 for my $head2 ($pod->head2) {
1253 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1254 or next;
1255
1256 my $cmd = $1;
1257 my @args = split /\|/, $2;
1258 @args = (".*") unless @args;
1259
1260 my $text = CFClient::pod_to_pango $head2->content;
1261
1262 for my $arg (@args) {
1263 $arg = $arg eq ".*" ? "" : " $arg";
1264
1265 $MAPWIDGET->add_command ("$cmd$arg", $text);
1266 }
1267 }
1268
1269 $self->{noface} = new_from_file CFClient::Texture
1270 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1271
1272 $self
1273}
1274
1275sub conn::stats_update {
1276 my ($self, $stats) = @_;
1277
1278 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1279 my $diff = $exp - $self->{prev_exp};
1280 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1281 if exists $self->{prev_exp} && $diff;
1282 $self->{prev_exp} = $exp;
1283 }
1284
1285 update_stats_window ($stats);
1286}
1287
1288sub conn::user_send {
1289 my ($self, $command) = @_;
1290
1291 $self->send_command ($command);
1292 status $command;
1293}
1294
1295sub conn::map_scroll {
1296 my ($self, $dx, $dy) = @_;
1297
1298 $MAP->scroll ($dx, $dy);
1299}
1300
1301sub conn::feed_map1a {
1302 my ($self, $data) = @_;
1303
1304# $self->Crossfire::Protocol::feed_map1a ($data);
1305
1306 $MAP->map1a_update ($data);
1307 $MAPWIDGET->update;
1308}
1309
1310sub conn::flush_map {
1311 my ($self) = @_;
1312
1313 my $map_info = delete $self->{map_info}
1314 or return;
1315
1316 my ($hash, $x, $y, $w, $h) = @$map_info;
1317
1318 my $data = $MAP->get_rect ($x, $y, $w, $h);
1319 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
1320 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
1321}
1322
1323sub conn::map_clear {
1324 my ($self) = @_;
1325
1326 $self->flush_map;
1327 delete $self->{neigh_map};
1328
1329 $MAP->clear;
1330}
1331
1332
1333sub conn::load_map($$$) {
1334 my ($self, $hash, $x, $y) = @_;
1335
1336 if (defined (my $data = $MAPCACHE->get ($hash))) {
1337 $data = Compress::LZF::decompress $data;
1338 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
1339 for my $id ($MAP->set_rect ($x, $y, $data)) {
1340 my $data = $TILECACHE->get ($id)
1341 or next;
1342
1343 $self->set_texture ($id => $data);
1344 }
1345 }
1346}
1347
1348# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1349# (server resource,s latency, bandwidth), so this hack is warranted.
1350# the right fix is to make real tiled maps with an overview file
1351sub conn::send_mapinfo {
1352 my ($self, $data, $cb) = @_;
1353
1354 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1355 my ($wx, $wy) = ($1, $2);
1356
1357 if ($data =~ /^spatial ([1-4]+)$/) {
1358 my @dx = (0, 0, 1, 0, -1);
1359 my @dy = (0, -1, 0, 1, 0);
1360 my ($dx, $dy);
1361
1362 for (split //, $1) {
1363 $dx += $dx[$_];
1364 $dy += $dy[$_];
1365 }
1366
1367 $cb->(spatial => 15,
1368 $self->{map_info}[1] - $MAP->ox + $dx * 50,
1369 $self->{map_info}[2] - $MAP->oy + $dy * 50,
1370 50, 50,
1371 sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1372 );
1373
1374 return;
1375 }
1376 }
1377
1378 $self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1379}
1380
1381# this method does a "flood fill" into every tile direction
1382# it assumes that tiles are arranged in a rectangular grid,
1383# i.e. a map is the same as the left of the right map etc.
1384# failure to comply are harmless and result in display errors
1385# at worst.
1386sub conn::flood_fill {
1387 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1388
1389 # the server does not allow map paths > 6
1390 return if 7 <= length $path;
1391
1392 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1393
1394 for (
1395 [1, 3, 0, -1],
1396 [2, 4, 1, 0],
1397 [3, 1, 0, 1],
1398 [4, 2, -1, 0],
1399 ) {
1400 my ($tile, $tile2, $dx, $dy) = @$_;
1401
1402 next if $block & (1 << $tile);
1403 my $block = $block | (1 << $tile2);
1404
1405 my $gx = $gx + $dx;
1406 my $gy = $gy + $dy;
1407
1408 next unless $flags & (1 << ($tile - 1));
1409 next if $self->{neigh_grid}{$gx, $gy}++;
1410
1411 my $neigh = $self->{neigh_map}{$hash} ||= [];
1412 if (my $info = $neigh->[$tile]) {
1413 my ($flags, $x, $y, $w, $h, $hash) = @$info;
1414
1415 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1416 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1417
1418 } else {
1419 $self->send_mapinfo ("spatial $path$tile", sub {
1420 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1421
1422 return if $mode ne "spatial";
1423
1424 $x += $MAP->ox;
1425 $y += $MAP->oy;
1426
1427 $self->load_map ($hash, $x, $y)
1428 unless $self->{neigh_map}{$hash}[5]++;#d#
1429
1430 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1431
1432 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1433 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1434 });
1435 }
1436 }
1437}
1438
1439sub conn::map_change {
1440 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1441
1442 $self->flush_map;
1443
1444 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1445
1446 my $mapmapw = $MAPMAP->{w};
1447 my $mapmaph = $MAPMAP->{h};
1448
1449 $self->{neigh_rect} = [
1450 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1451 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1452 ];
1453
1454 delete $self->{neigh_grid};
1455
1456 $x += $ox;
1457 $y += $oy;
1458
1459 $self->{map_info} = [$hash, $x, $y, $w, $h];
1460
1461 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1462 $STATWIDS->{map}->set_text ("Map: " . $map);
1463
1464 $self->load_map ($hash, $x, $y);
1465 $self->flood_fill (0, 0, 0, "", $hash, $flags);
1466}
1467
1468sub conn::face_find {
1469 my ($self, $facenum, $face) = @_;
1470
1471 my $hash = "$face->{chksum},$face->{name}";
1472
1473 my $id = $FACEMAP->get ($hash);
1474
1475 unless ($id) {
1476 # create new id for face
1477 # I love transactions
1478 for (1..100) {
1479 my $txn = $CFClient::DB_ENV->txn_begin;
1480 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1481 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1482 $id = ($id || 16) + 1;
1483 if ($FACEMAP->put (id => $id) == 0
1484 && $FACEMAP->put ($hash => $id) == 0) {
1485 $txn->txn_commit;
1486
1487 goto gotid;
1488 }
1489 }
1490 $txn->abort;
1491 }
1492
1493 CFClient::fatal "maximum number of transaction retries reached - database problems?";
1494 }
1495
1496gotid:
1497 $face->{id} = $id;
1498 $MAP->set_face ($facenum => $id);
1499 $self->{faceid}[$facenum] = $id;#d#
1500
1501 my $face = $TILECACHE->get ($id);
1502
1503 if ($face) {
1504 #$self->face_prefetch;
1505 $face
1506 } else {
1507 my $tex = $self->{noface};
1508 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1509 undef
1510 };
1511}
1512
1513sub conn::face_update {
1514 my ($self, $facenum, $face) = @_;
1515
1516 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1517
1518 $self->set_texture ($face->{id} => delete $face->{image});
1519}
1520
1521sub conn::set_texture {
1522 my ($self, $id, $data) = @_;
1523
1524 $self->{texture}[$id] ||= do {
1525 my $tex =
1526 new_from_image CFClient::Texture
1527 $data, minify => 1, mipmap => 1;
1528
1529 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1530 $MAPWIDGET->update;
1531
1532 $tex
1533 };
1534}
1535
1536sub conn::sound_play {
1537 my ($self, $x, $y, $soundnum, $type) = @_;
1538
1539 $SDL_MIXER
1540 or return;
1541
1542 my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1543 or return;
1544
1545 $chunk->play;
1546# warn "sound $x,$y,$soundnum,$type\n";#d#
1547}
1548
1549my $LAST_QUERY; # server is stupid, stupid, stupid
1550
1551sub conn::query {
1552 my ($self, $flags, $prompt) = @_;
1553
1554 $prompt = $LAST_QUERY unless length $prompt;
1555 $LAST_QUERY = $prompt;
1556
1557 my $dialog = new CFClient::UI::FancyFrame
1558 title => "Query",
1559 child => my $vbox = new CFClient::UI::VBox;
1560
1561 $vbox->add (new CFClient::UI::Label
1562 max_w => $::WIDTH * 0.4,
1563 ellipsise => 0,
1564 text => $prompt);
1565
1566 if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1567 $vbox->add (my $hbox = new CFClient::HBox);
1568 $hbox->add (new CFClient::Button
1569 text => "No",
1570 connect_activate => sub {
1571 $self->send ("reply n");
1572 $dialog->destroy;
1573 $MAPWIDGET->focus_in;
1574 }
1575 );
1576 $hbox->add (new CFClient::Button
1577 text => "Yes",
1578 connect_activate => sub {
1579 $self->send ("reply y");
1580 $dialog->destroy;
1581 },
1582 );
1583
1584 $dialog->focus_in;
1585
1586 } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1587 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1588 $vbox->add (my $entry = new CFClient::UI::Entry
1589 connect_changed => sub {
1590 $self->send ("reply $_[1]");
1591 $dialog->destroy;
1592 },
1593 );
1594
1595 $entry->focus_in;
1596
1597 } else {
1598 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1599
1600 $vbox->add (my $entry = new CFClient::UI::Entry
1601 $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1602 connect_activate => sub {
1603 $self->send ("reply $_[1]");
1604 $dialog->destroy;
1605 },
1606 );
1607
1608 $entry->focus_in;
1609 }
1610
1611 $dialog->show_centered;
1612}
1613
1614sub conn::drawinfo {
1615 my ($self, $color, $text) = @_;
1616
1617 my @color = (
1618 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1619 [1.00, 1.00, 1.00],
1620 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1621 [1.00, 0.00, 0.00],
1622 [1.00, 0.54, 0.00],
1623 [0.11, 0.56, 1.00],
1624 [0.93, 0.46, 0.00],
1625 [0.18, 0.54, 0.34],
1626 [0.56, 0.73, 0.56],
1627 [0.80, 0.80, 0.80],
1628 [0.55, 0.41, 0.13],
1629 [0.99, 0.77, 0.26],
1630 [0.74, 0.65, 0.41],
1631 );
1632
1633 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1634
1635 $text = CFClient::UI::Label::escape $text;
1636 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1637 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1638
1639 $LOGVIEW->add_paragraph ($color[$color],
1640 join "\n", map "$time $_", split /\n/, $text);
1641
1642 $STATUSBOX->add ($text,
1643 group => $text,
1644 fg => $color[$color],
1645 timeout => 10,
1646 tooltip_font => $::FONT_FIXED,
1647 );
1648}
1649
1650sub conn::drawextinfo {
1651 my ($self, $color, $type, $subtype, $message) = @_;
1652
1653 $self->drawinfo ($color, $message);
1654}
1655
1656sub conn::spell_add {
1657 my ($self, $spell) = @_;
1658
1659 # TODO
1660 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1661 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1662 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1663}
1664
1665sub conn::spell_delete {
1666 my ($self, $spell) = @_;
1667}
1668
1669sub conn::addme_success {
1670 my ($self) = @_;
1671
1672 $self->send ("command output-sync $CFG->{output_sync}");
1673 $self->send ("command output-count $CFG->{output_count}");
1674
1675 my $parser = new Pod::POM;
1676 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1677
1678 my %skill_tooltip;
1679
1680 for my $head2 ($pod->head2) {
1681 $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1682 }
1683
1684 for my $skill (values %{$self->{skill_info}}) {
1685 $MAPWIDGET->add_command ("ready_skill $skill",
1686 (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1687 . $skill_tooltip{$skill});
1688 $MAPWIDGET->add_command ("use_skill $skill",
1689 (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1690 . $skill_tooltip{$skill});
1691 }
1692}
1693
1694sub conn::eof {
1695 $MAPWIDGET->clr_commands;
1696
1697 stop_game;
1698}
1699
1700sub conn::image_info {
1701 my ($self, $numfaces) = @_;
1702
1703 $self->{num_faces} = $numfaces;
1704 $self->{face_prefetch} = [1 .. $numfaces];
1705 $self->face_prefetch;
1706}
1707
1708sub conn::face_prefetch {
1709 my ($self) = @_;
1710
1711 return unless $CFG->{face_prefetch};
1712
1713 if ($self->{num_faces}) {
1714 return if @{ $self->{send_queue} || [] };
1715 my $todo = @{ $self->{face_prefetch} }
1716 or return;
1717
1718 my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
1719
1720 $self->send ("requestinfo image_sums $face $face");
1721
1722 $STATUSBOX->add (CFClient::UI::Label::escape "prefetching $todo",
1723 group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1724 } elsif (!exists $self->{num_faces}) {
1725 $self->send ("requestinfo image_info");
1726
1727 $self->{num_faces} = 0;
1728
1729 $STATUSBOX->add (CFClient::UI::Label::escape "starting to prefetch",
1730 group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1731 }
1732}
1733
1734# check once/second for faces that need to be prefetched 1343# check once/second for faces that need to be prefetched
1735# this should, of course, only run on demand, but 1344# this should, of course, only run on demand, but
1736# SDL forces worse things on us.... 1345# SDL forces worse things on us....
1737 1346
1738Event->timer (after => 1, interval => 0.25, cb => sub { 1347Event->timer (after => 1, interval => 0.25, cb => sub {
1739 $CONN->face_prefetch 1348 $CONN->face_prefetch
1740 if $CONN; 1349 if $CONN;
1741}); 1350});
1742
1743sub update_floorbox {
1744 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1745 return unless $CONN;
1746
1747 $FLOORBOX->clear;
1748 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1749
1750 my $count = 7;
1751 for (@{ $CONN->{container}{0} }) {
1752 if (--$count) {
1753 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1754 } else {
1755 $FLOORBOX->add (new CFClient::UI::Label text => "More...");
1756 last;
1757 }
1758 }
1759 });
1760
1761 $WANT_REFRESH++;
1762}
1763
1764sub conn::container_add {
1765 my ($self, $tag, $items) = @_;
1766
1767 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1768
1769 if ($tag == 0) {
1770 update_floorbox;
1771 $OPENCONT = 0;
1772 $INVR_LBL->set_text ("Floor");
1773 $INVR->set_items ($self->{container}{0});
1774 } elsif ($tag == $self->{player}{tag}) {
1775 $INVR_LBL->set_text ("Player");
1776 $INV->set_items ($self->{container}{$self->{player}{tag}})
1777 } else {
1778 $OPENCONT = $tag;
1779 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1780 $INVR->set_items ($self->{container}{$tag});
1781 }
1782
1783 # $self-<{player}{tag} => player inv
1784 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1785}
1786
1787sub conn::container_clear {
1788 my ($self, $tag) = @_;
1789
1790 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1791
1792 if ($tag == 0) {
1793 update_floorbox;
1794 $OPENCONT = 0;
1795 $INVR_LBL->set_text ("Floor");
1796 $INVR->set_items ($self->{container}{0});
1797 } elsif ($tag == $self->{player}{tag}) {
1798 $INVR_LBL->set_text ("Player");
1799 $INV->set_items ($self->{container}{$tag})
1800 } else {
1801 $OPENCONT = $tag;
1802 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1803 $INVR->set_items ($self->{container}{$tag});
1804 }
1805
1806# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1807}
1808
1809sub conn::item_delete {
1810 my ($self, @items) = @_;
1811
1812 for (@items) {
1813 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1814
1815 if ($_->{container} == 0) {
1816 update_floorbox;
1817 $OPENCONT = 0;
1818 $INVR_LBL->set_text ("Floor");
1819 $INVR->set_items ($self->{container}{0});
1820 } elsif ($_->{container} == $self->{player}{tag}) {
1821 $INVR_LBL->set_text ("Player");
1822 $INV->set_items ($self->{container}{$self->{player}{tag}})
1823 } else {
1824 $OPENCONT = $_->{container};
1825 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1826 $INVR->set_items ($self->{container}{$_->{container}});
1827 }
1828 }
1829}
1830
1831sub conn::item_update {
1832 my ($self, $item) = @_;
1833
1834 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1835
1836 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1837 $OPENCONT = 0;
1838 $INVR_LBL->set_text ("Floor");
1839 $INVR->set_items ($self->{container}{0});
1840
1841 $item->{widget}->update_item
1842 if $item->{widget};
1843 } else {
1844 if ($item->{container} == 0) {
1845 update_floorbox;
1846 $OPENCONT = 0;
1847 $INVR_LBL->set_text ("Floor");
1848 $INVR->set_items ($self->{container}{0});
1849 } elsif ($item->{container} == $self->{player}{tag}) {
1850 $INV->set_items ($self->{container}{$item->{container}})
1851 }
1852 }
1853}
1854 1351
1855%SDL_CB = ( 1352%SDL_CB = (
1856 CFClient::SDL_QUIT => sub { 1353 CFClient::SDL_QUIT => sub {
1857 Event::unloop -1; 1354 Event::unloop -1;
1858 }, 1355 },
… …
1893 1390
1894{ 1391{
1895 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] }; 1392 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1896 1393
1897 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 1394 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1898 1395 CFClient::UI::set_layout ($::CFG->{layout});
1899 $TILECACHE = CFClient::db_table "tilecache";
1900 $FACEMAP = CFClient::db_table "facemap";
1901 1396
1902 my %DEF_CFG = ( 1397 my %DEF_CFG = (
1903 sdl_mode => 0, 1398 sdl_mode => 0,
1904 width => 640, 1399 width => 640,
1905 height => 480, 1400 height => 480,

Diff Legend

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