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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.113 by root, Sat Apr 15 19:35:22 2006 UTC vs.
Revision 1.118 by elmex, Sun Apr 16 17:43:17 2006 UTC

… …
13use SDL::OpenGL; 13use SDL::OpenGL;
14 14
15use Crossfire; 15use Crossfire;
16use Crossfire::Protocol; 16use Crossfire::Protocol;
17 17
18use Compress::LZF;
19
18use CFClient; 20use CFClient;
19use CFClient::UI; 21use CFClient::UI;
20 22
21our $VERSION = '0.1'; 23our $VERSION = '0.1';
22 24
23my $MAX_FPS = 60; 25my $MAX_FPS = 60;
24my $MIN_FPS = 5; # unused as of yet 26my $MIN_FPS = 5; # unused as of yet
25 27
26our $META_SERVER = "crossfire.real-time.com:13326"; 28our $META_SERVER = "crossfire.real-time.com:13326";
27 29
30our $FACEMAP;
31our $TILECACHE;
28our $FACECACHE; 32our $MAPCACHE;
29 33
30our $LAST_REFRESH; 34our $LAST_REFRESH;
31our $NOW; 35our $NOW;
32 36
33our $CFG; 37our $CFG;
… …
69 73
70sub start_game { 74sub start_game {
71 status "logging in..."; 75 status "logging in...";
72 76
73 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 77 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
78
79 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
74 80
75 $MAP = new CFClient::Map $mapsize, $mapsize; 81 $MAP = new CFClient::Map $mapsize, $mapsize;
76 82
77 my ($host, $port) = split /:/, $CFG->{host}; 83 my ($host, $port) = split /:/, $CFG->{host};
78 84
… …
166 172
167 $dialog 173 $dialog
168} 174}
169 175
170sub update_metaserver { 176sub update_metaserver {
177 my ($HOST) = @_;
178
171 status "fetching metaserver list..."; 179 status "fetching metaserver list...";
172 180
173 my $buf; 181 my $buf;
174 182
175 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 183 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
… …
186 194
187 my $table = $METASERVER->{table}; 195 my $table = $METASERVER->{table};
188 196
189 $table->clear; 197 $table->clear;
190 198
191 my @col = qw(#Users Host Uptime Version Description); 199 my @col = qw(Use #Users Host Uptime Version Description);
192 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_]) 200 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
193 for 0 .. $#col; 201 for 0 .. $#col;
194 202
195 my @align = qw(1 0 1 1 -1); 203 my @align = qw(1 0 1 1 -1);
196 204
197 my $y = 0; 205 my $y = 0;
198 for my $m (map [split /\|/], split /\015?\012/, $buf) { 206 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
199 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; 207 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
200 208
201 for ($desc) { 209 for ($desc) {
202 s/<br>/\n/gi; 210 s/<br>/\n/gi;
203 s/<li>/\n· /gi; 211 s/<li>/\n· /gi;
… …
214 $m->[8] % 60; 222 $m->[8] % 60;
215 223
216 $m = [$users, $host, $uptime, $version, $desc]; 224 $m = [$users, $host, $uptime, $version, $desc];
217 225
218 $y++; 226 $y++;
227
228 $table->add (0, $y, new CFClient::UI::VBox children => [
229 (new CFClient::UI::Button text => " ", connect_activate => sub {
230 $HOST->set_text ($CFG->{host} = $host);
231 }),
232 (new CFClient::UI::Empty expand => 1),
233 ]);
234
219 $table->add ($_, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => $FONTSIZE * 0.8) 235 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => $FONTSIZE * 0.8)
220 for 0 .. $#$m; 236 for 0 .. $#$m;
221 } 237 }
222 } 238 }
223 }); 239 });
224} 240}
… …
232 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host:Port"); 248 $table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host:Port");
233 249
234 { 250 {
235 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 251 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
236 252
237 $vbox->add (new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub { 253 $vbox->add (my $HOST = new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub {
238 my ($self, $value) = @_; 254 my ($self, $value) = @_;
239 $CFG->{host} = $value; 255 $CFG->{host} = $value;
240 }); 256 });
241 257
242 $METASERVER = metaserver_dialog; 258 $METASERVER = metaserver_dialog;
243 259
244 $vbox->add (new CFClient::UI::Flopper text => "Metaserver", other => $METASERVER, connect_open => sub { 260 $vbox->add (new CFClient::UI::Flopper text => "Metaserver", other => $METASERVER, connect_open => sub {
245 update_metaserver; 261 update_metaserver $HOST;
246 }); 262 });
247 } 263 }
248 264
249 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username"); 265 $table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username");
250 $table->add (1, 4, my $user = new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub { 266 $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
251 my ($self, $value) = @_; 267 my ($self, $value) = @_;
252 $CFG->{user} = $value; 268 $CFG->{user} = $value;
253 }); 269 });
254 270
255 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password"); 271 $table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
256 $table->add (1, 5, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub { 272 $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
257 my ($self, $value) = @_; 273 my ($self, $value) = @_;
258 $CFG->{password} = $value; 274 $CFG->{password} = $value;
259 }); 275 });
260 276
261 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd"); 277 $table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd");
… …
293 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 309 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
294 expand => 1, 310 expand => 1,
295 fontsize => $::CFG->{log_fontsize}, 311 fontsize => $::CFG->{log_fontsize},
296 ); 312 );
297 313
298 $vbox->add (my $input = new CFClient::UI::LineEntry); 314 $vbox->add (my $input = new CFClient::UI::LineEntry
315 connect_focus_in => sub {
316 my ($input, $prev_focus) = @_;
317
318 delete $input->{refocus_map};
319
320 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
321 $input->{refocus_map} = 1;
322 }
323 delete $input->{auto_activated};
324 },
299 $input->connect (activate => sub { 325 connect_activate => sub {
300 my ($input, $text) = @_; 326 my ($input, $text) = @_;
301 $input->set_text (''); 327 $input->set_text ('');
302 328
303 if ($text =~ /^\/(.*)/) { 329 if ($text =~ /^\/(.*)/) {
304 $::CONN->user_send ("command $1"); 330 $::CONN->user_send ("command $1");
305 } else { 331 } else {
306 my $say_cmd = $::CFG->{say_command} || 'say'; 332 my $say_cmd = $::CFG->{say_command} || 'say';
307 $::CONN->user_send ("command $say_cmd $text"); 333 $::CONN->user_send ("command $say_cmd $text");
308 } 334 }
335 if ($input->{refocus_map}) {
336 delete $input->{refocus_map};
337 $MAPWIDGET->focus_in
309 1 338 }
310 }); 339 },
311 $input->connect (escape => sub { 340 connect_escape => sub {
312 $MAPWIDGET->focus_in 341 $MAPWIDGET->focus_in
313 }); 342 },
314 $input->focus_in; 343 );
315 344
316 $CONSOLE = { 345 $CONSOLE = {
317 window => $window, 346 window => $window,
318 input => $input 347 input => $input
319 }; 348 };
… …
335 $FAST = $CFG->{fast}; 364 $FAST = $CFG->{fast};
336 365
337 SDL::GLSetAttribute SDL_GL_RED_SIZE, 5; 366 SDL::GLSetAttribute SDL_GL_RED_SIZE, 5;
338 SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5; 367 SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;
339 SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5; 368 SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
340 SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 0; 369 SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 1;
341 370
342 SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0; 371 SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
343 SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0; 372 SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
344 SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0; 373 SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
345 SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0; 374 SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
… …
387 $MAPWIDGET->focus_in; 416 $MAPWIDGET->focus_in;
388 $MAPWIDGET->connect (activate_console => sub { 417 $MAPWIDGET->connect (activate_console => sub {
389 my ($mapwidget, $preset) = @_; 418 my ($mapwidget, $preset) = @_;
390 419
391 if ($CONSOLE) { 420 if ($CONSOLE) {
421 $CONSOLE->{input}->{auto_activated} = 1;
392 $CONSOLE->{input}->focus_in; 422 $CONSOLE->{input}->focus_in;
393 423
394 if ($preset && $CONSOLE->{input}->get_text eq '') { 424 if ($preset && $CONSOLE->{input}->get_text eq '') {
395 $CONSOLE->{input}->set_text ($preset); 425 $CONSOLE->{input}->set_text ($preset);
396 } 426 }
… …
489 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y}); 519 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y});
490 $MAP->map1a_update ($data); 520 $MAP->map1a_update ($data);
491 $MAPWIDGET->update; 521 $MAPWIDGET->update;
492} 522}
493 523
494#sub conn::map_update { 524sub conn::flush_map {
495# my ($self, $dirty) = @_; 525 my ($self) = @_;
496# 526
497# $MAPWIDGET->update; 527 my $map_info = delete $self->{map_info}
498#} 528 or return;
529
530 my ($hash, $x, $y, $w, $h) = @$map_info;
531
532 my $data = $MAP->get_rect ($x, $y, $w, $h);
533 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
534
535 warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
536
537}
499 538
500sub conn::map_clear { 539sub conn::map_clear {
501 my ($self) = @_; 540 my ($self) = @_;
502 541
542 $self->flush_map;
543
503 $MAP->clear; 544 $MAP->clear;
545}
504 546
505# refresh; 547sub conn::map_info {
548 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
549
550 $self->flush_map;
551
552 $x = $::MAP->ox - $x;
553 $y = $::MAP->oy - $y;
554
555 $self->{map_info} = [$hash, $x, $y, $w, $h];
556
557 if (defined (my $data = $MAPCACHE->get ($hash))) {
558 $data = Compress::LZF::decompress $data;
559 warn sprintf "LOADmap[%s] length %d\n", $hash, length $data;#d#
560 for my $id ($MAP->set_rect ($x, $y, $data)) {
561 my $data = $TILECACHE->get ($id)
562 or next;
563
564 $self->set_texture ($id => $data);
565 }
566 }
506} 567}
507 568
508sub conn::face_find { 569sub conn::face_find {
509 my ($self, $face) = @_; 570 my ($self, $facenum, $face) = @_;
510 571
511 $FACECACHE->{"$face->{chksum},$face->{name}"} 572 my $hash = "$face->{chksum},$face->{name}";
573
574 my $id = $FACEMAP->get ($hash);
575
576 unless ($id) {
577 # create new id for face
578 # i love transactions
579 for (1..100) {
580 my $txn = $CFClient::DB_ENV->txn_begin;
581 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
582 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
583 $id++;
584 if ($FACEMAP->put (id => $id) == 0
585 && $FACEMAP->put ($hash => $id) == 0) {
586 $txn->txn_commit;
587
588 goto gotid;
589 }
590 }
591 $txn->abort;
592 }
593
594 CFClient::fatal "maximum number of transaction retries reached - database problems?";
595 }
596
597gotid:
598 $face->{id} = $id;
599 $MAP->set_face ($facenum => $id);
600 $TILECACHE->get ($id)
512} 601}
513 602
514sub conn::face_update { 603sub conn::face_update {
515 my ($self, $facenum, $face) = @_; 604 my ($self, $facenum, $face) = @_;
516 605
517 $FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image}; 606 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
518 607
519 my $tex = $face->{texture} = 608 $self->set_texture ($face->{id} => delete $face->{image});
609}
610
611sub conn::set_texture {
612 my ($self, $id, $data) = @_;
613
614 $self->{texture}[$id] ||= do {
615 my $tex =
520 new_from_image CFClient::Texture 616 new_from_image CFClient::Texture
521 delete $face->{image}, minify => 1; 617 $data, minify => 1;
522 618
523 $MAP->set_texture ($facenum, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 619 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
524 $MAPWIDGET->update; 620 $MAPWIDGET->update;
621
622 $tex
623 };
525} 624}
526 625
527sub conn::query { 626sub conn::query {
528 my ($self, $flags, $prompt) = @_; 627 my ($self, $flags, $prompt) = @_;
529 628
… …
535 my ($self, $color, $text) = @_; 634 my ($self, $color, $text) = @_;
536 635
537 my @color = ( 636 my @color = (
538 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00], 637 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
539 [1.00, 1.00, 1.00], 638 [1.00, 1.00, 1.00],
540 [0.00, 0.00, 0.55], 639 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
541 [1.00, 0.00, 0.00], 640 [1.00, 0.00, 0.00],
542 [1.00, 0.54, 0.00], 641 [1.00, 0.54, 0.00],
543 [0.11, 0.56, 1.00], 642 [0.11, 0.56, 1.00],
544 [0.93, 0.46, 0.00], 643 [0.93, 0.46, 0.00],
545 [0.18, 0.54, 0.34], 644 [0.18, 0.54, 0.34],
… …
588# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 687# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
589 }, 688 },
590); 689);
591 690
592############################################################################# 691#############################################################################
692
693$TILECACHE = CFClient::db_table "tilecache";
694$FACEMAP = CFClient::db_table "facemap";
593 695
594CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 696CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
595 697
596my %DEF_CFG = ( 698my %DEF_CFG = (
597 sdl_mode => 0, 699 sdl_mode => 0,
… …
630 732
631 CFClient::add_font $_ for @fonts; 733 CFClient::add_font $_ for @fonts;
632 CFClient::set_font $fonts[0]; 734 CFClient::set_font $fonts[0];
633} 735}
634 736
635$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};
636
637Event::loop; 737Event::loop;
638 738
639Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";
640 739

Diff Legend

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