> 32) & 0xffffffff; } sub enc_I16 { enc_U16 unpack "S", pack "s", $_[0]; } sub enc_I32 { enc_U32 unpack "I", pack "i", $_[0]; } sub enc_DATA { # a dream! $data .= $_[0]; } sub enc_STRING { # should use encode for speed and clarity ;) $data .= pack "v*", map ord, split //, $_[0]; } ]]> ############################################################################# # types ############################################################################# # structures ############################################################################# # "less" primitive types 1, square => 2, circle => 3, small_b => 4, small_w => 5, gray => 6, move => 7, addstone => 8, ); my %code_marker = reverse %marker_code; # this was the most horrible thing to decode. still not everything is decoded correctly(?) sub dec_TREE { my @r; while (length $data) { my $type = dec_U8; if ($type == 255) { push @r, [add_child => dec_I32]; } elsif ($type == 254) { push @r, ["done"]; } elsif ($type == 253) { push @r, ["type253"]; # ???? } elsif ($type == 252) { # even less clear push @r, ["more"]; } elsif ($type == 10) { # as usual, wms finds yet another way to duplicate code... oh well, what a mess. # (no wonder he is so keen on keeping it secret...) push @r, [rules => dec_rules]; } elsif ($type == 9 || $type == 22 || $type == 25 || $type == 31 || $type == 32) { push @r, [({ 9 => "comment", 22 => "unknown_comment22", 25 => "copyright", #? 31 => "date", 32 => "unknown_comment32", })->{$type} => dec_STRING]; } elsif ($type == 11 || $type == 12) { push @r, [player => $type - 11, dec_STRING]; } elsif ($type == 13 || $type == 14) { push @r, [rank => $type - 13, dec_U32]; } elsif ($type == 15 || $type == 16) { push @r, [set_timer => $type - 15, dec_time, dec_U16]; } elsif ($type == 17 || $type == 18) { push @r, [score => $type - 17, dec_score16]; } elsif ($type == 19) { push @r, [result => dec_result]; # not certain } elsif ($type == 30) { push @r, [active_player => dec_U8]; } elsif ($type == 0) { # label(?) my $label; my $c = dec_U16; $label .= chr $c if $c; my $c = dec_U16; $label .= chr $c if $c; my $c = dec_U16; $label .= chr $c if $c; # empty label == remove label push @r, [label => $label, dec_U8, dec_U8]; } elsif ($type > 0 && $type < 9) { # 1 marker type triangle # 2 marker type square # 3 marker type circle # 4 small stone b # 5 small stone w # 6 grayed out # 7 move # 8 also move(?) or preset? # # $a1 is probably player again (2 == remove) # x is from left 0 to right boardsize-1 # y is from top 0 to bottom boardsize-1 push @r, [$code_marker{$type} => dec_U8, dec_U8, dec_U8]; } else { push @r, [unknown => $type]; } } \@r; } sub enc_TREE { for (@{$_[0]}) { my ($type, @arg) = @$_; if ($type eq "add_child") { enc_U8 255; enc_I32 $arg[0]; } elsif ($type eq "done") { enc_U8 254; } elsif ($type eq "more") { enc_U8 253; } elsif ($type eq "comment") { # handle other string params, too enc_U8 9; enc_STRING $arg[0]; } elsif ($type eq "label") { enc_U8 0; enc_U16 ord substr "$arg[0]\x00\x00", 0, 1; enc_U16 ord substr "$arg[0]\x00\x00", 1, 1; enc_U16 ord substr "$arg[0]\x00\x00", 2, 1; enc_U8 $arg[1]; enc_U8 $arg[2]; } elsif ($marker_code{$type}) { enc_U8 $marker_code{$type}; enc_U8 $arg[0]; enc_U8 $arg[1]; enc_U8 $arg[2]; } else { warn "unable to encode tree node type $type\n"; } } } ]]> ############################################################################# # messages } 1; sub dec_ { my @r = unpack "v a*", $data; $data = pop @r; join ":", map chr, @r; } sub enc_ { $data .= pack "v", map ord, split //, $_[0]; } sub dec_ { (my ($r), $data) = unpack "Z a*", $data; $r; } sub enc_ { $data .= pack "Z", $_[0]; } sub dec_ { (1 / ) * dec_; } sub enc_ { enc_ $_[0] * ; } $r->{} = (my $array = []); while (length $data) { push @$array, dec_ ; } $r->{} = dec_ if ($r->{} ) ; $_[0]{} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/ or Carp::confess "FATAL: tried to send illegal username '$_[0]{}'"; $_[0]{} > 0 or Carp::confess "FATAL: tried to send a zero channel id"; enc_ defined $_[0]{} ? $_[0]{ } : ( ); sub dec_ { my $r = {}; bless $r, ::; $r; } sub enc_ { } # $recv{0x} = sub { $data = $_[0]; my $r; $r->{type} = ""; $r; }; $send{} = sub { $data = ""; enc_U16 0x; $data; }; [ => " ", " ", " ;"],