ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2haskell.xsl
(Generate patch)

Comparing kgsueme/doc/doc2haskell.xsl (file contents):
Revision 1.2 by pcg, Fri Jul 25 22:19:30 2003 UTC vs.
Revision 1.3 by pcg, Fri Jul 25 22:25:44 2003 UTC

… …
27getU16 = do 27getU16 = do
28 a <- getU8 28 a <- getU8
29 b <- getU8 29 b <- getU8
30 return $ a + b * 256 30 return $ a + b * 256
31 31
32dec_U64 32decU64
33dec_I8 33decI8
34dec_I16 34decI16
35dec_I32 35decI32
36dec_DATA 36decDATA
37 37
38sub dec_STRING { 38sub dec_STRING {
39 $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s; 39 $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
40 # use Encode... 40 # use Encode...
41 join "", map chr, unpack "v*", $1; 41 join "", map chr, unpack "v*", $1;
… …
121<xsl:apply-templates select="descendant::struct"/> 121<xsl:apply-templates select="descendant::struct"/>
122 122
123############################################################################# 123#############################################################################
124# "less" primitive types<![CDATA[ 124# "less" primitive types<![CDATA[
125 125
126my %marker_code = ( 126decTREE
127 triangle => 1, 127encTREE
128 square => 2,
129 circle => 3,
130 small_b => 4,
131 small_w => 5,
132 gray => 6,
133 move => 7,
134 addstone => 8,
135 );
136 128
137my %code_marker = reverse %marker_code;
138
139# this was the most horrible thing to decode. still not everything is decoded correctly(?)
140sub dec_TREE {
141 my @r;
142 while (length $data) {
143 my $type = dec_U8;
144 my $add = $type < 128;
145
146 $type &= 127;
147
148 if ($type == 127) {
149 dec_U8; # unused?? *sigh*
150 push @r, [add_node => dec_I32];
151
152 } elsif ($type == 126) {
153 push @r, [set_node => dec_I32];
154
155 } elsif ($type == 125) {
156 push @r, [set_current => dec_I32];
157
158 } elsif ($type == 34) {
159 push @r, [score => dec_U8, dec_score1000];
160
161 } elsif ($type == 29) {
162 push @r, [type_29 => dec_STRING];
163 warn "TYPE 29 $r[-1][1]\007 PLEASE REPORT";#d#
164 die;
165
166 } elsif ($type == 28) {
167 # move number, only in variations it seems. oh my.
168 push @r, [movenum => dec_STRING];
169
170 } elsif ($type == 25) {
171 push @r, [result => dec_result];
172
173 } elsif ($type == 23) {
174 push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8];
175
176 } elsif ($type == 22) {
177 push @r, [mark => $add, (&dec_U8 ? MARK_SMALL_W : MARK_SMALL_B), dec_U8, dec_U8];
178
179 } elsif ($type == 21) {
180 push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8];
181
182 } elsif ($type == 20) {
183 push @r, [mark => $add, MARK_SQUARE, dec_U8, dec_U8];
184
185 } elsif ($type == 19) {
186 push @r, [mark => $add, MARK_TRIANGLE, dec_U8, dec_U8];
187
188 } elsif ($type == 18) {
189 push @r, [mark => $add, MARK_LABEL, dec_U8, dec_U8, dec_STRING];
190
191 } elsif ($type == 17) {
192 push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]];
193
194 } elsif ($type == 16) {
195 push @r, [set_stone => $add, dec_U8, dec_U8, dec_U8];
196
197 } elsif ($type == 14) {
198 push @r, [move => $add, dec_U8, dec_U8, dec_U8];
199
200 } elsif (($type >= 4 && $type <= 9)
201 || ($type >= 11 && $type <= 13)
202 || $type == 24) {
203
204 push @r, [({
205 4 => "date",
206 5 => "unknown_comment5",
207 6 => "unknown_comment6",
208 7 => "unknown_comment7",
209 8 => "unknown_comment8",
210 9 => "copyright", #?
211 11 => "unknown_comment11",
212 12 => "unknown_comment12",
213 13 => "unknown_comment13",
214 24 => "comment",
215 })->{$type} => dec_STRING];
216
217 } elsif ($type == 3) {
218 push @r, [rank => dec_U8, dec_U32];
219
220 } elsif ($type == 2) {
221 push @r, [player => dec_U8, dec_STRING];
222
223 } elsif ($type == 0) {
224 # as usual, wms finds yet another way to duplicate code... oh well, what a mess.
225 # (no wonder he is so keen on keeping it a secret...)
226
227 push @r, [rules => dec_rules];
228
229 # OLD
230
231 } elsif (1) {
232 print STDERR KGS::Listener::Debug::dumpval(\@r);
233 open XTYPE, "|xtype"; print XTYPE $data; close XTYPE;
234 die "unknown tree type $type, PLEASE REPORT and include the game you wanted to watch. thx.";
235
236 } elsif ($type == 30) {
237 push @r, [active_player => dec_U8];
238
239 } elsif ($type == 0) { # label(?)
240 my $label;
241 my $c = dec_U16; $label .= chr $c if $c;
242 my $c = dec_U16; $label .= chr $c if $c;
243 my $c = dec_U16; $label .= chr $c if $c;
244
245 # empty label == remove label
246 push @r, [label => $label, dec_U8, dec_U8];
247
248 } elsif ($type > 0 && $type < 9) {
249 # 1 marker type triangle
250 # 2 marker type square
251 # 3 marker type circle
252 # 4 small stone b
253 # 5 small stone w
254 # 6 grayed out
255 # 7 move
256 # 8 also move(?) or preset?
257 #
258 # $a1 is probably player again (2 == remove)
259 # x is from left 0 to right boardsize-1
260 # y is from top 0 to bottom boardsize-1
261 push @r, [$code_marker{$type} => dec_U8, dec_U8, dec_U8];
262
263 } else {
264 push @r, [unknown => $type];
265 }
266 }
267 \@r;
268}
269
270sub enc_TREE {
271 die "tree encoding not yet supported again";
272 for (@{$_[0]}) {
273 my ($type, @arg) = @$_;
274
275 if ($type eq "add_child") {
276 enc_U8 255;
277 enc_I32 $arg[0];
278
279 } elsif ($type eq "done") {
280 enc_U8 254;
281
282 } elsif ($type eq "more") {
283 enc_U8 253;
284
285 } elsif ($type eq "comment") {
286 # handle other string params, too
287 enc_U8 9;
288 enc_STRING $arg[0];
289
290 } elsif ($type eq "label") {
291 enc_U8 0;
292 enc_U16 ord substr "$arg[0]\x00\x00", 0, 1;
293 enc_U16 ord substr "$arg[0]\x00\x00", 1, 1;
294 enc_U16 ord substr "$arg[0]\x00\x00", 2, 1;
295 enc_U8 $arg[1];
296 enc_U8 $arg[2];
297
298 } elsif ($marker_code{$type}) {
299 enc_U8 $marker_code{$type};
300 enc_U8 $arg[0];
301 enc_U8 $arg[1];
302 enc_U8 $arg[2];
303
304 } else {
305 warn "unable to encode tree node type $type\n";
306 }
307 }
308}
309]]> 129]]>
310 130
311############################################################################# 131#############################################################################
312# messages 132# messages
313<xsl:apply-templates select="descendant::message"/> 133<xsl:apply-templates select="descendant::message"/>
… …
315 135
3161; 1361;
317</xsl:template> 137</xsl:template>
318 138
319<xsl:template match="type[@type = 'S']"> 139<xsl:template match="type[@type = 'S']">
140dec<xsl:value-of select="@name"/> :: State [Word8] [Char]
320sub dec_<xsl:value-of select="@name"/> { 141dec<xsl:value-of select="@name"/> = do
321 my $res = ""; 142 -- decode UCS-2 string of length <xsl:value-of select="@length"/>
322 my @r = unpack "v<xsl:value-of select="@length"/> a*", $data; 143 -- the first 0 terminates the string, but not the field
323 $data = pop @r;
324 for (@r) {
325 last unless $_;
326 $res .= chr $_;
327 }
328 # dump extra data to file for later analysis
329 #my $x = pack "v*", @r; $x =~ s/^(..)*?\x00\x00//s; open DUMP, ">>/tmp/dump"; print DUMP $x; close DUMP;#d#
330 $res;
331}
332 144
333sub enc_<xsl:value-of select="@name"/> { 145enc<xsl:value-of select="@name"/> =
334 $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0]; 146 -- likewise, encode as UCS-2, fill space with 0
335}
336</xsl:template> 147</xsl:template>
337 148
338<xsl:template match="type[@type = 'A']"> 149<xsl:template match="type[@type = 'A']">
150dec<xsl:value-of select="@name"/> :: State [Word8] [Char]
339sub dec_<xsl:value-of select="@name"/> { 151dec<xsl:value-of select="@name"/> = do
340 (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r; 152 -- decode ASCII string of length <xsl:value-of select="@length"/>
341} 153 -- the first 0 terminates the string, but not the field
342 154
343sub enc_<xsl:value-of select="@name"/> { 155enc<xsl:value-of select="@name"/> =
344 $data .= pack "Z<xsl:value-of select="@length"/>", $_[0]; 156 -- likewise, encode as ASCII, fill space with 0
345}
346</xsl:template> 157</xsl:template>
347 158
348<xsl:template match="type[@multiplier]"> 159<xsl:template match="type[@multiplier]">
160dec<xsl:value-of select="@name"/> = do
161 n &lt;- dec<xsl:value-of select="@type"/>
162 return n * (1 / <xsl:value-of select="@multiplier"/>)
163
349sub dec_<xsl:value-of select="@name"/> { 164enc<xsl:value-of select="@name"/> =
350 (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>; 165 <xsl:value-of select="@multiplier"/> * enc<xsl:value-of select="@type"/>
351}
352
353sub enc_<xsl:value-of select="@name"/> {
354 enc_<xsl:value-of select="@type"/> $_[0] * <xsl:value-of select="@multiplier"/>;
355}
356</xsl:template> 166</xsl:template>
357 167
358<xsl:template match="member[@array = 'yes']" mode="dec"> 168<xsl:template match="member[@array = 'yes']" mode="dec">
359 $r->{<xsl:value-of select="@name"/>} = (my $array = []); 169 $r->{<xsl:value-of select="@name"/>} = (my $array = []);
360 while (length $data) { 170 while (length $data) {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines