ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/bin/kgsueme
(Generate patch)

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.13 by pcg, Fri May 30 03:31:10 2003 UTC vs.
Revision 1.25 by pcg, Fri May 30 15:50:20 2003 UTC

1#!/usr/bin/perl -I../lib/ 1#!/usr/bin/perl
2
3#use PApp::Util qw(dumpval); # debug only
4 2
5use Gtk; 3use Gtk;
6use Gtk::Gdk; 4use Gtk::Gdk;
7use Gtk::Gdk::Pixbuf; 5use Gtk::Gdk::Pixbuf;
8#use Gtk::Gdk::ImlibImage; 6#use Gtk::Gdk::ImlibImage;
9 7
10use KGS::Protocol; 8use KGS::Protocol;
11use KGS::Listener::Debug; 9use KGS::Listener::Debug;
12 10
11use Audio::Data;
12use Audio::Play;
13
13use IO::Socket::INET; 14use IO::Socket::INET;
14 15use List::Util;
15use Errno; 16use Errno;
16 17
17init Gtk; 18init Gtk;
18 19
19$HACK = 1; # do NEVER enable. ;) 20$HACK = 1; # do NEVER enable. ;)
20 21
22if ($HACK) {
23 $KGS::debug = 1;
24}
25
21our $config; 26our $config;
27our $LIBDIR = ".";
22our $IMGDIR = "images"; 28our $IMGDIR = "$LIBDIR/images";
29our $SNDDIR = "$LIBDIR/sounds";
23 30
24sub load_img { 31sub load_img {
25 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]" 32 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
26# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]" 33# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
27 or die "$IMGDIR/$_[0]: $!"; 34 or die "$IMGDIR/$_[0]: $!";
28} 35}
36
37my @fontchars = ('A' .. 'Z', 0 .. 9);
29 38
30our @black_img = load_img "b-01.png"; 39our @black_img = load_img "b-01.png";
31our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 40our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
32our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w); 41our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
33our @square_img = map +(load_img "square-$_.png"), qw(b w); 42our @square_img = map +(load_img "square-$_.png"), qw(b w);
34our @circle_img = map +(load_img "circle-$_.png"), qw(b w); 43our @circle_img = map +(load_img "circle-$_.png"), qw(b w);
35our $board_img = load_img "woodgrain-01.jpg"; 44our $board_img = load_img "woodgrain-01.jpg";
36 45
46our @font = (
47 [map +(load_img "font/$_-black.png"), @fontchars],
48 [map +(load_img "font/$_-white.png"), @fontchars],
49 );
50our %fontmap;
51@fontmap{@fontchars} = (0..25 + 10);
52@fontmap{'a' .. 'z'} = (0..25);
53
54{
55 #my $audioserver = new Audio::Play(0);
56 my %sound;
57 $SIG{CHLD} = 'IGNORE';
58
59 for (qw(alarm warning move)) {
60 local $/;
61 open my $snd, "<", "$SNDDIR/$_"
62 or die "$SNDDIR: $!";
63 binmode $snd;
64
65 $sound{$_} = new Audio::Data;
66 $sound{$_}->Load($snd);
67 }
68
69 sub play_sound {
70 if (fork == 0) {
71 if (my $audioserver = new Audio::Play(1)) {
72 $audioserver->play ($sound{$_[0]});
73 }
74 Gtk->_exit(0);
75 }
76 }
77}
78
37{ 79{
38 use Storable (); 80 use Storable ();
39 use Scalar::Util (); 81 use Scalar::Util ();
40 82
41 my $staterc = "$ENV{HOME}/.kgsueme"; 83 my $staterc = "$ENV{HOME}/.kgsueme";
42 84
43 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 85 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
44 my @widgets; 86 my @widgets;
45 87
46 $config = $state->{config} ||= {}; 88 $config = $state->{config} ||= {};
89
90 $config{speed} = 1;#d# optimize for speed or memory?
91 $config{conserve_memory} = 0;
47 92
48 # grr... more gtk+ brokenness 93 # grr... more gtk+ brokenness
49 my %get = ( 94 my %get = (
50 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 95 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
51 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] }, 96 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
52 window_size => sub { [ @{$_[0]->allocation}[2,3] ] }, 97 window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
53 #window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] }, 98 #window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
54 clist_column_widths => sub { 99 clist_column_widths => sub {
55 $_[0]{column_widths}; 100 $_[0]{column_widths};
56 }, 101 },
57 ); 102 );
58 103
… …
139 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text; 184 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
140 } 185 }
141} 186}
142 187
143if (0) { 188if (0) {
189 use KGS::Constants;
190
191 for (19) {
144 my $board = new game size => 5; 192 my $board = new game size => $_;
193 $board->{board} = new KGS::Game::Board;
194 $board->{board}{board}[0][0] = MARK_B;
195 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
196 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
197 $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
198 $board->{board}{label}[1][2] = "198";
199 $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
200 $board->{board}{label}[0][2] = "AWA";
145 $board->{window}->show_all; 201 $board->{window}->show_all;
202 }
146} 203}
147 204
148main Gtk; 205main Gtk;
149 206
150############################################################################# 207#############################################################################
… …
159 216
160 $self->{conn} = new KGS::Protocol; 217 $self->{conn} = new KGS::Protocol;
161 218
162 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :) 219 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
163 220
164 $self->listen($self->{conn}); 221 $self->listen($self->{conn}, "login");
165 222
166 $self->{roomlist} = new roomlist conn => $self->{conn}; 223 $self->{roomlist} = new roomlist conn => $self->{conn};
167 224
168 $self->{window} = new Gtk::Window 'toplevel'; 225 $self->{window} = new Gtk::Window 'toplevel';
169 $self->{window}->set_title('kgsueme'); 226 $self->{window}->set_title('kgsueme');
… …
246 if ($msg->{success}) { 303 if ($msg->{success}) {
247 for (keys %{$::config->{rooms}}) { 304 for (keys %{$::config->{rooms}}) {
248 $self->{roomlist}->join_room($_); 305 $self->{roomlist}->join_room($_);
249 } 306 }
250 } 307 }
251
252 warn PApp::Util::dumpval($::config);
253} 308}
254 309
255sub event_disconnect { } 310sub event_disconnect { }
256 311
257############################################################################# 312#############################################################################
… …
338 393
339sub new { 394sub new {
340 my $self = shift; 395 my $self = shift;
341 $self = $self->SUPER::new(@_); 396 $self = $self->SUPER::new(@_);
342 397
343 $self->listen($self->{conn}); 398 $self->listen($self->{conn}, qw(msg_room:));
344 399
345 $self->{window} = new Gtk::Window 'toplevel'; 400 $self->{window} = new Gtk::Window 'toplevel';
346 $self->{window}->set_title("KGS Room $self->{name}"); 401 $self->{window}->set_title("KGS Room $self->{name}");
347 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400]; 402 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
348 403
… …
391 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30]; 446 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
392 447
393 $self; 448 $self;
394} 449}
395 450
451sub join {
452 my ($self) = @_;
453 $self->SUPER::join;
454
455 $self->{window}->show_all;
456}
457
458sub part {
459 my ($self) = @_;
460 $self->SUPER::part;
461
462 delete $::config->{rooms}{$self->{channel}};
463 $self->{window}->hide_all;
464 $self->event_update_users;
465 $self->event_update_games;
466}
467
468sub inject_msg_room {
469 my ($self, $msg) = @_;
470
471 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
472}
473
396sub event_update_users { 474sub event_update_users {
397 my ($self) = @_; 475 my ($self) = @_;
398 476
399 $self->{event_update} ||= Gtk->timeout_add(200, sub { 477 $self->{event_update} ||= Gtk->timeout_add(200, sub {
400 my $l = $self->{userlist}; 478 my $l = $self->{userlist};
… …
439 delete $self->{event_update_games}; 517 delete $self->{event_update_games};
440 0; 518 0;
441 }); 519 });
442} 520}
443 521
444sub join {
445 my ($self) = @_;
446 $self->SUPER::join;
447
448 $self->{window}->show_all;
449}
450
451sub part {
452 my ($self) = @_;
453 $self->SUPER::part;
454
455 delete $::config->{rooms}{$self->{channel}};
456 $self->{window}->hide_all;
457 $self->event_update_users;
458 $self->event_update_games;
459}
460
461sub event_join { 522sub event_join {
462 my ($self) = @_; 523 my ($self) = @_;
463 $self->SUPER::event_join; 524 $self->SUPER::event_join;
464 525
465 $::config->{rooms}{$self->{channel}} = 1; 526 $::config->{rooms}{$self->{channel}} = 1;
… …
467 528
468sub event_update_roominfo { 529sub event_update_roominfo {
469 my ($self) = @_; 530 my ($self) = @_;
470 531
471 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n"); 532 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
472}
473
474sub inject_msg_room {
475 my ($self, $msg) = @_;
476 return unless $self->{channel} == $msg->{channel};
477
478 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
479} 533}
480 534
481############################################################################# 535#############################################################################
482 536
483package game; 537package game;
… …
493 $self = $self->SUPER::new(@_); 547 $self = $self->SUPER::new(@_);
494 548
495 $self->listen($self->{conn}); 549 $self->listen($self->{conn});
496 550
497 $self->{window} = new Gtk::Window 'toplevel'; 551 $self->{window} = new Gtk::Window 'toplevel';
498 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1) if $self->{channel};#d# 552 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
553 $self->{window}->set_title("KGS Game $title");
499 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 554 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
500 555
501 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 556 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
502 557
503 $self->{window}->add(my $hpane = new Gtk::HPaned); 558 $self->{window}->add(my $hpane = new Gtk::HPaned);
504 ::state $hpane, "game::hpane", undef, hpane_position => 500; 559 ::state $hpane, "game::hpane", undef, hpane_position => 500;
505 560
561 $hpane->pack1(my $vbox = new Gtk::VBox);
562
563 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
564
565 {
566 $frame->add(my $vbox = new Gtk::VBox);
567 $vbox->add($self->{title} = new Gtk::Label $title);
568
569 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
570 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
571 $scale->set_draw_value (1);
572 $scale->set_digits (0);
573 $scale->set_value_pos('top');
574
575 $self->{moveadj}->signal_connect (value_changed => sub {
576 $self->{board} = new KGS::Game::Board $self->{size};
577 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
578
579 $self->repaint_board;
580
581 # force a redraw (not perfect(?))
582 expose_event($self->{canvas}, $self, { area => [0, 0, @{$self->{canvas}->allocation}[2,3]] });
583
584 $self->{text}->backward_delete($self->{text}->get_length);
585 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
586 });
587 }
588
506 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual); 589 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
507 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap); 590 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
508 $hpane->pack1(($self->{canvas} = new Gtk::DrawingArea), 1, 1); 591 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
509 Gtk::Widget->pop_colormap; 592 Gtk::Widget->pop_colormap;
510 Gtk::Widget->pop_visual; 593 Gtk::Widget->pop_visual;
511 594
512 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); 595 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
513 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); 596 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
… …
560} 643}
561 644
562sub configure_event { 645sub configure_event {
563 my ($widget, $self, $event) = @_; 646 my ($widget, $self, $event) = @_;
564 delete $self->{stack}; 647 delete $self->{stack};
648 delete $self->{background};
565 $self->repaint_board; 649 $self->repaint_board;
566 1; 650 1;
567} 651}
568 652
569sub expose_event { 653sub INTERP_NEAREST (){ 1 }
570 my ($widget, $self, $event) = @_;
571
572 $self->{pixmap} or return;
573
574 my ($ox, $oy, $s) = @{$self->{offsets}};
575
576 my ($x, $y, $w, $h) =
577 @{Gtk::Gdk::Rectangle->intersect(
578 $event->{area},
579 [$ox, $oy, $s, $s]
580 )};
581
582 $self->{canvas}->window->draw_pixmap (
583 $self->{canvas}->style->white_gc,
584 $self->{pixmap},
585 $x - $ox, $y - $oy, $x, $y, $w, $h,
586 );
587 1;
588}
589
590# create new, _transparent_ pixbuf
591sub new_pixbuf {
592 my ($w, $h) = @_;
593
594 $pixbuf;
595}
596
597sub INTERP_TILES (){ 1 } 654sub INTERP_TILES (){ 1 }
598sub INTERP_BILINEAR (){ 2 } 655sub INTERP_BILINEAR (){ 2 }
599sub INTERP_HYPER (){ 3 } 656sub INTERP_HYPER (){ 3 }
600 657
601sub new_pixbuf { 658sub new_pixbuf {
602 my ($w, $h, $clear) = @_; 659 my ($w, $h, $alpha, $clear) = @_;
603 660
604 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', 1, 8, $w, $h; 661 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
605 662
606 if ($clear) { # damn, need to clear it ourselves 663 if ($clear) { # damn, need to clear it ourselves
607 my $row = "\x00\x00\x00\x00" x $w; 664 my $row = "\x00\x00\x00\x00" x $w;
608 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1; 665 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
609 } 666 }
… …
612} 669}
613 670
614sub scale_pixbuf { 671sub scale_pixbuf {
615 my ($src, $w, $h, $mode) = @_; 672 my ($src, $w, $h, $mode) = @_;
616 673
617 my $dst = new_pixbuf $w, $h; 674 my $dst = new_pixbuf $w, $h, 1;
618 675
619 $src->scale( 676 $src->scale(
620 $dst, 0, 0, $w, $h, 0, 0, 677 $dst, 0, 0, $w, $h, 0, 0,
621 $w / $src->get_width, $h / $src->get_height, 678 $w / $src->get_width, $h / $src->get_height,
622 $mode, 679 $mode,
623 ); 680 );
624 681
625 $dst; 682 $dst;
626} 683}
627 684
628sub label_font {
629 my ($size) = @_;
630
631 $size = int $size;
632 $size = 34 if $size > 34;
633
634 # I am soo incapable
635 for (8, 10, 11, 12, 14, 17, 18, 20, 24, 25, 34) {
636 next unless $size <= $_;
637 my $font = Gtk::Gdk::Font->fontset_load ("-*-helvetica-bold-r-*--$_-*");
638 return $font if $font;
639 }
640
641 return Gtk::Gdk::Font->fontset_load ("-*-helvetica-bold-r-*--8-*");
642}
643
644sub center_text {
645 my ($drawable, $font, $gc, $x, $y, $t) = @_;
646 my $w = $font->string_width ($t);
647 my $h = $font->string_height($t) - $font->descent;
648 $drawable->draw_text ($font, $gc, $x - $w*0.5, $y + $h * 0.5, $t, length $t);
649}
650
651# create a stack of stones 685# create a stack of stones
652sub create_stack { 686sub create_stack {
653 my ($self, $gc, $mark, $size) = @_; 687 my ($self, $mark, $size, $rand) = @_;
688
689 my $shadow = $size * 0.06;
654 690
655 my $c = \$self->{stack}{$mark}; 691 my $c = \$self->{stack}{$mark};
656 unless ($$c) { 692 unless ($$c) {
657 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 693 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
658 my $base = 694 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
659 $mark & (MARK_B | MARK_GRAY_B | MARK_W | MARK_GRAY_W)
660 ? scale_pixbuf $stone, $size, $size, INTERP_HYPER
661 : new_pixbuf $size, $size, 1;
662 695
696 # zeroeth the shadow
663 if ($mark & (MARK_GRAY_B | MARK_GRAY_W)) { 697 if ($mark & (MARK_B | MARK_W)) {
664 # make transparent by stippling :( 698 $::black_img[0]->composite (
699 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
700 $size / $stone->get_width, $size / $stone->get_height,
701 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
665 # #d# 702 );
666 } 703 }
667 704
705 # first the big stones
706 for ([MARK_B, 255],
707 [MARK_W, 255],
708 [MARK_GRAY_B, 128],
709 [MARK_GRAY_W, 128]) {
710 my ($mask, $alpha) = @$_;
711 if ($mark & $mask) {
712 $stone->composite (
713 $base, 0, 0, $size, $size, -0.5, -0.5,
714 $size / $stone->get_width, $size / $stone->get_height,
715 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
716 );
717 }
718 }
719
720 # then the samll stones
668 for ([MARK_SMALL_B, $::black_img[int rand @::black_img]], 721 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
669 [MARK_SMALL_W, $::white_img[int rand @::white_img]]) { 722 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
670 my ($mask, $img) = @$_; 723 my ($mask, $img) = @$_;
671 if ($mark & $mask) { 724 if ($mark & $mask) {
672 $img->composite ( 725 $img->composite (
673 $base, ($size / 3) x 6, 726 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
674 ($size - 1) / ($img->get_width - 1) / 3, ($size - 1) / ($img->get_height - 1) / 3, 727 $size / $img->get_width / 2, $size / $img->get_height / 2,
675 INTERP_HYPER, 255 728 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
676 ); 729 );
677 } 730 }
678 } 731 }
679 732
733 # and lastly any markers (labels NYI)
680 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B)); 734 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
681 735
682 for ([MARK_CIRCLE, $::circle_img[$dark_bg]], 736 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
683 [MARK_TRIANGLE, $::triangle_img[$dark_bg]], 737 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
684 [MARK_SQUARE, $::square_img[$dark_bg]]) { 738 [MARK_SQUARE, $::square_img[$dark_bg]]) {
685 my ($mask, $img) = @$_; 739 my ($mask, $img) = @$_;
686 if ($mark & $mask) { 740 if ($mark & $mask) {
687 $img->composite ( 741 $img->composite (
688 $base, 0, 0, $size, $size, 0, 0, 742 $base, 0, 0, $size, $size, -0.5, -0.5,
689 ($size - 1) / ($img->get_width - 1), ($size - 1) / ($img->get_height - 1), 743 $size / $img->get_width, $size / $img->get_height,
690 INTERP_HYPER, 255 744 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
691 ); 745 );
692 } 746 }
693 } 747 }
694 748
695 push @$$c, [$base->render_pixmap_and_mask (128)]; 749 push @$$c, $base;
696 } 750 }
697 } 751 }
698 752
699 @{$$c->[int rand @$$c]}; 753 $$c->[$rand % @$$c];
754}
755
756sub pixbuf_text {
757 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
758
759 my @c = grep $_,
760 map $::font[$colour][$::fontmap{$_}],
761 split //, $text;
762
763 if (@c) {
764 my $spacing = $height * 0.1;
765 my $s = $height / List::Util::max map $_->get_height, @c;
766 my $W = List::Util::sum map $_->get_width, @c;
767
768 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
769 $y -= $height * 0.5;
770
771 for (@c) {
772 my $w = $_->get_width * $s;
773 $_->composite ($pixbuf,
774 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
775 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
776
777 $x += $w + $spacing;
778 }
779 }
780}
781
782my $black_pb;
783
784sub pixbuf_rect {
785 my ($pb, $x1, $y1, $x2, $y2) = @_;
786 # we fake lines by... an unspeakable method :/
787 unless ($black_pb) {
788 $black_pb = new_pixbuf 1, 1, 0, 0;
789 $black_pb->put_pixels ("\x44\x11\x11", 0, 0);
790 }
791
792 $black_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, 192);
700} 793}
701 794
702sub repaint_board { 795sub repaint_board {
703 my ($self) = @_; 796 my ($self) = @_;
704 my $canvas = $self->{canvas}; 797 my $canvas = $self->{canvas};
705 798
706 %cache = (); 799 return unless $self->{board};
707 800
708 my ($w, $h) = @{$canvas->allocation}[2,3]; 801 my ($w, $h) = @{$canvas->allocation}[2,3];
709 802
710 my $s = $w > $h ? $h : $w; 803 my $s = $w > $h ? $h : $w;
711 804
712 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 805 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
713 806
714 my $pixmap = $self->{pixmap} = new Gtk::Gdk::Pixmap $self->{canvas}->window, $s, $s; 807 my $size = $self->{size};
715 808
716 { 809 my $border = int ($s / ($size + 3) * 0.5);
810 my $s2 = $s - $border * 2;
811 my $edge = int ($s2 / ($size + 1) * 0.97);
812 my $ofs = int ($edge / 2);
813
814 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
815
816 my $pixbuf;
817
818 if ($self->{background}) {
819 $pixbuf = $self->{background}->copy;
820 } else {
717 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height); 821 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
718 822
719 my $bg = $s < $bw && $s < $bh ? $::board_img : scale_pixbuf $::board_img, $s, $s, INTERP_TILES; 823 if ($s < $bw && $s < $bh) {
720 $bg->render_to_drawable( 824 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
721 $pixmap, $self->{canvas}->style->white_gc, 825 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
722 0, 0, 0, 0, $s, $s, 826 } else {
723 0, 0, 0 827 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
724 ); 828 }
725 }
726 829
727 my $gc = Gtk::Gdk::GC->new ($pixmap);
728
729 $gc->rgb_gc_set_foreground($line_colour);
730 $gc->set_line_attributes (int ($s / 300) + 1, 'solid', 'projecting', 'miter');
731
732 my $size = $self->{size};
733 my $border = int ($s / $size * 0.75);
734 my $s2 = $s - $border * 2;
735 my $edge = int ($s2 / $size); 830 my $linew = int ($s / 25 / $size);
736 my $ofs = int ($s2 / $size * 0.5);
737 831
738 my $font = label_font $ofs;
739
740 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size;
741
742 my $a = "A";
743 for my $i (1 .. $size) { 832 for my $i (1 .. $size) {
744 $pixmap->draw_line ($gc, $k[$i], $k[1], $k[$i], $k[$size]); 833 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
745 $pixmap->draw_line ($gc, $k[1], $k[$i], $k[$size], $k[$i]); 834 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
746 835
747 center_text $pixmap, $font, $gc, $k[$i], ($ofs +$border) / 2, $a; 836 # 38 max, but we allow a bit more
748 center_text $pixmap, $font, $gc, $k[$i], $s2 + $border + $ofs / 2, $a; 837 my $label = (qw(- A B C D E F G H J K L M N O P Q R S T U V W X Y Z
749 center_text $pixmap, $font, $gc, ($ofs + $border) / 2, $k[$i], $i; 838 AA BB CC DD EE FF GG HH JJ KK LL MM NN OO PP QQ RR SS TT UU VV WW XX YY ZZ))[$i];
750 center_text $pixmap, $font, $gc, $s2 + $border + $ofs / 2, $k[$i], $i;
751 839
840 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
841 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
842 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
843 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
844
752 $a++; 845 $a++;
753 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK... 846 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
847 }
848
849 unless ($::config->{conserve_memory}) {
850 $self->{background} = $pixbuf;
851 $pixbuf = $pixbuf->copy;
852 }
754 } 853 }
854
855 $self->{pixbuf} = $pixbuf;
755 856
756 # hoshi-points(!)#d# 857 # hoshi-points(!)#d#
757 # caching of empty board gfx(!)#d# 858 # caching of empty board gfx(!)#d#
758 859
759 if ($self->{board}) { 860 for my $x (1 .. $size) {
760 for my $x (1 .. $size) { 861 for my $y (1 .. $size) {
761 for my $y (1 .. $size) {
762 my $yk = $s2 * $x / $size - $ofs + $border;
763 my $mark = $self->{board}{board}[$x-1][$y-1]; 862 my $mark = $self->{board}{board}[$x-1][$y-1];
764 863
765 if ($mark) { 864 if ($mark) {
766 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs); 865 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
767 my ($pm, $bm) = $self->create_stack($gc, $mark, $edge); 866 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
768 867
769 $gc->set_clip_mask ($bm); 868 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
770 $gc->set_clip_origin ($dx, $dy); 869 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
771 $pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge); 870
871 # labels are handled here because they are quite rare
872 if ($mark & MARK_LABEL) {
873 pixbuf_text $pixbuf, $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1,
874 $k[$x], $k[$y], $ofs * 0.7,
875 $self->{board}{label}[$x-1][$y-1];
772 } 876 }
877
878 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
879
880 #$gc->set_clip_mask ($bm);
881 #$gc->set_clip_origin ($dx, $dy);
882 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
773 } 883 }
774 } 884 }
775 } 885 }
776} 886}
777 887
888sub expose_event {
889 my ($widget, $self, $event) = @_;
890
891 $self->{pixbuf} or return;
892
893 my ($ox, $oy, $s) = @{$self->{offsets}};
894
895 my ($x, $y, $w, $h) =
896 @{Gtk::Gdk::Rectangle->intersect(
897 $event->{area},
898 [$ox, $oy, $s, $s]
899 )};
900
901 if (defined $x) {
902 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
903 $x - $ox, $y - $oy, $x, $y, $w, $h);
904 #$self->{canvas}->window->draw_pixmap (
905 # $self->{canvas}->style->white_gc,
906 # $self->{pixmap},
907 # $x - $ox, $y - $oy, $x, $y, $w, $h,
908 #);
909 }
910 1;
911}
912
778sub event_update_tree { 913sub event_update_tree {
779 my ($self) = @_; 914 my ($self) = @_;
780 915
781 $self->{board} = new KGS::Game::Board $self->{size}; 916 $self->{path} = $self->get_path;
782 $self->{board}->interpret_path ($self->get_path); 917
918 my $move = @{$self->{path}};
783 919
784 $self->repaint_board; 920 $self->{moveadj}->upper($move);
785 921
786 # force a redraw (not perfect(?)) 922 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
787 expose_event $self->{canvas}, $self, { area => $self->{canvas}->allocation }; 923 $self->{moveadj}->set_value ($move);
924 }
925}
788 926
789 $self->{text}->backward_delete($self->{text}->get_length); 927sub event_move {
790 $self->{text}->insert(undef, undef, undef, $self->{board}{comment}.PApp::Util::dumpval([$self->{board}{time},$self->{board}{captures}])); 928 ::play_sound "move";
791} 929}
792 930
7931; 9311;
794 932
795 933

Diff Legend

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