c4

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # c4: Chip's Challenge Combined Converter
   5 #
   6 # Use "perldoc c4" to read the documentation.
   7 #
   8 # Copyright (C) 2003-2006 Brian Raiter. This program is licensed under
   9 # an MIT-style license. Please see the documentation for details.
  10 #
  11
  12 use strict;
  13
  14 #
  15 # First, some global functions used across packages.
  16 #
  17
  18 package main;
  19
  20 # All the names of all the tiles.
  21 #
  22 my @tilenames;
  23 my %tilenames;
  24 foreach my $names
  25        ([ "empty", "floor" ],
  26         [ "wall" ],
  27         [ "ic chip", "computer chip" ],
  28         [ "water" ],
  29         [ "fire" ],
  30         [ "hidden wall", "invisible wall permanent", "inv wall permanent" ],
  31         [ "wall north", "partition north", "blocked north" ],
  32         [ "wall west", "partition west", "blocked west" ],
  33         [ "wall south", "partition south", "blocked south" ],
  34         [ "wall east", "partition east", "blocked east" ],
  35         [ "block", "moveable block", "movable block" ],
  36         [ "dirt" ],
  37         [ "ice" ],
  38         [ "force floor south", "force south", "slide south",
  39                                               "slide floor south" ],
  40         [ "block north", "cloning block north" ],
  41         [ "block west", "cloning block west" ],
  42         [ "block south", "cloning block south" ],
  43         [ "block east", "cloning block east" ],
  44         [ "force floor north", "force north", "slide north",
  45                                               "slide floor north" ],
  46         [ "force floor east", "force east", "slide east", "slide floor east" ],
  47         [ "force floor west", "force west", "slide west", "slide floor west" ],
  48         [ "exit" ],
  49         [ "blue door", "door blue" ],
  50         [ "red door", "door red" ],
  51         [ "green door", "door green" ],
  52         [ "yellow door", "door yellow" ],
  53         [ "ice wall southeast", "ice wall se", "ice se",
  54                                 "ice corner southeast", "ice corner se" ],
  55         [ "ice wall southwest", "ice wall sw", "ice sw",
  56                                 "ice corner southwest", "ice corner sw" ],
  57         [ "ice wall northwest", "ice wall nw", "ice nw",
  58                                 "ice corner northwest", "ice corner nw" ],
  59         [ "ice wall northeast", "ice wall ne", "ice ne",
  60                                 "ice corner northeast", "ice corner ne" ],
  61         [ "blue block floor", "blue block fake", "blue wall fake" ],
  62         [ "blue block wall", "blue block real", "blue wall real" ],
  63         [ "(combination)" ],
  64         [ "thief", "spy" ],
  65         [ "socket" ],
  66         [ "green button", "button green", "toggle button", "button toggle" ],
  67         [ "red button", "button red", "clone button", "button clone" ],
  68         [ "toggle closed", "toggle wall closed", "closed toggle wall",
  69                            "toggle door closed", "closed toggle door" ],
  70         [ "toggle open", "toggle wall open", "open toggle wall",
  71                          "toggle door open", "open toggle door" ],
  72         [ "brown button", "button brown", "trap button", "button trap" ],
  73         [ "blue button", "button blue", "tank button", "button tank" ],
  74         [ "teleport" ],
  75         [ "bomb" ],
  76         [ "trap", "beartrap", "bear trap" ],
  77         [ "invisible wall", "invisible wall temporary", "inv wall temporary" ],
  78         [ "gravel" ],
  79         [ "popup wall", "pass once" ],
  80         [ "hint button" ],
  81         [ "wall southeast", "partition southeast", "blocked southeast",
  82                             "wall se", "partition se", "blocked se" ],
  83         [ "clone machine", "cloner", "cloning machine" ],
  84         [ "force floor any", "force any", "slide any", "slide floor any",
  85                              "force floor random", "force random",
  86                              "slide random", "slide floor random",
  87                              "random slide floor" ],
  88         [ "(chip drowned)" ],
  89         [ "(chip burned)" ],
  90         [ "(chip bombed)" ],
  91         [ "(unused 1)" ],
  92         [ "(unused 2)" ],
  93         [ "(unused 3)" ],
  94         [ "(exiting)" ],
  95         [ "(exit 1)" ],
  96         [ "(exit 2)" ],
  97         [ "(chip swimming north)", "(chip swimming n)" ],
  98         [ "(chip swimming west)", "(chip swimming w)" ],
  99         [ "(chip swimming south)", "(chip swimming s)" ],
 100         [ "(chip swimming east)", "(chip swimming e)" ],
 101         [ "bug north", "bee north" ],
 102         [ "bug west", "bee west" ],
 103         [ "bug south", "bee south" ],
 104         [ "bug east", "bee east" ],
 105         [ "fireball north", "flame north" ],
 106         [ "fireball west", "flame west" ],
 107         [ "fireball south", "flame south" ],
 108         [ "fireball east", "flame east" ],
 109         [ "ball north" ],
 110         [ "ball west" ],
 111         [ "ball south" ],
 112         [ "ball east" ],
 113         [ "tank north" ],
 114         [ "tank west" ],
 115         [ "tank south" ],
 116         [ "tank east" ],
 117         [ "glider north", "ghost north" ],
 118         [ "glider west", "ghost west" ],
 119         [ "glider south", "ghost south" ],
 120         [ "glider east", "ghost east" ],
 121         [ "teeth north", "frog north" ],
 122         [ "teeth west", "frog west" ],
 123         [ "teeth south", "frog south" ],
 124         [ "teeth east", "frog east" ],
 125         [ "walker north", "dumbbell north" ],
 126         [ "walker west", "dumbbell west" ],
 127         [ "walker south", "dumbbell south" ],
 128         [ "walker east", "dumbbell east" ],
 129         [ "blob north" ],
 130         [ "blob west" ],
 131         [ "blob south" ],
 132         [ "blob east" ],
 133         [ "paramecium north", "centipede north" ],
 134         [ "paramecium west", "centipede west" ],
 135         [ "paramecium south", "centipede south" ],
 136         [ "paramecium east", "centipede east" ],
 137         [ "blue key", "key blue" ],
 138         [ "red key", "key red" ],
 139         [ "green key", "key green" ],
 140         [ "yellow key", "key yellow" ],
 141         [ "water boots", "boots water", "water shield", "flippers" ],
 142         [ "fire boots", "boots fire", "fire shield" ],
 143         [ "ice boots", "boots ice", "spike shoes", "spiked shoes",
 144                        "ice skates", "skates" ],
 145         [ "force boots", "boots force", "slide boots", "boots slide",
 146                          "magnet", "suction boots" ],
 147         [ "chip north" ],
 148         [ "chip west" ],
 149         [ "chip south" ],
 150         [ "chip east" ])
 151 {
 152     push @tilenames, $names->[0];
 153     @tilenames{@$names} = ($#tilenames) x @$names;
 154 }
 155
 156 # The original 150 passwords.
 157 #
 158 my @origpasswords = @{
 159     [qw(BDHP    JXMJ    ECBQ    YMCJ    TQKB    WNLP    FXQO    NHAG
 160         KCRE    VUWS    CNPE    WVHI    OCKS    BTDY    COZQ    SKKK
 161         AJMG    HMJL    MRHR    KGFP    UGRW    WZIN    HUVE    UNIZ
 162         PQGV    YVYJ    IGGZ    UJDD    QGOL    BQZP    RYMS    PEFS
 163         BQSN    NQFI    VDTM    NXIS    VQNK    BIFA    ICXY    YWFH
 164         GKWD    LMFU    UJDP    TXHL    OVPZ    HDQJ    LXPP    JYSF
 165         PPXI    QBDH    IGGJ    PPHT    CGNX    ZMGC    SJES    FCJE
 166         UBXU    YBLT    BLDM    ZYVI    RMOW    TIGW    GOHX    IJPQ
 167         UPUN    ZIKZ    GGJA    RTDI    NLLY    GCCG    LAJM    EKFT
 168         QCCR    MKNH    MJDV    NMRH    FHIC    GRMO    JINU    EVUG
 169         SCWF    LLIO    OVPJ    UVEO    LEBX    FLHH    YJYS    WZYV
 170         VCZO    OLLM    JPQG    DTMI    REKF    EWCS    BIFQ    WVHY
 171         IOCS    TKWD    XUVU    QJXR    RPIR    VDDU    PTAC    KWNL
 172         YNEG    NXYB    ECRE    LIOC    KZQR    XBAO    KRQJ    NJLA
 173         PTAS    JWNL    EGRW    HXMF    FPZT    OSCW    PHTY    FLXP
 174         BPYS    SJUM    YKZE    TASX    MYRT    QRLD    JMWZ    FTLA
 175         HEAN    XHIZ    FIRD    ZYFA    TIGG    XPPH    LYWO    LUZL
 176         HPPX    LUJT    VLHH    SJUK    MCJE    UCRY    OKOR    GVXQ
 177         YBLI    JHEN    COZA    RGSK    DIGW    GNLP)]
 178 };
 179
 180 # Return true if the given tile is one of the creatures, one of the
 181 # blocks, or Chip.
 182 #
 183 sub iscreature($) { $_[0] >= 0x40 && $_[0] < 0x64 }
 184 sub isblock($)    { $_[0] == 0x0A || ($_[0] >= 0x0E && $_[0] < 0x12) }
 185 sub ischip($)     { $_[0] >= 0x6C && $_[0] < 0x70 }
 186
 187 my $filename = undef;
 188 my $filepos = undef;
 189 my $filelevel = undef;
 190 sub err(@)
 191 {
 192     if (defined $filename) {
 193         if (defined $filelevel) {
 194             print STDERR "$filename: level $filelevel: ";
 195         } elsif (defined $filepos) {
 196             print STDERR "$filename, byte $filepos: ";
 197         } elsif ($.) {
 198             print STDERR "$filename:$.: ";
 199         } else {
 200             print STDERR "$filename: ";
 201         }
 202     } else {
 203         if (defined $filelevel) {
 204             print STDERR "$filename: level $filelevel: ";
 205         } elsif (defined $filepos) {
 206             print STDERR "byte $filepos: ";
 207         } elsif ($.) {
 208             print STDERR "line $.: ";
 209         }
 210     }
 211     print STDERR @_, "\n";
 212     return;
 213 }
 214
 215 # Given a pack template, return the size of the packed data in bytes.
 216 # The template is assumed to only contain the types a, C, v, and V.
 217 #
 218 sub packlen($)
 219 {
 220     my $template = shift;
 221     my $size = 0;
 222     while (length $template) {
 223         my $char = substr $template, 0, 1, "";
 224         my $n = $char eq "V" ? 4 : $char eq "v" ? 2 : 1;
 225         $n *= $1 if $template =~ s/\A(\d+)//;
 226         $size += $n;
 227     }
 228     return $size;
 229 }
 230
 231 # Read a sequence of bytes from a binary file, according to a pack
 232 # template. The unpacked values are returned.
 233 #
 234 sub fileread($$;\$@)
 235 {
 236     my $input = shift;
 237     my $template = shift;
 238     my $levelsize = shift;
 239     my ($buf, $len);
 240     $len = ::packlen $template;
 241     return ::err "invalid template given to fileread" unless $len > 0;
 242     my $ret = sysread $input, $buf, $len;
 243     return ::err $! unless defined $ret;
 244     return ::err "unexpected EOF" unless $ret;
 245     $filepos ||= 0;
 246     $filepos += $ret;
 247     if (ref $levelsize) {
 248         return ::err "invalid metadata in data file",
 249                      " (expecting $len bytes; found only $$levelsize)"
 250             unless $len <= $$levelsize;
 251         $$levelsize -= $len;
 252     }
 253     my (@fields) = (unpack $template, $buf);
 254     foreach my $field (@fields) {
 255         last unless @_;
 256         my $min = shift;
 257         my $max = shift;
 258         return ::err "invalid data in data file"
 259             if defined $min && $field < $min or defined $max && $field > $max;
 260     }
 261     return wantarray ? @fields : $fields[-1];
 262 }
 263
 264 # Translate escape sequences in the given string.
 265 #
 266 sub unescape($)
 267 {
 268     local $_ = shift;
 269     s/\\([0-7][0-7][0-7])/chr oct$1/eg;
 270     s/\\([\\\"])/$1/g;
 271     return $_;
 272 }
 273
 274 sub escape($)
 275 {
 276     local $_ = shift;
 277     s/([\\\"])/\\$1/g;
 278     s/([^\020-\176])/sprintf"\\%03o",ord$1/eg;
 279     return $_;
 280 }
 281
 282 # Take a standard creature list from a dat file and augment it as
 283 # necessary for a Lynx-based file format. This involves adding entries
 284 # for Chip, blocks, immobile creatures, and creatures on clone
 285 # machines.
 286 #
 287 sub makelynxcrlist($$)
 288 {
 289     my $map = shift;
 290     my $datcreatures = shift;
 291     my @crlist;
 292     my @listed;
 293
 294     if (defined $datcreatures) {
 295         foreach my $n (0 .. $#$datcreatures) {
 296             $listed[$datcreatures->[$n][0]][$datcreatures->[$n][1]] = $n;
 297         }
 298     }
 299
 300     my $chip = undef;
 301     foreach my $y (0 .. 31) {
 302         foreach my $x (0 .. 31) {
 303             my $obj = $map->[$y][$x][0];
 304             next unless ::iscreature $obj || ::isblock $obj || ::ischip $obj;
 305             my ($seq, $ff, $mobile) = (0, 0, 1);
 306             if (::ischip $obj) {
 307                 return "multiple Chips present" if defined $chip;
 308                 $chip = @crlist;
 309             } elsif (::isblock $obj) {
 310                 $mobile = -1 if $map->[$y][$x][1] == $tilenames{"cloner"};
 311             } else {
 312                 if ($map->[$y][$x][1] == $tilenames{"cloner"}) {
 313                     $mobile = -1;
 314                 } else {
 315                     $mobile = defined $listed[$y][$x] ? 1 : 0;
 316                 }
 317                 $seq = $listed[$y][$x] + 1 if defined $listed[$y][$x];
 318             }
 319             push @crlist, [ $seq, $y, $x, $mobile ];
 320         }
 321     }
 322     return "Chip absent" unless defined $chip;
 323     return "over 128 creatures" if @crlist > 128;
 324     ($crlist[$chip], $crlist[0]) = ($crlist[0], $crlist[$chip]);
 325
 326     my @sortlist;
 327     foreach my $n (0 .. $#crlist) { push @sortlist, $n if $crlist[$n][0] }
 328     @sortlist = sort { $crlist[$a][0] <=> $crlist[$b][0] } @sortlist;
 329
 330     my @lynxcreatures;
 331     foreach my $n (0 .. $#crlist) {
 332         my $creature = $crlist[$n];
 333         $creature = $crlist[shift @sortlist] if $creature->[0];
 334         push @lynxcreatures, [ $creature->[1],
 335                                $creature->[2],
 336                                $creature->[3] ];
 337     }
 338
 339     return \@lynxcreatures;
 340 }
 341
 342 # Translate a creature list from a lynx-based file format to one
 343 # appropriate for a dat-based file format.
 344 #
 345 sub makedatcrlist($$)
 346 {
 347     my $map = shift;
 348     my $lynxcreatures = shift;
 349     my @crlist;
 350
 351     return undef unless defined $lynxcreatures;
 352
 353     foreach my $creature (@$lynxcreatures) {
 354         next if $creature->[2] != 1;
 355         next if ::ischip $map->[$creature->[0]][$creature->[1]][0];
 356         next if ::isblock $map->[$creature->[0]][$creature->[1]][0];
 357         push @crlist, [ $creature->[0], $creature->[1] ];
 358     }
 359
 360     return \@crlist;
 361 }
 362
 363 #
 364 # The textual source file format
 365 #
 366
 367 package txtfile;
 368
 369 # The list of default tile symbols.
 370 #
 371 my %tilesymbols = %{{
 372     " "  => $tilenames{"empty"},
 373     "#"  => $tilenames{"wall"},
 374     "\$" => $tilenames{"ic chip"},
 375     ","  => $tilenames{"water"},
 376     "&"  => $tilenames{"fire"},
 377     "~"  => $tilenames{"wall north"},
 378     "|"  => $tilenames{"wall west"},
 379     "_"  => $tilenames{"wall south"},
 380     " |" => $tilenames{"wall east"},
 381     "[]" => $tilenames{"block"},
 382     "["  => $tilenames{"block"},
 383     ";"  => $tilenames{"dirt"},
 384     "="  => $tilenames{"ice"},
 385     "v"  => $tilenames{"force south"},
 386     "^"  => $tilenames{"force north"},
 387     ">"  => $tilenames{"force east"},
 388     "<"  => $tilenames{"force west"},
 389     "E"  => $tilenames{"exit"},
 390     "H"  => $tilenames{"socket"},
 391     "6"  => $tilenames{"bomb"},
 392     ":"  => $tilenames{"gravel"},
 393     "?"  => $tilenames{"hint button"},
 394     "_|" => $tilenames{"wall southeast"},
 395     "<>" => $tilenames{"force any"},
 396     "@"  => $tilenames{"chip south"},
 397     "^]" => [ $tilenames{"cloning block north"}, $tilenames{"clone machine"} ],
 398     "<]" => [ $tilenames{"cloning block west"},  $tilenames{"clone machine"} ],
 399     "v]" => [ $tilenames{"cloning block south"}, $tilenames{"clone machine"} ],
 400     ">]" => [ $tilenames{"cloning block east"},  $tilenames{"clone machine"} ]
 401 }};
 402
 403 #
 404 #
 405 #
 406
 407 # Error message display.
 408 #
 409 sub err(@) { warn "line $.: ", @_, "\n"; return; }
 410
 411 # The list of incomplete tile names recognized. Each incomplete name
 412 # has a list of characters that complete them.
 413 #
 414 my %partialnames = %{{
 415     "key"       => { "blue key"         => "b", "red key"         => "r",
 416                      "green key"        => "g", "yellow key"      => "y" },
 417     "door"      => { "blue door"        => "b", "red door"        => "r",
 418                      "green door"       => "g", "yellow door"     => "y" },
 419     "bug"       => { "bug north"        => "n", "bug west"        => "w",
 420                      "bug south"        => "s", "bug east"        => "e" },
 421     "bee"       => { "bee north"        => "n", "bee west"        => "w",
 422                      "bee south"        => "s", "bee east"        => "e" },
 423     "fireball"  => { "fireball north"   => "n", "fireball west"   => "w",
 424                      "fireball south"   => "s", "fireball east"   => "e" },
 425     "flame"     => { "flame north"      => "n", "flame west"      => "w",
 426                      "flame south"      => "s", "flame east"      => "e" },
 427     "ball"      => { "ball north"       => "n", "ball west"       => "w",
 428                      "ball south"       => "s", "ball east"       => "e" },
 429     "tank"      => { "tank north"       => "n", "tank west"       => "w",
 430                      "tank south"       => "s", "tank east"       => "e" },
 431     "glider"    => { "glider north"     => "n", "glider west"     => "w",
 432                      "glider south"     => "s", "glider east"     => "e" },
 433     "ghost"     => { "ghost north"      => "n", "ghost west"      => "w",
 434                      "ghost south"      => "s", "ghost east"      => "e" },
 435     "teeth"     => { "teeth north"      => "n", "teeth west"      => "w",
 436                      "teeth south"      => "s", "teeth east"      => "e" },
 437     "frog"      => { "frog north"       => "n", "frog west"       => "w",
 438                      "frog south"       => "s", "frog east"       => "e" },
 439     "walker"    => { "walker north"     => "n", "walker west"     => "w",
 440                      "walker south"     => "s", "walker east"     => "e" },
 441     "dumbbell"  => { "dumbbell north"   => "n", "dumbbell west"   => "w",
 442                      "dumbbell south"   => "s", "dumbbell east"   => "e" },
 443     "blob"      => { "blob north"       => "n", "blob west"       => "w",
 444                      "blob south"       => "s", "blob east"       => "e" },
 445     "paramecium"=> { "paramecium north" => "n", "paramecium west" => "w",
 446                      "paramecium south" => "s", "paramecium east" => "e" },
 447     "centipede" => { "centipede north"  => "n", "centipede west"  => "w",
 448                      "centipede south"  => "s", "centipede east"  => "e" },
 449     "chip"      => { "chip north"       => "n", "chip west"       => "w",
 450                      "chip south"       => "s", "chip east"       => "e" },
 451     "(swimming chip)"
 452                 => { "(swimming chip north)" => "n",
 453                      "(swimming chip west)"  => "w",
 454                      "(swimming chip south)" => "s",
 455                      "(swimming chip east)"  => "e" }
 456 }};
 457
 458 # The list of tile definitions that are defined throughout the set. A
 459 # number of definitions are made by default at startup.
 460 #
 461 my %globaltiles = %tilesymbols;
 462
 463 # The list of tile definitions for a given level.
 464 #
 465 my %localtiles;
 466
 467 # Add a list of tile definitions to a hash.
 468 #
 469 sub addtiledefs(\%@)
 470 {
 471     my $tiledefs = shift;
 472     while (my $def = shift) { $tiledefs->{$def->[0]} = $def->[1] }
 473 }
 474
 475 # Given a string, return the tile with that name. If the name is not
 476 # recognized, undef is returned and a error message is displayed.
 477 #
 478 sub lookuptilename($)
 479 {
 480     my $name = shift;
 481     my $value = undef;
 482
 483     return $tilenames{$name} if exists $tilenames{$name};
 484
 485     if ($name =~ /^0x([0-9A-Fa-f][0-9A-Fa-f])$/) {
 486         $value = hex $1;
 487         return $value if $value >= 0 && $value <= 255;
 488     }
 489
 490     my $n = length $name;
 491     foreach my $key (keys %tilenames) {
 492         if ($name eq substr $key, 0, $n) {
 493             return ::err "ambiguous object id \"$name\""
 494                 if defined $value && $value != $tilenames{$key};
 495             $value = $tilenames{$key};
 496         }
 497     }
 498     return ::err "unknown object id \"$name\"" unless defined $value;
 499     return $value;
 500 }
 501
 502 # Given two characters, return the tile or pair of tiles which the
 503 # characters represent. The characters can stand for a pair of tiles
 504 # directly, or each character can independently represent one tile. In
 505 # either case, a pair of tiles is returned as an array ref. A single
 506 # tile is returned directly. If one or both characters are
 507 # unrecognized, undef is returned and an error message is displayed.
 508 #
 509 sub lookuptile($);
 510 sub lookuptile($)
 511 {
 512     my $symbol = shift;
 513     $symbol =~ s/\A(.) \Z/$1/;
 514
 515     return $localtiles{$symbol} if exists $localtiles{$symbol};
 516     return $globaltiles{$symbol} if exists $globaltiles{$symbol};
 517
 518     if (length($symbol) == 2) {
 519         my $top = lookuptile substr $symbol, 0, 1;
 520         if (defined $top && ref $top && $top->[1] < 0) {
 521             return $top;
 522         } elsif (defined $top && !ref $top) {
 523             my $bot = lookuptile substr $symbol, 1, 1;
 524             if (defined $bot && !ref $bot) {
 525                 return [ $top, $bot ];
 526             }
 527         }
 528     }
 529
 530     return ::err "unrecognized map tile \"$symbol\"";
 531 }
 532
 533 # Return the number of chips present on the map.
 534 #
 535 sub getchipcount($)
 536 {
 537     my $map = shift;
 538     my $count = 0;
 539
 540     foreach my $y (0 .. 31) {
 541         foreach my $x (0 .. 31) {
 542             ++$count if $map->[$y][$x][0] == 0x02;
 543             ++$count if $map->[$y][$x][1] == 0x02;
 544         }
 545     }
 546     return $count;
 547 }
 548
 549 # Given a completed map, return the default list of traps connections
 550 # as an array ref. (The default list follows the original Lynx rules
 551 # of connecting buttons to the first subsequent trap in reading
 552 # order.)
 553 #
 554 sub buildtraplist($)
 555 {
 556     my $map = shift;
 557     my $firsttrap = undef;
 558     my @traps;
 559     my @buttons;
 560
 561     foreach my $y (0 .. 31) {
 562         foreach my $x (0 .. 31) {
 563             if ($map->[$y][$x][0] == 0x27 || $map->[$y][$x][1] == 0x27) {
 564                 push @buttons, [ $y, $x ];
 565             } elsif ($map->[$y][$x][0] == 0x2B || $map->[$y][$x][1] == 0x2B) {
 566                 push @traps, map { { from => $_, to => [ $y, $x ] } } @buttons;
 567                 undef @buttons;
 568                 $firsttrap = [ $y, $x ] unless defined $firsttrap;
 569             }
 570         }
 571     }
 572     push @traps, map { { from => $_, to => $firsttrap } } @buttons
 573         if @buttons && defined $firsttrap;
 574     return \@traps;
 575 }
 576
 577 # Given a completed map, return the default list of clone machine
 578 # connections as an array ref. (This function looks a lot like the
 579 # prior one.)
 580 #
 581 sub buildclonerlist($)
 582 {
 583     my $map = shift;
 584     my $firstcm = undef;
 585     my @cms;
 586     my @buttons;
 587
 588     foreach my $y (0 .. 31) {
 589         foreach my $x (0 .. 31) {
 590             if ($map->[$y][$x][0] == 0x24 || $map->[$y][$x][1] == 0x24) {
 591                 push @buttons, [ $y, $x ];
 592             } elsif ($map->[$y][$x][0] == 0x31 || $map->[$y][$x][1] == 0x31) {
 593                 push @cms, map { { from => $_, to => [ $y, $x ] } } @buttons;
 594                 undef @buttons;
 595                 $firstcm = [ $y, $x ] unless defined $firstcm;
 596             }
 597         }
 598     }
 599     push @cms, map { { from => $_, to => $firstcm } } @buttons
 600         if @buttons && defined $firstcm;
 601     return \@cms;
 602 }
 603
 604 # Given a completed map, return the default ordering of creatures as
 605 # an array ref. (The default ordering is to first list the creatures
 606 # in reading order, including Chip. Then, the first creature on the
 607 # list swaps positions with Chip, who is then removed from the list.)
 608 #
 609 sub buildcreaturelist($$)
 610 {
 611     my $map = shift;
 612     my $ruleset = shift;
 613     my $chippos = undef;
 614     my @crlist;
 615
 616     foreach my $y (0 .. 31) {
 617         foreach my $x (0 .. 31) {
 618             my $tile = $map->[$y][$x][0];
 619             if (::iscreature $tile) {
 620                 push @crlist, [ $y, $x ];
 621             } elsif (::isblock $tile) {
 622                 push @crlist, [ $y, $x, 0 ];
 623             } elsif (::ischip $tile) {
 624                 $chippos = @crlist;
 625                 push @crlist, [ $y, $x, 0 ];
 626             }
 627         }
 628     }
 629     if ($ruleset eq "lynx") {
 630         ($crlist[0], $crlist[$chippos]) = ($crlist[$chippos], $crlist[0])
 631             if $chippos;
 632         foreach my $item (@crlist) { $#$item = 1 }
 633     } else {
 634         if (defined $chippos && $chippos > 1) {
 635             my $cr = shift @crlist;
 636             $crlist[$chippos - 1] = $cr;
 637         }
 638         for (my $n = $#crlist ; $n >= 0 ; --$n) {
 639             splice @crlist, $n, 1 if $#{$crlist[$n]} > 1;
 640         }
 641     }
 642
 643     return \@crlist;
 644 }
 645
 646 # Compare two arrays of lines of text. Wherever the same pair of
 647 # characters appears in same place in both arrays, the occurrence in
 648 # the first array is replaced with spaces.
 649 #
 650 sub subtracttext(\@\@)
 651 {
 652     my $array = shift;
 653     my $remove = shift;
 654
 655     for (my $n = 0 ; $n < @$array && $n < @$remove ; ++$n) {
 656         my $m = 0;
 657         while ($m < length $array->[$n] && $m < length $remove->[$n]) {
 658             my $a = substr $array->[$n], $m, 2;
 659             my $b = substr $remove->[$n], $m, 2;
 660             $a .= " " if length $a == 1;
 661             $b .= " " if length $b == 1;
 662             substr($array->[$n], $m, 2) = "  " if $a eq $b;
 663             $m += 2;
 664         }
 665     }
 666 }
 667
 668 # Interpret a textual description of a section of the map. The
 669 # interpreted map data is added to the map array passed as the first
 670 # argument. The second and third arguments set the origin of the map
 671 # section. The remaining arguments are the lines from the text file
 672 # describing the map section. The return value is 1 if the
 673 # interpretation is successful. If any part of the map sections cannot
 674 # be understood, undef is returned and an error message is displayed.
 675 #
 676 sub parsemap($$$@)
 677 {
 678     my $map = shift;
 679     my $y0 = shift;
 680     my $x0 = shift;
 681     return ::err "map extends below the 32nd row" if $y0 + @_ > 32;
 682     for (my $y = $y0 ; @_ ; ++$y) {
 683         my $row = shift;
 684         return ::err "map extends beyond the 32nd column"
 685             if $x0 + length($row) / 2 > 32;
 686         for (my $x = $x0 ; length $row ; ++$x) {
 687             my $cell = lookuptile substr $row, 0, 2;
 688             return ::err "unrecognized tile at ($x $y)" unless defined $cell;
 689             return unless defined $cell;
 690             if (ref $cell) {
 691                 if ($cell->[1] < 0) {
 692                     $map->[$y][$x] = [ $cell, 0x00 ];
 693                 } else {
 694                     $map->[$y][$x] = $cell;
 695                 }
 696             } else {
 697                 $map->[$y][$x] = [ $cell, 0x00 ];
 698             }
 699             substr($row, 0, 2) = "";
 700         }
 701     }
 702     return 1;
 703 }
 704
 705 # Interpret a textual overlay section. The first argument is the
 706 # level's hash ref. The second and third arguments set the origin of
 707 # the overlay section. The remaining arguments are the lines from the
 708 # text file describing the overlay. The return value is 1 if the
 709 # interpretation is successful. If any part of the overlay section
 710 # cannot be understood, undef is returned and an error message is
 711 # displayed.
 712 #
 713 sub parsecon($$$@)
 714 {
 715     my %symbols;
 716     my $data = shift;
 717     my $y0 = shift;
 718     my $x0 = shift;
 719     return ::err "overlay extends below the 32nd row" if $y0 + @_ > 32;
 720     for (my $y = $y0 ; @_ ; ++$y) {
 721         my $row = shift;
 722         return ::err "overlay extends beyond the 32nd column"
 723             if $x0 + length($row) / 2 > 32;
 724         for (my $x = $x0 ; length $row ; ++$x) {
 725             $_ = substr $row, 0, 1, "";
 726             push @{$symbols{$_}}, [ $y, $x ] unless $_ eq " " || $_ eq "";
 727             $_ = substr $row, 0, 1, "";
 728             push @{$symbols{$_}}, [ $y, $x ] unless $_ eq " " || $_ eq "";
 729         }
 730     }
 731
 732     foreach my $symbol (sort keys %symbols) {
 733         my $list = $symbols{$symbol};
 734         if (@$list == 1) {
 735             my ($y, $x) = ($list->[0][0], $list->[0][1]);
 736             my $cell = $data->{map}[$y][$x];
 737             return ::err "no creature under \"$symbol\" at ($x $y)"
 738                 unless defined $cell &&
 739                         (::iscreature $cell->[0] || ::iscreature $cell->[1]);
 740             push @{$data->{creatures}}, [ $y, $x ];
 741         } else {
 742             my $linktype = undef;
 743             my $to = undef;
 744             my (@from, $type);
 745             foreach my $pos (@$list) {
 746                 my ($y, $x) = ($pos->[0], $pos->[1]);
 747                 my $cell = $data->{map}[$y][$x];
 748                 my $obj = $cell->[1] || $cell->[0];
 749                 if ($obj == $tilenames{"red button"}) {
 750                     $type = "cloners";
 751                     push @from, [ $y, $x ];
 752                 } elsif ($obj == $tilenames{"brown button"}) {
 753                     $type = "traps";
 754                     push @from, [ $y, $x ];
 755                 } elsif ($obj == $tilenames{"clone machine"}) {
 756                     $type = "cloners";
 757                     return ::err "clone machine under \"$symbol\" at ($x $y) ",
 758                                  "wired to non-button at ($to->[1] $to->[0])"
 759                         if defined $to;
 760                     $to = [ $y, $x ];
 761                 } elsif ($obj == $tilenames{"beartrap"}) {
 762                     $type = "traps";
 763                     return ::err "beartrap under \"$symbol\" at ($x $y) ",
 764                                  "wired to non-button at ($to->[1] $to->[0])"
 765                         if defined $to;
 766                     $to = [ $y, $x ];
 767                 } else {
 768                     return ::err "no button/trap/clone machine ",
 769                                  "under \"$symbol\" at ($x $y)";
 770                 }
 771                 $linktype ||= $type;
 772                 return ::err "inconsistent connection ",
 773                              "under \"$symbol\" at ($x $y)"
 774                     unless $linktype eq $type;
 775             }
 776             push @{$data->{$linktype}},
 777                  map { { from => $_, to => $to } } @from;
 778         }
 779     }
 780     return 1;
 781 }
 782
 783 # Interpret a tile definition. Given a line of text supplying the tile
 784 # definition, the function returns an array ref. Each element in the
 785 # array is a pair: the first element gives the character(s), and the
 786 # second element supplies the tile(s). If the definition is ambiguous
 787 # or invalid, undef is returned and an error message is displayed.
 788 #
 789 sub parsetiledef($)
 790 {
 791     my $def = shift;
 792     $def =~ s/^(\S\S?)\t//
 793         or return ::err "syntax error in tile defintion \"$def\"";
 794     my $symbol = $1;
 795     $def = lc $def;
 796     $def =~ s/^\s+//;
 797     $def =~ s/\s+$//;
 798
 799     if ($def =~ /^([^\+]*[^\+\s])\s*\+\s*([^\+\s][^\+]*)$/) {
 800         my ($def1, $def2) = ($1, $2);
 801         my ($tile1, $tile2);
 802         $tile1 = lookuptilename $def1;
 803         return unless defined $tile1;
 804         if (lc $def2 eq "pos") {
 805             return ::err "ordered tile definition \"$symbol\" ",
 806                          "must be a single character"
 807                 unless length($symbol) == 1;
 808             $tile2 = -1;
 809         } else {
 810             $tile2 = lookuptilename $def2;
 811             return unless defined $tile2;
 812         }
 813         return [ [ $symbol, [ $tile1, $tile2 ] ] ];
 814     }
 815
 816     my @defs;
 817     if (exists $partialnames{$def}) {
 818         return ::err "incomplete tile definition \"$symbol\" ",
 819                      "must be a single character"
 820             unless length($symbol) == 1;
 821         foreach my $comp (keys %{$partialnames{$def}}) {
 822             push @defs, [ $symbol . $partialnames{$def}{$comp},
 823                           $tilenames{$comp} ];
 824         }
 825         return \@defs;
 826     }
 827
 828     my $tile = lookuptilename $def;
 829     return [ [ $symbol, $tile ] ] if defined $tile;
 830     return;
 831 }
 832
 833 # Given a handle to a text file, read the introductory lines that
 834 # precede the first level definition, if any, and return a hash ref
 835 # for storing the level set. If an error occurs, undef is returned and
 836 # an error message is displayed.
 837 #
 838 sub parseheader($)
 839 {
 840     my $input = shift;
 841     my $data = { ruleset => "lynx" };
 842     my $slurpingdefs = undef;
 843     local $_;
 844
 845     while (<$input>) {
 846         chomp;
 847         if (defined $slurpingdefs) {
 848             if (/^\s*[Ee][Nn][Dd]\s*$/) {
 849                 undef $slurpingdefs;
 850             } else {
 851                 my $def = parsetiledef $_;
 852                 return unless $def;
 853                 addtiledefs %globaltiles, @$def;
 854             }
 855             next;
 856         } elsif (/^\s*[Tt][Ii][Ll][Ee][Ss]\s*$/) {
 857             $slurpingdefs = 1;
 858             next;
 859         }
 860
 861         last if /^%%%$/;
 862         next if /^\s*$/ || /^%/;
 863
 864         /^\s*(\S+)\s+(\S(?:.*\S)?)\s*$/ or return ::err "syntax error";
 865         my ($name, $value) = ($1, $2);
 866         $name = lc $name;
 867         if ($name eq "ruleset") {
 868             $value = lc $value;
 869             return ::err "invalid ruleset \"$value\""
 870                 unless $value =~ /^(lynx|ms)$/;
 871             $data->{ruleset} = $value;
 872         } elsif ($name eq "maxlevel") {
 873             return ::err "invalid maximum level \"$value\""
 874                 unless $value =~ /\A\d+\Z/ && $value < 65536;
 875             $data->{maxlevel} = $value;
 876         } else {
 877             return ::err "invalid statement \"$name\"";
 878         }
 879     }
 880
 881     return ::err "unclosed definition section" if $slurpingdefs;
 882     return $data;
 883 }
 884
 885 # Given a handle to a text file, positioned at the start of a level
 886 # description, parse the lines describing the level and return a hash
 887 # ref containing the level data. If the end of the file is encountered
 888 # before a level description is found, false is returned. If any
 889 # errors are encountered, undef is returned and an error message is
 890 # displayed.
 891 #
 892 sub parselevel($$$)
 893 {
 894     my $input = shift;
 895     my $ruleset = shift;
 896     my $number = shift;
 897     my %data = (number => $number, leveltime => 0);
 898     my $seenanything = undef;
 899     my $slurpingdefs = undef;
 900     my $slurpingmap = undef;
 901     my @maptext;
 902     local $_;
 903
 904     $data{passwd} = $origpasswords[$number - 1]
 905         if $number >= 1 && $number <= 150;
 906
 907     for my $y (0 .. 31) {
 908         for my $x (0 .. 31) { $data{map}[$y][$x] = [ 0, 0 ] }
 909     }
 910     undef %localtiles;
 911
 912     while (<$input>) {
 913         chomp;
 914         if (defined $slurpingdefs) {
 915             if (/^\s*[Ee][Nn][Dd]\s*$/) {
 916                 undef $slurpingdefs;
 917             } else {
 918                 my $def = parsetiledef $_;
 919                 return unless $def;
 920                 addtiledefs %localtiles, @$def;
 921             }
 922             next;
 923         } elsif (defined $slurpingmap) {
 924             if (/^\s*([AEae])[Nn][Dd]\s*$/) {
 925                 my $overlay = lc($1) eq "a";
 926                 if ($slurpingmap->[2] >= 0) {
 927                     my @overlaytext = splice @maptext, $slurpingmap->[2];
 928                     return ::err "overlay section is taller than map section"
 929                         if @overlaytext > @maptext;
 930                     subtracttext @overlaytext, @maptext;
 931                     return unless parsecon \%data,
 932                                            $slurpingmap->[0],
 933                                            $slurpingmap->[1],
 934                                            @overlaytext;
 935                 } else {
 936                     $slurpingmap->[2] = @maptext;
 937                     return unless parsemap $data{map},
 938                                            $slurpingmap->[0],
 939                                            $slurpingmap->[1],
 940                                            @maptext;
 941                 }
 942                 unless ($overlay) {
 943                     undef $slurpingmap;
 944                     undef @maptext;
 945                 }
 946             } else {
 947                 1 while s{^([^\t]*)\t}{$1 . (" " x (8 - length($1) % 8))}e;
 948                 push @maptext, $_;
 949             }
 950             next;
 951         } elsif (/^\s*[Tt][Ii][Ll][Ee][Ss]\s*$/) {
 952             $slurpingdefs = 1;
 953             next;
 954         } elsif (/^\s*[Mm][Aa][Pp]\s*(?:(\d+)\s+(\d+)\s*)?$/) {
 955             $slurpingmap = [ $2 || 0, $1 || 0, -1 ];
 956             next;
 957         } elsif (/^\s*[Mm][Aa][Pp]/) {
 958             return ::err "invalid syntax following \"map\"";
 959         } elsif (/^\s*[Tt][Rr][Aa][Pp][Ss]\s*$/) {
 960             $data{traps} ||= [ ];
 961             next;
 962         } elsif (/^\s*[Cc][Ll][Oo][Nn][Ee][Rr][Ss]\s*$/) {
 963             $data{cloners} ||= [ ];
 964             next;
 965         } elsif (/^\s*[Cc][Rr][Ee][Aa][Tt][Uu][Rr][Ee][Ss]\s*$/) {
 966             $data{creatures} ||= [ ];
 967             next;
 968         }
 969
 970         last if /^%%%$/;
 971         next if /^\s*$/ || /^%/;
 972
 973         $seenanything = 1;
 974         /^\s*(\S+)\s+(\S(?:.*\S)?)\s*$/ or return ::err "syntax error";
 975         my ($name, $value) = ($1, $2);
 976         $name = lc $name;
 977         if ($name eq "level") {
 978             return ::err "invalid level number \"$value\""
 979                 unless $value =~ /\A\d+\Z/ && $value < 65536;
 980             $data{number} = $value;
 981         } elsif ($name eq "time") {
 982             return ::err "invalid level time \"$value\""
 983                 unless $value =~ /\A\d+\Z/ && $value < 65536;
 984             $data{leveltime} = $value;
 985         } elsif ($name eq "chips") {
 986             return ::err "invalid chip count \"$value\""
 987                 unless $value =~ /\A\d+\Z/ && $value < 65536;
 988             $data{chips} = $value;
 989         } elsif ($name eq "title" || $name eq "name") {
 990             $value = ::unescape $value if $value =~ s/\A\"(.*)\"\Z/$1/;
 991             $data{title} .= " " if defined $data{title};
 992             $data{title} .= $value;
 993         } elsif ($name eq "password" || $name eq "passwd") {
 994             return ::err "invalid password \"$value\""
 995                 unless $value =~ /\A[A-Z][A-Z][A-Z][A-Z]\Z/;
 996             $data{passwd} = $value;
 997         } elsif ($name eq "hint") {
 998             $value = ::unescape $value if $value =~ s/\A\"(.*)\"\Z/$1/;
 999             $data{hint} .= " " if defined $data{hint};
1000             $data{hint} .= $value;
1001         } elsif ($name eq "traps") {
1002             $data{traps} ||= [ ];
1003             while ($value =~ s/\A\s* (\d+)\s+(\d+) \s*[-=]?>\s*
1004                                      (\d+)\s+(\d+) (?:\s*[,;])?//x) {
1005                 push @{$data{traps}}, { from => [ $2, $1 ],
1006                                         to => [ $4, $3 ] };
1007             }
1008             return ::err "syntax error in trap list at \"$value\""
1009                 if $value && $value !~ /\A[,;]\Z/;
1010         } elsif ($name eq "cloners") {
1011             $data{cloners} ||= [ ];
1012             while ($value =~ s/\A\s* (\d+)\s+(\d+) \s*[-=]?>\s*
1013                                      (\d+)\s+(\d+) (?:\s*[,;])?//x) {
1014                 push @{$data{cloners}}, { from => [ $2, $1 ],
1015                                           to => [ $4, $3 ] };
1016             }
1017             return ::err "syntax error in clone machine list at \"$value\""
1018                 if $value && $value !~ /\A[,;]\Z/;
1019         } elsif ($name eq "creatures") {
1020             $data{creatures} ||= [ ];
1021             while ($value =~ s/\A\s* (\d+)\s+(\d+) (?:\s*[,;])?//x) {
1022                 push @{$data{creatures}}, [ $2, $1 ];
1023             }
1024             return ::err "syntax error in creature list at \"$value\""
1025                 if $value && $value !~ /\A[,;]\Z/;
1026         } elsif ($name eq "border") {
1027             my $cell = lookuptile $value;
1028             return unless defined $cell;
1029             $cell = [ $cell, 0x00 ] unless ref $cell;
1030             foreach my $y (0 .. 31) { $data{map}[$y][0]  = [ @$cell ] }
1031             foreach my $y (0 .. 31) { $data{map}[$y][31] = [ @$cell ] }
1032             foreach my $x (1 .. 30) { $data{map}[0][$x]  = [ @$cell ] }
1033             foreach my $x (1 .. 30) { $data{map}[31][$x] = [ @$cell ] }
1034         } elsif ($name eq "field") {
1035             return ::err "invalid field spec \"$value\""
1036                 unless $value =~ /^(\d+)\s+(\d+(?:\s+\d+)*)$/;
1037             my ($num, $data) = ($1, $2);
1038             return ::err "multiple specs for field $num"
1039                 if exists $data{fields}{$num};
1040             $data{fields}{$num} = join "", map { chr } split " ", $data;
1041         } else {
1042             return ::err "invalid command \"$name\"";
1043         }
1044     }
1045     return "" unless $seenanything;
1046
1047     return ::err "unclosed defs section" if $slurpingdefs;
1048     return ::err "unclosed map section" if $slurpingmap;
1049
1050     return ::err "missing level title" unless exists $data{title};
1051     return ::err "missing password" unless exists $data{passwd};
1052     return ::err "missing level map" unless exists $data{map};
1053
1054     $data{chips} = getchipcount $data{map} unless exists $data{chips};
1055     $data{traps} ||= buildtraplist $data{map};
1056     $data{cloners} ||= buildclonerlist $data{map};
1057     $data{creatures} ||= buildcreaturelist $data{map}, $ruleset;
1058     $data{lynxcreatures} = ::makelynxcrlist $data{map}, $data{creatures};
1059     $data{fields} ||= { };
1060
1061     return ::err "title too long (", length($data{title}), "); ",
1062                  "254 is the maximum length allowed"
1063         if length($data{title}) > 254;
1064     return ::err "hint too long (", length($data{hint}), "); ",
1065                  "254 is the maximum length allowed"
1066         if exists $data{hint} && length($data{hint}) > 254;
1067     return ::err "too many (", scalar(@{$data{traps}}), ") ",
1068                  "trap connections; 25 is the maximum allowed"
1069         if @{$data{traps}} > 25;
1070     return ::err "too many (", scalar(@{$data{cloners}}), ") ",
1071                  "clone machine connections; 31 is the maximum allowed"
1072         if @{$data{cloners}} > 31;
1073     return ::err "too many (", scalar(@{$data{creatures}}), ") ",
1074                  "creatures; 127 is the maximum allowed"
1075         if @{$data{creatures}} > 127;
1076
1077     return \%data;
1078 }
1079
1080 # This function takes a handle to a text file and returns a hash ref
1081 # containing the described level set. If the file could not be
1082 # completely translated, undef is returned and one or more error
1083 # messages will be displayed.
1084 #
1085 sub read($)
1086 {
1087     my $input = shift;
1088     my $data;
1089
1090     $data = parseheader $input;
1091     return unless $data;
1092
1093     my $lastnumber = 0;
1094     for (;;) {
1095         my $level = parselevel $input, $data->{ruleset}, $lastnumber + 1;
1096         return unless defined $level;
1097         last unless $level;
1098         $lastnumber = $level->{number};
1099         push @{$data->{levels}}, $level;
1100         last if eof $input;
1101     }
1102
1103     $#{$data->{levels}} = $data->{maxlevel} - 1
1104         if exists $data->{maxlevel} && $data->{maxlevel} < @{$data->{levels}};
1105
1106     return $data;
1107 }
1108
1109 #
1110 #
1111 #
1112
1113 my %globalsymbols;
1114 my %localsymbols;
1115
1116 $globalsymbols{"0"}[1] = " ";
1117 $globalsymbols{"0"}[2] = "  ";
1118 $globalsymbols{"0:0"}[1] = " ";
1119 $globalsymbols{"0:0"}[2] = "  ";
1120 foreach my $symbol (keys %tilesymbols) {
1121     my $key;
1122     if (ref $tilesymbols{$symbol}) {
1123         $key = "$tilesymbols{$symbol}[0]:$tilesymbols{$symbol}[1]";
1124     } else {
1125         $key = $tilesymbols{$symbol};
1126     }
1127     $globalsymbols{$key}[length $symbol] ||= $symbol;
1128 }
1129
1130 my @symbollist;
1131 my $newsym = -1;
1132
1133 sub printwrap($$$)
1134 {
1135     my $output = shift;
1136     my $prefix = shift;
1137     my @segments = split /(\S\s\S)/, ::escape shift;
1138
1139     push @segments, "" if @segments % 2 == 0;
1140     for (my $n = 1 ; $n < $#segments; ++$n) {
1141         $segments[$n - 1] .= substr($segments[$n], 0, 1);
1142         $segments[$n] = substr($segments[$n], 2, 1) . $segments[$n + 1];
1143         splice @segments, $n + 1, 1;
1144     }
1145
1146     my $width = 75 - length $prefix;
1147     my $line = shift @segments;
1148     while (@segments) {
1149         if (!$line || length($line) + length($segments[0]) < $width) {
1150             $line .= " " . shift @segments;
1151         } else {
1152             $line = "\"$line\"" if $line =~ /\\/;
1153             print $output "$prefix $line\n";
1154             $line = shift @segments;
1155         }
1156     }
1157     $line = "\"$line\"" if $line =~ /\\/ || $line =~ /^\s/ || $line =~ /\s$/;
1158     print $output "$prefix $line\n";
1159
1160     return 1;
1161 }
1162
1163 sub printlist($$@)
1164 {
1165     my $output = shift;
1166     my $prefix = shift;
1167
1168     while (@_) {
1169         my $item = shift;
1170         local $_ = "$prefix $item";
1171         my $x = length $_;
1172         print $output $_ or return;
1173         while (@_) {
1174             $x += 3 + length $_[0];
1175             last if $x > 76;
1176             $item = shift;
1177             print $output " ; $item" or return;
1178         }
1179         print $output "\n" or return;
1180     }
1181     return 1;
1182 }
1183
1184 sub tilesymbol($;$)
1185 {
1186     my $tile = shift;
1187     my $max = shift || 2;
1188
1189     return $globalsymbols{$tile}[$max] if defined $globalsymbols{$tile}[$max];
1190     return $globalsymbols{$tile}[1] if defined $globalsymbols{$tile}[1];
1191     return $localsymbols{$tile}[$max] if defined $localsymbols{$tile}[$max];
1192     return $localsymbols{$tile}[1] if defined $localsymbols{$tile}[1];
1193     return undef;
1194 }
1195
1196 sub getnewsym() { shift @symbollist }
1197
1198 sub resetnewsyms()
1199 {
1200     @symbollist = split //,
1201       "ABCDFGIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz012345789@*+.,'`-!";
1202 }
1203
1204 sub cellsymbol($;$)
1205 {
1206     my $top = shift;
1207     my $bot = shift || 0;
1208     my $tile;
1209     my $symbol;
1210
1211     return "  " if $top == 0 && $bot == 0;
1212
1213     $tile = $bot ? "$top:$bot" : $top;
1214     $symbol = tilesymbol $tile;
1215     if (defined $symbol) {
1216         $symbol = "$symbol " if length($symbol) == 1;
1217         return $symbol;
1218     }
1219
1220     if ($bot) {
1221         if ($top == 0) {
1222             $symbol = tilesymbol $bot, 1;
1223             return " $symbol" if defined $symbol;
1224         } else {
1225             my $st = tilesymbol $top, 1;
1226             if (defined $st) {
1227                 my $sb = tilesymbol $bot, 1;
1228                 return "$st$sb" if defined $sb;
1229             }
1230         }
1231     }
1232
1233     $symbol = getnewsym;
1234     unless (defined $symbol) {
1235         ::err "too many unique tile combinations required";
1236         $symbol = "\\";
1237     }
1238     $localsymbols{$tile}[length $symbol] = $symbol;
1239
1240     $symbol = "$symbol " if length($symbol) == 1;
1241     return $symbol;
1242 }
1243
1244 sub trimmap(\@)
1245 {
1246     my $map = shift;
1247     my @xs = (0) x 32;
1248     my @ys = (0) x 32;
1249
1250     my $count = 0;
1251     foreach my $y (0 .. 31) {
1252         foreach my $x (0 .. 31) {
1253             next if $map->[$y][$x][0] == 0 && $map->[$y][$x][1] == 0;
1254             ++$xs[$x];
1255             ++$ys[$y];
1256             ++$count;
1257         }
1258     }
1259     return (0, 0, 0, 0, 0) unless $count;
1260
1261     my $border = 0;
1262     if ($map->[0][0][0] != 0 && $map->[0][0][1] == 0) {
1263         my $tile = $map->[0][0][0];
1264         foreach my $n (1 .. 31) {
1265             goto noborder unless $map->[$n][0][0] == $tile
1266                               && $map->[$n][31][0] == $tile
1267                               && $map->[0][$n][0] == $tile
1268                               && $map->[31][$n][0] == $tile
1269                               && $map->[$n][0][1] == 0
1270                               && $map->[$n][31][1] == 0
1271                               && $map->[0][$n][1] == 0
1272                               && $map->[31][$n][1] == 0;
1273         }
1274         $border = $tile;
1275         $xs[0] = $xs[31] = $ys[0] = $ys[31] = 0;
1276       noborder:
1277     }
1278
1279     my ($left, $right, $top, $bottom) = (-1, 32, -1, 32);
1280     1 until $xs[++$left];
1281     1 until $xs[--$right];
1282     1 until $ys[++$top];
1283     1 until $ys[--$bottom];
1284
1285     return 0, 31, 0, 31, 0 if $border && $left == 1 && $right == 30
1286                                       && $top == 1 && $bottom == 30;
1287
1288     return ($left, $right, $top, $bottom, $border);
1289 }
1290
1291 sub writeheader($\%)
1292 {
1293     my $output = shift;
1294     my $data = shift;
1295
1296         print $output "ruleset $data->{ruleset}\n"
1297     and print $output "\n%%%\n";
1298 }
1299
1300 sub writelevelheader($\%)
1301 {
1302     my $output = shift;
1303     my $level = shift;
1304
1305     printwrap $output, "title  ", $level->{title} or return;
1306     print $output "passwd  $level->{passwd}\n" or return;
1307     print $output "chips   $level->{chips}\n" or return
1308         if exists $level->{chips} && $level->{chips};
1309     print $output "time    $level->{leveltime}\n" or return
1310         if exists $level->{leveltime} && $level->{leveltime};
1311     printwrap $output, "hint   ", $level->{hint} or return
1312         if exists $level->{hint};
1313     print $output "\n";
1314 }
1315
1316 sub writelevelmap($\@)
1317 {
1318     my $output = shift;
1319     my $map = shift;
1320     my (@tiletext, @maptext);
1321
1322     undef %localsymbols;
1323     resetnewsyms;
1324
1325     my ($left, $right, $top, $bottom, $border) = trimmap @$map;
1326
1327     $border = cellsymbol $border if $border;
1328     foreach my $y ($top .. $bottom) {
1329         my $mapline = "";
1330         foreach my $x ($left .. $right) {
1331             $mapline .= cellsymbol $map->[$y][$x][0], $map->[$y][$x][1];
1332         }
1333         $mapline =~ s/\s+$//;
1334         push @maptext, "$mapline\n";
1335     }
1336
1337     foreach my $tiles (keys %localsymbols) {
1338         foreach my $tile (@{$localsymbols{$tiles}}) {
1339             next unless defined $tile;
1340             my $line = "$tile\t";
1341             if ($tiles =~ /^(\d+):(\d+)$/) {
1342                 my ($top, $bot) = ($1, $2);
1343                 $line .= "$tilenames[$top] + $tilenames[$bot]\n";
1344             } else {
1345                 $line .= "$tilenames[$tiles]\n";
1346             }
1347             push @tiletext, $line;
1348         }
1349     }
1350     @tiletext = sort @tiletext;
1351
1352     print $output "tiles\n", @tiletext, "end\n\n" or return if @tiletext;
1353     print $output "border $border\n\n" or return if $border;
1354
1355     print $output ($left || $top ? "map $left $top\n" : "map\n"),
1356                   @maptext,
1357                   "end\n\n"
1358         or return;
1359 }
1360
1361 sub writelevelcloners($\%)
1362 {
1363     my $output = shift;
1364     my $level = shift;
1365     my $n;
1366
1367     my $default = txtfile::buildclonerlist $level->{map};
1368     if (!defined $level->{cloners}) {
1369         return print $output "cloners\n\n" if @$default;
1370         return 1;
1371     }
1372     $n = 0;
1373     if (@$default == @{$level->{cloners}}) {
1374         for ($n = 0 ; $n < @$default ; ++$n) {
1375             last if $default->[$n]{from}[0] != $level->{cloners}[$n]{from}[0]
1376                  || $default->[$n]{from}[1] != $level->{cloners}[$n]{from}[1]
1377                  || $default->[$n]{to}[0] != $level->{cloners}[$n]{to}[0]
1378                  || $default->[$n]{to}[1] != $level->{cloners}[$n]{to}[1];
1379         }
1380     }
1381     return 1 if $n == @$default;
1382
1383     printlist $output, "cloners",
1384               map { "$_->{from}[1] $_->{from}[0] -> $_->{to}[1] $_->{to}[0]" }
1385                   @{$level->{cloners}}
1386         or return;
1387     print $output "\n";
1388 }
1389
1390 sub writeleveltraps($\%)
1391 {
1392     my $output = shift;
1393     my $level = shift;
1394     my $n;
1395
1396     my $default = txtfile::buildtraplist $level->{map};
1397     if (!defined $level->{traps}) {
1398         return print $output "traps\n\n" if @$default;
1399         return 1;
1400     }
1401     $n = 0;
1402     if (@$default == @{$level->{traps}}) {
1403         for ($n = 0 ; $n < @$default ; ++$n) {
1404             last if $default->[$n]{from}[0] != $level->{traps}[$n]{from}[0]
1405                  || $default->[$n]{from}[1] != $level->{traps}[$n]{from}[1]
1406                  || $default->[$n]{to}[0] != $level->{traps}[$n]{to}[0]
1407                  || $default->[$n]{to}[1] != $level->{traps}[$n]{to}[1];
1408         }
1409     }
1410     return 1 if $n == @$default;
1411
1412     printlist $output, "traps",
1413               map { "$_->{from}[1] $_->{from}[0] -> $_->{to}[1] $_->{to}[0]" }
1414                   @{$level->{traps}}
1415         or return;
1416     print $output "\n";
1417 }
1418
1419 sub writelevelcrlist($\%$)
1420 {
1421     my $output = shift;
1422     my $level = shift;
1423     my $ruleset = shift;
1424     my $n;
1425
1426     my $default = txtfile::buildcreaturelist $level->{map}, $ruleset;
1427     if (!defined $level->{creatures}) {
1428         return print $output "creatures\n\n" if @$default;
1429         return 1;
1430     }
1431
1432     $n = 0;
1433     if (@$default == @{$level->{creatures}}) {
1434         for ($n = 0 ; $n < @$default ; ++$n) {
1435             last if $default->[$n][0] != $level->{creatures}[$n][0]
1436                  || $default->[$n][1] != $level->{creatures}[$n][1];
1437         }
1438     }
1439     return 1 if $n == @$default;
1440
1441     printlist $output, "creatures",
1442               map { "$_->[1] $_->[0]" } @{$level->{creatures}}
1443         or return;
1444     print $output "\n";
1445 }
1446
1447 sub writelevel($\%$)
1448 {
1449     my $output = shift;
1450     my $level = shift;
1451     my $ruleset = shift;
1452
1453     writelevelheader $output, %$level or return;
1454     writelevelmap $output, @{$level->{map}} or return;
1455     writeleveltraps $output, %$level or return;
1456     writelevelcloners $output, %$level or return;
1457     writelevelcrlist $output, %$level, $ruleset or return;
1458
1459     print $output "%%%\n";
1460 }
1461
1462 sub write($$)
1463 {
1464     my $output = shift;
1465     my $data = shift;
1466
1467     $globalsymbols{$tilenames{"block north"}} =
1468                         [ @{$globalsymbols{$tilenames{"block"}}} ]
1469         if $data->{ruleset} eq "lynx";
1470
1471     writeheader $output, %$data or return;
1472
1473     my $lastnumber = 0;
1474     foreach my $level (@{$data->{levels}}) {
1475         $filelevel = $level->{number};
1476         ++$lastnumber;
1477         print $output "\n" or return;
1478         print $output "level $level->{number}\n" or return
1479             unless $level->{number} == $lastnumber;
1480         writelevel $output, %$level, $data->{ruleset} or return;
1481         $lastnumber = $level->{number};
1482     }
1483
1484     return 1;
1485 }
1486
1487 #
1488 #
1489 #
1490
1491 package datfile;
1492
1493 # Given a string of run-length encoded data, return the original
1494 # uncompressed string.
1495 #
1496 sub rleuncompress($)
1497 {
1498     local $_ = shift;
1499     1 while s/\xFF(.)(.)/$2 x ord$1/se;
1500     return $_;
1501 }
1502
1503 sub parseheader($)
1504 {
1505     my $input = shift;
1506     my %data;
1507
1508     my ($sig, $maxlevel) = ::fileread $input, "Vv" or return;
1509     if ($sig == 0x0002AAAC) {
1510         $data{ruleset} = "ms";
1511     } elsif ($sig == 0x0102AAAC) {
1512         $data{ruleset} = "lynx";
1513     } else {
1514         return ::err "not a valid data file";
1515     }
1516     return ::err "file contains no maps" if $maxlevel <= 0;
1517     $data{maxlevel} = $maxlevel;
1518
1519     return \%data;
1520 }
1521
1522 sub parselevelmap($$)
1523 {
1524     my $layer1 = shift;
1525     my $layer2 = shift;
1526     my @map;
1527     if (length($layer1) > 1024) {
1528         ::err "warning: excess data in top layer of map";
1529         substr($layer1, 1024) = "";
1530     }
1531     if (length($layer2) > 1024) {
1532         ::err "warning: excess data in bottom layer of map";
1533         substr($layer2, 1024) = "";
1534     }
1535     return ::err "invalid map in data file"
1536         unless length($layer1) == 1024 && length($layer2) == 1024;
1537     foreach my $y (0 .. 31) {
1538         foreach my $x (0 .. 31) {
1539             $map[$y][$x][0] = ord substr $layer1, 0, 1, "";
1540             $map[$y][$x][1] = ord substr $layer2, 0, 1, "";
1541         }
1542     }
1543     return \@map;
1544 }
1545
1546 sub parselevel($)
1547 {
1548     my $input = shift;
1549     my %level;
1550     my ($fieldnum, $fieldsize, $data);
1551
1552     my $levelsize = "";
1553     return ::err $! unless defined sysread $input, $levelsize, 2;
1554     return "" unless length($levelsize) == 2;
1555     $levelsize = unpack "v", $levelsize;
1556     return ::err "invalid metadata in file (only $levelsize bytes in level)"
1557         unless $levelsize > 8;
1558
1559     @level{qw(number leveltime chips)} = ::fileread $input, "vvv", $levelsize
1560         or return;
1561
1562     ($fieldnum, $fieldsize) = ::fileread $input, "vv", $levelsize,
1563                                          1, 1, 0, 1024
1564         or return;
1565     my $layer1 = ::fileread $input, "a$fieldsize", $levelsize or return;
1566     $fieldsize = ::fileread $input, "v", $levelsize, 0, 1024 or return;
1567     my $layer2 = ::fileread $input, "a$fieldsize", $levelsize or return;
1568     ::fileread $input, "v", $levelsize or return;
1569     $level{map} = parselevelmap rleuncompress $layer1, rleuncompress $layer2
1570         or return;
1571
1572     while ($levelsize > 0) {
1573         ($fieldnum, $fieldsize) = ::fileread $input, "CC", $levelsize, 1, 10
1574             or last;
1575         $data = ::fileread $input, "a$fieldsize", $levelsize or return;
1576         if ($fieldnum == 1) {
1577             return ::err "invalid field" unless $fieldsize > 1;
1578             $level{leveltime} = unpack "v", $data;
1579             return ::err "invalid data in field 1"
1580                 unless $level{leveltime} >= 0 && $level{leveltime} <= 65535;
1581         } elsif ($fieldnum == 2) {
1582             return ::err "invalid field" unless $fieldsize > 1;
1583             $level{chips} = unpack "v", $data;
1584             return ::err "invalid data in field 2"
1585                 unless $level{chips} >= 0 && $level{chips} <= 65535;
1586         } elsif ($fieldnum == 3) {
1587             ($level{title} = $data) =~ s/\0\Z//;
1588         } elsif ($fieldnum == 4) {
1589             $fieldsize /= 2;
1590             my @values = unpack "v$fieldsize", $data;
1591             for (my $i = 0 ; $i < $fieldsize / 5 ; ++$i) {
1592                 $level{traps}[$i]{from}[1] = shift @values;
1593                 $level{traps}[$i]{from}[0] = shift @values;
1594                 $level{traps}[$i]{to}[1] = shift @values;
1595                 $level{traps}[$i]{to}[0] = shift @values;
1596                 shift @values;
1597             }
1598         } elsif ($fieldnum == 5) {
1599             $fieldsize /= 2;
1600             my @values = unpack "v$fieldsize", $data;
1601             for (my $i = 0 ; $i < $fieldsize / 4 ; ++$i) {
1602                 $level{cloners}[$i]{from}[1] = shift @values;
1603                 $level{cloners}[$i]{from}[0] = shift @values;
1604                 $level{cloners}[$i]{to}[1] = shift @values;
1605                 $level{cloners}[$i]{to}[0] = shift @values;
1606             }
1607         } elsif ($fieldnum == 6) {
1608             ($level{passwd} = $data) =~ s/\0\Z//;
1609             $level{passwd} ^= "\x99" x length $level{passwd};
1610         } elsif ($fieldnum == 7) {
1611             ($level{hint} = $data) =~ s/\0\Z//;
1612         } elsif ($fieldnum == 8) {
1613             ::err "field 8 not yet supported; ignoring";
1614         } elsif ($fieldnum == 9) {
1615             ::err "ignoring useless field 9 entry";
1616         } elsif ($fieldnum == 10) {
1617             my @values = unpack "C$fieldsize", $data;
1618             for (my $i = 0 ; $i < $fieldsize / 2 ; ++$i) {
1619                 $level{creatures}[$i][1] = shift @values;
1620                 $level{creatures}[$i][0] = shift @values;
1621             }
1622         }
1623     }
1624     return ::err "$levelsize bytes left over at end" if $levelsize;
1625
1626     $level{lynxcreatures} = ::makelynxcrlist $level{map}, $level{creatures};
1627
1628     return \%level;
1629 }
1630
1631 sub read($)
1632 {
1633     my $input = shift;
1634     my $data;
1635
1636     $data = parseheader $input;
1637     return unless $data;
1638
1639     for (;;) {
1640         my $level = parselevel $input;
1641         return unless defined $level;
1642         last unless $level;
1643         push @{$data->{levels}}, $level;
1644     }
1645
1646     ::err "warning: number of levels incorrect in header ($data->{maxlevel}, ",
1647                 "should be ", scalar(@{$data->{levels}}), ")"
1648         unless $data->{maxlevel} == @{$data->{levels}};
1649
1650     return $data;
1651 }
1652
1653 #
1654 #
1655 #
1656
1657 # Given a string of packed data, return a string containing the same
1658 # data run-length encoded.
1659 #
1660 sub rlecompress($)
1661 {
1662     my $in = shift;
1663     my $out = "";
1664
1665     while (length $in) {
1666         my $byte = substr $in, 0, 1;
1667         my $n = 1;
1668         ++$n while $n < length $in && $byte eq substr $in, $n, 1;
1669         substr($in, 0, $n) = "";
1670         while ($n >= 255) { $out .= "\xFF\xFF$byte"; $n -= 255; }
1671         if ($n > 3) {
1672             $out .= "\xFF" . chr($n) . $byte;
1673         } elsif ($n) {
1674             $out .= $byte x $n;
1675         }
1676     }
1677     return $out;
1678 }
1679
1680 # Given a level set definition, return the pack arguments for creating
1681 # the .dat file's header data.
1682 #
1683 sub mkdatfileheader(\%)
1684 {
1685     my $data = shift;
1686     my @fields;
1687
1688     if ($data->{ruleset} eq "ms") {
1689         push @fields, 0x0002AAAC;
1690     } else {
1691         push @fields, 0x0102AAAC;
1692     }
1693     push @fields, scalar @{$data->{levels}};
1694     return ("Vv", @fields);
1695 }
1696
1697 # Given a level definition, return the pack arguments for creating the
1698 # level's header data in the .dat file.
1699 #
1700 sub mkdatfilelevelheader(\%)
1701 {
1702     my $data = shift;
1703     my @fields;
1704
1705     push @fields, $data->{number};
1706     push @fields, $data->{leveltime};
1707     push @fields, $data->{chips};
1708     return ("vvv", @fields);
1709 }
1710
1711 # Given a level definition, return the pack arguments for creating the
1712 # level's map data in the .dat file.
1713 #
1714 sub mkdatfilelevelmap(\%)
1715 {
1716     my $data = shift;
1717     my $map = $data->{map};
1718     my ($layer1, $layer2);
1719     my @fields;
1720
1721     for my $y (0 .. 31) {
1722         for my $x (0 .. 31) {
1723             if (defined $map->[$y][$x]) {
1724                 if (defined $map->[$y][$x][0]) {
1725                     $layer1 .= chr $map->[$y][$x][0];
1726                 } else {
1727                     $layer1 .= "\0";
1728                 }
1729                 if (defined $map->[$y][$x][1]) {
1730                     $layer2 .= chr $map->[$y][$x][1];
1731                 } else {
1732                     $layer2 .= "\0";
1733                 }
1734             } else {
1735                 $layer1 .= "\0";
1736                 $layer2 .= "\0";
1737             }
1738         }
1739     }
1740
1741     $layer1 = rlecompress $layer1;
1742     $layer2 = rlecompress $layer2;
1743
1744     push @fields, 1;
1745     push @fields, length $layer1;
1746     push @fields, $layer1;
1747     push @fields, length $layer2;
1748     push @fields, $layer2;
1749
1750     return ("vva$fields[1]va$fields[3]", @fields);
1751 }
1752
1753 # Given a level definition, return the pack arguments for creating the
1754 # level's title field in the .dat file.
1755 #
1756 sub mkdatfileleveltitle(\%)
1757 {
1758     my $data = shift;
1759     my $n = length($data->{title}) + 1;
1760     return ("CCa$n", 3, $n, $data->{title});
1761 }
1762
1763 # Given a level definition, return the pack arguments for creating the
1764 # level's hint field in the .dat file.
1765 #
1766 sub mkdatfilelevelhint(\%)
1767 {
1768     my $data = shift;
1769     return ("") unless exists $data->{hint};
1770     my $n = length($data->{hint}) + 1;
1771     return ("CCa$n", 7, $n, $data->{hint});
1772 }
1773
1774 # Given a level definition, return the pack arguments for creating the
1775 # level's password field in the .dat file.
1776 #
1777 sub mkdatfilelevelpasswd(\%)
1778 {
1779     my $data = shift;
1780     my $n = length($data->{passwd}) + 1;
1781     return ("CCa$n", 6, $n, $data->{passwd} ^ "\x99\x99\x99\x99");
1782 }
1783
1784 # Given a level definition, return the pack arguments for creating the
1785 # level's bear trap list field in the .dat file.
1786 #
1787 sub mkdatfileleveltraps(\%)
1788 {
1789     my $data = shift;
1790
1791     return ("") unless exists $data->{traps};
1792     my $list = $data->{traps};
1793     my $n = @$list;
1794     return ("") unless $n;
1795     my @fields;
1796
1797     push @fields, 4;
1798     push @fields, $n * 10;
1799     foreach my $i (0 .. $#$list) {
1800         push @fields, $list->[$i]{from}[1], $list->[$i]{from}[0];
1801         push @fields, $list->[$i]{to}[1], $list->[$i]{to}[0];
1802         push @fields, 0;
1803     }
1804     return (("CCv" . ($n * 5)), @fields);
1805 }
1806
1807 # Given a level definition, return the pack arguments for creating the
1808 # level's clone machine list field in the .dat file.
1809 #
1810 sub mkdatfilelevelcloners(\%)
1811 {
1812     my $data = shift;
1813
1814     return ("") unless exists $data->{cloners};
1815     my $list = $data->{cloners};
1816     my $n = @$list;
1817     return ("") unless $n;
1818     my @fields;
1819
1820     push @fields, 5;
1821     push @fields, $n * 8;
1822     foreach my $i (0 .. $#$list) {
1823         push @fields, $list->[$i]{from}[1], $list->[$i]{from}[0];
1824         push @fields, $list->[$i]{to}[1], $list->[$i]{to}[0];
1825     }
1826     return (("CCv" . ($n * 4)), @fields);
1827 }
1828
1829 # Given a level definition, return the pack arguments for creating the
1830 # level's creature list field in the .dat file.
1831 #
1832 sub mkdatfilelevelcrlist(\%)
1833 {
1834     my $data = shift;
1835
1836     return ("") unless exists $data->{creatures};
1837     my $list = $data->{creatures};
1838     return ("") unless $list && @$list;
1839     my $n = @$list;
1840     my @fields;
1841
1842     push @fields, 10;
1843     push @fields, $n * 2;
1844     foreach my $i (0 .. $#$list) {
1845         push @fields, $list->[$i][1], $list->[$i][0];
1846     }
1847     return (("CCC" . ($n * 2)), @fields);
1848 }
1849
1850 # Given a level definition, return the pack arguments for creating the
1851 # level's miscellaneous fields, if any, in the .dat file.
1852 #
1853 sub mkdatfilelevelmisc(\%)
1854 {
1855     my $data = shift;
1856     my ($template, @fields) = ("");
1857
1858     return ("") unless exists $data->{fields};
1859     foreach my $num (keys %{$data->{fields}}) {
1860         my $n = length($data->{fields}{$num});
1861         $template .= "CCa$n";
1862         push @fields, $num, $n, $data->{fields}{$num};
1863     }
1864     return ($template, @fields);
1865 }
1866
1867 # Given a level definition, return the pack arguments for creating the
1868 # level in the .dat file.
1869 #
1870 sub mkdatfilelevel(\%)
1871 {
1872     my $data = shift;
1873     my ($template, @fields);
1874     my @p;
1875
1876     @p = mkdatfilelevelheader %$data;  $template .= shift @p; push @fields, @p;
1877     @p = mkdatfilelevelmap %$data;     $template .= shift @p; push @fields, @p;
1878
1879     my $data2pos = @fields;            $template .= "v";      push @fields, 0;
1880     my $tmplt2pos = length $template;
1881
1882     @p = mkdatfileleveltitle %$data;   $template .= shift @p; push @fields, @p;
1883     @p = mkdatfilelevelhint %$data;    $template .= shift @p; push @fields, @p;
1884     @p = mkdatfilelevelpasswd %$data;  $template .= shift @p; push @fields, @p;
1885     @p = mkdatfileleveltraps %$data;   $template .= shift @p; push @fields, @p;
1886     @p = mkdatfilelevelcloners %$data; $template .= shift @p; push @fields, @p;
1887     @p = mkdatfilelevelcrlist %$data;  $template .= shift @p; push @fields, @p;
1888     @p = mkdatfilelevelmisc %$data;    $template .= shift @p; push @fields, @p;
1889
1890     $fields[$data2pos] = ::packlen substr $template, $tmplt2pos;
1891
1892     unshift @fields, ::packlen $template;
1893     $template = "v$template";
1894
1895     return ($template, @fields);
1896 }
1897
1898 # Given a level set definition, return the pack arguments for creating
1899 # the .dat file.
1900 #
1901 sub mkdatfile(\%)
1902 {
1903     my $data = shift;
1904     my ($template, @fields);
1905     my @p;
1906
1907     @p = mkdatfileheader %$data;
1908     $template = shift @p;
1909     @fields = @p;
1910
1911     foreach my $level (@{$data->{levels}}) {
1912         $filelevel = $level->{number};
1913         @p = mkdatfilelevel %$level;
1914         $template .= shift @p;
1915         push @fields, @p;
1916     }
1917
1918     return ($template, @fields);
1919 }
1920
1921 # This function takes a handle to a binary file and a hash ref
1922 # defining a level set, and writes the level set to the binary file as
1923 # a .dat file. The return value is false if the file's contents could
1924 # not be completely created; otherwise a true value is returned.
1925 #
1926 sub write($$)
1927 {
1928     my $file = shift;
1929     my $data = shift;
1930
1931     my @args = mkdatfile %$data;
1932     my $template = shift @args;
1933     print $file pack $template, @args;
1934 }
1935
1936 #
1937 #
1938 #
1939
1940 package lynxfmt;
1941
1942 my @objectkey = ($tilenames{"empty"},
1943                  $tilenames{"wall"},
1944                  $tilenames{"ice"},
1945                  $tilenames{"dirt"},
1946                  $tilenames{"blue block floor"},
1947                  $tilenames{"force north"},
1948                  $tilenames{"force east"},
1949                  $tilenames{"force south"},
1950                  $tilenames{"force west"},
1951                  $tilenames{"force any"},
1952                  $tilenames{"ice corner se"},
1953                  $tilenames{"ice corner sw"},
1954                  $tilenames{"ice corner nw"},
1955                  $tilenames{"ice corner ne"},
1956                  $tilenames{"teleport"},
1957                  $tilenames{"ice boots"},
1958                  $tilenames{"fire boots"},
1959                  $tilenames{"force boots"},
1960                  $tilenames{"water boots"},
1961                  $tilenames{"fire"},
1962                  $tilenames{"water"},
1963                  $tilenames{"thief"},
1964                  $tilenames{"popup wall"},
1965                  $tilenames{"toggle open"},
1966                  $tilenames{"toggle closed"},
1967                  $tilenames{"green button"},
1968                  $tilenames{"red door"},
1969                  $tilenames{"blue door"},
1970                  $tilenames{"yellow door"},
1971                  $tilenames{"green door"},
1972                  $tilenames{"red key"},
1973                  $tilenames{"blue key"},
1974                  $tilenames{"yellow key"},
1975                  $tilenames{"green key"},
1976                  $tilenames{"blue button"},
1977                  $tilenames{"computer chip"},   # counted
1978                  $tilenames{"socket"},
1979                  $tilenames{"exit"},
1980                  $tilenames{"invisible wall temporary"},
1981                  $tilenames{"invisible wall permanent"},
1982                  $tilenames{"gravel"},
1983                  $tilenames{"wall east"},
1984                  $tilenames{"wall south"},
1985                  $tilenames{"wall southeast"},
1986                  $tilenames{"bomb"},
1987                  $tilenames{"bear trap"},
1988                  $tilenames{"brown button"},
1989                  $tilenames{"clone machine"},
1990                  $tilenames{"red button"},
1991                  $tilenames{"computer chip"},   # uncounted
1992                  $tilenames{"blue block wall"},
1993                  $tilenames{"hint button"});
1994
1995 my @creaturekey = (0, 0, 0, 0,
1996                    $tilenames{"chip north"},      $tilenames{"chip east"},
1997                    $tilenames{"chip south"},      $tilenames{"chip west"},
1998                    $tilenames{"bug north"},       $tilenames{"bug east"},
1999                    $tilenames{"bug south"},       $tilenames{"bug west"},
2000                    $tilenames{"centipede north"}, $tilenames{"centipede east"},
2001                    $tilenames{"centipede south"}, $tilenames{"centipede west"},
2002                    $tilenames{"fireball north"},  $tilenames{"fireball east"},
2003                    $tilenames{"fireball south"},  $tilenames{"fireball west"},
2004                    $tilenames{"glider north"},    $tilenames{"glider east"},
2005                    $tilenames{"glider south"},    $tilenames{"glider west"},
2006                    $tilenames{"ball north"},      $tilenames{"ball east"},
2007                    $tilenames{"ball south"},      $tilenames{"ball west"},
2008                    $tilenames{"block north"},     $tilenames{"block east"},
2009                    $tilenames{"block south"},     $tilenames{"block west"},
2010                    $tilenames{"tank north"},      $tilenames{"tank east"},
2011                    $tilenames{"tank south"},      $tilenames{"tank west"},
2012                    $tilenames{"walker north"},    $tilenames{"walker east"},
2013                    $tilenames{"walker south"},    $tilenames{"walker west"},
2014                    $tilenames{"blob north"},      $tilenames{"blob east"},
2015                    $tilenames{"blob south"},      $tilenames{"blob west"},
2016                    $tilenames{"teeth north"},     $tilenames{"teeth east"},
2017                    $tilenames{"teeth south"},     $tilenames{"teeth west"});
2018
2019 my @textkey =
2020     ("\n"," ","0","1","2","3","4","5","6","7","8","9","A","B","C","D",
2021       "E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T",
2022       "U","V","W","X","Y","Z","!",'"',"'","(",")",",","-",".",":",";",
2023       "?", (("%") x 207));
2024
2025 my @levelfilenames = @{
2026     [qw(lesson_1.pak    lesson_2.pak    lesson_3.pak    lesson_4.pak
2027         lesson_5.pak    lesson_6.pak    lesson_7.pak    lesson_8.pak
2028         nuts_and.pak    brushfir.pak    trinity.pak     hunt.pak
2029         southpol.pak    telebloc.pak    elementa.pak    cellbloc.pak
2030         nice_day.pak    castle_m.pak    digger.pak      tossed_s.pak
2031         iceberg.pak     forced_e.pak    blobnet.pak     oorto_ge.pak
2032         blink.pak       chchchip.pak    go_with_.pak    ping_pon.pak
2033         arcticfl.pak    mishmesh.pak    knot.pak        scavenge.pak
2034         on_the_r.pak    cypher.pak      lemmings.pak    ladder.pak
2035         seeing_s.pak    sampler.pak     glut.pak        floorgas.pak
2036         i.pak           beware_o.pak    lock_blo.pak    refracti.pak
2037         monster_.pak    three_do.pak    pier_sev.pak    mugger_s.pak
2038         problems.pak    digdirt.pak     i_slide.pak     the_last.pak
2039         traffic_.pak    grail.pak       potpourr.pak    deepfree.pak
2040         mulligan.pak    loop_aro.pak    hidden_d.pak    scoundre.pak
2041         rink.pak        slo_mo.pak      block_fa.pak    spooks.pak
2042         amsterda.pak    victim.pak      chipmine.pak    eeny_min.pak
2043         bounce_c.pak    nightmar.pak    corridor.pak    reverse_.pak
2044         morton.pak      playtime.pak    steam.pak       four_ple.pak
2045         invincib.pak    force_sq.pak    drawn_an.pak    vanishin.pak
2046         writers_.pak    socialis.pak    up_the_b.pak    wars.pak
2047         telenet.pak     suicide.pak     citybloc.pak    spirals.pak
2048         block.pak       playhous.pak    jumping_.pak    vortex.pak
2049         roadsign.pak    now_you_.pak    four_squ.pak    paranoia.pak
2050         metastab.pak    shrinkin.pak    catacomb.pak    colony.pak
2051         apartmen.pak    icehouse.pak    memory.pak      jailer.pak
2052         short_ci.pak    kablam.pak      balls_o_.pak    block_ou.pak
2053         torturec.pak    chiller.pak     time_lap.pak    fortune_.pak
2054         open_que.pak    deceptio.pak    oversea_.pak    block_ii.pak
2055         the_mars.pak    miss_dir.pak    slide_st.pak    alphabet.pak
2056         perfect_.pak    t_fair.pak      the_pris.pak    firetrap.pak
2057         mixed_nu.pak    block_n_.pak    skelzie.pak     all_full.pak
2058         lobster_.pak    ice_cube.pak    totally_.pak    mix_up.pak
2059         blobdanc.pak    pain.pak        trust_me.pak    doublema.pak
2060         goldkey.pak     partial_.pak    yorkhous.pak    icedeath.pak
2061         undergro.pak    pentagra.pak    stripes.pak     fireflie.pak
2062         level145.pak    cake_wal.pak    force_fi.pak    mind_blo.pak
2063         special.pak     level150.pak)]
2064 };
2065
2066 my (%objectkey, %creaturekey, %textkey);
2067 for (0 .. $#objectkey) { $objectkey{$objectkey[$_]} = $_ }
2068 for (0 .. $#creaturekey) { $creaturekey{$creaturekey[$_]} = $_ }
2069 $creaturekey{$tilenames{"block"}} = $creaturekey{$tilenames{"block north"}};
2070 for (0 .. $#textkey) { $textkey{$textkey[$_]} = chr $_ }
2071
2072 #
2073 #
2074 #
2075
2076 sub longestmatch($$$)
2077 {
2078     my $dictionary = shift;
2079     my $data = shift;
2080     my $pos = shift;
2081
2082     my ($longest, $longestlen) = ("", 0);
2083     foreach my $entry (@$dictionary) {
2084         my $len = length $entry->{text};
2085         if ($len > $longestlen && $entry->{text} eq substr $data, $pos, $len) {
2086             ($longest, $longestlen) = ($entry, $len);
2087         }
2088     }
2089     return $longest;
2090 }
2091
2092 sub builddict($)
2093 {
2094     my $data = shift;
2095     my $dictionary = [ ];
2096
2097     my $pos = 0;
2098     while ($pos < length $data) {
2099         my $entry = { refcount => 0 };
2100         my ($match, $len);
2101         $match = longestmatch $dictionary, $data, $pos;
2102         if ($match) {
2103             $entry->{left} = $match;
2104             $len = length $match->{text};
2105         } else {
2106             $len = 1;
2107         }
2108         $entry->{text} = substr $data, $pos, $len;
2109         $pos += $len;
2110         last if $pos >= length $data;
2111         $match = longestmatch $dictionary, $data, $pos;
2112         if ($match) {
2113             $entry->{right} = $match;
2114             $len = length $match->{text};
2115         } else {
2116             $len = 1;
2117         }
2118         $entry->{text} .= substr $data, $pos, $len;
2119         $pos += $len;
2120         push @$dictionary, $entry;
2121     }
2122
2123     return $dictionary;
2124 }
2125
2126 sub refcountadd($$);
2127 sub refcountadd($$)
2128 {
2129     my $entry = shift;
2130     $entry->{refcount} += shift;
2131     refcountadd $entry->{left}, $entry->{refcount} if exists $entry->{left};
2132     refcountadd $entry->{right}, $entry->{refcount} if exists $entry->{right};
2133 }
2134
2135 sub countuses($$)
2136 {
2137     my $dictionary = shift;
2138     my $data = shift;
2139
2140     my $pos = 0;
2141     while ($pos < length $data) {
2142         my $entry = longestmatch $dictionary, $data, $pos;
2143         if ($entry) {
2144             ++$entry->{refcount};
2145             $pos += length $entry->{text};
2146         } else {
2147             ++$pos;
2148         }
2149     }
2150     foreach my $entry (@$dictionary) { refcountadd $entry, 0 }
2151 }
2152
2153 sub assignkeys($$)
2154 {
2155     my $dictionary = shift;
2156     my $data = shift;
2157     my @used;
2158
2159     while ($data =~ /(.)/gs) { $used[ord $1] = 1 }
2160     my $n = 0;
2161     foreach my $entry (@$dictionary) {
2162         ++$n while $used[$n];
2163         die "too many dictionary entries; not enough keys" if $n >= 256;
2164         $entry->{key} = chr $n;
2165         $used[$n] = 1;
2166     }
2167 }
2168
2169 sub composedict($)
2170 {
2171     my $dictionary = shift;
2172     my ($out, $len) = ("", 0);
2173
2174     foreach my $entry (@$dictionary) {
2175         $out .= $entry->{key};
2176         if (exists $entry->{left}) {
2177             $out .= $entry->{left}{key};
2178         } else {
2179             $out .= substr $entry->{text}, 0, 1;
2180         }
2181         if (exists $entry->{right}) {
2182             $out .= $entry->{right}{key};
2183         } else {
2184             $out .= substr $entry->{text}, -1;
2185         }
2186         ++$len;
2187     }
2188
2189     return ($out, $len);
2190 }
2191
2192 sub composedata($$)
2193 {
2194     my $dictionary = shift;
2195     my $data = shift;
2196     my ($out, $len) = ("", 0);
2197
2198     my $pos = 0;
2199     while ($pos < length $data) {
2200         my $entry = longestmatch $dictionary, $data, $pos;
2201         if ($entry) {
2202             $out .= $entry->{key};
2203             $pos += length $entry->{text};
2204         } else {
2205             $out .= substr $data, $pos, 1;
2206             ++$pos;
2207         }
2208         ++$len;
2209     }
2210
2211     return ($out, $len);
2212 }
2213
2214 sub compress($)
2215 {
2216     my $data = shift;
2217     my $dictionary = builddict $data;
2218     countuses $dictionary, $data;
2219     $dictionary = [ grep { $_->{refcount} > 3 } @$dictionary ];
2220     assignkeys $dictionary, $data;
2221     my ($cdict, $dictlen) = composedict $dictionary;
2222     my ($cdata, $datalen) = composedata $dictionary, $data;
2223     return pack("vv", $dictlen, $datalen) . $cdict . $cdata;
2224 }
2225
2226 sub expand($)
2227 {
2228     my $data = shift;
2229
2230     my $tablesize = unpack "v", substr $data, 0, 2, "";
2231     my $datasize = unpack "v", substr $data, 0, 2, "";
2232
2233     my @data = map { ord } split //, $data;
2234     my @table;
2235
2236     for (my $n = 0 ; $n < $tablesize ; ++$n) {
2237         return ::err "@{[$tablesize - $n]} entries missing"
2238             unless @data;
2239         my $key = shift @data;
2240         my $val1 = shift @data;
2241         my $val2 = shift @data;
2242         if (defined $table[$val1]) {
2243             $val1 = $table[$val1];
2244         } else {
2245             $val1 = chr $val1;
2246         }
2247         if (defined $table[$val2]) {
2248             $val2 = $table[$val2];
2249         } else {
2250             $val2 = chr $val2;
2251         }
2252         $table[$key] = "$val1$val2";
2253     }
2254
2255     $data = "";
2256     foreach my $byte (@data) {
2257         if (defined $table[$byte]) {
2258             $data .= $table[$byte];
2259         } else {
2260             $data .= chr $byte;
2261         }
2262     }
2263
2264     return $data;
2265 }
2266
2267 sub parsemap($$)
2268 {
2269     my $level = shift;
2270     my @data = map { ord } split //, shift;
2271
2272     return ::err "@{[1024 - @data]} bytes missing from map data"
2273         unless @data == 1024;
2274     $level->{chips} = 0;
2275     foreach my $y (0 .. 31) {
2276         foreach my $x (0 .. 31) {
2277             my $obj = shift @data;
2278             ::err "undefined object $obj at ($x $y)"
2279                 unless defined $objectkey[$obj];
2280             $level->{map}[$y][$x][0] = $objectkey[$obj];
2281             $level->{map}[$y][$x][1] = 0;
2282             ++$level->{chips} if $obj == 0x23;
2283         }
2284     }
2285
2286     return 1;
2287 }
2288
2289 sub parsecrlist($$)
2290 {
2291     my $level = shift;
2292     my $data = shift;
2293
2294     my @t = map { ord } split //, substr $data, 0, 128, "";
2295     my @x = map { ord } split //, substr $data, 0, 128, "";
2296     my @y = map { ord } split //, substr $data, 0, 128, "";
2297
2298     foreach my $n (0 .. 127) {
2299         next unless $t[$n];
2300         my $x = $x[$n] >> 3;
2301         my $y = $y[$n] >> 3;
2302         my $t = $creaturekey[$t[$n] & 0x7F];
2303         push @{$level->{creatures}}, [ $y, $x ]; # unless $t[$n] & 0x80;
2304         $level->{map}[$y][$x][1] = $level->{map}[$y][$x][0];
2305         $level->{map}[$y][$x][0] = $t;
2306     }
2307
2308     return 1;
2309 }
2310
2311 sub parselevel($)
2312 {
2313     my $data = shift;
2314     my $level = { };
2315
2316     $data = expand $data or return ::err "invalid data";
2317
2318     local $_;
2319     $_ = substr $data, 0, 1024, "";
2320     parsemap $level, $_
2321         or return ::err "invalid map";
2322     $_ = substr $data, 0, 384, "";
2323     parsecrlist $level, $_
2324         or return ::err "invalid creature list";
2325     $level->{creatures} = ::makedatcrlist $level->{map},
2326                                           $level->{lynxcreatures};
2327     $level->{traps} = txtfile::buildtraplist $level->{map};
2328     $level->{cloners} = txtfile::buildclonerlist $level->{map};
2329
2330     $level->{leveltime} = unpack "v", substr $data, 0, 2, "";
2331
2332     $data = join "", map { $textkey[ord] } split //, $data;
2333     $data =~ s/\A([^\n]+)\n//;
2334     $level->{title} = $1;
2335     $data =~ s/\n+\Z//;
2336     if (length $data) {
2337         $data =~ tr/\n/ /s;
2338         $level->{hint} = $data;
2339     }
2340
2341     return $level;
2342 }
2343
2344 sub readmsdos($)
2345 {
2346     my $dirname = shift;
2347     my $data = { ruleset => "lynx" };
2348
2349     foreach my $n (0 .. $#levelfilenames) {
2350         $filename = "$dirname/$levelfilenames[$n]";
2351         $filelevel = $n + 1;
2352         next unless -e $filename;
2353         open FILE, "< $filename" or return ::err $!;
2354         binmode FILE;
2355         my $level = parselevel join "", <FILE>;
2356         close FILE;
2357         return unless defined $level;
2358         $level->{number} = $n + 1;
2359         $level->{passwd} = $origpasswords[$n];
2360         push @{$data->{levels}}, $level;
2361     }
2362
2363     return $data;
2364 }
2365
2366 sub readrom($)
2367 {
2368     my $input = shift;
2369     my $data = { ruleset => "lynx" };
2370
2371     my $buf = ::fileread $input, "a20" or return;
2372     return ::err "invalid ROM file"
2373         unless $buf eq "LYNX\000\002\000\000\001\000chipchal.l";
2374
2375     my @levels;
2376     sysseek $input, 0x02F0, 0 or return ::err $!;
2377     for (my $n = 0 ; $n < 150 ; ++$n) {
2378         my @rec = ::fileread $input, "C4vv" or return;
2379         $levels[$n][0] = (($rec[0] << 9) | $rec[1]
2380                                          | (($rec[2] & 0x01) << 8)) + 0x40;
2381         $levels[$n][1] = $rec[5];
2382     }
2383
2384     for (my $n = 0 ; $n < 150 ; ++$n) {
2385         $filelevel = $n + 1;
2386         $buf = sysseek $input, $levels[$n][0], 0 or return ::err $!;
2387         $buf = ::fileread $input, "a$levels[$n][1]" or return;
2388         next if $levels[$n][1] == 5 && $buf eq "\000\000\001\000\377";
2389         my $level = parselevel $buf;
2390         return unless defined $level;
2391         $level->{number} = $n + 1;
2392         $level->{passwd} = $origpasswords[$n];
2393         push @{$data->{levels}}, $level;
2394     }
2395
2396     return $data;
2397 }
2398
2399 #
2400 #
2401 #
2402
2403 sub translatetext($;$)
2404 {
2405     my $in = shift;
2406     my $multiline = shift || 0;
2407
2408     my $out = "";
2409     my ($x, $y) = (0, 0);
2410     my $brk = [ undef ];
2411
2412     foreach my $char (split //, $in) {
2413         if ($char eq "\n") {
2414             ++$y;
2415             $x = -1;
2416             $brk = [ undef ];
2417         } elsif ($x >= 19) {
2418             if (!$multiline || $y >= 6) {
2419                 ::err "truncated text";
2420                 substr($out, 17 - $x) = "" if $y >= 6 && $x >= 19;
2421                 last;
2422             }
2423             if ($brk->[0]) {
2424                 $x -= $brk->[0];
2425                 substr($out, $brk->[1], 1) = "\0";
2426             } else {
2427                 $x = -1;
2428                 $out .= "\0";
2429             }
2430             ++$y;
2431             $brk = [ undef ];
2432         } elsif ($char eq " ") {
2433             $brk = [ $x, length $out ];
2434         }
2435         $out .= $textkey{uc $char};
2436         ++$x;
2437     }
2438
2439     return $out;
2440 }
2441
2442 sub mklevelmap($)
2443 {
2444     my $level = shift;
2445     my $out = "";
2446     my $chips = 0;
2447
2448     for (my $y = 0 ; $y < 32 ; ++$y) {
2449         for (my $x = 0 ; $x < 32 ; ++$x) {
2450             my $obj;
2451             my $top = $level->{map}[$y][$x][0];
2452             my $bot = $level->{map}[$y][$x][1];
2453             if (::iscreature $top || ::ischip $top || ::isblock $top) {
2454                 $obj = $bot;
2455                 if (::iscreature $obj || ::isblock $obj || ::ischip $obj) {
2456                     ::err "ignoring buried creature";
2457                     $obj = 0;
2458                 }
2459             } else {
2460                 ::err "ignoring buried object" if $bot;
2461                 $obj = $top;
2462             }
2463             if ($obj == $tilenames{"computer chip"}) {
2464                 $obj = $chips < $level->{chips} ? 0x23 : 0x31;
2465                 ++$chips;
2466             } else {
2467                 $obj = $objectkey{$obj};
2468                 unless (defined $obj) {
2469                     ::err "ignoring non-Lynx object";
2470                     $obj = 0;
2471                 }
2472             }
2473             $out .= chr $obj;
2474         }
2475     }
2476
2477     ::err "chips needed was reduced" if $chips < $level->{chips};
2478
2479     return $out;
2480 }
2481
2482 sub mklevelcrlist($)
2483 {
2484     my $level = shift;
2485     my @listed;
2486     my @crlist;
2487
2488     return ::err "invalid creature list: $level->{lynxcreatures}"
2489         unless ref $level->{lynxcreatures};
2490
2491     my ($types, $xs, $ys) = ("", "", "");
2492     foreach my $creature (@{$level->{lynxcreatures}}) {
2493         my $y = $creature->[0];
2494         my $x = $creature->[1];
2495         my $type = $level->{map}[$y][$x][0];
2496         $type = $creaturekey{$type};
2497         unless (defined $type) {
2498             ::err "ignoring non-Lynx creature in creature list";
2499             next;
2500         }
2501         $type |= 0x80 if $creature->[2] < 0;
2502         $y <<= 3;
2503         $x <<= 3;
2504         ++$y, ++$x if $creature->[2] == 0;
2505         $types .= chr $type;
2506         $xs .= chr $x;
2507         $ys .= chr $y;
2508     }
2509
2510     return pack "a128 a128 a128", $types, $xs, $ys;
2511 }
2512
2513 sub mkleveldata($)
2514 {
2515     my $level = shift;
2516     my $out = "";
2517     my $part;
2518
2519     $part = mklevelmap $level;
2520     return unless defined $part;
2521     $out .= $part;
2522
2523     $part = mklevelcrlist $level;
2524     return unless defined $part;
2525     $out .= $part;
2526
2527     $out .= pack "v", $level->{leveltime};
2528
2529     $part = translatetext $level->{title};
2530     return unless defined $part;
2531     $out .= "$part\0";
2532
2533     if (exists $level->{hint}) {
2534         $part = translatetext $level->{hint}, 1;
2535         return unless defined $part;
2536         $out .= "$part\0";
2537     }
2538
2539     $out .= "\0";
2540
2541     return compress $out;
2542 }
2543
2544 sub writemsdos($$)
2545 {
2546     my $dirname = shift;
2547     my $data = shift;
2548
2549     ::err "warning: storing an MS-ruleset level set in a Lynx-only file format"
2550         unless $data->{ruleset} eq "lynx";
2551
2552     foreach my $level (@{$data->{levels}}) {
2553         $filename = $dirname;
2554         $filelevel = undef;
2555         if ($level->{number} >= @levelfilenames) {
2556             ::err "ignoring level $level->{number}, number too high";
2557             next;
2558         } elsif ($level->{number} < 1) {
2559             ::err "ignoring level $level->{number}, number invalid";
2560             next;
2561         }
2562         $filename = "$dirname/$levelfilenames[$level->{number} - 1]";
2563         $filelevel = $level->{number};
2564         ::err "ignoring password"
2565             if $level->{passwd} ne $origpasswords[$level->{number} - 1];
2566         open FILE, "> $filename" or return ::err $!;
2567         binmode FILE;
2568         my $out = mkleveldata $level or return;
2569         print FILE $out or return ::err $!;
2570         close FILE or return ::err $!;
2571     }
2572
2573     return 1;
2574 }
2575
2576 sub writerom($$)
2577 {
2578     my $file = shift;
2579     my $data = shift;
2580
2581     ::err "warning: storing an MS-ruleset level set in a Lynx-only file format"
2582         unless $data->{ruleset} eq "lynx";
2583
2584     my $buf = ::fileread $file, "a22" or return;
2585     return ::err "invalid ROM file"
2586         unless $buf eq "LYNX\000\002\000\000\001\000chipchal.lyx";
2587
2588     sysseek $file, 0x02F0, 0 or return ::err $!;
2589     my @ptr = ::fileread $file, "C4" or return ::err $!;
2590     my $startpos = (($ptr[0] << 9) | $ptr[1] | (($ptr[2] & 0x01) << 8));
2591
2592     my @levellist;
2593     my $dropped;
2594     foreach my $level (@{$data->{levels}}) {
2595         my $n = $level->{number};
2596         $filelevel = $n;
2597         if ($n < 1) {
2598             ::err "ignoring invalid-numbered level $n";
2599         } elsif ($n > 149) {
2600             ++$dropped;
2601         } elsif (defined $levellist[$n]) {
2602             ::err "ignoring duplicate level $n";
2603         } else {
2604             ::err "ignoring password"
2605                 if $level->{passwd} ne $origpasswords[$n - 1];
2606             $levellist[$n] = mkleveldata $level;
2607             return unless defined $levellist[$n];
2608         }
2609     }
2610     ::err "ignored $dropped level(s) above level 149" if $dropped;
2611
2612     my $levels = "";
2613     my $index = "";
2614     my $ptr = $startpos;
2615     for (my $n = 1 ; $n <= 149 ; ++$n) {
2616         my $size;
2617         if ($levellist[$n]) {
2618             $levels .= $levellist[$n];
2619             $size = length $levellist[$n];
2620         } else {
2621             $levels .= "\000\000\001\000\377";
2622             $size = 5;
2623         }
2624         $index .= pack "C4vv", ($ptr >> 9), ($ptr & 0xFF),
2625                                (($ptr >> 8) & 0x01), 0, 0, $size;
2626         $ptr += $size;
2627     }
2628     $levels .= "\000\000\001\000\377";
2629     $index .= pack "C4vv", ($ptr >> 9), ($ptr & 0xFF),
2630                            (($ptr >> 8) & 0x01), 0, 0, 5;
2631
2632     return ::err "too much data; cannot fit inside the ROM file"
2633         if length $levels > 0x11D00;
2634
2635     sysseek $file, 0x02F0, 0 or return ::err $!;
2636     syswrite $file, $index or return ::err $!;
2637     sysseek $file, $startpos + 0x40, 0 or return ::err $!;
2638     syswrite $file, $levels or return ::err $!;
2639
2640     return 1;
2641 }
2642
2643 #
2644 #
2645 #
2646
2647 package cudfile;
2648
2649 # The terse names used by the universal-dump file format.
2650 #
2651 my @shortnames = ("empty",              # 0x00
2652                   "wall",               # 0x01
2653                   "ic_chip",            # 0x02
2654                   "water",              # 0x03
2655                   "fire",               # 0x04
2656                   "inv_wall_per",       # 0x05
2657                   "wall_N",             # 0x06
2658                   "wall_W",             # 0x07
2659                   "wall_S",             # 0x08
2660                   "wall_E",             # 0x09
2661                   "block",              # 0x0A
2662                   "dirt",               # 0x0B
2663                   "ice",                # 0x0C
2664                   "force_S",            # 0x0D
2665                   "block_N",            # 0x0E
2666                   "block_W",            # 0x0F
2667                   "block_S",            # 0x10
2668                   "block_E",            # 0x11
2669                   "force_N",            # 0x12
2670                   "force_E",            # 0x13
2671                   "force_W",            # 0x14
2672                   "exit",               # 0x15
2673                   "blue_door",          # 0x16
2674                   "red_door",           # 0x17
2675                   "green_door",         # 0x18
2676                   "yellow_door",        # 0x19
2677                   "ice_turn_SE",        # 0x1A
2678                   "ice_turn_SW",        # 0x1B
2679                   "ice_turn_NW",        # 0x1C
2680                   "ice_turn_NE",        # 0x1D
2681                   "blue_floor",         # 0x1E
2682                   "blue_wall",          # 0x1F
2683                   "overlay",            # 0x20
2684                   "thief",              # 0x21
2685                   "socket",             # 0x22
2686                   "green_button",       # 0x23
2687                   "red_button",         # 0x24
2688                   "toggle_close",       # 0x25
2689                   "toggle_open",        # 0x26
2690                   "brown_button",       # 0x27
2691                   "blue_button",        # 0x28
2692                   "teleport",           # 0x29
2693                   "bomb",               # 0x2A
2694                   "trap",               # 0x2B
2695                   "inv_wall_tmp",       # 0x2C
2696                   "gravel",             # 0x2D
2697                   "popup_wall",         # 0x2E
2698                   "hint_button",        # 0x2F
2699                   "wall_SE",            # 0x30
2700                   "cloner",             # 0x31
2701                   "force_any",          # 0x32
2702                   "chip_drowned",       # 0x33
2703                   "chip_burned",        # 0x34
2704                   "chip_bombed",        # 0x35
2705                   "unused_1",           # 0x36
2706                   "unused_2",           # 0x37
2707                   "unused_3",           # 0x38
2708                   "chip_exiting",       # 0x39
2709                   "exit_1",             # 0x3A
2710                   "exit_2",             # 0x3B
2711                   "chip_swim_N",        # 0x3C
2712                   "chip_swim_W",        # 0x3D
2713                   "chip_swim_S",        # 0x3E
2714                   "chip_swim_E",        # 0x3F
2715                   "bug_N",              # 0x40
2716                   "bug_W",              # 0x41
2717                   "bug_S",              # 0x42
2718                   "bug_E",              # 0x43
2719                   "fireball_N",         # 0x44
2720                   "fireball_W",         # 0x45
2721                   "fireball_S",         # 0x46
2722                   "fireball_E",         # 0x47
2723                   "ball_N",             # 0x48
2724                   "ball_W",             # 0x49
2725                   "ball_S",             # 0x4A
2726                   "ball_E",             # 0x4B
2727                   "tank_N",             # 0x4C
2728                   "tank_W",             # 0x4D
2729                   "tank_S",             # 0x4E
2730                   "tank_E",             # 0x4F
2731                   "glider_N",           # 0x50
2732                   "glider_W",           # 0x51
2733                   "glider_S",           # 0x52
2734                   "glider_E",           # 0x53
2735                   "teeth_N",            # 0x54
2736                   "teeth_W",            # 0x55
2737                   "teeth_S",            # 0x56
2738                   "teeth_E",            # 0x57
2739                   "walker_N",           # 0x58
2740                   "walker_W",           # 0x59
2741                   "walker_S",           # 0x5A
2742                   "walker_E",           # 0x5B
2743                   "blob_N",             # 0x5C
2744                   "blob_W",             # 0x5D
2745                   "blob_S",             # 0x5E
2746                   "blob_E",             # 0x5F
2747                   "centipede_N",        # 0x60
2748                   "centipede_W",        # 0x61
2749                   "centipede_S",        # 0x62
2750                   "centipede_E",        # 0x63
2751                   "blue_key",           # 0x64
2752                   "red_key",            # 0x65
2753                   "green_key",          # 0x66
2754                   "yellow_key",         # 0x67
2755                   "water_boots",        # 0x68
2756                   "fire_boots",         # 0x69
2757                   "ice_boots",          # 0x6A
2758                   "force_boots",        # 0x6B
2759                   "chip_N",             # 0x6C
2760                   "chip_W",             # 0x6D
2761                   "chip_S",             # 0x6E
2762                   "chip_E"              # 0x6F
2763 );
2764 for (0x70 .. 0xFF) { $shortnames[$_] = sprintf "tile_%02X", $_ }
2765
2766 sub write($$)
2767 {
2768     my $output = shift;
2769     my $data = shift;
2770     my $list;
2771
2772     print $output "BEGIN CUD 1 ruleset $data->{ruleset}\n\n" or return;
2773
2774     foreach my $level (@{$data->{levels}}) {
2775         printf $output "%03d chips %d\n", $level->{number}, $level->{chips}
2776             or return;
2777         printf $output "%03d time %d\n", $level->{number}, $level->{leveltime}
2778             or return;
2779         printf $output "%03d passwd %s\n", $level->{number}, $level->{passwd}
2780             or return;
2781         printf $output "%03d title:%s\n", $level->{number},
2782                                           ::escape $level->{title}
2783             or return;
2784         printf $output "%03d hint", $level->{number} or return;
2785         print $output ":", ::escape $level->{hint} or return
2786             if exists $level->{hint};
2787         print $output "\n" or return;
2788
2789         my @notes;
2790         $list = $level->{traps};
2791         foreach my $i (0 .. $#$list) {
2792             $notes[$list->[$i]{from}[0]][$list->[$i]{from}[1]]{tfr} = $i + 1;
2793             $notes[$list->[$i]{to}[0]][$list->[$i]{to}[1]]{tto} = $i + 1;
2794         }
2795         $list = $level->{cloners};
2796         foreach my $i (0 .. $#$list) {
2797             $notes[$list->[$i]{from}[0]][$list->[$i]{from}[1]]{cfr} = $i + 1;
2798             $notes[$list->[$i]{to}[0]][$list->[$i]{to}[1]]{cto} = $i + 1;
2799         }
2800         $list = $level->{creatures};
2801         foreach my $i (0 .. $#$list) {
2802             $notes[$list->[$i][0]][$list->[$i][1]]{crl} = $i + 1;
2803         }
2804
2805         foreach my $y (0 .. 31) {
2806             foreach my $x (0 .. 31) {
2807                 next if $level->{map}[$y][$x][0] == 0
2808                      && $level->{map}[$y][$x][1] == 0
2809                      && !defined $notes[$y][$x];
2810                 printf $output "%03d (%02d %02d) ", $level->{number}, $x, $y
2811                     or return;
2812                 printf $output "%-12.12s %-12.12s ",
2813                                $shortnames[$level->{map}[$y][$x][0]],
2814                                $shortnames[$level->{map}[$y][$x][1]]
2815                     or return;
2816                 printf $output " Tfr=%-2.2s", $notes[$y][$x]{tfr} or return
2817                     if exists $notes[$y][$x]{tfr};
2818                 printf $output " Tto=%-2.2s", $notes[$y][$x]{tto} or return
2819                     if exists $notes[$y][$x]{tto};
2820                 printf $output " Cfr=%-2.2s", $notes[$y][$x]{cfr} or return
2821                     if exists $notes[$y][$x]{cfr};
2822                 printf $output " Cto=%-2.2s", $notes[$y][$x]{cto} or return
2823                     if exists $notes[$y][$x]{cto};
2824                 printf $output " CL=%-3.3s", $notes[$y][$x]{crl} or return
2825                     if exists $notes[$y][$x]{crl};
2826                 printf $output "\n" or return;
2827             }
2828         }
2829         printf $output "\n" or return;
2830     }
2831
2832     print $output "END\n" or return;
2833
2834     return 1;
2835 }
2836
2837 #
2838 #
2839 #
2840
2841 package main;
2842
2843 use constant yowzitch => <<EOT;
2844 Usage: c4 [-INTYPE] INFILE [-OUTTYPE] OUTFILE
2845
2846 The type switches can be omitted if the file's type can be inferred
2847 directly. Available types:
2848
2849     -D     Microsoft data file (*.dat)
2850     -T     textual source file (*.txt)
2851     -R     Lynx ROM file (*.lnx, *.lyx)
2852     -P     MS-DOS fileset (directory of *.pak files)
2853     -U     Chip's universal dump file (*.cud) [write-only]
2854 EOT
2855 use constant vourzhon => "1.0\n";
2856
2857 my ($infile, $outfile);
2858 my ($intype, $outtype);
2859
2860 sub deducetype($)
2861 {
2862     local $_ = shift;
2863     if (-d $_) {
2864         return "P";
2865     } elsif (/\.dat$/) {
2866         return "D";
2867     } elsif (/\.txt$/ || /^-$/) {
2868         return "T";
2869     } elsif (/\.lnx$/ || /\.lyx$/) {
2870         return "R";
2871     } elsif (/\.cud$/) {
2872         return "U";
2873     }
2874     return;
2875 }
2876
2877 sub findfiletype($)
2878 {
2879     open FILE, shift or return;
2880     local $_;
2881     sysread FILE, $_, 16 or return;
2882     close FILE;
2883     return "D" if /\A\xAC\xAA\x02/;
2884     return "R" if /\ALYNX\0/;
2885     return "T" if /\A\s*(rul|til|max|%%%)/;
2886     return;
2887 }
2888
2889 die yowzitch unless @ARGV;
2890 print yowzitch and exit if $ARGV[0] =~ /^--?(h(elp)?|\?)$/;
2891 print vourzhon and exit if $ARGV[0] =~ /^--?[Vv](ersion)?$/;
2892
2893 $infile = shift;
2894 if ($infile =~ /^-([A-Za-z])$/) {
2895     $intype = uc $1;
2896     $infile = shift;
2897 }
2898 die yowzitch unless @ARGV;
2899 $outfile = shift;
2900 if ($outfile =~ /^-([A-Za-z])$/) {
2901     $outtype = uc $1;
2902     $outfile = shift;
2903 }
2904 die yowzitch unless defined $infile && defined $outfile && @ARGV == 0;
2905
2906 $intype ||= deducetype $infile;
2907 $outtype ||= deducetype $outfile;
2908 die "$outfile: file type unspecified\n" unless $outtype;
2909 $intype = findfiletype $infile if !defined $intype && -f $infile;
2910 die "$infile: file type unspecified\n" unless $intype;
2911
2912 my $data;
2913
2914 $filename = $infile;
2915 if ($intype eq "D") {
2916     open FILE, "< $infile" or die "$infile: $!\n";
2917     binmode FILE;
2918     $data = datfile::read \*FILE or exit 1;
2919     close FILE;
2920 } elsif ($intype eq "T") {
2921     open FILE, "< $infile" or die "$infile: $!\n";
2922     $data = txtfile::read \*FILE or exit 1;
2923     close FILE;
2924 } elsif ($intype eq "P") {
2925     $data = lynxfmt::readmsdos $infile or exit 1;
2926 } elsif ($intype eq "R") {
2927     open FILE, "< $infile" or die "$infile: $!\n";
2928     binmode FILE;
2929     $data = lynxfmt::readrom \*FILE or exit 1;
2930     close FILE;
2931 } elsif ($intype eq "U") {
2932     die "File type -U is a write-only file format.\n";
2933 } else {
2934     die "Unknown file type option -$intype.\n";
2935 }
2936
2937 undef $filename;
2938 undef $filelevel;
2939 undef $filepos;
2940
2941 $filename = $outfile;
2942
2943 if ($outtype eq "D") {
2944     open FILE, "> $outfile" or die "$outfile: $!\n";
2945     binmode FILE;
2946     datfile::write \*FILE, $data or die "$outfile: $!\n";
2947     close FILE or die "$outfile: $!\n";
2948 } elsif ($outtype eq "T") {
2949     open FILE, "> $outfile" or die "$outfile: $!\n";
2950     txtfile::write \*FILE, $data or die "$outfile: $!\n";
2951     close FILE or die "$outfile: $!\n";
2952 } elsif ($outtype eq "P") {
2953     lynxfmt::writemsdos $outfile, $data or exit 1;
2954 } elsif ($outtype eq "R") {
2955     open FILE, "+< $outfile" or die "$outfile: $!\n";
2956     binmode FILE;
2957     lynxfmt::writerom \*FILE, $data or die "$outfile: $!\n";
2958     close FILE or die "$outfile: $!\n";
2959 } elsif ($outtype eq "U") {
2960     open FILE, "> $outfile" or die "$outfile: $!\n";
2961     cudfile::write \*FILE, $data or die "$outfile: $!\n";
2962     close FILE or die "$outfile: $!\n";
2963 } else {
2964     die "Unknown file type option -$outtype.\n";
2965 }
2966
2967 #
2968 # The documentation
2969 #
2970
2971 =head1 NAME
2972
2973 c4 - Chip's Challenge combined converter
2974
2975 =head1 SYNOPSIS
2976
2977     c4 [-INTYPE] INFILENAME [-OUTTYPE] OUTFILENAME
2978
2979 c4 allows one to translate between the several different types of
2980 files used to represent level sets for the game Chip's Challenge.
2981
2982 c4 expects there to be two files named on the command-line. c4 reads
2983 the levels stored in the first file, and then writes the levels out to
2984 the second file. The format to use with each file usually can be
2985 inferred by c4 by examining the filenames. If not, then it may be
2986 necessary to use switches before one or both filenames to indicate
2987 their type.
2988
2989 There are four different types of files that c4 understands.
2990
2991     -D     MS data file (*.dat).
2992
2993 This is the file type used by Chip's Challenge for Microsoft Windows
2994 3.x. It is the file type used by most other programs, such as ChipEdit
2995 and Tile World.
2996
2997     -R     Lynx ROM file (*.lnx, *.lyx)
2998
2999 This "file type" is actually just a ROM image of the original Chip's
3000 Challenge for the Atari Lynx handheld. It is used by Lynx emulators
3001 such as Handy.
3002
3003     -P     MS-DOS fileset (directory of *.pak files)
3004
3005 This is the format used by the MS-DOS port of Chip's Challenge. In
3006 this case, the filename given on the command line actually names a
3007 directory, containing *.pak files.
3008
3009     -T     textual source file (*.txt)
3010
3011 This file type is native to c4. It is a plain text file, which allows
3012 levels to be defined pictorially using a simple text editor. A
3013 complete description of the syntax of these files is provided below.
3014
3015 =head1 EXAMPLES
3016
3017     c4 mylevels.txt mylevels.dat
3018
3019 Create a .dat file from a textual source file.
3020
3021     c4 -P levels -D doslevels.dat
3022
3023 "levels" is a directory of MS-DOS *.pak files. c4 translates the
3024 directory contents into a single .dat file. Note that the switches in
3025 this example are optional, as c4 would be able to infer the desired
3026 formats.
3027
3028     c4 mylevels.dat chipsch.lnx
3029
3030 Embed the levels from the .dat file into a Lynx ROM file. Note that c4
3031 does NOT create chipsch.lnx. You must provide the ROM image file,
3032 which c4 then alters to contain your levels. (Obviously, you should
3033 not use this command on your master copy of the ROM file.)
3034
3035     c4 chipsch.lnx -T out
3036
3037 Output the levels in the .dat file as a text file. Here the -T switch
3038 is needed to indicate that a text file is the desired output format.
3039
3040 When producing a text file, c4 will attempt to produce legible source,
3041 but the results will often not be as good as what a human being would
3042 produce. (In particular, c4 cannot draw overlays.)
3043
3044 =head1 NOTES
3045
3046 Be aware that there can be various problems when translating a set of
3047 levels using the MS ruleset to one of the Lynx-only file formats.
3048 There are numerous objects and configurations in the MS ruleset which
3049 cannot be represented in the Lynx ruleset. Usually c4 will display a
3050 warning when some aspect of the data could not be transferred intact
3051 because of this.
3052
3053 The remainder of this documentation describes the syntax of the
3054 textual source file format.
3055
3056 =head1 LAYOUT OF THE INPUT FILE
3057
3058 The source file is broken up into subsections. Each subsection defines
3059 a separate level in the set.
3060
3061 The subsections are separated from each other by a line containing
3062 three percent signs:
3063
3064     %%%
3065
3066 A line of three percent signs also comes before the first level and
3067 after the last level, at the end of the source file.
3068
3069 Any other line that begins with a percent sign is treated as a
3070 comment, and its contents are ignored.
3071
3072 Beyond these things, the source file consists of statements.
3073 Statements generally appear as a single line of text. Some statements,
3074 however, require multiple lines. These multi-line statements are
3075 terminated with the word B<end> appearing alone on a line.
3076
3077 =head1 INPUT FILE HEADER STATEMENTS
3078
3079 There are a couple of statements that can appear at the very top of
3080 the source file, before the first level subsection.
3081
3082     ruleset [ lynx | ms ]
3083
3084 The B<ruleset> statement is the most important of these. It defines
3085 the ruleset for the level set. If the B<ruleset> statment is absent,
3086 it defaults to B<lynx>.
3087
3088     maxlevel NNN
3089
3090 The B<maxlevel> statement specifies the number of the last level in
3091 the .dat file. By default, this value is provided automatically and
3092 does not need to be specified.
3093
3094 In addition to the above, a set of tile definitions can appear in the
3095 header area. See below for a full description of the B<tiles>
3096 multi-line statement. Any tile definitions provided here remain in
3097 force throughout the file.
3098
3099 =head1 INPUT FILE LEVEL STATEMENTS
3100
3101 Within each level's subsection, the following two statments will
3102 usually appear at the top.
3103
3104     title STRING
3105     password PASS
3106
3107 The B<title> statement supplies the level's title, or name. The title
3108 string can be surrounded by double quotes, or unadorned. The
3109 B<password> statement supplies the level's password. This password
3110 must consist of exactly four uppercase alphabetic characters.
3111
3112 If the level's number is 150 or less, the B<password> statement may be
3113 omitted. In that case the level's password will default to match that
3114 level in the original Lynx set. (N.B.: The Lynx ROM file format does
3115 not provide a mechanism for setting passwords, so in that case the
3116 default password will be used regardless.)
3117
3118 The following statements may also appear in a level subsection.
3119
3120     chips NNN
3121
3122 The B<chips> statement defines how many chips are required on this
3123 level to open the chip socket. The default value is zero.
3124
3125     time NNN
3126
3127 The B<time> statement defines how many seconds are on the level's
3128 clock. The default value is zero (i.e., no time limit).
3129
3130     hint STRING
3131
3132 The B<hint> statement defines the level's hint text. As with the
3133 B<title> statement, the string can either be unadorned or delimited
3134 with double quotes. If a section contains multiple B<hint> statements,
3135 the texts are appended together, e.g.:
3136
3137     hint This is a relatively long hint, and so it
3138     hint is helpful to be able to break it up across
3139     hint several lines.
3140
3141 Note that the same can be done with B<title> statements.
3142
3143     tiles
3144     DEF1
3145     DEF2
3146     ...
3147     end
3148
3149 The B<tiles> multi-line statement introduces one or more tile
3150 definitions. The definitions appear one per line, until a line
3151 containing B<end> is found. Note that the tile definitions given here
3152 only apply to the current level. A complete description of tile
3153 definitions is given below.
3154
3155     map [ X Y ]    map [ X Y ]
3156     LINE1          LINE1
3157     LINE2          LINE2
3158     ...            ...
3159     and            end
3160     OVER1
3161     OVER2
3162     ...
3163     end
3164
3165 The B<map> statement defines the actual contents of (part of) the
3166 level's map. The line containing the B<map> statement can optionally
3167 include a pair of coordinates; these coordinates indicate where the
3168 the section will be located on the level's map. If coordinates are
3169 omitted, the defined section will be located at (0 0) -- i.e., the
3170 upper-left corner of the level. The lines inside the B<map> statement
3171 pictorially define the contents of the map section, until a line
3172 containing B<and> or B<end> is encountered. When the map is terminated
3173 by B<and>, then the lines defining the map section are immediately
3174 followed by lines defining an overlay. The overlay uses the same
3175 origin as the map section (though it is permissible for the overlay to
3176 be smaller than the map section it is paired with). A complete
3177 description of the map and overlay sections is given below.
3178
3179     border TL
3180
3181 The B<border> statement specifies a tile. The edges of the map are
3182 then changed to contain this tile. Typically this is used to enclose
3183 the level in walls.
3184
3185 The following statements are also available, though they are usually
3186 not needed. They provide means for explicitly defining level data, for
3187 the occasional situation where the usual methods are more cumbersome.
3188
3189     creatures X1 Y1 ; X2 Y2 ...
3190
3191 The B<creatures> statements permits explicit naming of the coordinates
3192 in the creature list. Pairs of coordinates are separated from each
3193 other by semicolons; any number of coordinate pairs can be specified.
3194 There can be multiple B<creatures> statements in a level's subsection.
3195
3196     traps P1 Q1 -> R1 S1 ; P2 Q2 -> R2 S2 ...
3197
3198 The B<traps> statement permits explicit naming of the coordinates for
3199 elements in the bear trap list. Coordinates are given in one or more
3200 groups of four, separated by semicolons. Each group consists of the x-
3201 and y-coordinates of the brown button, an arrow (->), and then the x-
3202 and y-coordinates of the bear trap. Any number of B<traps> statements
3203 can appear in a level's subsection.
3204
3205     cloners P1 Q1 -> R1 S1 ; P2 Q2 -> R2 S2 ...
3206
3207 The B<cloners> statement permits explicit naming of elements in the
3208 clone machine list. It uses the same syntax as the B<traps> statment,
3209 with the red button's coordinates preceding the coordinates of the
3210 clone machine.
3211
3212     level NNN
3213
3214 The B<level> statement defines the level's number. By default it is
3215 one more than the number of the prior level.
3216
3217     field NN B01 B02 ...
3218
3219 The B<field> statement allows fields to be directly specified and
3220 embedded in the .dat file. The first argument specifies the field
3221 number; the remaining arguments provide the byte values for the actual
3222 field data. These statements are only meaningful in conjunction with
3223 producing a .dat file.
3224
3225 =head1 DEFINING TILES
3226
3227 A tile definition consists of two parts. The first part is either one
3228 or two characters. The characters can be letters, numbers, punctuation
3229 -- anything except spaces. The second part is the name of a tile or a
3230 pair of tiles. The characters then become that tile's representation.
3231
3232 Here is an example of some tile definitions:
3233
3234     tiles
3235     #       wall
3236     *       teleport
3237     rb      red button
3238     @       chip south
3239     end
3240
3241 (Note that a single tab character comes after the characters and
3242 before the tile names.) Once these definitions have been provided, the
3243 newly-defined characters can then be used in a map.
3244
3245 The above definitions all use singular tiles. To define a pair of
3246 tiles, combine the two names with a plus sign, like so:
3247
3248     tiles
3249     X       block + bomb
3250     G       glider north + clone machine
3251     end
3252
3253 Notice that the top tile is named first, then the bottom tile.
3254
3255 The B<tiles> statement is the only statement that can appear in the
3256 header, as well as in a level's subsection. Tile definitions in the
3257 header are global, and can be used in every subsection. Tile
3258 definitions inside a subsection are local, and apply only to that
3259 level.
3260
3261 A number of tile definitions are pre-set ahead of time, supplying
3262 standard representations for some of the most common tiles. (If these
3263 representations are not desired, the characters can always be
3264 redefined.) Here are some of the built-in definitions:
3265
3266     #       wall                  $       computer chip
3267     ,       water                 H       socket
3268     =       ice                   E       exit
3269     &       fire                  []      block
3270     6       bomb                  ?       hint button
3271
3272 See below for the complete list of tile names and built-in
3273 definitions.
3274
3275 A few groups tiles allow one to specify multiple definitions in a
3276 single line. For example:
3277
3278     tiles
3279     G       glider
3280     end
3281
3282 This one definition is equivalent to the following:
3283
3284     tiles
3285     Gn      glider north
3286     Gs      glider south
3287     Ge      glider east
3288     Gw      glider west
3289     end
3290
3291 (Note that "G" by itself is still undefined.) All creatures, including
3292 Chip, can be defined using this abbreviated form.
3293
3294 Doors and keys are the other groups that have this feature; the
3295 following definition:
3296
3297     tiles
3298     D       door
3299     end
3300
3301 is equivalent to:
3302
3303     tiles
3304     Dr      red door
3305     Db      blue door
3306     Dy      yellow door
3307     Dg      green door
3308     end
3309
3310 =head1 MAP SECTIONS
3311
3312 Once all the needed tiles have defined representations, using the map
3313 statement is a simple matter. Here is an example:
3314
3315     map
3316     # # # # # #
3317     # &     & # # #
3318         []    H E #
3319     # &     $ # # #
3320     # # # # # #
3321     end
3322
3323 This is a map of a small room. A block stands in the way of the
3324 entrance. Three of the four corners contain fire; the fourth contains
3325 a chip. On the east wall is an exit guarded by a chip socket.
3326
3327 Note that each cell in the map is two characters wide. (Thus, for
3328 example, the octothorpes describe a solid wall around the room.)
3329
3330 Here is a larger example, which presents the map from LESSON 2:
3331
3332     tiles
3333     B       bug north
3334     C       chip south
3335     end
3336
3337     map 7 7
3338         # # # # # # #
3339         #     $     #
3340         #           #
3341         #     #     # # # # # # # # # #
3342     # # #     # B     , ,           $ #
3343     # E H     # # B   , ,   [][]C ?   #
3344     # # #     # B     , ,           $ #
3345         #     #     # # # # # # # # # #
3346         #           #
3347         #     $     #
3348         # # # # # # #
3349     end
3350
3351 There are a couple of different ways to fill a cell with two tiles.
3352 The first way is to simply use tile definitions which contains two
3353 tiles:
3354
3355     tiles
3356     X       block + bomb
3357     G       glider east + clone machine
3358     end
3359
3360     map 12 14
3361             # #
3362           6 E #
3363             # # X
3364     G
3365     end
3366
3367 The second way is to squeeze two representations into a single cell.
3368 Obviously, this can only be done with both representations are a
3369 single character.
3370
3371     tiles
3372     [       block
3373     G       glider east
3374     +       clone machine
3375     end
3376
3377     map 12 14
3378             # #
3379           6 E #
3380             # # [6
3381     G+
3382     end
3383
3384 In both cases, the top tile always comes before the bottom tile. Note
3385 that you can "bury" a tile by placing it to the right of a space:
3386
3387     map
3388     # # # # # #
3389        6 6 6E #
3390     # # # # # #
3391     end
3392
3393 Any number of map statements can appear in a level's subsection. The
3394 map statements will be combined together to make the complete map.
3395
3396 =head1 OVERLAY SECTIONS
3397
3398 Every map statement can optionally include an overlay section. This
3399 overlay permits button connections and monster ordering to be defined.
3400
3401 The overlay is applied to the same position as the map section it
3402 accompanies. The overlay can duplicate parts of the map section it
3403 covers, and any such duplication will be ignored. The only characters
3404 in the overlay that are significant are the ones that differ from the
3405 map section it covers. These characters are treated as labels. Labels
3406 are always a single character; two non-space characters in a cell
3407 always indicates two separate labels. Any non-space characters can be
3408 used as labels, as long as they don't match up with the map.
3409
3410 An overlay section defines a button connection by using the same label
3411 in two (or more) cells. One of the labelled cells will contain either
3412 a bear trap or a clone machine, and the other will contain the
3413 appropriate button. If there are more than two cells with the same
3414 label, all but one should contain a button.
3415
3416 Characters that only appear once in an overlay, on the other hand,
3417 indicate creatures. The characters then indicate the ordering of the
3418 creatures in the creature list with respect to each other. The
3419 ordering of characters is the usual ASCII sequence (e.g., numbers
3420 first, then capital letters, then lowercase letters).
3421
3422 For example, here is a map with an overlay that demonstrates all three
3423 of these uses:
3424
3425     tiles
3426     G       glider east
3427     +       clone machine
3428     r       red button
3429     *       beartrap
3430     b       brown button
3431     end
3432
3433     map
3434     G                           v #
3435     G+      *   r   * G+    b &   # r
3436     G+    *     r     #           # r
3437     # >   b b G             < #   #
3438     and
3439     2                           v #
3440     A       c   C   d C     d &   # A
3441     B     a     C     #           # B
3442     # >   a c 1             < #   #
3443     end
3444
3445 In this example, capitals are used for the clone machine connections,
3446 lowercase for the bear trap connections, and numbers are used for the
3447 creature ordering.
3448
3449 (Note that the gliders atop clone machines are not numbered. While it
3450 is not an error to include clone machine creatures in the ordering,
3451 they are ignored under the MS ruleset.)
3452
3453 It is not necessary to reproduce any of the map section's text in the
3454 overlay section. Blanks can be used instead. The ignoring of matching
3455 text is simply a feature designed to assist the user in keeping the
3456 overlay's contents properly aligned.
3457
3458 The B<traps>, B<cloners>, and B<creatures> statements can be used in
3459 lieu of, or in conjunction with, data from overlay sections. In the
3460 case of the creature list, items are added to the list in the order
3461 that they are encountered in the source text.
3462
3463 If a level contains no overlay information and none of the above three
3464 statements, then this information will be filled in automatically. The
3465 data will be determined by following the original Lynx-based rules --
3466 viz., buttons are connected to the next beartrap/clone machine in
3467 reading order, wrapping around to the top if necessary. (Likewise, the
3468 creature ordering is just the order of the creatures in their initial
3469 placement, modified by swapping the first creature with Chip.) Thus,
3470 if you actually want to force an empty bear trap list, clone machine
3471 list, or creature list, you must include an empty B<traps>,
3472 B<cloners>, and/or B<creatures> statement.
3473
3474 =head1 TILE NAMES
3475
3476 Here is the complete list of tiles as they are named in definitions.
3477 Two or more names appearing on the same line indicates that they are
3478 two different names for the same tile. Note that the tile names are
3479 not case-sensitive; capitalization is ignored.
3480
3481     empty
3482     wall
3483     water
3484     fire
3485     dirt
3486     ice
3487     gravel
3488     computer chip          ic chip
3489     socket
3490     exit
3491     ice corner southeast   ice se
3492     ice corner southwest   ice sw
3493     ice corner northwest   ice nw
3494     ice corner northeast   ice ne
3495     force floor north      force north
3496     force floor south      force south
3497     force floor east       force east
3498     force floor west       force west
3499     force floor random     force random              force any
3500     hidden wall permanent  invisible wall permanent
3501     hidden wall temporary  invisible wall temporary
3502     wall north             partition north
3503     wall south             partition south
3504     wall east              partition east
3505     wall west              partition west
3506     wall southeast         partition southeast       wall se
3507     closed toggle wall     closed toggle door        toggle closed
3508     open toggle wall       open toggle door          toggle open
3509     blue door              door blue
3510     red door               door red
3511     green door             door green
3512     yellow door            door yellow
3513     blue key               key blue
3514     red key                key red
3515     green key              key green
3516     yellow key             key yellow
3517     blue button            button blue               tank button
3518     red button             button red                clone button
3519     green button           button green              toggle button
3520     brown button           button brown              trap button
3521     blue block floor       blue wall fake
3522     blue block wall        blue wall real
3523     thief
3524     teleport
3525     bomb
3526     beartrap               trap
3527     popup wall
3528     hint button
3529     clone machine          cloner
3530     water boots            water shield              flippers
3531     fire boots             fire shield
3532     ice boots              spiked shoes              skates
3533     force boots            magnet                    suction boots
3534     block                  moveable block
3535     cloning block north    block north
3536     cloning block south    block south
3537     cloning block east     block east
3538     cloning block west     block west
3539     chip north
3540     chip south
3541     chip east
3542     chip west
3543     ball north
3544     tank north
3545     bug north              bee north
3546     paramecium north       centipede north
3547     fireball north         flame north
3548     glider north           ghost north
3549     blob north
3550     walker north           dumbbell north
3551     teeth north            frog north
3552
3553 (The last nine lines, listing the creatures, only show the
3554 north-facing versions. The remaining 27 names, for the south-, east-,
3555 and west-facing versions, follow the obvious patttern.)
3556
3557 Note that tile names may be abbreviated to any unique prefix. In
3558 particular, this permits one to write names like "glider north" as
3559 simply "glider n".
3560
3561 There are also tile names for the "extra" MS tiles. These tiles are
3562 listed in parentheses, as an indicator that they were not originally
3563 intended to be used in maps.
3564
3565     (combination)
3566     (chip drowned)
3567     (chip burned)
3568     (chip bombed)
3569     (unused 1)
3570     (unused 2)
3571     (unused 3)
3572     (exiting)
3573     (exit 1)
3574     (exit 2)
3575     (chip swimming north)  (chip swimming n)
3576     (chip swimming west)   (chip swimming w)
3577     (chip swimming south)  (chip swimming s)
3578     (chip swimming east)   (chip swimming e)
3579
3580 Finally, note that one can also explicitly refer to tiles by their
3581 hexadecimal byte value under the MS rules by using the "0x" prefix.
3582 Thus, the names "0x2A" and "bomb" are equivalent.
3583
3584 =head1 PREDEFINED TILE DEFINITIONS
3585
3586 The following is the complete list of built-in tile definitions:
3587
3588     #       wall                  E       exit
3589     $       ic chip               H       socket
3590     ,       water                 =       ice
3591     &       fire                  6       bomb
3592     ;       dirt                  :       gravel
3593     ~       wall north            ^       force floor north
3594     _       wall south            v       force floor south
3595     |       wall west             <       force floor west
3596      |      wall east             >       force floor east
3597     _|      wall southeast        <>      force floor random
3598     ?       hint button           @       chip south
3599     []      block                 [       block
3600     ^]      cloning block north + clone machine
3601     <]      cloning block west + clone machine
3602     v]      cloning block south + clone machine
3603     >]      cloning block east + clone machine
3604
3605 =head1 LICENSE
3606
3607 c4, Copyright (C) 2003-2006 Brian Raiter <breadbox@muppetlabs.com>
3608
3609 Permission is hereby granted, free of charge, to any person obtaining
3610 a copy of this software and documentation (the "Software"), to deal in
3611 the Software without restriction, including without limitation the
3612 rights to use, copy, modify, merge, publish, distribute, sublicense,
3613 and/or sell copies of the Software, and to permit persons to whom the
3614 Software is furnished to do so, subject to the following conditions:
3615
3616 The above copyright notice and this permission notice shall be
3617 included in all copies or substantial portions of the Software.
3618
3619 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
3620 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
3621 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
3622 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
3623 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
3624 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
3625 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
3626
3627 =cut