--- kgsueme/doc/doc2messages.xsl	2003/06/04 19:12:51	1.1
+++ kgsueme/doc/doc2messages.xsl	2003/06/05 10:09:10	1.2
@@ -3,35 +3,385 @@
 
 <xsl:output method="text" media-type="text/plain" encoding="utf-8"/>
 
-<xsl:template match="/">
+<xsl:template match="/"><![CDATA[
+# This is an automatically generated file. 
+# This is an automatically generated file. 
+# This is an automatically generated file. 
+# This is an automatically generated file. 
+# This is an automatically generated file. 
+
+# See doc/protocol.xml and doc/doc2messages.xsl
+
 package KGS::Messages;
 
+use strict;
+
+our %type;
+our %send;
+our %recv;
+
 {
-<xsl:apply-templates/>
+
+my $data; # stores currently processed decoding/encoding packet
+
+# primitive enc/decoders
+
+#############################################################################
+
+sub dec_U8 {
+   (my ($r), $data) = unpack "C a*", $data; $r;
+}
+
+sub dec_U16 {
+   (my ($r), $data) = unpack "v a*", $data; $r;
+}
+
+sub dec_U32 {
+   (my ($r), $data) = unpack "V a*", $data; $r;
+}
+
+sub dec_U64 {
+   my ($lo, $hi) = (dec_U32, dec_U32);
+   $lo + $hi * 2**32;
+}
+
+sub dec_I8 {
+   (my ($r), $data) = unpack "c a*", $data;
+   $r;
+}
+
+sub dec_I16 {
+   (my ($r), $data) = unpack "v a*", $data;
+   unpack "s", pack "S", $r;
+}
+
+sub dec_I32 {
+   (my ($r), $data) = unpack "V a*", $data;
+   unpack "i", pack "I", $r;
+}
+
+sub dec_DATA {
+   (my ($r), $data) = ($data, ""); $r;
+}
+
+sub dec_STRING {
+   $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
+   # use Encode...
+   join "", map chr, unpack "v*", $1;
+}
+
+sub dec_CONSTANT {
+   $_[0];
+}
+
+sub dec_HEX { # for debugging
+   "HEX: " . unpack "H*", $data;#d#
+}
+
+sub enc_HEX {
+   die "enc_HEX not defined for good";
+}
+
+#############################################################################
+
+sub enc_U8 {
+   $data .= pack "C", $_[0];
+}
+
+sub enc_U16 {
+   $data .= pack "v", $_[0];
+}
+
+sub enc_U32 {
+   $data .= pack "V", $_[0];
+}
+
+sub enc_U64 {
+   enc_U32 $_[0] & 0xffffffff;
+   enc_U32 +($_[0] >> 32) & 0xffffffff;
+}
+
+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
+<xsl:apply-templates select="descendant::type"/>
+
+#############################################################################
+# structures
+<xsl:apply-templates select="descendant::struct"/>
+
+#############################################################################
+# "less" primitive types<![CDATA[
+
+my %marker_code = (
+      triangle => 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_U32];
+
+      } 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_score];
+
+      } elsif ($type == 19) {
+         push @r, [result => dec_result];
+
+      } 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_U32 $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
+<xsl:apply-templates select="descendant::message"/>
 }
 
 1;
 </xsl:template>
 
