… | |
… | |
15 | |
15 | |
16 | our $VERSION = '0.0'; # be more confident.... |
16 | our $VERSION = '0.0'; # be more confident.... |
17 | |
17 | |
18 | $SIG{QUIT} = sub { Carp::confess "SIGQUIT" }; |
18 | $SIG{QUIT} = sub { Carp::confess "SIGQUIT" }; |
19 | |
19 | |
|
|
20 | my $conn = new KGS::Protocol; |
20 | my $kgs; |
21 | my $kgs; |
21 | my $gtp; |
22 | my $gtp; |
22 | |
23 | |
23 | my $verbose = 1; |
24 | my $verbose = 1; |
24 | my $user = "gtpguest"; |
25 | my $user = "gtpguest"; |
… | |
… | |
48 | |
49 | |
49 | package kgs; |
50 | package kgs; |
50 | |
51 | |
51 | use base KGS::Listener; |
52 | use base KGS::Listener; |
52 | |
53 | |
53 | my $conn = new KGS::Protocol; |
|
|
54 | |
|
|
55 | sub new { |
54 | sub new { |
56 | my $class = shift; |
55 | my $class = shift; |
57 | my $self = bless { @_ }, $class; |
56 | my $self = bless { @_ }, $class; |
58 | |
57 | |
59 | print STDERR "$0 version $VERSION connecting...\n" if $verbose; |
58 | print STDERR "$0 version $VERSION connecting...\n" if $verbose; |
60 | |
59 | |
61 | my $sock = new IO::Socket::INET PeerHost => $ENV{KGSHOST} || "kgs.kiseido.com", PeerPort => "2379" |
60 | my $sock = new IO::Socket::INET PeerHost => KGS::Protocol::KGSHOST, PeerPort => KGS::Protocol::KGSPORT |
62 | or die "connect: $!"; |
61 | or die "connect: $!"; |
63 | |
62 | |
64 | $sock->blocking (1); |
63 | $sock->blocking (1); |
65 | $conn->handshake ($sock); |
64 | $conn->handshake ($sock); |
66 | |
65 | |
… | |
… | |
121 | return unless (lc $self->{conn}{name}) eq (lc $msg->{name2}); |
120 | return unless (lc $self->{conn}{name}) eq (lc $msg->{name2}); |
122 | |
121 | |
123 | $gtp->send ("kgs-user-chat $msg->{name} $msg->{message}"); |
122 | $gtp->send ("kgs-user-chat $msg->{name} $msg->{message}"); |
124 | } |
123 | } |
125 | |
124 | |
|
|
125 | sub inject_new_game { |
|
|
126 | my ($self, $msg) = @_; |
|
|
127 | |
|
|
128 | $::lastnew = $msg->{channel};#d# |
|
|
129 | $gtp->send ("kgs-game-new $msg->{cid} $msg->{channel}"); |
|
|
130 | } |
|
|
131 | |
126 | ############################################################################# |
132 | ############################################################################# |
127 | |
133 | |
128 | package room; |
134 | package room; |
129 | |
135 | |
130 | use base KGS::Listener::Room; |
136 | use base KGS::Listener::Room; |
… | |
… | |
154 | |
160 | |
155 | for (@$add, @$upd) { |
161 | for (@$add, @$upd) { |
156 | $gtp->send (sprintf "kgs-game-update %d %d %s %s %s %s %d %d %f %d %d %d %d %s", |
162 | $gtp->send (sprintf "kgs-game-update %d %d %s %s %s %s %d %d %f %d %d %d %d %s", |
157 | $self->{channel}, $_->{channel}, |
163 | $self->{channel}, $_->{channel}, |
158 | $_->type_char, |
164 | $_->type_char, |
|
|
165 | ::format_user $_->{black}, |
|
|
166 | ::format_user $_->{white}, |
159 | ::format_user $_->{user1}, |
167 | ::format_user $_->{owner}, |
160 | ::format_user $_->{user2}, |
|
|
161 | ::format_user $_->{user3}, |
|
|
162 | $_->size, |
168 | $_->size, |
163 | $_->{handicap}, |
169 | $_->{handicap}, |
164 | $_->{komi}, |
170 | $_->{komi}, |
165 | $_->moves, |
171 | $_->moves, |
166 | $_->{flags}, |
172 | $_->{flags}, |
… | |
… | |
309 | } |
315 | } |
310 | |
316 | |
311 | ############################################################################# |
317 | ############################################################################# |
312 | |
318 | |
313 | package gtp; |
319 | package gtp; |
|
|
320 | |
|
|
321 | use Gtk2::GoBoard::Constants; |
|
|
322 | use KGS::Constants; |
314 | |
323 | |
315 | use Fcntl; |
324 | use Fcntl; |
316 | |
325 | |
317 | sub new { |
326 | sub new { |
318 | my $class = shift; |
327 | my $class = shift; |
… | |
… | |
439 | name => $kgs->{user}, |
448 | name => $kgs->{user}, |
440 | name2 => $1, |
449 | name2 => $1, |
441 | message => $2); |
450 | message => $2); |
442 | $self->reply ($id, ""); |
451 | $self->reply ($id, ""); |
443 | |
452 | |
|
|
453 | } elsif ($cmd =~ /^kgs-game-new-demo\s+(\d+)\s+(\d+)$/) { |
|
|
454 | my $tid = $conn->alloc_clientid; |
|
|
455 | $kgs->send (new_game => |
|
|
456 | channel => $1, |
|
|
457 | cid => $tid, |
|
|
458 | type => 0, |
|
|
459 | rules => { |
|
|
460 | ruleset => 0, |
|
|
461 | size => $2, |
|
|
462 | komi => 0, |
|
|
463 | timesys => 0, |
|
|
464 | time => 0, |
|
|
465 | interval => 0, |
|
|
466 | count => 0, |
|
|
467 | }); |
|
|
468 | $self->reply ($id, $tid); |
|
|
469 | } elsif ($cmd =~ /^kgs-game-edit\s+(\d+)\s+(.*)$/) { |
|
|
470 | my $gid = $1 || $::lastnew;#d# |
|
|
471 | my $spec = $2; |
|
|
472 | my @tree = (); |
|
|
473 | while ($spec =~ s/^([a-z])(\d+)\s+\+?(\S+)\s*//) { # should use mg |
|
|
474 | my ($x, $y, $spec) = ($1, $2, $3); |
|
|
475 | my $add = $spec !~ s/^-//; |
|
|
476 | $x = index "abcdefghjklmnopqrstuvwxyz", lc $x; |
|
|
477 | $y--; |
|
|
478 | |
|
|
479 | if ($spec eq "b") { push @tree, [set_stone => 0, $x, $y]; |
|
|
480 | } elsif ($spec eq "w") { push @tree, [set_stone => 1, $x, $y]; |
|
|
481 | } elsif ($spec eq "n") { push @tree, [set_stone => 2, $x, $y]; |
|
|
482 | } elsif ($spec eq "sb") { push @tree, [mark => $add, MARK_SMALL_B, $x, $y]; |
|
|
483 | } elsif ($spec eq "sw") { push @tree, [mark => $add, MARK_SMALL_W, $x, $y]; |
|
|
484 | } elsif ($spec eq "sn") { push @tree, [mark => 0, MARK_SMALL_B, $x, $y]; |
|
|
485 | } elsif ($spec eq "triangle") { push @tree, [mark => $add, MARK_TRIANGLE, $x, $y]; |
|
|
486 | } elsif ($spec eq "square") { push @tree, [mark => $add, MARK_SQUARE, $x, $y]; |
|
|
487 | } elsif ($spec eq "circle") { push @tree, [mark => $add, MARK_CIRCLE, $x, $y]; |
|
|
488 | } elsif ($spec =~ /label=(\S+)/) { push @tree, [mark => length $1, MARK_LABEL, $x, $y, $1]; |
|
|
489 | } elsif ($spec eq "grayed") { push @tree, [mark => $add, MARK_GRAYED, $x, $y]; |
|
|
490 | } else { |
|
|
491 | $self->reply_err ($id, "illegal edit spec '$spec'"); |
|
|
492 | return; |
|
|
493 | } |
|
|
494 | } |
|
|
495 | $kgs->send (upd_tree => |
|
|
496 | channel => $gid, |
|
|
497 | tree => \@tree); |
|
|
498 | $self->reply ($id, ""); |
|
|
499 | |
444 | } else { |
500 | } else { |
445 | $self->reply_err ($id, "illegal command"); |
501 | $self->reply_err ($id, "illegal command"); |
446 | } |
502 | } |
447 | } |
503 | } |
448 | |
504 | |
… | |
… | |
476 | Command extension used by the controller: |
532 | Command extension used by the controller: |
477 | |
533 | |
478 | kgs-login message |
534 | kgs-login message |
479 | kgs-room-update <rid> <name> # update room info |
535 | kgs-room-update <rid> <name> # update room info |
480 | kgs-room-chat <rid> <user> <message> # somebody says sth. |
536 | kgs-room-chat <rid> <user> <message> # somebody says sth. |
481 | kgs-game-update <rid> <gid> <type> <user1> <user2> \ |
537 | kgs-game-update <rid> <gid> <type> <black> <white> \ |
482 | <user3> <size> <handicap> <komi> <moves> \ |
538 | <owner> <size> <handicap> <komi> <moves> \ |
483 | <flags> <observers> <saved> <notes> |
539 | <flags> <observers> <saved> <notes> |
484 | kgs-game-delete <rid> <gid> # game removed |
540 | kgs-game-delete <rid> <gid> # game removed |
485 | kgs-user-update <rid> <user> # user added/updated |
541 | kgs-user-update <rid> <user> # user added/updated |
486 | kgs-user-delete <rid> <user> # user removed |
542 | kgs-user-delete <rid> <user> # user removed |
487 | |
543 | |
488 | kgs-game-resign <gid> <color> |
544 | kgs-game-resign <gid> <color> |
489 | kgs-game-score <gid> <w-territory> <w-captures> <w-komi> <b-territory> <b-captures> <b-komi> |
545 | kgs-game-score <gid> <w-territory> <w-captures> <w-komi> <b-territory> <b-captures> <b-komi> |
490 | kgs-game-id <gid> # set id for following gid-less commands |
546 | kgs-game-id <gid> # set id for following gid-less commands |
491 | |
547 | |
492 | kgs-user-chat <user> <message> # got private message from user |
548 | kgs-user-chat <user> <message> # got private message from user |
|
|
549 | kgs-game-new <tid> <gid> # a new game was created with temporary id <tid> |
493 | ... |
550 | ... |
494 | |
551 | |
495 | Commands usable by the client: |
552 | Commands usable by the client as commands issued to the controller: |
496 | |
553 | |
497 | kgs-room-list # ask for roomlist update |
554 | kgs-room-list # ask for roomlist update |
498 | kgs-room-join <rid> # join given room |
555 | kgs-room-join <rid> # join given room |
499 | kgs-room-chat <rid> <message> # say sth. in room |
556 | kgs-room-chat <rid> <message> # say sth. in room |
500 | kgs-room-part <rid> # leave gives room |
557 | kgs-room-part <rid> # leave gives room |
… | |
… | |
502 | kgs-game-join <gid> # join the given game |
559 | kgs-game-join <gid> # join the given game |
503 | kgs-game-part <gid> # leave the given game |
560 | kgs-game-part <gid> # leave the given game |
504 | kgs-game-chat <gid> <message> # say sth. |
561 | kgs-game-chat <gid> <message> # say sth. |
505 | |
562 | |
506 | kgs-user-chat <user> <message> # send private msg to user |
563 | kgs-user-chat <user> <message> # send private msg to user |
|
|
564 | kgs-game-new-demo <rid> <size> # create new demo game (other agruments might get added) |
|
|
565 | # returns a temporary game id |
|
|
566 | kgs-game-edit <gid> <coord> <editspec> <coord> <editspec>... |
|
|
567 | # editspec is one of |
|
|
568 | # b|w|n set black/white/no stone |
|
|
569 | # sb|sw|sn set/clear black/white/no small stone |
|
|
570 | # [+-]triangle set/clear triangle |
|
|
571 | # [+-]square set/clear square |
|
|
572 | # [+-]circle set/clear circle |
|
|
573 | # [+-]grayed set/clear grayed-flag |
|
|
574 | # label=xyz set label to xyz |
507 | ... |
575 | ... |
508 | |
576 | |
509 | EOF |
577 | EOF |
510 | exit shift; |
578 | exit shift; |
511 | } |
579 | } |