ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
Revision: 1.104
Committed: Fri Apr 14 14:55:28 2006 UTC (18 years, 1 month ago) by root
Branch: MAIN
Changes since 1.103: +2 -3 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/bin/perl
2
3 use strict;
4 use utf8;
5
6 use Time::HiRes 'time';
7 use Event;
8
9 use SDL;
10 use SDL::App;
11 use SDL::Event;
12 use SDL::Surface;
13 use SDL::OpenGL;
14
15 use Crossfire;
16 use Crossfire::Protocol;
17
18 use CFClient;
19 use CFClient::UI;
20
21 our $VERSION = '0.1';
22
23 my $MAX_FPS = 60;
24 my $MIN_FPS = 5; # unused as of yet
25
26 our $FACECACHE;
27
28 our $LAST_REFRESH;
29 our $NOW;
30
31 our $CFG;
32 our $CONN;
33 our $FAST; # fast, low-quality mode, possibly useful for software-rendering
34
35 our @SDL_MODES;
36 our $WIDTH;
37 our $HEIGHT;
38 our $FULLSCREEN;
39 our $FONTSIZE;
40
41 our $MAP;
42 our $MAPWIDGET;
43
44 our $SDL_ACTIVE;
45 our $SDL_EV;
46 our %SDL_CB;
47
48 our $ALT_ENTER_MESSAGE;
49 our $STATUS_LINE;
50 our $DEBUG_STATUS;
51 our $BUTTONBAR;
52 our $LOGVIEW;
53 our $CONSOLE;
54
55 sub status {
56 $STATUS_LINE->set_text ($_[0]);
57 my ($w, $h) = $STATUS_LINE->size_request;
58 $STATUS_LINE->size_allocate (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $h, $w, $h);
59 }
60
61 sub debug {
62 $DEBUG_STATUS->set_text ($_[0]);
63 my ($w, $h) = $DEBUG_STATUS->size_request;
64 $DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);
65 }
66
67 sub start_game {
68 status "logging in...";
69
70 my $mapsize = List::Util::min 64, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
71
72 $MAP = new CFClient::Map $mapsize, $mapsize;
73
74 $CONN = new conn
75 host => $CFG->{host},
76 port => $CFG->{port},
77 user => $CFG->{user},
78 pass => $CFG->{password},
79 mapw => $mapsize,
80 maph => $mapsize,
81 ;
82
83 status "login successful";
84
85 CFClient::lowdelay fileno $CONN->{fh};
86 }
87
88 sub stop_game {
89 undef $CONN;
90 }
91
92 sub config_dialog {
93 my $dialog = new CFClient::UI::FancyFrame
94 child => (my $vbox = new CFClient::UI::VBox);
95 $vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
96 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
97
98 $table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode");
99 $table->add (1, 0, my $hbox = new CFClient::UI::HBox);
100
101 $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
102 $hbox->add (my $mode_label = new CFClient::UI::Label height => $FONTSIZE * 0.8);
103
104 $mode_slider->connect (changed => sub {
105 my ($self, $value) = @_;
106
107 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
108 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
109 });
110 $mode_slider->emit (changed => $mode_slider->{range}[0]);
111
112 $table->add (0, 1, new CFClient::UI::Label align => 1, text => "Fullscreen");
113 $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {
114 my ($self, $value) = @_;
115 $CFG->{fullscreen} = $value;
116 });
117
118 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Fast & Ugly");
119 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub {
120 my ($self, $value) = @_;
121 $CFG->{fast} = $value;
122 });
123
124 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Fog of War");
125 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub {
126 my ($self, $value) = @_;
127 $CFG->{fow_enable} = $value;
128 });
129
130 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "FoW Intensity");
131 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub {
132 my ($self, $value) = @_;
133 $CFG->{fow_intensity} = $value;
134 });
135
136 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "FoW Smooth");
137 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub {
138 my ($self, $value) = @_;
139 $CFG->{fow_smooth} = $value;
140 });
141
142 $table->add (1, 6, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
143 destroy_screen ();
144 init_screen ();
145 });
146
147 $vbox->add (new CFClient::UI::Label align => 0, text => "Server Setup");
148 $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
149 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host");
150 $table->add (1, 2, my $host = new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub {
151 my ($self, $value) = @_;
152 $CFG->{host} = $value;
153 });
154
155 $table->add (0, 3, new CFClient::UI::Label align => 1, text => "Port");
156 $table->add (1, 3, my $port = new CFClient::UI::Entry text => $CFG->{port}, connect_changed => sub {
157 my ($self, $value) = @_;
158 $CFG->{port} = $value;
159 });
160
161 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username");
162 $table->add (1, 4, my $user = new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
163 my ($self, $value) = @_;
164 $CFG->{user} = $value;
165 });
166
167 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
168 $table->add (1, 5, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
169 my ($self, $value) = @_;
170 $CFG->{password} = $value;
171 });
172
173 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd");
174 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
175 my ($self, $value) = @_;
176 $CFG->{say_command} = $value;
177 });
178
179 $table->add (0, 7, new CFClient::UI::Label align => 1, text => "Map Size");
180 $table->add (1, 7, new CFClient::UI::Slider
181 req_w => 100,
182 range => [$CFG->{mapsize}, 10, 100 + 1, 1],
183 connect_changed => sub {
184 my ($self, $value) = @_;
185
186 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
187 },
188 );
189
190 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
191 start_game;
192 });
193
194 $vbox->add (my $hbox = new CFClient::UI::HBox);
195
196 $hbox->add (new CFClient::UI::Button expand => 1, align => 0, text => "Save", connect_activate => sub {
197 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
198 status "Configuration Saved";
199 });
200
201 $dialog
202 }
203
204 sub console_window {
205 my $window = new CFClient::UI::FancyFrame
206 border_bg => [1, 1, 1, 0.5],
207 bg => [0.3, 0.3, 0.3, 0.8],
208 child => (my $vbox = new CFClient::UI::VBox);
209
210 $vbox->add ($LOGVIEW = new CFClient::UI::TextView expand => 1);
211 $vbox->add (my $input = new CFClient::UI::LineEntry);
212 $input->connect (activate => sub {
213 my ($input, $text) = @_;
214 $input->set_text ('');
215
216 if ($text =~ /^\/(.*)/) {
217 $::CONN->user_send ("command $1");
218 } else {
219 my $say_cmd = $::CFG->{say_command} || 'say';
220 $::CONN->user_send ("command $say_cmd $text");
221 }
222 1
223 });
224 $input->connect (escape => sub {
225 $MAPWIDGET->focus_in
226 });
227 $input->focus_in;
228
229 $CONSOLE = {
230 window => $window,
231 input => $input
232 };
233
234 $window
235 }
236
237 sub sdl_init {
238 SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO
239 and die "SDL::Init failed!\n";
240 }
241
242 sub init_screen {
243 sdl_init;
244
245 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
246 $FULLSCREEN = $CFG->{fullscreen};
247 $FAST = $CFG->{fast};
248
249 SDL::GLSetAttribute SDL_GL_RED_SIZE, 5;
250 SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;
251 SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
252 SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 0;
253
254 SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
255 SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
256 SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
257 SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
258
259 SDL::GLSetAttribute SDL_GL_DOUBLEBUFFER, 1;
260 SDL::GLSetAttribute SDL_GL_BUFFER_SIZE, 15;
261 SDL::GLSetAttribute SDL_GL_DEPTH_SIZE, 0;
262
263 SDL::SetVideoMode $WIDTH, $HEIGHT, 0,
264 SDL_HWSURFACE | SDL_ANYFORMAT | SDL_OPENGL | SDL_DOUBLEBUF
265 | ($FULLSCREEN ? SDL_FULLSCREEN : 0)
266 or die "SDL::SetVideoMode failed!\n";
267
268 SDL::WMSetCaption "Crossfire+ Client", "Crossfire+";
269
270 $SDL_EV = new SDL::Event;
271 $SDL_EV->set_unicode (1);
272
273 $SDL_ACTIVE = 1;
274
275 $LAST_REFRESH = time - 0.01;
276
277 CFClient::gl_init;
278
279 $FONTSIZE = int $HEIGHT / 40;
280
281 #############################################################################
282
283 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
284 $CFClient::UI::TOPLEVEL->add ($DEBUG_STATUS);
285
286 $STATUS_LINE = new CFClient::UI::Label
287 padding => 0,
288 y => $HEIGHT * 44 / 45 - $FONTSIZE;
289 $CFClient::UI::TOPLEVEL->add ($STATUS_LINE);
290
291 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
292 padding => 0,
293 y => $HEIGHT * 44 / 45,
294 height => $HEIGHT / 45,
295 text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
296 $CFClient::UI::TOPLEVEL->add ($ALT_ENTER_MESSAGE);
297
298 $CFClient::UI::TOPLEVEL->add ($MAPWIDGET = new CFClient::UI::MapWidget);
299 $MAPWIDGET->focus_in;
300 $MAPWIDGET->connect (activate_console => sub {
301 my ($mapwidget, $preset) = @_;
302
303 if ($CONSOLE) {
304 $CONSOLE->{input}->focus_in;
305
306 if ($preset && $CONSOLE->{input}->get_text eq '') {
307 $CONSOLE->{input}->set_text ($preset);
308 }
309 }
310 });
311
312 $CFClient::UI::TOPLEVEL->add ($BUTTONBAR = new CFClient::UI::HBox);
313
314 $BUTTONBAR->add (my $setup = new CFClient::UI::Flopper x => 0, y => 0, text => "Setup", other => config_dialog, state => 1);
315 $BUTTONBAR->add (my $setup = new CFClient::UI::Flopper x => 0, y => 0, text => "Console", other => console_window);
316 }
317
318 sub destroy_screen {
319 $CFClient::UI::TOPLEVEL->{children} = [];
320 undef $SDL_ACTIVE;
321 undef $SDL_EV;
322 SDL::Quit;
323 }
324
325 my %animate_object;
326 my $animate_timer;
327
328 my $want_refresh;
329 my $can_refresh;
330
331 my $fps = 9;
332
333 sub force_refresh {
334 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
335 debug sprintf "%3.2f", $fps;
336
337 $want_refresh = 0;
338 $can_refresh = 0;
339
340 glViewport 0, 0, $WIDTH, $HEIGHT;
341 glClearColor +($CFG->{fow_intensity}) x 3, 1;
342 glClear GL_COLOR_BUFFER_BIT;
343
344 glMatrixMode GL_PROJECTION;
345 glLoadIdentity;
346 glOrtho 0, $WIDTH, $HEIGHT, 0, -10000 , 10000;
347 glMatrixMode GL_MODELVIEW;
348 glLoadIdentity;
349
350 $CFClient::UI::TOPLEVEL->draw;
351
352 SDL::GLSwapBuffers;
353
354 $LAST_REFRESH = $NOW;
355 }
356
357 my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
358 $NOW = time;
359
360 ($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()
361 while $SDL_EV->poll;
362
363 if (%animate_object) {
364 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
365 $want_refresh++;
366 }
367
368 if ($want_refresh) {
369 force_refresh;
370 } else {
371 $can_refresh = 1;
372 }
373 });
374
375 sub refresh {
376 $want_refresh++;
377 }
378
379 sub animation_start {
380 my ($widget) = @_;
381 $animate_object{$widget} = $widget;
382 }
383
384 sub animation_stop {
385 my ($widget) = @_;
386 delete $animate_object{$widget};
387 }
388
389 @conn::ISA = Crossfire::Protocol::;
390
391 sub conn::user_send {
392 my ($self, $command) = @_;
393
394 $self->send ($command);
395 status $command;
396 }
397
398 sub conn::feed_map1a {
399 my ($self, $data) = @_;
400
401 # $self->Crossfire::Protocol::feed_map1a ($data);
402
403 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y});
404 $MAP->map1a_update ($data);
405 $MAPWIDGET->update;
406 }
407
408 #sub conn::map_update {
409 # my ($self, $dirty) = @_;
410 #
411 # $MAPWIDGET->update;
412 #}
413
414 sub conn::map_clear {
415 my ($self) = @_;
416
417 $MAP->clear;
418
419 # refresh;
420 }
421
422 sub conn::face_find {
423 my ($self, $face) = @_;
424
425 $FACECACHE->{"$face->{chksum},$face->{name}"}
426 }
427
428 sub conn::face_update {
429 my ($self, $facenum, $face) = @_;
430
431 $FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image};
432
433 my $tex = $face->{texture} = new_from_image CFClient::Texture delete $face->{image};
434
435 $MAP->set_texture ($facenum, @$tex{qw(name w h s t)});
436 $MAPWIDGET->update;
437 }
438
439 sub conn::query {
440 my ($self, $flags, $prompt) = @_;
441
442 #TODO
443 warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
444 }
445
446 sub conn::drawinfo {
447 my ($self, $color, $text) = @_;
448
449 my @color = (
450 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
451 [1.00, 1.00, 1.00],
452 [0.00, 0.00, 0.55],
453 [1.00, 0.00, 0.00],
454 [1.00, 0.54, 0.00],
455 [0.11, 0.56, 1.00],
456 [0.93, 0.46, 0.00],
457 [0.18, 0.54, 0.34],
458 [0.56, 0.73, 0.56],
459 [0.80, 0.80, 0.80],
460 [0.55, 0.41, 0.13],
461 [0.99, 0.77, 0.26],
462 [0.74, 0.65, 0.41],
463 );
464
465 $LOGVIEW->add_paragraph ($color[$color], $text);
466 }
467
468 %SDL_CB = (
469 SDL_QUIT() => sub {
470 Event::unloop -1;
471 },
472 SDL_VIDEORESIZE() => sub {
473 },
474 SDL_VIDEOEXPOSE() => sub {
475 refresh;
476 },
477 SDL_KEYDOWN() => sub {
478 if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
479 # alt-enter
480 destroy_screen;
481 $CFG->{fullscreen} = !$CFG->{fullscreen};
482 init_screen;
483 } else {
484 CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
485 }
486 },
487 SDL_KEYUP() => sub {
488 CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
489 },
490 SDL_MOUSEMOTION() => sub {
491 CFClient::UI::feed_sdl_motion_event ($SDL_EV);
492 },
493 SDL_MOUSEBUTTONDOWN() => sub {
494 CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
495 },
496 SDL_MOUSEBUTTONUP() => sub {
497 CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
498 },
499 SDL_ACTIVEEVENT() => sub {
500 # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
501 },
502 );
503
504 #############################################################################
505
506 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
507
508 my %DEF_CFG = (
509 width => 640,
510 height => 480,
511 fast => 0,
512 fow_enable => 1,
513 fow_intensity => 0.45,
514 fow_smooth => 0,
515 fullscreen => 0,
516 sdl_mode => 0,
517 mapsize => 100,
518 host => "crossfire.schmorp.de",
519 port => 13327,
520 say_command => 'say',
521 );
522
523 while (my ($k, $v) = each %DEF_CFG) {
524 $CFG->{$k} = $v unless exists $CFG->{$k};
525 }
526
527 sdl_init;
528
529 @SDL_MODES = reverse
530 grep $_->[0] >= 640 && $_->[1] >= 480,
531 map [SDL::RectW ($_), SDL::RectH ($_)],
532 @{ SDL::ListModes 0, SDL_FULLSCREEN | SDL_HWSURFACE | SDL_OPENGL };
533
534 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
535
536 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
537
538 init_screen;
539
540 {
541 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);
542
543 CFClient::add_font $_ for @fonts;
544 CFClient::set_font $fonts[0];
545 }
546
547 $FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};
548
549 Event::loop;
550
551 Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";
552