EcYLcHqz

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
12use strict;
13
14#
15# First, some global functions used across packages.
16#
17
18package main;
19
20# All the names of all the tiles.
21#
22my @tilenames;
23my %tilenames;
24foreach 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#
158my @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#
183sub iscreature($) { $_[0] >= 0x40 && $_[0] < 0x64 }
184sub isblock($)    { $_[0] == 0x0A || ($_[0] >= 0x0E && $_[0] < 0x12) }
185sub ischip($)     { $_[0] >= 0x6C && $_[0] < 0x70 }
186
187my $filename = undef;
188my $filepos = undef;
189my $filelevel = undef;
190sub 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#
218sub 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#
234sub 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#
266sub 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
274sub 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#
287sub 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#
345sub 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
367package txtfile;
368
369# The list of default tile symbols.
370#
371my %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#
409sub 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#
414my %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#
461my %globaltiles = %tilesymbols;
462
463# The list of tile definitions for a given level.
464#
465my %localtiles;
466
467# Add a list of tile definitions to a hash.
468#
469sub 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#
478sub 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#
509sub lookuptile($);
510sub 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#
535sub 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#
554sub 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#
581sub 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#
609sub 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#
650sub 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#
676sub 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#
713sub 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#
789sub 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#
838sub 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#
892sub 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#
1085sub 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
1113my %globalsymbols;
1114my %localsymbols;
1115
1116$globalsymbols{"0"}[1] = " ";
1117$globalsymbols{"0"}[2] = "  ";
1118$globalsymbols{"0:0"}[1] = " ";
1119$globalsymbols{"0:0"}[2] = "  ";
1120foreach 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
1130my @symbollist;
1131my $newsym = -1;
1132
1133sub 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
1163sub 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
1184sub 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
1196sub getnewsym() { shift @symbollist }
1197
1198sub resetnewsyms()
1199{
1200    @symbollist = split //,
1201      q|ABCDFGIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuwxyz012345789*+.'`-!|;
1202}
1203
1204sub 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
1244sub 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
1291sub 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
1300sub 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
1316sub 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
1361sub 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
1390sub 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
1419sub 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
1447sub 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
1462sub 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
1491package datfile;
1492
1493# Given a string of run-length encoded data, return the original
1494# uncompressed string.
1495#
1496sub rleuncompress($)
1497{
1498    local $_ = shift;
1499    1 while s/\xFF(.)(.)/$2 x ord$1/se;
1500    return $_;
1501}
1502
1503sub 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
1522sub 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
1546sub 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
1631sub 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#
1660sub 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#
1683sub 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#
1700sub 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# 
1714sub 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#
1756sub 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#
1766sub 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#
1777sub 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#
1787sub 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#
1810sub 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#
1832sub 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#
1853sub 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#
1870sub 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#
1901sub 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#
1926sub 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
1940package lynxfmt;
1941
1942my @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
1995my @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
2019my @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
2025my @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
2066my (%objectkey, %creaturekey, %textkey);
2067for (0 .. $#objectkey) { $objectkey{$objectkey[$_]} = $_ }
2068for (0 .. $#creaturekey) { $creaturekey{$creaturekey[$_]} = $_ }
2069$creaturekey{$tilenames{"block"}} = $creaturekey{$tilenames{"block north"}};
2070for (0 .. $#textkey) { $textkey{$textkey[$_]} = chr $_ }
2071
2072#
2073#
2074#
2075
2076sub 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
2092sub 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
2126sub refcountadd($$);
2127sub 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
2135sub 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
2153sub 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
2169sub 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
2192sub 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
2214sub 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
2226sub 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
2267sub 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
2289sub 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
2311sub 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
2344sub 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
2366sub 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
2403sub 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
2442sub 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
2482sub 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
2513sub 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
2544sub 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
2576sub 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
2647package cudfile;
2648
2649# The terse names used by the universal-dump file format.
2650#
2651my @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);
2764for (0x70 .. 0xFF) { $shortnames[$_] = sprintf "tile_%02X", $_ }
2765
2766sub 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
2841package main;
2842
2843use constant yowzitch => <<EOT;
2844Usage: c4 [-INTYPE] INFILE [-OUTTYPE] OUTFILE
2845
2846The type switches can be omitted if the file's type can be inferred
2847directly. 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]
2854EOT
2855use constant vourzhon => "1.0\n";
2856
2857my ($infile, $outfile);
2858my ($intype, $outtype);
2859
2860sub 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
2877sub 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
2889die yowzitch unless @ARGV;
2890print yowzitch and exit if $ARGV[0] =~ /^--?(h(elp)?|\?)$/;
2891print vourzhon and exit if $ARGV[0] =~ /^--?[Vv](ersion)?$/;
2892
2893$infile = shift;
2894if ($infile =~ /^-([A-Za-z])$/) {
2895    $intype = uc $1;
2896    $infile = shift;
2897}
2898die yowzitch unless @ARGV;
2899$outfile = shift;
2900if ($outfile =~ /^-([A-Za-z])$/) {
2901    $outtype = uc $1;
2902    $outfile = shift;
2903}
2904die yowzitch unless defined $infile && defined $outfile && @ARGV == 0;
2905
2906$intype ||= deducetype $infile;
2907$outtype ||= deducetype $outfile;
2908die "$outfile: file type unspecified\n" unless $outtype;
2909$intype = findfiletype $infile if !defined $intype && -f $infile;
2910die "$infile: file type unspecified\n" unless $intype;
2911
2912my $data;
2913
2914$filename = $infile;
2915if ($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
2937undef $filename;
2938undef $filelevel;
2939undef $filepos;
2940
2941$filename = $outfile;
2942
2943if ($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
2973c4 - Chip's Challenge combined converter
2974
2975=head1 SYNOPSIS
2976
2977    c4 [-INTYPE] INFILENAME [-OUTTYPE] OUTFILENAME
2978
2979c4 allows one to translate between the several different types of
2980files used to represent level sets for the game Chip's Challenge.
2981
2982c4 expects there to be two files named on the command-line. c4 reads
2983the levels stored in the first file, and then writes the levels out to
2984the second file. The format to use with each file usually can be
2985inferred by c4 by examining the filenames. If not, then it may be
2986necessary to use switches before one or both filenames to indicate
2987their type.
2988
2989There are four different types of files that c4 understands.
2990
2991    -D     MS data file (*.dat).
2992
2993This is the file type used by Chip's Challenge for Microsoft Windows
29943.x. It is the file type used by most other programs, such as ChipEdit
2995and Tile World.
2996
2997    -R     Lynx ROM file (*.lnx, *.lyx)
2998
2999This "file type" is actually just a ROM image of the original Chip's
3000Challenge for the Atari Lynx handheld. It is used by Lynx emulators
3001such as Handy.
3002
3003    -P     MS-DOS fileset (directory of *.pak files)
3004
3005This is the format used by the MS-DOS port of Chip's Challenge. In
3006this case, the filename given on the command line actually names a
3007directory, containing *.pak files.
3008
3009    -T     textual source file (*.txt)
3010
3011This file type is native to c4. It is a plain text file, which allows
3012levels to be defined pictorially using a simple text editor. A
3013complete description of the syntax of these files is provided below.
3014
3015=head1 EXAMPLES
3016
3017    c4 mylevels.txt mylevels.dat
3018
3019Create 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
3024directory contents into a single .dat file. Note that the switches in
3025this example are optional, as c4 would be able to infer the desired
3026formats.
3027
3028    c4 mylevels.dat chipsch.lnx
3029
3030Embed the levels from the .dat file into a Lynx ROM file. Note that c4
3031does NOT create chipsch.lnx. You must provide the ROM image file,
3032which c4 then alters to contain your levels. (Obviously, you should
3033not use this command on your master copy of the ROM file.)
3034
3035    c4 chipsch.lnx -T out
3036
3037Output the levels in the .dat file as a text file. Here the -T switch
3038is needed to indicate that a text file is the desired output format.
3039
3040When producing a text file, c4 will attempt to produce legible source,
3041but the results will often not be as good as what a human being would
3042produce. (In particular, c4 cannot draw overlays.)
3043
3044=head1 NOTES
3045
3046Be aware that there can be various problems when translating a set of
3047levels using the MS ruleset to one of the Lynx-only file formats.
3048There are numerous objects and configurations in the MS ruleset which
3049cannot be represented in the Lynx ruleset. Usually c4 will display a
3050warning when some aspect of the data could not be transferred intact
3051because of this.
3052
3053The remainder of this documentation describes the syntax of the
3054textual source file format.
3055
3056=head1 LAYOUT OF THE INPUT FILE
3057
3058The source file is broken up into subsections. Each subsection defines
3059a separate level in the set.
3060
3061The subsections are separated from each other by a line containing
3062three percent signs:
3063
3064    %%%
3065
3066A line of three percent signs also comes before the first level and
3067after the last level, at the end of the source file.
3068
3069Any other line that begins with a percent sign is treated as a
3070comment, and its contents are ignored.
3071
3072Beyond these things, the source file consists of statements.
3073Statements generally appear as a single line of text. Some statements,
3074however, require multiple lines. These multi-line statements are
3075terminated with the word B<end> appearing alone on a line.
3076
3077=head1 INPUT FILE HEADER STATEMENTS
3078
3079There are a couple of statements that can appear at the very top of
3080the source file, before the first level subsection.
3081
3082    ruleset [ lynx | ms ]
3083
3084The B<ruleset> statement is the most important of these. It defines
3085the ruleset for the level set. If the B<ruleset> statment is absent,
3086it defaults to B<lynx>.
3087
3088    maxlevel NNN
3089
3090The B<maxlevel> statement specifies the number of the last level in
3091the .dat file. By default, this value is provided automatically and
3092does not need to be specified.
3093
3094In addition to the above, a set of tile definitions can appear in the
3095header area. See below for a full description of the B<tiles>
3096multi-line statement. Any tile definitions provided here remain in
3097force throughout the file.
3098
3099=head1 INPUT FILE LEVEL STATEMENTS
3100
3101Within each level's subsection, the following two statments will
3102usually appear at the top.
3103
3104    title STRING
3105    password PASS
3106
3107The B<title> statement supplies the level's title, or name. The title
3108string can be surrounded by double quotes, or unadorned. The
3109B<password> statement supplies the level's password. This password
3110must consist of exactly four uppercase alphabetic characters.
3111
3112If the level's number is 150 or less, the B<password> statement may be
3113omitted. In that case the level's password will default to match that
3114level in the original Lynx set. (N.B.: The Lynx ROM file format does
3115not provide a mechanism for setting passwords, so in that case the
3116default password will be used regardless.)
3117
3118The following statements may also appear in a level subsection.
3119
3120    chips NNN
3121
3122The B<chips> statement defines how many chips are required on this
3123level to open the chip socket. The default value is zero.
3124
3125    time NNN
3126
3127The B<time> statement defines how many seconds are on the level's
3128clock. The default value is zero (i.e., no time limit).
3129
3130    hint STRING
3131
3132The B<hint> statement defines the level's hint text. As with the
3133B<title> statement, the string can either be unadorned or delimited
3134with double quotes. If a section contains multiple B<hint> statements,
3135the 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
3141Note that the same can be done with B<title> statements.
3142
3143    tiles
3144    DEF1
3145    DEF2
3146    ...
3147    end
3148
3149The B<tiles> multi-line statement introduces one or more tile
3150definitions. The definitions appear one per line, until a line
3151containing B<end> is found. Note that the tile definitions given here
3152only apply to the current level. A complete description of tile
3153definitions 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
3165The B<map> statement defines the actual contents of (part of) the
3166level's map. The line containing the B<map> statement can optionally
3167include a pair of coordinates; these coordinates indicate where the
3168the section will be located on the level's map. If coordinates are
3169omitted, the defined section will be located at (0 0) -- i.e., the
3170upper-left corner of the level. The lines inside the B<map> statement
3171pictorially define the contents of the map section, until a line
3172containing B<and> or B<end> is encountered. When the map is terminated
3173by B<and>, then the lines defining the map section are immediately
3174followed by lines defining an overlay. The overlay uses the same
3175origin as the map section (though it is permissible for the overlay to
3176be smaller than the map section it is paired with). A complete
3177description of the map and overlay sections is given below.
3178
3179    border TL
3180
3181The B<border> statement specifies a tile. The edges of the map are
3182then changed to contain this tile. Typically this is used to enclose
3183the level in walls.
3184
3185The following statements are also available, though they are usually
3186not needed. They provide means for explicitly defining level data, for
3187the occasional situation where the usual methods are more cumbersome.
3188
3189    creatures X1 Y1 ; X2 Y2 ...
3190
3191The B<creatures> statements permits explicit naming of the coordinates
3192in the creature list. Pairs of coordinates are separated from each
3193other by semicolons; any number of coordinate pairs can be specified.
3194There can be multiple B<creatures> statements in a level's subsection.
3195
3196    traps P1 Q1 -> R1 S1 ; P2 Q2 -> R2 S2 ...
3197
3198The B<traps> statement permits explicit naming of the coordinates for
3199elements in the bear trap list. Coordinates are given in one or more
3200groups of four, separated by semicolons. Each group consists of the x-
3201and y-coordinates of the brown button, an arrow (->), and then the x-
3202and y-coordinates of the bear trap. Any number of B<traps> statements
3203can appear in a level's subsection.
3204
3205    cloners P1 Q1 -> R1 S1 ; P2 Q2 -> R2 S2 ...
3206
3207The B<cloners> statement permits explicit naming of elements in the
3208clone machine list. It uses the same syntax as the B<traps> statment,
3209with the red button's coordinates preceding the coordinates of the
3210clone machine.
3211
3212    level NNN
3213
3214The B<level> statement defines the level's number. By default it is
3215one more than the number of the prior level.
3216
3217    field NN B01 B02 ...
3218
3219The B<field> statement allows fields to be directly specified and
3220embedded in the .dat file. The first argument specifies the field
3221number; the remaining arguments provide the byte values for the actual
3222field data. These statements are only meaningful in conjunction with
3223producing a .dat file.
3224
3225=head1 DEFINING TILES
3226
3227A tile definition consists of two parts. The first part is either one
3228or two characters. The characters can be letters, numbers, punctuation
3229-- anything except spaces. The second part is the name of a tile or a
3230pair of tiles. The characters then become that tile's representation.
3231
3232Here 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
3242before the tile names.) Once these definitions have been provided, the
3243newly-defined characters can then be used in a map.
3244
3245The above definitions all use singular tiles. To define a pair of
3246tiles, 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
3253Notice that the top tile is named first, then the bottom tile.
3254
3255The B<tiles> statement is the only statement that can appear in the
3256header, as well as in a level's subsection. Tile definitions in the
3257header are global, and can be used in every subsection. Tile
3258definitions inside a subsection are local, and apply only to that
3259level.
3260
3261A number of tile definitions are pre-set ahead of time, supplying
3262standard representations for some of the most common tiles. (If these
3263representations are not desired, the characters can always be
3264redefined.) 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
3272See below for the complete list of tile names and built-in
3273definitions.
3274
3275A few groups tiles allow one to specify multiple definitions in a
3276single line. For example:
3277
3278    tiles
3279    G       glider
3280    end
3281
3282This 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
3292Chip, can be defined using this abbreviated form.
3293
3294Doors and keys are the other groups that have this feature; the
3295following definition:
3296
3297    tiles
3298    D       door
3299    end
3300
3301is 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
3312Once all the needed tiles have defined representations, using the map
3313statement is a simple matter. Here is an example:
3314
3315    map
3316    # # # # # #
3317    # &     & # # #
3318        []    H E #
3319    # &     $ # # #
3320    # # # # # #
3321    end
3322
3323This is a map of a small room. A block stands in the way of the
3324entrance. Three of the four corners contain fire; the fourth contains
3325a chip. On the east wall is an exit guarded by a chip socket.
3326
3327Note that each cell in the map is two characters wide. (Thus, for
3328example, the octothorpes describe a solid wall around the room.)
3329
3330Here 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
3351There are a couple of different ways to fill a cell with two tiles.
3352The first way is to simply use tile definitions which contains two
3353tiles:
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
3367The second way is to squeeze two representations into a single cell.
3368Obviously, this can only be done with both representations are a
3369single 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
3384In both cases, the top tile always comes before the bottom tile. Note
3385that 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
3393Any number of map statements can appear in a level's subsection. The
3394map statements will be combined together to make the complete map.
3395
3396=head1 OVERLAY SECTIONS
3397
3398Every map statement can optionally include an overlay section. This
3399overlay permits button connections and monster ordering to be defined.
3400
3401The overlay is applied to the same position as the map section it
3402accompanies. The overlay can duplicate parts of the map section it
3403covers, and any such duplication will be ignored. The only characters
3404in the overlay that are significant are the ones that differ from the
3405map section it covers. These characters are treated as labels. Labels
3406are always a single character; two non-space characters in a cell
3407always indicates two separate labels. Any non-space characters can be
3408used as labels, as long as they don't match up with the map.
3409
3410An overlay section defines a button connection by using the same label
3411in two (or more) cells. One of the labelled cells will contain either
3412a bear trap or a clone machine, and the other will contain the
3413appropriate button. If there are more than two cells with the same
3414label, all but one should contain a button.
3415
3416Characters that only appear once in an overlay, on the other hand,
3417indicate creatures. The characters then indicate the ordering of the
3418creatures in the creature list with respect to each other. The
3419ordering of characters is the usual ASCII sequence (e.g., numbers
3420first, then capital letters, then lowercase letters).
3421
3422For example, here is a map with an overlay that demonstrates all three
3423of 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
3445In this example, capitals are used for the clone machine connections,
3446lowercase for the bear trap connections, and numbers are used for the
3447creature ordering.
3448
3449(Note that the gliders atop clone machines are not numbered. While it
3450is not an error to include clone machine creatures in the ordering,
3451they are ignored under the MS ruleset.)
3452
3453It is not necessary to reproduce any of the map section's text in the
3454overlay section. Blanks can be used instead. The ignoring of matching
3455text is simply a feature designed to assist the user in keeping the
3456overlay's contents properly aligned.
3457
3458The B<traps>, B<cloners>, and B<creatures> statements can be used in
3459lieu of, or in conjunction with, data from overlay sections. In the
3460case of the creature list, items are added to the list in the order
3461that they are encountered in the source text.
3462
3463If a level contains no overlay information and none of the above three
3464statements, then this information will be filled in automatically. The
3465data will be determined by following the original Lynx-based rules --
3466viz., buttons are connected to the next beartrap/clone machine in
3467reading order, wrapping around to the top if necessary. (Likewise, the
3468creature ordering is just the order of the creatures in their initial
3469placement, modified by swapping the first creature with Chip.) Thus,
3470if you actually want to force an empty bear trap list, clone machine
3471list, or creature list, you must include an empty B<traps>,
3472B<cloners>, and/or B<creatures> statement.
3473
3474=head1 TILE NAMES
3475
3476Here is the complete list of tiles as they are named in definitions.
3477Two or more names appearing on the same line indicates that they are
3478two different names for the same tile. Note that the tile names are
3479not 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
3554north-facing versions. The remaining 27 names, for the south-, east-,
3555and west-facing versions, follow the obvious patttern.)
3556
3557Note that tile names may be abbreviated to any unique prefix. In
3558particular, this permits one to write names like "glider north" as
3559simply "glider n".
3560
3561There are also tile names for the "extra" MS tiles. These tiles are
3562listed in parentheses, as an indicator that they were not originally
3563intended 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
3580Finally, note that one can also explicitly refer to tiles by their
3581hexadecimal byte value under the MS rules by using the "0x" prefix.
3582Thus, the names "0x2A" and "bomb" are equivalent.
3583
3584=head1 PREDEFINED TILE DEFINITIONS
3585
3586The 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
3607c4, Copyright (C) 2003-2006 Brian Raiter <breadbox@muppetlabs.com>
3608
3609Permission is hereby granted, free of charge, to any person obtaining
3610a copy of this software and documentation (the "Software"), to deal in
3611the Software without restriction, including without limitation the
3612rights to use, copy, modify, merge, publish, distribute, sublicense,
3613and/or sell copies of the Software, and to permit persons to whom the
3614Software is furnished to do so, subject to the following conditions:
3615
3616The above copyright notice and this permission notice shall be
3617included in all copies or substantial portions of the Software.
3618
3619THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
3620EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
3621MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
3622IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
3623CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
3624TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
3625SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
3626
3627=cut