-<xsl:template match="macro">
-$macro{<xsl:value-of select="@name"/>} = [<xsl:apply-templates/>
-];
+<xsl:template match="type[@type = 'S']">
+sub dec_<xsl:value-of select="@name"/> {
+   my @r = unpack "v<xsl:value-of select="@length"/> a*", $data;
+   $data = pop @r;
+   join ":", map chr, @r;
+}
+
+sub enc_<xsl:value-of select="@name"/> {
+   $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0];
+}
+</xsl:template>
+
+<xsl:template match="type[@type = 'A']">
+sub dec_<xsl:value-of select="@name"/> {
+   (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r;
+}
+
+sub enc_<xsl:value-of select="@name"/> {
+   $data .= pack "Z<xsl:value-of select="@length"/>", $_[0];
+}
+</xsl:template>
+
+<xsl:template match="type[@multiplier]">
+sub dec_<xsl:value-of select="@name"/> {
+   (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>;
+}
+
+sub enc_<xsl:value-of select="@name"/> {
+   enc_<xsl:value-of select="@type"/> $_[0] * <xsl:value-of select="@multiplier"/>;
+}
+</xsl:template>
+
+<xsl:template match="member[@array = 'yes']" mode="dec">
+   $r->{<xsl:value-of select="@name"/>} = (my $array = []);
+   while (length $data) {
+      push @$array, dec_<xsl:value-of select="@type"/>
+                        <xsl:text> </xsl:text>
+                        <xsl:value-of select="@default"/>;
+   }
+</xsl:template>
+
+<xsl:template match="member" mode="dec">
+   $r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/>
+                                              <xsl:text> </xsl:text>
+                                              <xsl:value-of select="@default"/>
+   <xsl:if test="@guard-cond">
+      if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if>
+   <xsl:text>;</xsl:text>
+</xsl:template>
+
+<xsl:template match="member" mode="enc">
+   <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'">
+      $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/
+         or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'";
+   </xsl:if><!--#d#-->
+   <!-- #d#, remove when kgs is repaired --><xsl:if test="@name = 'channel'">
+      $_[0]{<xsl:value-of select="@name"/>} > 0
+         or Carp::confess "FATAL: tried to send a zero channel id";
+   </xsl:if><!--#d#-->
+   enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
+   <xsl:text>} : (</xsl:text>
+   <xsl:value-of select="@default"/>
+   <xsl:text>);</xsl:text>
+</xsl:template>
+
+<xsl:template match="struct">
+sub dec_<xsl:value-of select="@name"/> {
+   my $r = {};
+   <xsl:apply-templates select="member" mode="dec"/>
+   <xsl:if test="@class">
+   bless $r, <xsl:value-of select="@class"/>::;
+   </xsl:if>
+   $r;
+}
+
+sub enc_<xsl:value-of select="@name"/> {
+   <xsl:apply-templates select="member" mode="enc"/>
+}
 </xsl:template>
 
 <xsl:template match="message">
 # <xsl:value-of select="@name"/>
-my $msg = [<xsl:apply-templates/>
-];<xsl:if test="@send='yes'">
-$send{<xsl:value-of select="@name"/>} = [ 0x<xsl:value-of select="@type"/>, $msg ];
-</xsl:if>
 <xsl:if test="@recv='yes'">
-$recv{0x<xsl:value-of select="@type"/>} = [ <xsl:value-of select="@name"/> => $msg ];
+$recv{0x<xsl:value-of select="@type"/>} = sub {
+   $data = $_[0];
+   my $r;
+   $r->{type} = "<xsl:value-of select="@name"/>";
+   <xsl:apply-templates select="member" mode="dec"/>
+   $r;
+};
+</xsl:if>
+<xsl:if test="@send='yes'">
+$send{<xsl:value-of select="@name"/>} = sub {
+   $data = "";
+   enc_U16 0x<xsl:value-of select="@type"/>;
+   <xsl:apply-templates select="member" mode="enc"/>
+   $data;
+};
 </xsl:if>
 </xsl:template>
 
 <xsl:template match="member">
-   [<xsl:value-of select="@name"/> => "<xsl:value-of select="@type"/>", "<xsl:value-of select="@default"/>", "<xsl:value-of select="@guard"/>"],<!--
---></xsl:template>
+   [<xsl:value-of select="@name"/>
+   <xsl:text>=> "</xsl:text>
+   <xsl:value-of select="@type"/>
+   <xsl:text>", "</xsl:text>
+   <xsl:value-of select="@default"/>
+   <xsl:text>", "</xsl:text>
+   <xsl:value-of select="@guard"/>
+   <xsl:text>;"],</xsl:text>
+</xsl:template>
 
 <xsl:template match="text()">
 </xsl:template>