> 32) & 0xffffffff; } sub enc_I8 { $data .= pack "c", $_[0]; } 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_ZSTRING { # should use encode for speed and clarity ;) $data .= pack "v*", (map ord, split //, $_[0]), 0; } sub enc_STRING { # should use encode for speed and clarity ;) $data .= pack "v*", map ord, split //, $_[0]; } sub enc_CONSTANT { # nop } sub enc_password { require Math::BigInt; # I insist on 32-bit-perl.. should use C # $hash must be 64 bit my $hash = new Math::BigInt; $hash = $hash * 1055 + ord for split //, $_[0]; enc_U64 $hash; } sub enc_HEX { die "enc_HEX not defined for good"; } ]]> ############################################################################# # types ############################################################################# # structures ############################################################################# # "less" primitive types dec_I32]; } elsif ($type == 126) { push @r, [set_node => dec_I32]; } elsif ($type == 125) { push @r, [set_current => dec_I32]; } elsif ($type == 34) { push @r, [score => dec_U8, dec_score1000]; } elsif ($type == 29) { push @r, [type_29 => dec_ZSTRING]; warn "UNKNOWN TREE TYPE 29 $r[-1][1]\007 PLEASE REPORT";#d# die; } elsif ($type == 28) { # move number, only in variations it seems. oh my. push @r, [movenum => dec_ZSTRING]; } elsif ($type == 26) { push @r, [type_26 => dec_U8]; # sets a flag (?) warn "unknown tree node 26, PLEASE REPORT AND INCLUDE THE GAME\n"; } elsif ($type == 25) { push @r, [result => dec_result]; } elsif ($type == 23) { push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8]; } elsif ($type == 22) { push @r, [mark => $add, dec_U8() ? MARK_SMALL_W : MARK_SMALL_B, dec_U8, dec_U8]; } elsif ($type == 21) { push @r, [mark => $add, MARK_SQUARE, dec_U8, dec_U8]; } elsif ($type == 20) { push @r, [mark => $add, MARK_TRIANGLE, dec_U8, dec_U8]; } elsif ($type == 19) { push @r, [mark => $add, MARK_LABEL, dec_U8, dec_U8, dec_ZSTRING]; #push @r, [unknown_18 => dec_U8, dec_U32, dec_U32, dec_U8, dec_U32, dec_U32, dec_U32]; #push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]]; } elsif ($type == 18) { push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]]; } elsif ($type == 17) { push @r, [set_stone => dec_U8, dec_U8, dec_U8];#d#? # } elsif ($type == 16) { # push @r, [set_stone => dec_U8, dec_U8, dec_U8];#o# } elsif ($type == 15) { push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8];#d#? } elsif ($type == 14) { push @r, [move => dec_U8, dec_U8, dec_U8]; } elsif (($type >= 4 && $type <= 9) || ($type >= 11 && $type <= 13) || $type == 24) { push @r, [({ 4 => "date", 5 => "unknown_comment5", 6 => "game_id", #?# 7 => "unknown_comment7", 8 => "unknown_comment8", 9 => "copyright", #? 11 => "unknown_comment11", 12 => "unknown_comment12", 13 => "unknown_comment13", 24 => "comment", })->{$type} => dec_ZSTRING]; } elsif ($type == 3) { push @r, [rank => dec_U8, dec_U32]; } elsif ($type == 2) { push @r, [player => dec_U8, dec_ZSTRING]; } elsif ($type == 1) { push @r, [sgf_name => dec_ZSTRING]; } elsif ($type == 0) { # as usual, wms finds yet another way to duplicate code... oh well, what a mess. # (no wonder he is so keen on keeping it a secret...) push @r, [rules => dec_rules]; # OLD } else { require KGS::Listener::Debug; # hack print STDERR KGS::Listener::Debug::dumpval(\@r); printf "offset: 0x%04x\n", $ofs; open XTYPE, "|xtype"; print XTYPE $old_data; close XTYPE; warn "unknown tree type $type, PLEASE REPORT and include the game you wanted to watch. thx."; } push @{$r[-1]}, offset => sprintf "0x%x", $ofs;#d# } # print STDERR KGS::Listener::Debug::dumpval(\@r);#d# # return [];#d# \@r; } sub enc_TREE { for (@{$_[0]}) { my ($type, @arg) = @$_; if ($type eq "add_node") { enc_U8 127; enc_U8 0; # unused? enc_I32 $arg[0]; } elsif ($type eq "set_node") { enc_U8 126; enc_I32 $arg[0]; } elsif ($type eq "set_current") { enc_U8 125; enc_I32 $arg[0]; } elsif ($type eq "movenum") { enc_U8 28; enc_ZSTRING $arg[0]; } elsif ($type eq "set_stone") { enc_U8 16; enc_U8 $arg[0]; enc_U8 $arg[1]; enc_U8 $arg[2]; } elsif ($type eq "move") { enc_U8 14; enc_U8 $arg[0]; enc_U8 $arg[1]; enc_U8 $arg[2]; } elsif ($type eq "comment") { enc_U8 24; enc_ZSTRING $arg[0]; } elsif ($type eq "mark") { my $op = ({ &MARK_GRAYED => 23, &MARK_SMALL_B => 22, &MARK_SMALL_W => 22, &MARK_SQUARE => 21, &MARK_TRIANGLE => 20, &MARK_LABEL => 19, &MARK_CIRCLE => 15, })->{$arg[1]}; enc_U8 $op + ($arg[0] ? 0 : 128); enc_U8 $arg[1] == MARK_SMALL_W if $op == 22; enc_U8 $arg[2]; enc_U8 $arg[3]; enc_ZSTRING $arg[4] if $op == 18; # unknown types } elsif ($type eq "type_29") { enc_U8 29; enc_ZSTRING $arg[0]; } elsif ($type eq "type_26") { enc_U8 26; enc_U8 $arg[0]; } else { warn "unable to encode tree node type $type\n"; } } }; ]]> ############################################################################# # messages } 1; sub dec_ { my $res = ""; my @r = unpack "v a*", $data; $data = pop @r; for (@r) { last unless $_; $res .= chr $_; } # dump extra data to file for later analysis #my $x = pack "v*", @r; $x =~ s/^(..)*?\x00\x00//s; open DUMP, ">>/root/kgs-dump"; print DUMP $x; close DUMP;#d# $res; } sub enc_ { $data .= pack "v", map ord, split //, $_[0]; } sub dec_ { (my ($r), $data) = unpack "Z a*", $data; $r; } sub enc_ { $data .= pack "a", $_[0]; } sub dec_ { (1 / ) * dec_; } sub enc_ { enc_ $_[0] * ; } $r->{} = (my $array = []); while (length $data) { push @$array, dec_ ; } $r->{} = dec_ if ($r->{} ) ; enc_ defined $_[0]{} ? $_[0]{ } : ( ); sub dec_ { my $r = {}; bless $r, ::; $r; } sub enc_ { } # $dec_{0x} = sub { $data = $_[0]; my $r; $r->{type} = ""; $r; }; $enc_{} = sub { $data = ""; enc_U16 0x; $data; };