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.15 by root, Sat May 27 19:49:07 2006 UTC vs.
Revision 1.56 by root, Mon Jun 5 05:23:21 2006 UTC

25# need to do it again because that pile of garbage called PAR nukes it before main 25# need to do it again because that pile of garbage called PAR nukes it before main
26unshift @INC, $ENV{PAR_TEMP} 26unshift @INC, $ENV{PAR_TEMP}
27 if %PAR::LibCache; 27 if %PAR::LibCache;
28 28
29use Time::HiRes 'time'; 29use Time::HiRes 'time';
30use Pod::POM;
31use Event; 30use Event;
32 31
33use Crossfire; 32use Crossfire;
34use Crossfire::Protocol::Constants; 33use Crossfire::Protocol::Constants;
35 34
41use CFClient::UI; 40use CFClient::UI;
42use CFClient::MapWidget; 41use CFClient::MapWidget;
43 42
44$Event::DIED = sub { 43$Event::DIED = sub {
45 # TODO: display dialog box or so 44 # TODO: display dialog box or so
45 Carp::confess $_[1];#d#TODO: remove when stable
46 CFClient::error $_[1]; 46 CFClient::error $_[1];
47}; 47};
48 48
49#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d# 49#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
50 50
81our $LOGVIEW; 81our $LOGVIEW;
82our $CONSOLE; 82our $CONSOLE;
83our $METASERVER; 83our $METASERVER;
84our $LOGIN_BUTTON; 84our $LOGIN_BUTTON;
85our $QUIT_DIALOG; 85our $QUIT_DIALOG;
86our $HOST_ENTRY;
87
88our $SETUP_DIALOG;
89our $SETUP_NOTEBOOK;
90our $SETUP_SERVER;
91our $SETUP_KEYBOARD;
92our $SETUP_SPELLS;
86 93
87our $FLOORBOX; 94our $FLOORBOX;
88our $GAUGES; 95our $GAUGES;
89our $STATWIDS; 96our $STATWIDS;
90 97
97 104
98our $ALT_ENTER_MESSAGE; 105our $ALT_ENTER_MESSAGE;
99our $STATUSBOX; 106our $STATUSBOX;
100our $DEBUG_STATUS; 107our $DEBUG_STATUS;
101 108
109our $INV_WINDOW;
102our $INV; 110our $INV;
103our $INVR; 111our $INVR;
104our $INVR_LBL; 112our $INV_RIGHT_HB;
113
114our $BIND_EDITOR;
115
116our $PICKUP_CFG;
105 117
106sub status { 118sub status {
107 $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 119 $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
108} 120}
109 121
110sub debug { 122sub debug {
111 $DEBUG_STATUS->set_text ($_[0]); 123 $DEBUG_STATUS->set_text ($_[0]);
112 my ($w, $h) = $DEBUG_STATUS->size_request;
113 $DEBUG_STATUS->move ($WIDTH - $w, 0);
114} 124}
115 125
116sub start_game { 126sub start_game {
117 status "logging in..."; 127 status "logging in...";
128
129 $LOGIN_BUTTON->set_text ("Logout");
130 $SETUP_DIALOG->hide;
118 131
119 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 132 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
120 133
121 my ($host, $port) = split /:/, $CFG->{host}; 134 my ($host, $port) = split /:/, $CFG->{host};
122 135
151 }; 164 };
152 165
153 if ($CONN) { 166 if ($CONN) {
154 CFClient::lowdelay fileno $CONN->{fh}; 167 CFClient::lowdelay fileno $CONN->{fh};
155 168
156 $LOGIN_BUTTON->set_text ("Logout");
157 status "login successful"; 169 status "login successful";
158
159 $BUTTONBAR->{children}[1]->emit ("activate")
160 if $BUTTONBAR->{children}[1]->{state};
161
162 } else { 170 } else {
163 status "unable to connect"; 171 status "unable to connect";
164 stop_game(); 172 stop_game();
165 } 173 }
166} 174}
167 175
168sub stop_game { 176sub stop_game {
177 $LOGIN_BUTTON->set_text ("Login");
178 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
179 $SETUP_DIALOG->show;
180 $INV_WINDOW->hide;
181
169 return unless $CONN; 182 return unless $CONN;
170 183
171 status "connection closed"; 184 status "connection closed";
172 $LOGIN_BUTTON->set_text ("Login"); 185
173 $CONN->destroy; 186 $CONN->destroy;
174 $CONN = 0; # false, does not autovivify 187 $CONN = 0; # false, does not autovivify
175
176 $BUTTONBAR->{children}[1]->emit ("activate")
177 unless $BUTTONBAR->{children}[1]->{state};
178} 188}
179 189
180sub client_setup { 190sub graphics_setup {
181 my $dialog = new CFClient::UI::FancyFrame
182 title => "Client Setup",
183 child => (my $vbox = new CFClient::UI::VBox); 191 my $vbox = new CFClient::UI::VBox;
192
184 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 193 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
185 194
186 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); 195 $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
187 $table->add (1, 0, my $hbox = new CFClient::UI::HBox); 196 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
188 197
189 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]); 198 $hbox->add (my $mode_slider = new CFClient::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
190 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999"); 199 $hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
191 200
192 $mode_slider->connect (changed => sub { 201 $mode_slider->connect (changed => sub {
193 my ($self, $value) = @_; 202 my ($self, $value) = @_;
194 203
201 210
202 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); 211 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
203 $table->add (1, $row++, new CFClient::UI::CheckBox 212 $table->add (1, $row++, new CFClient::UI::CheckBox
204 state => $CFG->{fullscreen}, 213 state => $CFG->{fullscreen},
205 tooltip => "Bring the client into fullscreen mode.", 214 tooltip => "Bring the client into fullscreen mode.",
206 connect_changed => sub { 215 on_changed => sub {
207 my ($self, $value) = @_; 216 my ($self, $value) = @_;
208 $CFG->{fullscreen} = $value; 217 $CFG->{fullscreen} = $value;
209 } 218 }
210 ); 219 );
211 220
212 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 221 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
213 $table->add (1, $row++, new CFClient::UI::CheckBox 222 $table->add (1, $row++, new CFClient::UI::CheckBox
214 state => $CFG->{fast}, 223 state => $CFG->{fast},
215 tooltip => "Lower the visual quality considerably to speed up rendering.", 224 tooltip => "Lower the visual quality considerably to speed up rendering.",
216 connect_changed => sub { 225 on_changed => sub {
217 my ($self, $value) = @_; 226 my ($self, $value) = @_;
218 $CFG->{fast} = $value; 227 $CFG->{fast} = $value;
219 } 228 }
220 ); 229 );
221 230
222 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale"); 231 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
223 $table->add (1, $row++, new CFClient::UI::Slider 232 $table->add (1, $row++, new CFClient::UI::Slider
224 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], 233 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
225 tooltip => "Enlarge or shrink the displayed map. Changes are instant.", 234 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
226 connect_changed => sub { 235 on_changed => sub {
227 my ($self, $value) = @_; 236 my ($self, $value) = @_;
228 $CFG->{map_scale} = 2 ** $value; 237 $CFG->{map_scale} = 2 ** $value;
229 } 238 }
230 ); 239 );
231 240
232 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 241 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
233 $table->add (1, $row++, new CFClient::UI::CheckBox 242 $table->add (1, $row++, new CFClient::UI::CheckBox
234 state => $CFG->{fow_enable}, 243 state => $CFG->{fow_enable},
235 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.", 244 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
236 connect_changed => sub { 245 on_changed => sub {
237 my ($self, $value) = @_; 246 my ($self, $value) = @_;
238 $CFG->{fow_enable} = $value; 247 $CFG->{fow_enable} = $value;
239 } 248 }
240 ); 249 );
241 250
242 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 251 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
243 $table->add (1, $row++, new CFClient::UI::Slider 252 $table->add (1, $row++, new CFClient::UI::Slider
244 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256], 253 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
245 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.", 254 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
246 connect_changed => sub { 255 on_changed => sub {
247 my ($self, $value) = @_; 256 my ($self, $value) = @_;
248 $CFG->{fow_intensity} = $value; 257 $CFG->{fow_intensity} = $value;
249 } 258 }
250 ); 259 );
251 260
252 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); 261 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
253 $table->add (1, $row++, new CFClient::UI::CheckBox 262 $table->add (1, $row++, new CFClient::UI::CheckBox
254 state => $CFG->{fow_smooth}, 263 state => $CFG->{fow_smooth},
255 tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.", 264 tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
256 connect_changed => sub { 265 on_changed => sub {
257 my ($self, $value) = @_; 266 my ($self, $value) = @_;
258 $CFG->{fow_smooth} = $value; 267 $CFG->{fow_smooth} = $value;
259 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2; 268 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
260 } 269 }
261 ); 270 );
262 271
263 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 272 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
264 $table->add (1, $row++, new CFClient::UI::Slider 273 $table->add (1, $row++, new CFClient::UI::Slider
265 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1], 274 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
266 tooltip => "The base font size used by most GUI elements that do not have their own setting.", 275 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
267 connect_changed => sub { $CFG->{gui_fontsize} = $_[1] }, 276 on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
268 ); 277 );
269 278
270 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize"); 279 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
271 $table->add (1, $row++, new CFClient::UI::Slider 280 $table->add (1, $row++, new CFClient::UI::Slider
272 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1], 281 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
273 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.", 282 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
274 connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) }, 283 on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
275 ); 284 );
276 285
277 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize"); 286 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
278 287
279 $table->add (1, $row++, new CFClient::UI::Slider 288 $table->add (1, $row++, new CFClient::UI::Slider
280 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1], 289 range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
281 tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.", 290 tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
282 connect_changed => sub { 291 on_changed => sub {
283 $CFG->{stat_fontsize} = $_[1]; 292 $CFG->{stat_fontsize} = $_[1];
284 &set_stats_window_fontsize; 293 &set_stats_window_fontsize;
285 } 294 }
286 ); 295 );
287 296
288 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); 297 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
289 $table->add (1, $row++, new CFClient::UI::Slider 298 $table->add (1, $row++, new CFClient::UI::Slider
290 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1], 299 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
291 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.", 300 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
292 connect_changed => sub { 301 on_changed => sub {
293 $CFG->{gauge_fontsize} = $_[1]; 302 $CFG->{gauge_fontsize} = $_[1];
294 &set_gauge_window_fontsize; 303 &set_gauge_window_fontsize;
295 } 304 }
296 ); 305 );
297 306
298 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size"); 307 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
299 $table->add (1, $row++, new CFClient::UI::Slider 308 $table->add (1, $row++, new CFClient::UI::Slider
300 range => [$CFG->{gauge_size}, 0.2, 0.8], 309 range => [$CFG->{gauge_size}, 0.2, 0.8],
301 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.", 310 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
302 connect_changed => sub { 311 on_changed => sub {
303 $CFG->{gauge_size} = $_[1]; 312 $CFG->{gauge_size} = $_[1];
304 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); 313 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
305 } 314 }
306 ); 315 );
307 316
308 $table->add (1, $row++, new CFClient::UI::Button 317 $table->add (1, $row++, new CFClient::UI::Button
309 expand => 1, align => 0, text => "Apply", 318 expand => 1, align => 0, text => "Apply",
310 tooltip => "Apply the video settings", 319 tooltip => "Apply the video settings",
311 connect_activate => sub { 320 on_activate => sub {
312 video_shutdown (); 321 video_shutdown ();
313 video_init (); 322 video_init ();
314 } 323 }
315 ); 324 );
325
326 $vbox
327}
328
329sub audio_setup {
330 my $vbox = new CFClient::UI::VBox;
331
332 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
333
334 my $row = 0;
316 335
317 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); 336 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
318 $table->add (1, $row++, new CFClient::UI::CheckBox 337 $table->add (1, $row++, new CFClient::UI::CheckBox
319 state => $CFG->{audio_enable}, 338 state => $CFG->{audio_enable},
320 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.", 339 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.",
321 connect_changed => sub { 340 on_changed => sub {
322 $CFG->{audio_enable} = $_[1]; 341 $CFG->{audio_enable} = $_[1];
323 } 342 }
324 ); 343 );
325# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); 344# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
326# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub { 345# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
327# $CFG->{effects_volume} = $_[1]; 346# $CFG->{effects_volume} = $_[1];
328# }); 347# });
329 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); 348 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
330 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox); 349 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
331 $hbox->add (new CFClient::UI::CheckBox 350 $hbox->add (new CFClient::UI::CheckBox
332 expand => 1, state => $CFG->{bgm_enable}, 351 expand => 1, state => $CFG->{bgm_enable},
333 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.", 352 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
334 connect_changed => sub { 353 on_changed => sub {
335 $CFG->{bgm_enable} = $_[1]; 354 $CFG->{bgm_enable} = $_[1];
336 } 355 }
337 ); 356 );
338 $hbox->add (new CFClient::UI::Slider 357 $hbox->add (new CFClient::UI::Slider
339 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128], 358 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
340 tooltip => "The volume of the background music. Changes are instant.", 359 tooltip => "The volume of the background music. Changes are instant.",
341 connect_changed => sub { 360 on_changed => sub {
342 $CFG->{bgm_volume} = $_[1]; 361 $CFG->{bgm_volume} = $_[1];
343 CFClient::MixMusic::volume $_[1] * 128; 362 CFClient::MixMusic::volume $_[1] * 128;
344 } 363 }
345 ); 364 );
346 365
347 $table->add (1, $row++, new CFClient::UI::Button 366 $table->add (1, $row++, new CFClient::UI::Button
348 expand => 1, align => 0, text => "Apply", 367 expand => 1, align => 0, text => "Apply",
349 tooltip => "Apply the audio settings", 368 tooltip => "Apply the audio settings",
350 connect_activate => sub { 369 on_activate => sub {
351 audio_shutdown (); 370 audio_shutdown ();
352 audio_init (); 371 audio_init ();
353 } 372 }
354 ); 373 );
355 374
356 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command"); 375 $vbox
357 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
358 text => $CFG->{say_command},
359 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. "
360 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
361 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
362 connect_changed => sub {
363 my ($self, $value) = @_;
364 $CFG->{say_command} = $value;
365 }
366 );
367
368 $dialog
369} 376}
370 377
371sub set_stats_window_fontsize { 378sub set_stats_window_fontsize {
372 for (values %{$STATWIDS}) { 379 for (values %{$STATWIDS}) {
373 $_->set_fontsize ($::CFG->{stat_fontsize}); 380 $_->set_fontsize ($::CFG->{stat_fontsize});
382 389
383sub make_gauge_window { 390sub make_gauge_window {
384 my $gh = int $HEIGHT * $CFG->{gauge_size}; 391 my $gh = int $HEIGHT * $CFG->{gauge_size};
385 392
386 my $win = new CFClient::UI::Frame ( 393 my $win = new CFClient::UI::Frame (
387 req_y => -1, 394 force_x => 0,
395 force_y => "max",
388 user_w => $WIDTH, 396 force_w => $WIDTH,
389 user_h => $gh, 397 force_h => $gh,
390 ); 398 );
391 399
392 $win->add (my $hbox = new CFClient::UI::HBox 400 $win->add (my $hbox = new CFClient::UI::HBox
393 children => [ 401 children => [
394 (new CFClient::UI::HBox expand => 1), 402 (new CFClient::UI::HBox expand => 1),
430 &set_gauge_window_fontsize; 438 &set_gauge_window_fontsize;
431 439
432 $win 440 $win
433} 441}
434 442
443
435sub make_stats_window { 444sub make_stats_window {
436 my $tgw = new CFClient::UI::FancyFrame title => "Stats"; 445 my $tgw = new CFClient::UI::FancyFrame
446 y => $HEIGHT * (2/8),
447 x => "max",
448 title => "Stats",
449 name => "stats_window";
437 450
438 $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);
439 $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,
440 can_hover => 1, can_events => 1, 453 can_hover => 1, can_events => 1,
441 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.");
540 update_stats_window ({}); 553 update_stats_window ({});
541 554
542 $tgw 555 $tgw
543} 556}
544 557
545sub formsep { 558sub formsep($) {
546 reverse join ",", grep length, split /(...)/, reverse $_[0] * 1 559 scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
547} 560}
548 561
549sub update_stats_window { 562sub update_stats_window {
550 my ($stats) = @_; 563 my ($stats) = @_;
551 564
613 626
614 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}}) 627 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
615 for keys %tbl; 628 for keys %tbl;
616} 629}
617 630
618sub metaserver_dialog {
619 my $dialog = new CFClient::UI::FancyFrame
620 title => "Server List",
621 child => (my $vbox = new CFClient::UI::VBox);
622
623 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
624
625 $dialog
626}
627
628my $METASERVER_ATIME; 631my $METASERVER_ATIME;
629 632
630sub update_metaserver { 633sub update_metaserver {
631 my ($HOST) = @_;
632
633 return if $METASERVER_ATIME > time; 634 return if $METASERVER_ATIME > time;
634 $METASERVER_ATIME = time + 60; 635 $METASERVER_ATIME = time + 60;
635 636
636 my $table = $METASERVER->{table}; 637 my $table = $METASERVER->{table};
637 $table->clear; 638 $table->clear;
688 $m = [$users, $host, $uptime, $version, $desc]; 689 $m = [$users, $host, $uptime, $version, $desc];
689 690
690 $y++; 691 $y++;
691 692
692 $table->add (0, $y, new CFClient::UI::VBox children => [ 693 $table->add (0, $y, new CFClient::UI::VBox children => [
693 (new CFClient::UI::Button text => "Use", connect_activate => sub { 694 (new CFClient::UI::Button text => "Use", on_activate => sub {
694 $HOST->set_text ($CFG->{host} = $host); 695 $HOST_ENTRY->set_text ($CFG->{host} = $host);
696 $METASERVER->toggle_visibility;
695 }), 697 }),
696 (new CFClient::UI::Empty expand => 1), 698 (new CFClient::UI::Empty expand => 1),
697 ]); 699 ]);
698 700
699 $table->add ($_ + 1, $y, new CFClient::UI::Label 701 $table->add ($_ + 1, $y, new CFClient::UI::Label
702 } 704 }
703 } 705 }
704 }); 706 });
705} 707}
706 708
709sub metaserver_dialog {
710 my $dialog = new CFClient::UI::FancyFrame
711 title => "Server List",
712 name => 'metaserver_dialog',
713 x => 'center',
714 y => 'center',
715 child => (my $vbox = new CFClient::UI::VBox),
716 on_visibility_change => sub {
717 update_metaserver if $_[1];
718 },
719 ;
720
721 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
722
723 $dialog
724}
725
707sub server_setup { 726sub server_setup {
708 my $dialog = new CFClient::UI::FancyFrame
709 title => "Server Setup",
710 child => (my $vbox = new CFClient::UI::VBox); 727 my $vbox = new CFClient::UI::VBox;
711 728
712 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); 729 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
713 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); 730 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
714 731
715 { 732 {
716 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 733 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
717 734
718 $vbox->add ( 735 $vbox->add (
719 my $HOST = new CFClient::UI::Entry 736 $HOST_ENTRY = new CFClient::UI::Entry
720 expand => 1, 737 expand => 1,
721 text => $CFG->{host}, 738 text => $CFG->{host},
722 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to", 739 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
723 connect_changed => sub { 740 on_changed => sub {
724 my ($self, $value) = @_; 741 my ($self, $value) = @_;
725 $CFG->{host} = $value; 742 $CFG->{host} = $value;
726 } 743 }
727 ); 744 );
728 745
729 $METASERVER = metaserver_dialog; 746 $METASERVER = metaserver_dialog;
730 747
731 $vbox->add (new CFClient::UI::Flopper 748 $vbox->add (new CFClient::UI::Button
732 expand => 1, 749 expand => 1,
733 text => "Server List", 750 text => "Server List",
734 other => $METASERVER, 751 other => $METASERVER,
735 tooltip => "Show a list of available crossfire servers", 752 tooltip => "Show a list of available crossfire servers",
736 connect_open => sub { 753 on_activate => sub { $METASERVER->toggle_visibility },
737 update_metaserver $HOST;
738 }
739 ); 754 );
740 } 755 }
741 756
742 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username"); 757 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
743 $table->add (1, 4, new CFClient::UI::Entry 758 $table->add (1, 4, new CFClient::UI::Entry
744 text => $CFG->{user}, 759 text => $CFG->{user},
745 tooltip => "The name of your character on the server", 760 tooltip => "The name of your character on the server",
746 connect_changed => sub { 761 on_changed => sub {
747 my ($self, $value) = @_; 762 my ($self, $value) = @_;
748 $CFG->{user} = $value; 763 $CFG->{user} = $value;
749 } 764 }
750 ); 765 );
751 766
752 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); 767 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
753 $table->add (1, 5, new CFClient::UI::Entry 768 $table->add (1, 5, new CFClient::UI::Entry
754 text => $CFG->{password}, 769 text => $CFG->{password},
755 hidden => 1, 770 hidden => 1,
756 tooltip => "The password for your character", 771 tooltip => "The password for your character",
757 connect_changed => sub { 772 on_changed => sub {
758 my ($self, $value) = @_; 773 my ($self, $value) = @_;
759 $CFG->{password} = $value; 774 $CFG->{password} = $value;
760 } 775 }
761 ); 776 );
762 777
763 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 778 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
764 $table->add (1, 7, new CFClient::UI::Slider 779 $table->add (1, 7, new CFClient::UI::Slider
765 req_w => 100, 780 force_w => 100,
766 range => [$CFG->{mapsize}, 10, 100, 0, 1], 781 range => [$CFG->{mapsize}, 10, 100, 0, 1],
767 tooltip => "This is the size of the portion of the map update the server sends you. " 782 tooltip => "This is the size of the portion of the map update the server sends you. "
768 . "If you set this to a high value you will be able to see further, " 783 . "If you set this to a high value you will be able to see further, "
769 . "but you also increase bandwidth requirements and latency. " 784 . "but you also increase bandwidth requirements and latency. "
770 . "This option is only used once at log-in.", 785 . "This option is only used once at log-in.",
771 connect_changed => sub { 786 on_changed => sub {
772 my ($self, $value) = @_; 787 my ($self, $value) = @_;
773 788
774 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 789 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
775 }, 790 },
776 ); 791 );
783 . "This might increase or create lag, but increases the chances " 798 . "This might increase or create lag, but increases the chances "
784 . "of faces being ready for display when you encounter them. " 799 . "of faces being ready for display when you encounter them. "
785 . "It also uses up server bandwidth on every connect, " 800 . "It also uses up server bandwidth on every connect, "
786 . "so only set it if you really need to prefetch images. " 801 . "so only set it if you really need to prefetch images. "
787 . "This option can be set and unset any time.", 802 . "This option can be set and unset any time.",
788 connect_changed => sub { $CFG->{face_prefetch} = $_[1] }, 803 on_changed => sub { $CFG->{face_prefetch} = $_[1] },
789 ); 804 );
790 805
791 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count"); 806 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
792 $table->add (1, 9, new CFClient::UI::Entry 807 $table->add (1, 9, new CFClient::UI::Entry
793 text => $CFG->{output_count}, 808 text => $CFG->{output_count},
794 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 809 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
795 connect_changed => sub { $CFG->{output_count} = $_[1] }, 810 on_changed => sub { $CFG->{output_count} = $_[1] },
796 ); 811 );
797 812
798 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync"); 813 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
799 $table->add (1, 10, new CFClient::UI::Entry 814 $table->add (1, 10, new CFClient::UI::Entry
800 text => $CFG->{output_sync}, 815 text => $CFG->{output_sync},
801 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", 816 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
802 connect_changed => sub { $CFG->{output_sync} = $_[1] }, 817 on_changed => sub { $CFG->{output_sync} = $_[1] },
803 ); 818 );
804 819
805 $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button 820 $table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
806 expand => 1, 821 expand => 1,
807 align => 0, 822 align => 0,
808 text => "Login", 823 text => "Login",
809 connect_activate => sub { 824 on_activate => sub {
810 $CONN ? stop_game 825 $CONN ? stop_game
811 : start_game; 826 : start_game;
812 }, 827 },
813 ); 828 );
814 829
815 $dialog 830 $table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
831 $table->add (1, 12, my $saycmd = new CFClient::UI::Entry
832 text => $CFG->{say_command},
833 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. "
834 . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
835 . "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
836 on_changed => sub {
837 my ($self, $value) = @_;
838 $CFG->{say_command} = $value;
839 }
840 );
841
842 $vbox
816} 843}
817 844
818sub message_window { 845sub message_window {
819 my $window = new CFClient::UI::FancyFrame 846 my $window = new CFClient::UI::FancyFrame
847 name => "message_window",
820 title => "Messages", 848 title => "Messages",
821 border_bg => [1, 1, 1, 1], 849 border_bg => [1, 1, 1, 1],
822 bg => [0, 0, 0, 0.75], 850 bg => [0, 0, 0, 0.75],
851 x => "max",
852 y => 0,
823 user_w => int $::WIDTH / 3, 853 force_w => $::WIDTH / 3,
824 user_h => int $::HEIGHT / 5, 854 force_h => $::HEIGHT / 5,
825 child => (my $vbox = new CFClient::UI::VBox); 855 child => (my $vbox = new CFClient::UI::VBox);
826 856
827 $vbox->add ($LOGVIEW); 857 $vbox->add ($LOGVIEW);
828 858
829 $vbox->add (my $input = new CFClient::UI::Entry 859 $vbox->add (my $input = new CFClient::UI::Entry
830 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> " 860 tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
831 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). " 861 . "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
832 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). " 862 . "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
833 . "A better way to submit commands (and the occasional chat command) is often the map command completer.", 863 . "A better way to submit commands (and the occasional chat command) is often the map command completer.",
834 connect_focus_in => sub { 864 on_focus_in => sub {
835 my ($input, $prev_focus) = @_; 865 my ($input, $prev_focus) = @_;
836 866
837 delete $input->{refocus_map}; 867 delete $input->{refocus_map};
838 868
839 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) { 869 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
840 $input->{refocus_map} = 1; 870 $input->{refocus_map} = 1;
841 } 871 }
842 delete $input->{auto_activated}; 872 delete $input->{auto_activated};
843 }, 873 },
844 connect_activate => sub { 874 on_activate => sub {
845 my ($input, $text) = @_; 875 my ($input, $text) = @_;
846 $input->set_text (''); 876 $input->set_text ('');
847 877
848 if ($text =~ /^\/(.*)/) { 878 if ($text =~ /^\/(.*)/) {
849 $::CONN->user_send ($1); 879 $::CONN->user_send ($1);
854 if ($input->{refocus_map}) { 884 if ($input->{refocus_map}) {
855 delete $input->{refocus_map}; 885 delete $input->{refocus_map};
856 $MAPWIDGET->focus_in 886 $MAPWIDGET->focus_in
857 } 887 }
858 }, 888 },
859 connect_escape => sub { 889 on_escape => sub {
860 $MAPWIDGET->focus_in 890 $MAPWIDGET->focus_in
861 }, 891 },
862 ); 892 );
863 893
864 $CONSOLE = { 894 $CONSOLE = {
865 window => $window, 895 window => $window,
866 input => $input 896 input => $input,
867 }; 897 };
868 898
869 $window 899 $window
870} 900}
871 901
872sub open_quit_dialog { 902sub open_quit_dialog {
873 unless ($QUIT_DIALOG) { 903 unless ($QUIT_DIALOG) {
874
875 $QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?"; 904 $QUIT_DIALOG = new CFClient::UI::FancyFrame
905 x => "center",
906 y => "center",
907 z => 50,
908 title => "Really Quit?",
909 ;
876 910
877 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1); 911 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
878 912
879 $vb->add (new CFClient::UI::Label 913 $vb->add (new CFClient::UI::Label
880 text => "You should find a savebed and apply it first!", 914 text => "You should find a savebed and apply it first!",
883 ); 917 );
884 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 918 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
885 $hb->add (new CFClient::UI::Button 919 $hb->add (new CFClient::UI::Button
886 text => "Ok", 920 text => "Ok",
887 expand => 1, 921 expand => 1,
888 connect_activate => sub { $QUIT_DIALOG->hide }, 922 on_activate => sub { $QUIT_DIALOG->hide },
889 ); 923 );
890 $hb->add (new CFClient::UI::Button 924 $hb->add (new CFClient::UI::Button
891 text => "Quit anyway", 925 text => "Quit anyway",
892 expand => 1, 926 expand => 1,
893 connect_activate => sub { exit }, 927 on_activate => sub { exit },
894 ); 928 );
929 }
895 930
896 $QUIT_DIALOG->show_centered; 931 $QUIT_DIALOG->show;
897 } else { 932}
898 $QUIT_DIALOG->show_centered; 933
934sub autopickup_setup {
935 my $table = new CFClient::UI::Table;
936
937 for (
938 ["General", 0, 0,
939 ["Enable autopickup" => CFClient::Pickup::PU_NEWMODE],
940 ["Inhibit autopickup" => CFClient::Pickup::PU_INHIBIT],
941 ["Stop before pickup" => CFClient::Pickup::PU_STOP],
942 ["Debug autopickup" => CFClient::Pickup::PU_DEBUG],
943 ],
944 ["Weapons", 0, 6,
945 ["All weapons" => CFClient::Pickup::PU_ALLWEAPON],
946 ["Missile weapons" => CFClient::Pickup::PU_MISSILEWEAPON],
947 ["Bows" => CFClient::Pickup::PU_BOW],
948 ["Arrows" => CFClient::Pickup::PU_ARROW],
949 ],
950 ["Armour", 0, 12,
951 ["Helmets" => CFClient::Pickup::PU_HELMET],
952 ["Shields" => CFClient::Pickup::PU_SHIELD],
953 ["Body Armour" => CFClient::Pickup::PU_ARMOUR],
954 ["Boots" => CFClient::Pickup::PU_BOOTS],
955 ["Gloves" => CFClient::Pickup::PU_GLOVES],
956 ["Cloaks" => CFClient::Pickup::PU_CLOAK],
957 ],
958
959 ["Readables", 2, 2,
960 ["Spellbooks" => CFClient::Pickup::PU_SPELLBOOK],
961 ["Skillscrolls" => CFClient::Pickup::PU_SKILLSCROLL],
962 ["Normal Books/Scrolls" => CFClient::Pickup::PU_READABLES],
963 ],
964 ["Misc", 2, 7,
965 ["Food" => CFClient::Pickup::PU_FOOD],
966 ["Drinks" => CFClient::Pickup::PU_DRINK],
967 ["Valuables (Money, Gems)" => CFClient::Pickup::PU_VALUABLES],
968 ["Keys" => CFClient::Pickup::PU_KEY],
969 ["Magical Items" => CFClient::Pickup::PU_MAGICAL],
970 ["Potions" => CFClient::Pickup::PU_POTION],
971 ["Magic Devices" => CFClient::Pickup::PU_MAGIC_DEVICE],
972 ["Ignore cursed" => CFClient::Pickup::PU_NOT_CURSED],
973 ["Jewelery" => CFClient::Pickup::PU_JEWELS],
974 ],
975 )
899 } 976 {
977 my ($title, $x, $y, @bits) = @$_;
978 $table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
979
980 for (@bits) {
981 ++$y;
982
983 my $mask = $_->[1];
984 $table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
985 $table->add ($x+1, $y, new CFClient::UI::CheckBox
986 state => $CFG->{pickup} & $mask,
987 on_changed => sub {
988 my ($box, $value) = @_;
989 if ($value) {
990 $::CFG->{pickup} |= $mask;
991 } else {
992 $::CFG->{pickup} = $::CFG->{pickup} & ~$mask;
993 }
994 $::CONN->send (sprintf "command pickup %u", $::CFG->{pickup})
995 if defined $::CONN;
996 });
997 }
998 }
999
1000 $table
900} 1001}
901 1002
902sub make_inventory_window { 1003sub make_inventory_window {
903 my $invwin = new CFClient::UI::FancyFrame 1004 my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
904 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory"; 1005 x => "center",
1006 y => "center",
1007 force_w => $WIDTH * 9/10,
1008 force_h => $HEIGHT * 9/10,
1009 title => "Inventory",
1010 ;
905 1011
906 $invwin->add (my $hb = new CFClient::UI::HBox expand => 1); 1012 $invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
907 1013
908 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1); 1014 $hb->add (my $vb1 = new CFClient::UI::VBox);
909 $vb1->add (my $lbl = new CFClient::UI::Label align => 0); 1015 $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
910 $lbl->set_text ("Player");
911 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1); 1016 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
912 1017
913 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1); 1018 $hb->add (my $vb2 = new CFClient::UI::VBox);
1019
1020 $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
1021
1022 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
1023
1024 # XXX: Call after $INVR = ... because set_opencont sets the items
1025 CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
1026
1027 $invwin
1028}
1029
1030sub spell_setup {
1031 new CFClient::UI::SpellList
1032}
1033
1034sub keyboard_setup {
1035 my $binding_list = new CFClient::UI::VBox;
1036
1037 my $refresh;
1038 $refresh = sub {
1039 $binding_list->clear ();
1040
1041 for my $mod (keys %{$::CFG->{bindings}}) {
1042 for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
1043 my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
1044 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1045
1046 my $lbl = join "; ", @$cmds;
1047 my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
1048 $binding_list->add (my $hb = new CFClient::UI::HBox);
1049 $hb->add (new CFClient::UI::Button
1050 text => "delete",
1051 tooltip => "Deletes the binding",
1052 on_activate => sub {
1053 $binding_list->remove ($hb);
1054 delete $::CFG->{bindings}->{$mod}->{$sym};
1055 });
1056
1057 $hb->add (new CFClient::UI::Button
1058 text => "edit",
1059 tooltip => "Edits the binding",
1060 on_activate => sub {
1061 $::BIND_EDITOR->set_binding (
1062 $mod, $sym, $::CFG->{bindings}->{$mod}->{$sym},
1063 sub {
1064 my ($nmod, $nsym, $ncmds) = @_;
1065 delete $::CFG->{bindings}->{$mod}->{$sym};
1066 $::CFG->{bindings}->{$nmod}->{$nsym} = $ncmds;
1067 $refresh->();
1068 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1069 $SETUP_DIALOG->show;
1070 },
1071 sub {
1072 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1073 $SETUP_DIALOG->show;
1074 });
1075 $::BIND_EDITOR->show;
1076 $SETUP_DIALOG->hide;
1077 });
1078
1079 $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
1080 $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
1081 }
1082 }
1083 };
1084
1085 my $vb = new CFClient::UI::VBox;
1086 $vb->add ($binding_list);
914 $vb2->add (my $hb2 = new CFClient::UI::HBox); 1087 $vb->add (my $hb = new CFClient::UI::HBox);
1088
915 $hb2->add (new CFClient::UI::Button 1089 $hb->add (new CFClient::UI::Button
916 text => "Close", 1090 text => "record new",
917 tooltip => "Close the currently open container (if one is open)", 1091 expand => 1,
1092 tooltip => "This button opens the binding editor with an empty binding.",
918 connect_activate => sub { 1093 on_activate => sub {
919 $CONN->send ("apply $CONN->{open_container}") 1094 $::BIND_EDITOR->set_binding (undef, undef, [],
920 if $CONN->{open_container} != 0; 1095 sub {
1096 my ($mod, $sym, $cmds) = @_;
1097 $::CFG->{bindings}->{$mod}->{$sym} = $cmds;
1098 $refresh->();
1099 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1100 $SETUP_DIALOG->show;
1101 },
1102 sub {
1103 $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1104 $SETUP_DIALOG->show;
1105 },
1106 );
1107 $SETUP_DIALOG->hide;
1108 $::BIND_EDITOR->show;
921 }, 1109 },
922 ); 1110 );
923 $hb2->add ($INVR_LBL = new CFClient::UI::Label align => 0);
924 1111
925 $INVR_LBL->set_text ("Floor"); 1112 $hb->add (new CFClient::UI::Button
926 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1); 1113 text => "close",
1114 tooltip => "Closes the binding window",
1115 expand => 1,
1116 on_activate => sub {
1117 $SETUP_DIALOG->hide;
1118 }
1119 );
927 1120
928 $invwin 1121 $refresh->();
1122
1123 $vb
929} 1124}
930 1125
931sub make_help_window { 1126sub make_help_window {
932 my $win = new CFClient::UI::FancyFrame 1127 my $win = new CFClient::UI::FancyFrame
933 user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation"; 1128 x => 'center',
1129 y => 'center',
1130 z => 2,
1131 name => 'doc_browser',
1132 force_w => int $WIDTH * 7/8,
1133 force_h => int $HEIGHT * 7/8,
1134 title => "Documentation";
934 1135
935 $win->add (my $vbox = new CFClient::UI::VBox); 1136 $win->add (my $vbox = new CFClient::UI::VBox);
936 1137
937 $vbox->add (my $buttons = new CFClient::UI::HBox); 1138 $vbox->add (my $buttons = new CFClient::UI::HBox);
938 $vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8); 1139 $vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
945 ) { 1146 ) {
946 my ($pod, $label) = @$_; 1147 my ($pod, $label) = @$_;
947 1148
948 $buttons->add (new CFClient::UI::Button 1149 $buttons->add (new CFClient::UI::Button
949 text => $label, 1150 text => $label,
950 connect_activate => sub { 1151 on_activate => sub {
951 my $parser = new Pod::POM;
952 my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod"); 1152 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod";
953 1153
954 $viewer->clear; 1154 $viewer->clear;
955 1155
956 $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0]) 1156 $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
957 for @{ CFClient::pod_to_pango_list $pom }; 1157 for @{ CFClient::pod_to_pango_list $pom };
999 if ($DEBUG_STATUS) { 1199 if ($DEBUG_STATUS) {
1000 CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h; 1200 CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1001 } else { 1201 } else {
1002 # create the widgets 1202 # create the widgets
1003 1203
1004 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1; 1204 $DEBUG_STATUS = new CFClient::UI::Label
1205 padding => 0,
1206 z => 100,
1207 force_x => "max",
1208 force_y => 0;
1005 $DEBUG_STATUS->show; 1209 $DEBUG_STATUS->show;
1006 1210
1211 $BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
1212
1007 $STATUSBOX = new CFClient::UI::Statusbox; 1213 $STATUSBOX = new CFClient::UI::Statusbox;
1008 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]); 1214 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1009 1215
1010 (new CFClient::UI::Frame 1216 (new CFClient::UI::Frame
1011 bg => [0, 0, 0, 0.4], 1217 bg => [0, 0, 0, 0.4],
1012 req_y => -1, 1218 force_x => 0,
1219 force_y => "max",
1013 child => $STATUSBOX, 1220 child => $STATUSBOX,
1014 )->show; 1221 )->show;
1015 1222
1016 CFClient::UI::FancyFrame->new ( 1223 CFClient::UI::FancyFrame->new (
1224 title => "Map",
1225 name => "mapmap",
1226 x => 0,
1227 y => $FONTSIZE + 8,
1017 border_bg => [1, 1, 1, 192/255], 1228 border_bg => [1, 1, 1, 192/255],
1018 bg => [1, 1, 1, 0], 1229 bg => [1, 1, 1, 0],
1019 child => ($MAPMAP = new CFClient::MapWidget::MapMap 1230 child => ($MAPMAP = new CFClient::MapWidget::MapMap
1020 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.", 1231 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1021 ), 1232 ),
1044 can_hover => 1, 1255 can_hover => 1,
1045 can_events => 1, 1256 can_events => 1,
1046 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.", 1257 tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1047 ; 1258 ;
1048 1259
1260 $SETUP_DIALOG = new CFClient::UI::FancyFrame
1261 title => "Setup",
1262 name => "setup_dialog",
1263 x => 'center',
1264 y => 'center',
1265 z => 2,
1266 force_w => $::WIDTH * 0.6,
1267 force_h => $::HEIGHT * 0.6,
1268 ;
1269
1270 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
1271 filter => new CFClient::UI::ScrolledWindow xxx => 1, expand => 1, scroll_y => 1);
1272
1273 $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1274 "Configure the server to play on, your username, password and other server-related options.");
1275 $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
1276 "Configure autopicking stetings, i.e. which items you will pick up automatically when walking over them.");
1277 $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1278 "Configure the video mode, performance, fonts and other graphical aspects of the game.");
1279 $SETUP_NOTEBOOK->add (Audio => audio_setup,
1280 "Configure the use of audio, sound effects and background music.");
1281 $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
1282 "Lets you define, edit and delete bindings."
1283 . "There is a shortcut for making bindings: <b>Left Control + Insert</b> opens the binding editor "
1284 . "with nothing set and the recording started. After doing the actions you "
1285 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
1286 . "After pressing the combo the binding will be saved automatically and the "
1287 . "binding editor closes");
1288 $SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
1289 "Displays all spells you have and lets you edit keyboard shortcuts for them.");
1290
1049 $BUTTONBAR = new CFClient::UI::HBox; 1291 $BUTTONBAR = new CFClient::UI::HBox x => 0, y => 0;
1050 1292
1051 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup, 1293 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1052 tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options."); 1294 tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1053 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup, 1295
1054 tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
1055 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window, 1296 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
1056 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server."); 1297 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1057 1298
1058 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 1299 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
1059 1300
1060 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window, 1301 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
1061 tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times."); 1302 tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
1062 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window, 1303 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
1063 tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :)."); 1304 tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
1305 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory.");
1064 1306
1065 $BUTTONBAR->add (new CFClient::UI::Button 1307 $BUTTONBAR->add (new CFClient::UI::Button
1066 text => "Save Config", 1308 text => "Save Config",
1067 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.", 1309 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1068 connect_activate => sub { 1310 on_activate => sub {
1311 $::CFG->{layout} = CFClient::UI::get_layout;
1069 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 1312 CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1070 status "Configuration Saved"; 1313 status "Configuration Saved";
1071 }, 1314 },
1072 ); 1315 );
1073 1316
1074 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window, 1317 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1075 tooltip => "View Documentation"); 1318 tooltip => "View Documentation");
1076 1319
1077 $BUTTONBAR->add (new CFClient::UI::Button 1320 $BUTTONBAR->add (new CFClient::UI::Button
1078 text => "Quit", 1321 text => "Quit",
1079 tooltip => "Terminates the program", 1322 tooltip => "Terminates the program",
1080 connect_activate => sub { 1323 on_activate => sub {
1081 if ($CONN) { 1324 if ($CONN) {
1082 open_quit_dialog; 1325 open_quit_dialog;
1083 } else { 1326 } else {
1084 exit; 1327 exit;
1085 } 1328 }
1086 }, 1329 },
1087 ); 1330 );
1088 1331
1089 $BUTTONBAR->show; 1332 $BUTTONBAR->show;
1333 $SETUP_DIALOG->show;
1334 }
1090 1335
1091 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); 1336 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1092
1093 # delay till geometry is constant
1094 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
1095 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
1096 my $widget = $GAUGES->{win};
1097 $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
1098 });
1099 force_refresh ();
1100 }
1101} 1337}
1102 1338
1103sub video_shutdown { 1339sub video_shutdown {
1104 undef $SDL_ACTIVE; 1340 undef $SDL_ACTIVE;
1105} 1341}
1172 1408
1173my %demo;#d# 1409my %demo;#d#
1174 1410
1175sub force_refresh { 1411sub force_refresh {
1176 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05; 1412 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1177 debug sprintf "%3.2f", $fps; 1413 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1178 1414
1179 $CFClient::UI::ROOT->draw; 1415 $CFClient::UI::ROOT->draw;
1180 1416
1181 $WANT_REFRESH = 0; 1417 $WANT_REFRESH = 0;
1182 $CAN_REFRESH = 0; 1418 $CAN_REFRESH = 0;
1237}; 1473};
1238 1474
1239 CFClient::SDL_GL_SwapBuffers; 1475 CFClient::SDL_GL_SwapBuffers;
1240} 1476}
1241 1477
1242my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { 1478my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1243 $NOW = time; 1479 $NOW = time;
1244 1480
1245 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 1481 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1246 for CFClient::SDL_PollEvent; 1482 for CFClient::SDL_PollEvent;
1247 1483
1314############################################################################# 1550#############################################################################
1315 1551
1316$SIG{INT} = $SIG{TERM} = sub { exit }; 1552$SIG{INT} = $SIG{TERM} = sub { exit };
1317 1553
1318{ 1554{
1319 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] }; 1555 local $SIG{__DIE__} = sub {
1556 return unless defined $^S && !$^S;
1557 Carp::confess $_[1];#d#TODO: remove when stable
1558 CFClient::fatal $_[0];
1559 };
1320 1560
1321 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 1561 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1562 CFClient::UI::set_layout ($::CFG->{layout});
1322 1563
1323 my %DEF_CFG = ( 1564 my %DEF_CFG = (
1324 sdl_mode => 0, 1565 sdl_mode => 0,
1325 width => 640, 1566 width => 640,
1326 height => 480, 1567 height => 480,
1403 1644
1404END { CFClient::SDL_Quit } 1645END { CFClient::SDL_Quit }
1405 1646
1406=head1 NAME 1647=head1 NAME
1407 1648
1408pclient - A Crossfire+ and Crossfire game client 1649cfplus - A Crossfire+ and Crossfire game client
1409 1650
1410=head1 SYNOPSIS 1651=head1 SYNOPSIS
1411 1652
1412Just run it - no commandline arguments are supported. 1653Just run it - no commandline arguments are supported.
1413 1654
1414=head1 USAGE 1655=head1 USAGE
1415 1656
1416Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used 1657cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1417fullscreen and interactively. 1658fullscreen and interactively.
1418 1659
1660=head1 DEBUGGING
1661
1662
1663CFPLUS_DEBUG - environment variable
1664
1665 1 draw borders around widgets
1666 2 add low-level widget info to tooltips
1667 4 show fps
1668 8 suppress tooltips
1669
1419=head1 AUTHOR 1670=head1 AUTHOR
1420 1671
1421Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org> 1672Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1422 1673
1423 1674

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines