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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.9 by pcg, Thu May 29 10:32:06 2003 UTC vs.
Revision 1.30 by pcg, Sat May 31 05:35:48 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;
7#use Gtk::Gdk::Pixbuf; 5use Gtk::Gdk::Pixbuf;
8use Gtk::Gdk::ImlibImage; 6#use Gtk::Gdk::ImlibImage;
9
10use Gnome;
11 7
12use KGS::Protocol; 8use KGS::Protocol;
13use KGS::Listener::Debug; 9use KGS::Listener::Debug;
14 10
11use Audio::Data;
12use Audio::Play;
13
15use IO::Socket::INET; 14use IO::Socket::INET;
16 15use List::Util;
17use Errno; 16use Errno;
18 17
19init Gnome "kgsueme"; 18init Gtk;
20 19
21$HACK = 1; # do NEVER enable. ;) 20our $HACK = 1; # do NEVER enable. ;)
21our $DEBUG_EXPOSE = 0;
22
23if ($HACK) {
24 $KGS::debug = 1;
25}
26
27our $VERSION = "0.1";
22 28
23our $config; 29our $config;
30our $LIBDIR = ".";
24our $IMGDIR = "images"; 31our $IMGDIR = "$LIBDIR/images";
32our $SNDDIR = "$LIBDIR/sounds";
25 33
26sub load_img { 34sub load_img {
27# new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]" 35 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
28 load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]" 36# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
29 or die "$IMGDIR/$_[0]: $!"; 37 or die "$IMGDIR/$_[0]: $!";
30} 38}
31 39
40my @fontchars = ('A' .. 'Z', 0 .. 9);
41
32our @black_img = load_img "b-01.png"; 42our @black_img = load_img "b-01.png";
33our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 43our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
44our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
45our @square_img = map +(load_img "square-$_.png"), qw(b w);
46our @circle_img = map +(load_img "circle-$_.png"), qw(b w);
34our $board_img = load_img "woodgrain-01.jpg"; 47our $board_img = load_img "woodgrain-01.jpg";
48
49our @font = (
50 [map +(load_img "font/$_-black.png"), @fontchars],
51 [map +(load_img "font/$_-white.png"), @fontchars],
52 );
53our %fontmap;
54@fontmap{@fontchars} = (0..25 + 10);
55@fontmap{'a' .. 'z'} = (0..25);
56
57{
58 #my $audioserver = new Audio::Play(0);
59 my %sound;
60 $SIG{CHLD} = 'IGNORE';
61
62 for (qw(alarm warning move pass ring connect user_unknown)) {
63 local $/;
64 open my $snd, "<", "$SNDDIR/$_"
65 or die "$SNDDIR/$_: $!";
66 binmode $snd;
67
68 $sound{$_} = new Audio::Data;
69 $sound{$_}->Load($snd);
70 }
71
72 sub play_sound {
73 my ($annoyancy, $sound) = @_;
74 # annoyany 1 => important, annoyance 2 => useful, annoyancy 3 => not useful
75 if (fork == 0) {
76 if (my $audioserver = new Audio::Play(1)) {
77 $audioserver->play ($sound{$sound});
78 }
79 Gtk->_exit(0);
80 }
81 }
82}
35 83
36{ 84{
37 use Storable (); 85 use Storable ();
38 use Scalar::Util (); 86 use Scalar::Util ();
39 87
… …
41 89
42 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 90 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
43 my @widgets; 91 my @widgets;
44 92
45 $config = $state->{config} ||= {}; 93 $config = $state->{config} ||= {};
94
95 $config->{speed} = 1;#d# optimize for speed or memory?
96 $config->{conserve_memory} = 0; # try to conserve memory at the expense of speed
97 $config->{randomize} = 0; # randomize placement of stones
46 98
47 # grr... more gtk+ brokenness 99 # grr... more gtk+ brokenness
48 my %get = ( 100 my %get = (
49 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 101 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
50 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] }, 102 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
51 window_size => sub { [ @{$_[0]->allocation}[2,3] ] }, 103 window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
52 #window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] }, 104 #window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
53 clist_column_widths => sub { 105 clist_column_widths => sub {
54 $_[0]{column_widths}; 106 $_[0]{column_widths};
55 }, 107 },
56 ); 108 );
57 109
… …
137 $main->{status}->pop($context_id{$type}) if $context_id{$type}; 189 $main->{status}->pop($context_id{$type}) if $context_id{$type};
138 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text; 190 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
139 } 191 }
140} 192}
141 193
194if (0) {
195 use KGS::Constants;
196
197 for (19) {
198 my $board = new game %{Storable::retrieve "testboard.storable"};
199
200 if (0) {
201 $board->{board} = new KGS::Game::Board;
202 $board->{board}{board}[0][0] = MARK_B;
203 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
204 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
205 $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
206 $board->{board}{label}[1][2] = "198";
207 $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
208 $board->{board}{label}[0][2] = "AWA";
209 }
210 $board->{window}->show_all;
211 }
212}
213
142main Gtk; 214main Gtk;
143 215
144############################################################################# 216#############################################################################
145 217
146package kgsueme; 218package kgsueme;
… …
151 my $self = shift; 223 my $self = shift;
152 $self = $self->SUPER::new(@_); 224 $self = $self->SUPER::new(@_);
153 225
154 $self->{conn} = new KGS::Protocol; 226 $self->{conn} = new KGS::Protocol;
155 227
156 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :) 228 KGS::Listener::Debug->new->listen($self->{conn}, "any"); #d# debug only :)
157 229
158 $self->listen($self->{conn}); 230 $self->listen($self->{conn}, "login");
159 231
160 $self->{roomlist} = new roomlist conn => $self->{conn}; 232 $self->{roomlist} = new roomlist conn => $self->{conn};
161 233
162 $self->{window} = new Gtk::Window 'toplevel'; 234 $self->{window} = new Gtk::Window 'toplevel';
163 $self->{window}->set_title('kgsueme'); 235 $self->{window}->set_title('kgsueme');
… …
226 } 298 }
227 $self->{conn}->feed_data($buf); 299 $self->{conn}->feed_data($buf);
228 }; 300 };
229 301
230 # now login 302 # now login
231 $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text); 303 $self->{conn}->login("kgsueme $VERSION $^O", $self->{login}->get_text, $self->{password}->get_text);
232} 304}
233 305
234sub inject_login { 306sub inject_login {
235 my ($self, $msg) = @_; 307 my ($self, $msg) = @_;
236 308
… …
239 311
240 if ($msg->{success}) { 312 if ($msg->{success}) {
241 for (keys %{$::config->{rooms}}) { 313 for (keys %{$::config->{rooms}}) {
242 $self->{roomlist}->join_room($_); 314 $self->{roomlist}->join_room($_);
243 } 315 }
316 ::play_sound 3, "connect";
317 } elsif ($msg->{result} eq "user unknown") {
318 ::play_sound 2, "user_unknown";
319 } else {
320 ::play_sound 2, "warning";
244 } 321 }
245
246 warn PApp::Util::dumpval($::config);
247} 322}
248 323
249sub event_disconnect { } 324sub event_disconnect { }
250 325
251############################################################################# 326#############################################################################
… …
332 407
333sub new { 408sub new {
334 my $self = shift; 409 my $self = shift;
335 $self = $self->SUPER::new(@_); 410 $self = $self->SUPER::new(@_);
336 411
337 $self->listen($self->{conn}); 412 $self->listen($self->{conn}, qw(msg_room:));
338 413
339 $self->{window} = new Gtk::Window 'toplevel'; 414 $self->{window} = new Gtk::Window 'toplevel';
340 $self->{window}->set_title("KGS Room $self->{name}"); 415 $self->{window}->set_title("KGS Room $self->{name}");
341 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400]; 416 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
342 417
… …
356 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120]; 431 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
357 432
358 $self->{gamelist}->signal_connect(select_row => sub { 433 $self->{gamelist}->signal_connect(select_row => sub {
359 my $game = $self->{gamelist}->get_row_data($_[1]) 434 my $game = $self->{gamelist}->get_row_data($_[1])
360 or return; 435 or return;
361 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}; 436 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}, room => $self;
362 $self->{game}{$game->{channel}}->join; 437 $self->{game}{$game->{channel}}->join;
363 $self->{gamelist}->unselect_all; 438 $self->{gamelist}->unselect_all;
364 }); 439 });
365 440
366 $vpane->add(my $vbox = new Gtk::VBox); 441 $vpane->add(my $vbox = new Gtk::VBox);
… …
385 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30]; 460 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
386 461
387 $self; 462 $self;
388} 463}
389 464
465sub join {
466 my ($self) = @_;
467 $self->SUPER::join;
468
469 $self->{window}->show_all;
470}
471
472sub part {
473 my ($self) = @_;
474 $self->SUPER::part;
475
476 delete $::config->{rooms}{$self->{channel}};
477 $self->{window}->hide_all;
478}
479
480sub inject_msg_room {
481 my ($self, $msg) = @_;
482
483 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
484}
485
390sub event_update_users { 486sub event_update_users {
391 my ($self) = @_; 487 my ($self) = @_;
392 488
489 Gtk->timeout_remove (delete $self->{update_users}) if $self->{update_users};
393 $self->{event_update} ||= Gtk->timeout_add(200, sub { 490 $self->{update_users} ||= Gtk->timeout_add(100, sub {
491 return unless $self->{joined};
492
394 my $l = $self->{userlist}; 493 my $l = $self->{userlist};
395 494
396 $l->freeze; 495 $l->freeze;
397 my $pos = $l->get_vadjustment->get_value; 496 my $pos = $l->get_vadjustment->get_value;
398 $l->clear; 497 $l->clear;
… …
404 } 503 }
405 $l->sort; 504 $l->sort;
406 $l->get_vadjustment->set_value($pos); 505 $l->get_vadjustment->set_value($pos);
407 $l->thaw; 506 $l->thaw;
408 507
409 delete $self->{event_update}; 508 delete $self->{update_users};
410 0;
411 }); 509 });
412} 510}
413 511
414sub event_update_games { 512sub event_update_games {
415 my ($self) = @_; 513 my ($self) = @_;
… …
433 delete $self->{event_update_games}; 531 delete $self->{event_update_games};
434 0; 532 0;
435 }); 533 });
436} 534}
437 535
438sub join {
439 my ($self) = @_;
440 $self->SUPER::join;
441
442 $self->{window}->show_all;
443}
444
445sub part {
446 my ($self) = @_;
447 $self->SUPER::part;
448
449 delete $::config->{rooms}{$self->{channel}};
450 $self->{window}->hide_all;
451 $self->event_update;
452 $self->event_update_games;
453}
454
455sub event_join { 536sub event_join {
456 my ($self) = @_; 537 my ($self) = @_;
457 $self->SUPER::event_join; 538 $self->SUPER::event_join;
458 539
459 $::config->{rooms}{$self->{channel}} = 1; 540 $::config->{rooms}{$self->{channel}} = 1;
… …
461 542
462sub event_update_roominfo { 543sub event_update_roominfo {
463 my ($self) = @_; 544 my ($self) = @_;
464 545
465 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n"); 546 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
466}
467
468sub inject_msg_room {
469 my ($self, $msg) = @_;
470 return unless $self->{channel} == $msg->{channel};
471
472 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
473} 547}
474 548
475############################################################################# 549#############################################################################
476 550
477package game; 551package game;
… …
487 $self = $self->SUPER::new(@_); 561 $self = $self->SUPER::new(@_);
488 562
489 $self->listen($self->{conn}); 563 $self->listen($self->{conn});
490 564
491 $self->{window} = new Gtk::Window 'toplevel'; 565 $self->{window} = new Gtk::Window 'toplevel';
492 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1); 566 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
567 $self->{window}->set_title("KGS Game $title");
493 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 568 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
494 569
495 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 570 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
496 571
497 $self->{window}->add(my $hpane = new Gtk::HPaned); 572 $self->{window}->add(my $hpane = new Gtk::HPaned);
498 ::state $hpane, "game::hpane", undef, hpane_position => 500; 573 ::state $hpane, "game::hpane", undef, hpane_position => 500;
499 574
500 $::config{aa} = 0; 575 $hpane->pack1(my $vbox = new Gtk::VBox);
501 $self->{canvas} = $::config{aa} ? new_aa Gnome::Canvas : new Gnome::Canvas; 576
502 $hpane->add($self->{canvas}); 577 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
503 578
504 { 579 {
505 my $line_colour = $::config{line_colour} || "darkbrown"; 580 $frame->add(my $vbox = new Gtk::VBox);
506 my $border = 0.1; 581 $vbox->add($self->{title} = new Gtk::Label $title);
507 my $ofs = 0.5 / $self->{size}; 582
583 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
584 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
585 $scale->set_draw_value (1);
586 $scale->set_digits (0);
587 $scale->set_value_pos('top');
588
589 $self->{moveadj}->signal_connect (value_changed => sub {
590 $self->{board} = new KGS::Game::Board $self->{size};
591 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
592
593 my $area = $self->repaint_board;
594
595 # force a redraw (not perfect(?))
596 $self->expose ($area);
597
598 $self->{text}->backward_delete($self->{text}->get_length);
599 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
600 });
601
602 $self->{moveadj}->upper (scalar @{$self->{path}}) if $self->{path};
603 }
508 604
509 $self->{canvas}->set_pixels_per_unit(1000); 605 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
510 $self->{canvas}->set_scroll_region(-$border,-$border,1+$border,1+$border); 606 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
607 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
608 Gtk::Widget->pop_colormap;
609 Gtk::Widget->pop_visual;
511 610
512 $self->{canvas}->signal_connect(size_allocate => sub { 611 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
513 my ($w, $h) = @{$_[1]}[2,3]; 612 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
514 613
515 $self->{canvas}->set_pixels_per_unit(($w > $h ? $h : $w)/(1+$border*2));
516
517 1;
518 });
519
520 my $croot = $self->{canvas}->root;
521 my $cgroup = $croot; #->new($croot, "Gnome::CanvasGroup");
522
523 if ($::board_img) {
524 $cgroup->new($cgroup, "Gnome::CanvasImage",
525 x => -$border, y => -$border,
526 width => 1+$border*2, height => 1+$border*2,
527 image => $::board_img,
528 anchor => "nw"
529 );
530 } else {
531 $cgroup->new($cgroup, "Gnome::CanvasRect",
532 x1 => -$border, x2 => 1+$border,
533 y1 => -$border, y2 => 1+$border,
534 outline_color => "black",
535 fill_color => "brown",
536 width_pixels => 2,
537 );
538 }
539
540 my $a = "A";
541 for my $i (1 .. $self->{size}) { # one more iteration for the last lines
542 my $k = $i / $self->{size} - $ofs;
543
544 $cgroup->new($cgroup, "Gnome::CanvasLine",
545 points => [ $k,$ofs, $k,1-$ofs ],
546 fill_color => $line_colour,
547 width_pixels => 1);
548
549 $cgroup->new($cgroup, "Gnome::CanvasLine",
550 points => [ $ofs,$k, 1-$ofs,$k ],
551 fill_color => $line_colour,
552 width_pixels => 1);
553
554 for ( [$k,-$border*0.5,$a], [$k,1+$border*0.5,$a], [-$border*0.5,$k,$i], [1+$border*0.5,$k,$i] ) {
555 my ($x, $y, $text) = @$_;
556
557 my $text = $cgroup->new($cgroup, "Gnome::CanvasText",
558 x => 0, y => 0, text => $text,
559 justification => "center",
560 anchor => "center",
561 font => $::config{aa} ? "-*-helvetica-medium-r-*--34-*" : "-*-helvetica-bold-r-*--17-*",
562 fill_color => $line_colour);
563
564 $text->affine_relative($border*0.015,0, 0,$border*0.015, $x,$y);
565 }
566
567 $a++;
568 }
569
570 my $stones = [[]];
571
572 for my $x (1 .. $self->{size}) {
573 my $xk = $x / $self->{size} - $ofs;
574 for my $y (1 .. $self->{size}) {
575 my $yk = $y / $self->{size} - $ofs;
576
577 my $col = $stones->[$x-1][$y-1] = [];
578
579 if (1) {
580 $col->[0] =
581 $cgroup->new($cgroup, "Gnome::CanvasImage",
582 x => $xk, y => $yk,
583 width => $ofs*2, height => $ofs*2,
584 image => $::black_img[int rand @::black_img],
585 anchor => "center");
586 $col->[1] =
587 $cgroup->new($cgroup, "Gnome::CanvasImage",
588 x => $xk, y => $yk,
589 width => $ofs*2, height => $ofs*2,
590 image => $::white_img[int rand @::white_img],
591 anchor => "center");
592 } else {
593 die "need pixmaps\n";
594 # too large, scale has NO effect
595 $col->[0] =
596 $cgroup->new($cgroup, "Gnome::CanvasEllipse",
597 x1 => $xk, x2 => $xk + 0.001,
598 y1 => $yk, y2 => $yk + 0.001,
599 outline_color => "black", width_pixels => 2,
600 fill_color => "black");
601 $col->[1] =
602 $cgroup->new($cgroup, "Gnome::CanvasEllipse",
603 x1 => $xk, x2 => $xk + 0.001,
604 y1 => $yk, y2 => $yk + 0.001,
605 outline_color => "black", width_pixels => 2,
606 fill_color => "white");
607 }
608 }
609 }
610
611 $self->{board_gfx}{stones} = $stones;
612 }
613
614 $hpane->add(my $vpane = new Gtk::VPaned); 614 $hpane->pack2((my $vpane = new Gtk::VPaned), 0, 0);
615 ::state $vpane, "game", $self->{name}, vpane_position => 80; 615 ::state $vpane, "game", $self->{name}, vpane_position => 80;
616 616
617 $vpane->add(my $sw = new Gtk::ScrolledWindow); 617 $vpane->add(my $sw = new Gtk::ScrolledWindow);
618 $sw->set_policy("automatic", "always"); 618 $sw->set_policy("automatic", "always");
619 619
… …
653 653
654sub part { 654sub part {
655 my ($self) = @_; 655 my ($self) = @_;
656 $self->SUPER::part; 656 $self->SUPER::part;
657 657
658 $self->{window}->hide_all; 658 $self->{window}->hide;
659 $self->event_update; 659}
660
661sub configure_event {
662 my ($widget, $self, $event) = @_;
663 delete $self->{stack};
664 delete $self->{pixbuf};
665 delete $self->{board_shown};
666 delete $self->{background};
667 $self->repaint_board;
668 1;
669}
670
671sub INTERP_NEAREST (){ 1 }
672sub INTERP_TILES (){ 1 }
673sub INTERP_BILINEAR (){ 2 }
674sub INTERP_HYPER (){ 3 }
675
676sub new_pixbuf {
677 my ($w, $h, $alpha, $clear) = @_;
678
679 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
680
681 if ($clear) { # damn, need to clear it ourselves
682 my $row = "\x00\x00\x00\x00" x $w;
683 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
684 }
685
686 $pixbuf;
687}
688
689sub scale_pixbuf {
690 my ($src, $w, $h, $mode) = @_;
691
692 my $dst = new_pixbuf $w, $h, 1;
693
694 $src->scale(
695 $dst, 0, 0, $w, $h, 0, 0,
696 $w / $src->get_width, $h / $src->get_height,
697 $mode,
698 );
699
700 $dst;
701}
702
703# create a stack of stones
704sub create_stack {
705 my ($self, $mark, $size, $rand) = @_;
706
707 my $shadow = $size * 0.05;
708
709 my $c = \$self->{stack}{$mark};
710 unless ($$c) {
711 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
712 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
713
714 # zeroeth the shadow
715 if ($mark & (MARK_B | MARK_W)) {
716 $::black_img[0]->composite (
717 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
718 $size / $stone->get_width, $size / $stone->get_height,
719 $::config->{speed} ? INTERP_NEAREST : INTERP_TILES, 128
720 );
721 }
722
723 # first the big stones (handicap stones different for effect)
724 for ([MARK_B, $mark & MARK_MOVE ? 255 : 192],
725 [MARK_W, $mark & MARK_MOVE ? 255 : 192],
726 [MARK_GRAY_B, 128],
727 [MARK_GRAY_W, 128]) {
728 my ($mask, $alpha) = @$_;
729 if ($mark & $mask) {
730 $stone->composite (
731 $base, 0, 0, $size, $size, -0.5, -0.5,
732 $size / $stone->get_width, $size / $stone->get_height,
733 $::config->{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
734 );
735 }
736 }
737
738 # then the samll stones
739 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
740 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
741 my ($mask, $img) = @$_;
742 if ($mark & $mask) {
743 $img->composite (
744 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
745 $size / $img->get_width / 2, $size / $img->get_height / 2,
746 $::config->{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
747 );
748 }
749 }
750
751 # and lastly any markers
752 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
753
754 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
755 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
756 [MARK_SQUARE, $::square_img[$dark_bg]]) {
757 my ($mask, $img) = @$_;
758 if ($mark & $mask) {
759 $img->composite (
760 $base, 0, 0, $size, $size, -0.5, -0.5,
761 $size / $img->get_width, $size / $img->get_height,
762 $::config->{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
763 );
764 }
765 }
766
767 push @$$c, $base;
768 }
769 }
770
771 $$c->[$rand % @$$c];
772}
773
774sub pixbuf_text {
775 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
776
777 my @c = grep $_,
778 map $::font[$colour][$::fontmap{$_}],
779 split //, $text;
780
781 if (@c) {
782 my $spacing = $height * 0.1;
783 my $s = $height / List::Util::max map $_->get_height, @c;
784 my $W = List::Util::sum map $_->get_width, @c;
785
786 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
787 $y -= $height * 0.5;
788
789 for (@c) {
790 my $w = $_->get_width * $s;
791 $_->composite ($pixbuf,
792 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
793 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
794
795 $x += $w + $spacing;
796 }
797 }
798}
799
800my $black_pb;
801
802sub pixbuf_rect {
803 my ($pb, $x1, $y1, $x2, $y2) = @_;
804 # we fake lines by... an unspeakable method :/
805 unless ($black_pb) {
806 $black_pb = new_pixbuf 1, 1, 0, 0;
807 $black_pb->put_pixels ("\x44\x11\x11", 0, 0);
808 }
809
810 $black_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, 192);
811}
812
813sub repaint_board {
814 my ($self) = @_;
815 my $canvas = $self->{canvas};
816 my $expose_area = undef;
817
818 return $expose_area unless $self->{board};
819
820 my ($w, $h) = @{$canvas->allocation}[2,3];
821
822 my $s = $w > $h ? $h : $w;
823
824 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
825
826 my $size = $self->{size};
827
828 my $border = int ($s / ($size + 3) * 0.5);
829 my $s2 = $s - $border * 2;
830 my $edge = int ($s2 / ($size + 1) * 0.95) - ($::config->{randomize} ? 3 : 0);
831 my $ofs = int ($edge / 2);
832
833 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
834
835 my $pixbuf;
836
837 my $oldboard;
838
839 if ($self->{background}) {
840 if ($oldboard = $self->{board_shown}) {
841 $pixbuf = $self->{pixbuf};
842 } else {
843 $pixbuf = $self->{background}->copy;
844 $expose_area = [0, 0, $s, $s];
845 }
846 } else {
847 $expose_area = [0, 0, $s, $s];
848
849 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
850
851 if ($s < $bw && $s < $bh) {
852 $pixbuf = new_pixbuf $s, $s, $::config->{conserve_memory} ? 0 : 1, 0;
853 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
854 } else {
855 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config->{speed} ? INTERP_NEAREST : INTERP_TILES;
856 }
857
858 my $linew = int ($s / 25 / $size);
859
860 for my $i (1 .. $size) {
861 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
862 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
863
864 # 38 max, but we allow a bit more
865 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
866 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];
867
868 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
869 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
870 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
871 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
872
873 $a++;
874 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
875 }
876
877 unless ($::config->{conserve_memory}) {
878 $self->{background} = $pixbuf;
879 $pixbuf = $pixbuf->copy;
880 }
881 }
882
883 $self->{pixbuf} = $pixbuf;
884
885 # hoshi-points(!)#d#
886 # caching of empty board gfx(!)#d#
887
888 for my $x (1 .. $size) {
889 for my $y (1 .. $size) {
890 my $rand = ($x ^ $y ^ 0x5555);
891
892 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
893
894 if ($::config->{randomize}) {
895 $dx += ($rand % 7) - 3;
896 $dy += ($rand / 3 % 7) - 3;
897 }
898
899 my $shadow = $edge * 0.05;
900 my $area = [$dx, $dy, $edge + $shadow, $edge + $shadow];
901
902 my $mark = $self->{board}{board}[$x-1][$y-1];
903 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
904
905 if ($oldboard) {
906 next if $old == $mark; # no change
907
908 $self->{background}->copy_area (@$area, $pixbuf, $dx, $dy);
909 $expose_area = $expose_area
910 ? Gtk::Gdk::Rectangle->union ($expose_area, $area)
911 : $area;
912 }
913
914 if ($mark) {
915 my $pb = $self->create_stack($mark, $edge, $rand);
916
917 $pb->composite ($pixbuf, @$area,
918 $dx, $dy, 1, 1, $::config->{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
919
920 # labels are handled here because they are quite rare
921 if ($mark & MARK_LABEL) {
922 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
923
924 if ($white) {
925 pixbuf_text $pixbuf, 0,
926 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
927 $self->{board}{label}[$x-1][$y-1];
928 }
929 pixbuf_text $pixbuf, $white,
930 $k[$x], $k[$y], $ofs * 0.7,
931 $self->{board}{label}[$x-1][$y-1];
932 }
933
934 # old pixmap&mask-way. that was fast ;(
935 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
936
937 #$gc->set_clip_mask ($bm);
938 #$gc->set_clip_origin ($dx, $dy);
939 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
940 }
941 }
942 }
943
944 $self->{board_shown} = Storable::dclone $self->{board};
945 #d# save
946 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
947
948 $expose_area;
949}
950
951sub expose {
952 my ($self, $area) = @_;
953
954 if ($area && $self->{pixbuf}) {
955 my ($x, $y, $w, $h) = @$area;
956 my ($ox, $oy, $s) = @{$self->{offsets}};
957
958 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
959 $x, $y, $x + $ox, $y + $oy, $w, $h);
960 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
961 $x + $ox - 1, $y + $oy - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
962
963 #$self->{canvas}->window->draw_pixmap (
964 # $self->{canvas}->style->white_gc,
965 # $self->{pixmap},
966 # $x - $ox, $y - $oy, $x, $y, $w, $h,
967 #);
968 }
969}
970
971sub expose_event {
972 my ($widget, $self, $event) = @_;
973
974 $self->{pixbuf} or return;
975
976 my $area = $event->{area};
977 my ($ox, $oy, $s) = @{$self->{offsets}};
978
979 $self->expose (Gtk::Gdk::Rectangle->intersect (
980 [$area->[0] - $ox, $area->[1] - $oy, $area->[2], $area->[3]],
981 [0, 0, $s, $s],
982 ));
983
984 1;
660} 985}
661 986
662sub event_update_tree { 987sub event_update_tree {
663 my ($self) = @_; 988 my ($self) = @_;
664 989
665 my $board = new KGS::Game::Board $self->{size}; 990 $self->{path} = $self->get_path;
666 $board->interpret_path ($self->get_path);
667
668 for my $x (0 .. $self->{size} - 1) {
669 for my $y (0 .. $self->{size} - 1) {
670 my $v = $board->{board}[$x][$y];
671
672 $v & MARK_B
673 ? $self->{board_gfx}->{stones}->[$x][$y][0]->show
674 : $self->{board_gfx}->{stones}->[$x][$y][0]->hide;
675 $v & MARK_W
676 ? $self->{board_gfx}->{stones}->[$x][$y][1]->show
677 : $self->{board_gfx}->{stones}->[$x][$y][1]->hide;
678 }
679 } 991
992 my $move = @{$self->{path}};
680 993
681 $self->{text}->backward_delete($self->{text}->get_length); 994 $self->{moveadj}->upper($move);
682 $self->{text}->insert(undef, undef, undef, $board->{comment}.PApp::Util::dumpval([$board->{time},$board->{captures}])); 995
996 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
997 $self->{moveadj}->value ($move);
998 $self->{moveadj}->value_changed;
999 }
1000}
1001
1002sub event_part {
1003 my ($self) = @_;
1004 $self->SUPER::event_part;
1005 (delete $self->{window})->destroy; # hmm.. why does this keep the object alive? puzzling.. ahh.. the callbacks ;)
1006 delete $self->{room}{game}{$self->{channel}};
1007}
1008
1009sub event_move {
1010 my ($self, $pass) = @_;
1011 ::play_sound 1, $pass ? "pass" : "move";
1012}
1013
1014sub DESTROY {#d#
1015 warn "DESTROY(@_)\n";#d#
683} 1016}
684 1017
6851; 10181;
686 1019
687 1020

Diff Legend

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