ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2messages.xsl
Revision: 1.10
Committed: Sun Jul 20 01:29:20 2003 UTC (20 years, 10 months ago) by pcg
Content type: application/xml
Branch: MAIN
Changes since 1.9: +59 -29 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 pcg 1.1 <!DOCTYPE xsl:stylesheet>
2     <xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
3    
4     <xsl:output method="text" media-type="text/plain" encoding="utf-8"/>
5    
6 pcg 1.2 <xsl:template match="/"><![CDATA[
7     # This is an automatically generated file.
8     # This is an automatically generated file.
9     # This is an automatically generated file.
10     # This is an automatically generated file.
11     # This is an automatically generated file.
12    
13     # See doc/protocol.xml and doc/doc2messages.xsl
14    
15 pcg 1.1 package KGS::Messages;
16    
17 pcg 1.5 use KGS::Constants; # REPLACE by parsed file, too
18    
19 pcg 1.2 use strict;
20    
21     our %type;
22     our %send;
23     our %recv;
24    
25 pcg 1.1 {
26 pcg 1.2
27     my $data; # stores currently processed decoding/encoding packet
28    
29     # primitive enc/decoders
30    
31     #############################################################################
32    
33     sub dec_U8 {
34     (my ($r), $data) = unpack "C a*", $data; $r;
35     }
36    
37     sub dec_U16 {
38     (my ($r), $data) = unpack "v a*", $data; $r;
39     }
40    
41     sub dec_U32 {
42     (my ($r), $data) = unpack "V a*", $data; $r;
43     }
44    
45     sub dec_U64 {
46     my ($lo, $hi) = (dec_U32, dec_U32);
47     $lo + $hi * 2**32;
48     }
49    
50     sub dec_I8 {
51     (my ($r), $data) = unpack "c a*", $data;
52     $r;
53     }
54    
55     sub dec_I16 {
56     (my ($r), $data) = unpack "v a*", $data;
57     unpack "s", pack "S", $r;
58     }
59    
60     sub dec_I32 {
61     (my ($r), $data) = unpack "V a*", $data;
62     unpack "i", pack "I", $r;
63     }
64    
65     sub dec_DATA {
66     (my ($r), $data) = ($data, ""); $r;
67     }
68    
69     sub dec_STRING {
70     $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
71     # use Encode...
72     join "", map chr, unpack "v*", $1;
73     }
74    
75     sub dec_CONSTANT {
76     $_[0];
77     }
78    
79     sub dec_HEX { # for debugging
80     "HEX: " . unpack "H*", $data;#d#
81     }
82    
83     sub enc_HEX {
84     die "enc_HEX not defined for good";
85     }
86    
87     #############################################################################
88    
89     sub enc_U8 {
90     $data .= pack "C", $_[0];
91     }
92    
93     sub enc_U16 {
94     $data .= pack "v", $_[0];
95     }
96    
97     sub enc_U32 {
98     $data .= pack "V", $_[0];
99     }
100    
101     sub enc_U64 {
102     enc_U32 $_[0] & 0xffffffff;
103     enc_U32 +($_[0] >> 32) & 0xffffffff;
104     }
105    
106 pcg 1.9 sub enc_I8 {
107     $data .= pack "c", $_[0];
108     }
109    
110 pcg 1.6 sub enc_I16 {
111     enc_U16 unpack "S", pack "s", $_[0];
112     }
113    
114 pcg 1.2 sub enc_I32 {
115     enc_U32 unpack "I", pack "i", $_[0];
116     }
117    
118     sub enc_DATA {
119     # a dream!
120     $data .= $_[0];
121     }
122    
123     sub enc_STRING {
124     # should use encode for speed and clarity ;)
125     $data .= pack "v*", map ord, split //, $_[0];
126     }
127 pcg 1.7
128     sub enc_password {
129     require Math::BigInt; # I insist on 32-bit-perl.. should use C
130     # $hash must be 64 bit
131     my $hash = new Math::BigInt;
132     $hash = $hash * 1055 + ord for split //, $_[0];
133     enc_U64 $hash;
134     }
135    
136 pcg 1.2 ]]>
137    
138     #############################################################################
139     # types
140     <xsl:apply-templates select="descendant::type"/>
141    
142     #############################################################################
143     # structures
144     <xsl:apply-templates select="descendant::struct"/>
145    
146     #############################################################################
147     # "less" primitive types<![CDATA[
148    
149     my %marker_code = (
150     triangle => 1,
151     square => 2,
152     circle => 3,
153     small_b => 4,
154     small_w => 5,
155     gray => 6,
156     move => 7,
157     addstone => 8,
158     );
159    
160     my %code_marker = reverse %marker_code;
161    
162     # this was the most horrible thing to decode. still not everything is decoded correctly(?)
163     sub dec_TREE {
164     my @r;
165     while (length $data) {
166     my $type = dec_U8;
167 pcg 1.10 my $add = $type < 128;
168 pcg 1.2
169 pcg 1.10 $type &= 127;
170 pcg 1.2
171 pcg 1.10 if ($type == 127) {
172     dec_U8; # unused?? *sigh*
173     push @r, [add_node => dec_I32];
174 pcg 1.2
175 pcg 1.10 } elsif ($type == 126) {
176     push @r, [set_node => dec_I32];
177 pcg 1.2
178 pcg 1.10 } elsif ($type == 125) {
179     push @r, [set_current => dec_I32];
180 pcg 1.2
181 pcg 1.10 } elsif ($type == 34) {
182     push @r, [score => dec_U8, dec_score1000];
183    
184     } elsif ($type == 25) {
185     push @r, [result => dec_result];
186    
187     } elsif ($type == 23) {
188     push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8];
189    
190     } elsif ($type == 22) {
191     push @r, [mark => $add, (&dec_U8 ? MARK_SMALL_W : MARK_SMALL_B), dec_U8, dec_U8];
192    
193     } elsif ($type == 21) {
194     push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8];
195    
196     } elsif ($type == 17) {
197     push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]];
198    
199     } elsif ($type == 16) {
200     push @r, [set_stone => $add, dec_U8, dec_U8, dec_U8];
201    
202     } elsif ($type == 14) {
203     push @r, [move => $add, dec_U8, dec_U8, dec_U8];
204 pcg 1.2
205 pcg 1.10 } elsif (($type >= 4 && $type <= 9)
206     || ($type >= 11 && $type <= 13)
207     || $type == 24) {
208 pcg 1.2
209     push @r, [({
210 pcg 1.10 4 => "date",
211     5 => "unknown_comment5",
212     6 => "unknown_comment6",
213     7 => "unknown_comment7",
214     8 => "unknown_comment8",
215     9 => "copyright", #?
216     11 => "unknown_comment11",
217     12 => "unknown_comment12",
218     13 => "unknown_comment13",
219     24 => "comment",
220 pcg 1.2 })->{$type} => dec_STRING];
221    
222 pcg 1.10 } elsif ($type == 3) {
223     push @r, [rank => dec_U8, dec_U32];
224 pcg 1.2
225 pcg 1.10 } elsif ($type == 2) {
226     push @r, [player => dec_U8, dec_STRING];
227 pcg 1.2
228 pcg 1.10 } elsif ($type == 0) {
229     # as usual, wms finds yet another way to duplicate code... oh well, what a mess.
230     # (no wonder he is so keen on keeping it a secret...)
231    
232     push @r, [rules => dec_rules];
233 pcg 1.2
234 pcg 1.10 # OLD
235 pcg 1.2
236 pcg 1.10 } elsif (1) {
237     print STDERR KGS::Listener::Debug::dumpval(\@r);
238     open XTYPE, "|xtype"; print XTYPE $data; close XTYPE;
239     die "unknown type $type";
240 pcg 1.2
241     } elsif ($type == 30) {
242     push @r, [active_player => dec_U8];
243    
244     } elsif ($type == 0) { # label(?)
245     my $label;
246     my $c = dec_U16; $label .= chr $c if $c;
247     my $c = dec_U16; $label .= chr $c if $c;
248     my $c = dec_U16; $label .= chr $c if $c;
249    
250     # empty label == remove label
251     push @r, [label => $label, dec_U8, dec_U8];
252    
253     } elsif ($type > 0 && $type < 9) {
254     # 1 marker type triangle
255     # 2 marker type square
256     # 3 marker type circle
257     # 4 small stone b
258     # 5 small stone w
259     # 6 grayed out
260     # 7 move
261     # 8 also move(?) or preset?
262     #
263     # $a1 is probably player again (2 == remove)
264     # x is from left 0 to right boardsize-1
265     # y is from top 0 to bottom boardsize-1
266     push @r, [$code_marker{$type} => dec_U8, dec_U8, dec_U8];
267    
268     } else {
269     push @r, [unknown => $type];
270     }
271     }
272     \@r;
273     }
274    
275     sub enc_TREE {
276     for (@{$_[0]}) {
277     my ($type, @arg) = @$_;
278    
279     if ($type eq "add_child") {
280     enc_U8 255;
281 pcg 1.3 enc_I32 $arg[0];
282 pcg 1.2
283     } elsif ($type eq "done") {
284     enc_U8 254;
285    
286     } elsif ($type eq "more") {
287     enc_U8 253;
288    
289     } elsif ($type eq "comment") {
290     # handle other string params, too
291     enc_U8 9;
292     enc_STRING $arg[0];
293    
294     } elsif ($type eq "label") {
295     enc_U8 0;
296     enc_U16 ord substr "$arg[0]\x00\x00", 0, 1;
297     enc_U16 ord substr "$arg[0]\x00\x00", 1, 1;
298     enc_U16 ord substr "$arg[0]\x00\x00", 2, 1;
299     enc_U8 $arg[1];
300     enc_U8 $arg[2];
301    
302     } elsif ($marker_code{$type}) {
303     enc_U8 $marker_code{$type};
304     enc_U8 $arg[0];
305     enc_U8 $arg[1];
306     enc_U8 $arg[2];
307    
308     } else {
309     warn "unable to encode tree node type $type\n";
310     }
311     }
312     }
313     ]]>
314    
315     #############################################################################
316     # messages
317     <xsl:apply-templates select="descendant::message"/>
318 pcg 1.1 }
319    
320     1;
321     </xsl:template>
322    
323 pcg 1.2 <xsl:template match="type[@type = 'S']">
324     sub dec_<xsl:value-of select="@name"/> {
325     my @r = unpack "v<xsl:value-of select="@length"/> a*", $data;
326     $data = pop @r;
327     join ":", map chr, @r;
328     }
329    
330     sub enc_<xsl:value-of select="@name"/> {
331     $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0];
332     }
333     </xsl:template>
334    
335     <xsl:template match="type[@type = 'A']">
336     sub dec_<xsl:value-of select="@name"/> {
337     (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r;
338     }
339    
340     sub enc_<xsl:value-of select="@name"/> {
341     $data .= pack "Z<xsl:value-of select="@length"/>", $_[0];
342     }
343     </xsl:template>
344    
345     <xsl:template match="type[@multiplier]">
346     sub dec_<xsl:value-of select="@name"/> {
347     (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>;
348     }
349    
350     sub enc_<xsl:value-of select="@name"/> {
351     enc_<xsl:value-of select="@type"/> $_[0] * <xsl:value-of select="@multiplier"/>;
352     }
353     </xsl:template>
354    
355     <xsl:template match="member[@array = 'yes']" mode="dec">
356     $r->{<xsl:value-of select="@name"/>} = (my $array = []);
357     while (length $data) {
358     push @$array, dec_<xsl:value-of select="@type"/>
359     <xsl:text> </xsl:text>
360     <xsl:value-of select="@default"/>;
361     }
362     </xsl:template>
363    
364     <xsl:template match="member" mode="dec">
365     $r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/>
366     <xsl:text> </xsl:text>
367     <xsl:value-of select="@default"/>
368     <xsl:if test="@guard-cond">
369     if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if>
370     <xsl:text>;</xsl:text>
371     </xsl:template>
372    
373     <xsl:template match="member" mode="enc">
374     <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'">
375     $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/
376     or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'";
377     </xsl:if><!--#d#-->
378     enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
379     <xsl:text>} : (</xsl:text>
380     <xsl:value-of select="@default"/>
381     <xsl:text>);</xsl:text>
382     </xsl:template>
383    
384     <xsl:template match="struct">
385     sub dec_<xsl:value-of select="@name"/> {
386     my $r = {};
387     <xsl:apply-templates select="member" mode="dec"/>
388     <xsl:if test="@class">
389     bless $r, <xsl:value-of select="@class"/>::;
390     </xsl:if>
391     $r;
392     }
393    
394     sub enc_<xsl:value-of select="@name"/> {
395     <xsl:apply-templates select="member" mode="enc"/>
396     }
397 pcg 1.1 </xsl:template>
398    
399     <xsl:template match="message">
400     # <xsl:value-of select="@name"/>
401 pcg 1.2 <xsl:if test="@recv='yes'">
402     $recv{0x<xsl:value-of select="@type"/>} = sub {
403     $data = $_[0];
404     my $r;
405     $r->{type} = "<xsl:value-of select="@name"/>";
406     <xsl:apply-templates select="member" mode="dec"/>
407     $r;
408     };
409 pcg 1.1 </xsl:if>
410 pcg 1.2 <xsl:if test="@send='yes'">
411     $send{<xsl:value-of select="@name"/>} = sub {
412     $data = "";
413     enc_U16 0x<xsl:value-of select="@type"/>;
414     <xsl:apply-templates select="member" mode="enc"/>
415     $data;
416     };
417 pcg 1.1 </xsl:if>
418     </xsl:template>
419    
420     <xsl:template match="member">
421 pcg 1.2 [<xsl:value-of select="@name"/>
422     <xsl:text>=> "</xsl:text>
423     <xsl:value-of select="@type"/>
424     <xsl:text>", "</xsl:text>
425     <xsl:value-of select="@default"/>
426     <xsl:text>", "</xsl:text>
427     <xsl:value-of select="@guard"/>
428     <xsl:text>;"],</xsl:text>
429     </xsl:template>
430 pcg 1.1
431     <xsl:template match="text()">
432     </xsl:template>
433    
434     </xsl:stylesheet>
435