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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.16 by pcg, Fri May 30 07:19:16 2003 UTC vs.
Revision 1.24 by pcg, Fri May 30 11:59:28 2003 UTC

27sub load_img { 27sub load_img {
28 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]" 28 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
29# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]" 29# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
30 or die "$IMGDIR/$_[0]: $!"; 30 or die "$IMGDIR/$_[0]: $!";
31} 31}
32
33my @fontchars = ('A' .. 'Z', 0 .. 9);
32 34
33our @black_img = load_img "b-01.png"; 35our @black_img = load_img "b-01.png";
34our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 36our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
35our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w); 37our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
36our @square_img = map +(load_img "square-$_.png"), qw(b w); 38our @square_img = map +(load_img "square-$_.png"), qw(b w);
37our @circle_img = map +(load_img "circle-$_.png"), qw(b w); 39our @circle_img = map +(load_img "circle-$_.png"), qw(b w);
38our $board_img = load_img "woodgrain-01.jpg"; 40our $board_img = load_img "woodgrain-01.jpg";
39 41
42our @font = (
43 [map +(load_img "font/$_-black.png"), @fontchars],
44 [map +(load_img "font/$_-white.png"), @fontchars],
45 );
46our %fontmap;
47@fontmap{@fontchars} = (0..25 + 10);
48@fontmap{'a' .. 'z'} = (0..25);
49
40{ 50{
41 #my $audioserver = new Audio::Play(0); 51 #my $audioserver = new Audio::Play(0);
42 my %sound; 52 my %sound;
43 $SIG{CHLD} = 'IGNORE'; 53 $SIG{CHLD} = 'IGNORE';
44 54
52 $sound{$_}->Load($snd); 62 $sound{$_}->Load($snd);
53 } 63 }
54 64
55 sub play_sound { 65 sub play_sound {
56 if (fork == 0) { 66 if (fork == 0) {
57 my $audioserver = new Audio::Play(1); 67 if (my $audioserver = new Audio::Play(1)) {
58 $audioserver->play ($sound{$_[0]}); 68 $audioserver->play ($sound{$_[0]});
69 }
59 Gtk->_exit(0); 70 Gtk->_exit(0);
60 } 71 }
61 } 72 }
62} 73}
63 74
69 80
70 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 81 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
71 my @widgets; 82 my @widgets;
72 83
73 $config = $state->{config} ||= {}; 84 $config = $state->{config} ||= {};
85
86 $config{speed} = 1;#d# optimize for speed or memory?
87 $config{conserve_memory} = 0;
74 88
75 # grr... more gtk+ brokenness 89 # grr... more gtk+ brokenness
76 my %get = ( 90 my %get = (
77 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 91 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
78 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] }, 92 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
166 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text; 180 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
167 } 181 }
168} 182}
169 183
170if (0) { 184if (0) {
185 use KGS::Constants;
186
171 my $board = new game size => 5; 187 my $board = new game size => 5;
188 $board->{board} = new KGS::Game::Board;
189 $board->{board}{board}[0][0] = MARK_B;
190 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
191 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
172 $board->{window}->show_all; 192 $board->{window}->show_all;
173} 193}
174 194
175main Gtk; 195main Gtk;
176 196
585} 605}
586 606
587sub configure_event { 607sub configure_event {
588 my ($widget, $self, $event) = @_; 608 my ($widget, $self, $event) = @_;
589 delete $self->{stack}; 609 delete $self->{stack};
610 delete $self->{background};
590 $self->repaint_board; 611 $self->repaint_board;
591 1; 612 1;
592} 613}
593 614
594sub expose_event { 615sub INTERP_NEAREST (){ 1 }
595 my ($widget, $self, $event) = @_;
596
597 $self->{pixmap} or return;
598
599 my ($ox, $oy, $s) = @{$self->{offsets}};
600
601 my ($x, $y, $w, $h) =
602 @{Gtk::Gdk::Rectangle->intersect(
603 $event->{area},
604 [$ox, $oy, $s, $s]
605 )};
606
607 $self->{canvas}->window->draw_pixmap (
608 $self->{canvas}->style->white_gc,
609 $self->{pixmap},
610 $x - $ox, $y - $oy, $x, $y, $w, $h,
611 );
612 1;
613}
614
615# create new, _transparent_ pixbuf
616sub new_pixbuf {
617 my ($w, $h) = @_;
618
619 $pixbuf;
620}
621
622sub INTERP_TILES (){ 1 } 616sub INTERP_TILES (){ 1 }
623sub INTERP_BILINEAR (){ 2 } 617sub INTERP_BILINEAR (){ 2 }
624sub INTERP_HYPER (){ 3 } 618sub INTERP_HYPER (){ 3 }
625 619
626sub new_pixbuf { 620sub new_pixbuf {
627 my ($w, $h, $clear) = @_; 621 my ($w, $h, $alpha, $clear) = @_;
628 622
629 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', 1, 8, $w, $h; 623 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
630 624
631 if ($clear) { # damn, need to clear it ourselves 625 if ($clear) { # damn, need to clear it ourselves
632 my $row = "\x00\x00\x00\x00" x $w; 626 my $row = "\x00\x00\x00\x00" x $w;
633 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1; 627 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
634 } 628 }
637} 631}
638 632
639sub scale_pixbuf { 633sub scale_pixbuf {
640 my ($src, $w, $h, $mode) = @_; 634 my ($src, $w, $h, $mode) = @_;
641 635
642 my $dst = new_pixbuf $w, $h; 636 my $dst = new_pixbuf $w, $h, 1;
643 637
644 $src->scale( 638 $src->scale(
645 $dst, 0, 0, $w, $h, 0, 0, 639 $dst, 0, 0, $w, $h, 0, 0,
646 $w / $src->get_width, $h / $src->get_height, 640 $w / $src->get_width, $h / $src->get_height,
647 $mode, 641 $mode,
648 ); 642 );
649 643
650 $dst; 644 $dst;
651} 645}
652 646
653sub label_font {
654 my ($size) = @_;
655
656 $size = int $size;
657 $size = 34 if $size > 34;
658
659 # I am soo incapable
660 for (8, 10, 11, 12, 14, 17, 18, 20, 24, 25, 34) {
661 next unless $size <= $_;
662 my $font = Gtk::Gdk::Font->fontset_load ("-*-helvetica-bold-r-*--$_-*");
663 return $font if $font;
664 }
665
666 return Gtk::Gdk::Font->fontset_load ("-*-helvetica-bold-r-*--8-*");
667}
668
669sub center_text {
670 my ($drawable, $font, $gc, $x, $y, $t) = @_;
671 my $w = $font->string_width ($t);
672 my $h = $font->string_height($t) - $font->descent;
673 $drawable->draw_text ($font, $gc, $x - $w*0.5, $y + $h * 0.5, $t, length $t);
674}
675
676# create a stack of stones 647# create a stack of stones
677sub create_stack { 648sub create_stack {
678 my ($self, $gc, $mark, $size, $rand) = @_; 649 my ($self, $mark, $size, $rand) = @_;
650
651 my $shadow = $size * 0.06;
679 652
680 my $c = \$self->{stack}{$mark}; 653 my $c = \$self->{stack}{$mark};
681 unless ($$c) { 654 unless ($$c) {
682 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 655 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
683 my $base = 656 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
684 $mark & (MARK_B | MARK_GRAY_B | MARK_W | MARK_GRAY_W)
685 ? scale_pixbuf $stone, $size, $size, INTERP_HYPER
686 : new_pixbuf $size, $size, 1;
687 657
658 # zeroeth the shadow
688 if ($mark & (MARK_GRAY_B | MARK_GRAY_W)) { 659 if ($mark & (MARK_B | MARK_W)) {
689 # make transparent by stippling :( 660 $::black_img[0]->composite (
690 # fix this to use compositing if/when we have full compositing support 661 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
691 # in kgsueme 662 $size / $stone->get_width, $size / $stone->get_height,
692 my @row = ( 663 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
693 "\xff\xff\xff\xff\x00\x00\x00\x00" x ($size / 2 + 1), 664 );
694 "\x00\x00\x00\x00\xff\xff\xff\xff" x ($size / 2 + 1),
695 );
696 $base->put_pixels ($base->get_pixels ($_) & $row[$_ & 1], $_, 0)
697 for 0 .. $size - 1;
698 } 665 }
699 666
667 # first the big stones
668 for ([MARK_B, 255],
669 [MARK_W, 255],
670 [MARK_GRAY_B, 128],
671 [MARK_GRAY_W, 128]) {
672 my ($mask, $alpha) = @$_;
673 if ($mark & $mask) {
674 $stone->composite (
675 $base, 0, 0, $size, $size, -0.5, -0.5,
676 $size / $stone->get_width, $size / $stone->get_height,
677 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
678 );
679 }
680 }
681
682 # then the samll stones
700 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]], 683 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
701 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) { 684 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
702 my ($mask, $img) = @$_; 685 my ($mask, $img) = @$_;
703 if ($mark & $mask) { 686 if ($mark & $mask) {
704 $img->composite ( 687 $img->composite (
705 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4) x 2, 688 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
706 $size / $img->get_width / 2, $size / $img->get_height / 2, 689 $size / $img->get_width / 2, $size / $img->get_height / 2,
707 INTERP_HYPER, 192 690 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
708 ); 691 );
709 } 692 }
710 } 693 }
711 694
695 # and lastly any markers (labels NYI)
712 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B)); 696 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
713 697
714 for ([MARK_CIRCLE, $::circle_img[$dark_bg]], 698 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
715 [MARK_TRIANGLE, $::triangle_img[$dark_bg]], 699 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
716 [MARK_SQUARE, $::square_img[$dark_bg]]) { 700 [MARK_SQUARE, $::square_img[$dark_bg]]) {
717 my ($mask, $img) = @$_; 701 my ($mask, $img) = @$_;
718 if ($mark & $mask) { 702 if ($mark & $mask) {
719 $img->composite ( 703 $img->composite (
720 $base, 0, 0, $size, $size, 0, 0, 704 $base, 0, 0, $size, $size, -0.5, -0.5,
721 ($size - 1) / ($img->get_width - 1), ($size - 1) / ($img->get_height - 1), 705 $size / $img->get_width, $size / $img->get_height,
722 INTERP_HYPER, 255 706 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
723 ); 707 );
724 } 708 }
725 } 709 }
726 710
727 push @$$c, [$base->render_pixmap_and_mask (128)]; 711 push @$$c, $base;
728 } 712 }
729 } 713 }
730 714
731 @{$$c->[$rand % @$$c]}; 715 $$c->[$rand % @$$c];
716}
717
718sub pixbuf_text {
719 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
720
721 my $c = $::font[$colour][$::fontmap{substr $text, 0, 1}];
722
723 if ($c) {
724 my ($w, $h) = ($c->get_width, $c->get_height);
725 my $s = ($height-1) / ($h-1);
726
727 $x -= $w * $s * 0.5;
728 $y -= $height * 0.5;
729
730 $c->composite ($pixbuf,
731 $x, $y, $w*$s+0.5, $height+0.5, $x-0.5, $y-0.5, $s, $s,
732 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192);
733
734 } else {
735 warn "unable to render character '$text'";
736 }
737}
738
739my $black_pb;
740
741sub pixbuf_rect {
742 my ($pb, $x1, $y1, $x2, $y2) = @_;
743 # we fake lines by... an unspeakable method :/
744 unless ($black_pb) {
745 $black_pb = new_pixbuf 1, 1, 0, 0;
746 $black_pb->put_pixels ("\x44\x11\x11", 0, 0);
747 }
748
749 $black_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, 192);
732} 750}
733 751
734sub repaint_board { 752sub repaint_board {
735 my ($self) = @_; 753 my ($self) = @_;
736 my $canvas = $self->{canvas}; 754 my $canvas = $self->{canvas};
737 755
738 return unless $self->{board}; 756 return unless $self->{board};
739
740 %cache = ();
741 757
742 my ($w, $h) = @{$canvas->allocation}[2,3]; 758 my ($w, $h) = @{$canvas->allocation}[2,3];
743 759
744 my $s = $w > $h ? $h : $w; 760 my $s = $w > $h ? $h : $w;
745 761
746 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 762 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
747 763
748 my $pixmap = $self->{pixmap} = new Gtk::Gdk::Pixmap $self->{canvas}->window, $s, $s;
749
750 {
751 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
752
753 my $bg = $s < $bw && $s < $bh ? $::board_img : scale_pixbuf $::board_img, $s, $s, INTERP_TILES;
754 $bg->render_to_drawable(
755 $pixmap, $self->{canvas}->style->white_gc,
756 0, 0, 0, 0, $s, $s,
757 0, 0, 0
758 );
759 }
760
761 my $gc = Gtk::Gdk::GC->new ($pixmap);
762
763 $gc->rgb_gc_set_foreground($line_colour);
764 $gc->set_line_attributes (int ($s / 300) + 1, 'solid', 'projecting', 'miter');
765
766 my $size = $self->{size}; 764 my $size = $self->{size};
765
767 my $border = int ($s / $size); 766 my $border = int ($s / $size);
768 my $s2 = $s - $border * 2; 767 my $s2 = $s - $border * 2;
769 my $edge = int ($s2 / $size) | 1; 768 my $edge = int ($s2 / $size * 0.97);
770 my $ofs = int ($edge / 2); 769 my $ofs = int ($edge / 2);
771 770
772 my $font = label_font $ofs;
773
774 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size; 771 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size;
775 772
773 my $pixbuf;
774
775 if ($self->{background}) {
776 $pixbuf = $self->{background}->copy;
777 } else {
778 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
779
780 if ($s < $bw && $s < $bh) {
781 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
782 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
783 } else {
784 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
785 }
786
787 my $linew = int ($s / 500);
788
776 my $a = "A"; 789 my $a = "A";
777 for my $i (1 .. $size) { 790 for my $i (1 .. $size) {
778 $pixmap->draw_line ($gc, $k[$i], $k[1], $k[$i], $k[$size]); 791 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
779 $pixmap->draw_line ($gc, $k[1], $k[$i], $k[$size], $k[$i]); 792 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
780 793
781 center_text $pixmap, $font, $gc, $k[$i], ($ofs +$border) / 2, $a; 794 pixbuf_text $pixbuf, 0, $k[$i], ($ofs +$border) / 2, $ofs, $a;
782 center_text $pixmap, $font, $gc, $k[$i], $s2 + $border + $ofs / 2, $a; 795 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border + $ofs / 2, $ofs, $a;
783 center_text $pixmap, $font, $gc, ($ofs + $border) / 2, $k[$i], $size - $i + 1; 796 pixbuf_text $pixbuf, 0, ($ofs + $border) / 2, $k[$i], $ofs, $size - $i + 1;
784 center_text $pixmap, $font, $gc, $s2 + $border + $ofs / 2, $k[$i], $size - $i + 1; 797 pixbuf_text $pixbuf, 0, $s2 + $border + $ofs / 2, $k[$i], $ofs, $size - $i + 1;
785 798
786 $a++; 799 $a++;
787 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK... 800 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
801 }
802
803 unless ($::config->{conserve_memory}) {
804 $self->{background} = $pixbuf;
805 $pixbuf = $pixbuf->copy;
806 }
788 } 807 }
808
809 $self->{pixbuf} = $pixbuf;
789 810
790 # hoshi-points(!)#d# 811 # hoshi-points(!)#d#
791 # caching of empty board gfx(!)#d# 812 # caching of empty board gfx(!)#d#
792 813
793 for my $x (1 .. $size) { 814 for my $x (1 .. $size) {
794 for my $y (1 .. $size) { 815 for my $y (1 .. $size) {
795 my $yk = $s2 * $x / $size - $ofs + $border;
796 my $mark = $self->{board}{board}[$x-1][$y-1]; 816 my $mark = $self->{board}{board}[$x-1][$y-1];
797 817
798 if ($mark) { 818 if ($mark) {
799 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs); 819 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
820 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
821
822 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
823 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
824
800 my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 ); 825 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
801 826
802 $gc->set_clip_mask ($bm); 827 #$gc->set_clip_mask ($bm);
803 $gc->set_clip_origin ($dx, $dy); 828 #$gc->set_clip_origin ($dx, $dy);
804 $pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge); 829 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
805 } 830 }
806 } 831 }
807 } 832 }
833}
834
835sub expose_event {
836 my ($widget, $self, $event) = @_;
837
838 $self->{pixbuf} or return;
839
840 my ($ox, $oy, $s) = @{$self->{offsets}};
841
842 my ($x, $y, $w, $h) =
843 @{Gtk::Gdk::Rectangle->intersect(
844 $event->{area},
845 [$ox, $oy, $s, $s]
846 )};
847
848 if (defined $x) {
849 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
850 $x - $ox, $y - $oy, $x, $y, $w, $h);
851 #$self->{canvas}->window->draw_pixmap (
852 # $self->{canvas}->style->white_gc,
853 # $self->{pixmap},
854 # $x - $ox, $y - $oy, $x, $y, $w, $h,
855 #);
856 }
857 1;
808} 858}
809 859
810sub event_update_tree { 860sub event_update_tree {
811 my ($self) = @_; 861 my ($self) = @_;
812 862

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines