IllogiGames:Celestial Pirates/Cv dungeon

From Illogicopedia
Jump to navigation Jump to search

Translator Script used for Celestial Pirates part I, and possibly some other stuff


#!/usr/bin/perl -w
use strict;
#
# Convert the single file source using symbolic names to
# a single file using offsets
#
my $filename = "the-stench-1-rooms.html";
my $index_only = 0;
my $sort_rooms = 0;
my $cv_to_singlefile = 1;
my $cv_to_multifile = 0;
my %room_names;			# Room IDs based on definition order
my %room_used;
my @room_array;
my $debug = 0;
my $optimize = 0;
my %alpha_room_ids;		# Room IDs based on alphabetical order
my %shared_ilist_for_state;	# Map of state number to inventory list number

#
# Some random numbers -- generated by C's 'random' function, which is supposed to be pretty good.
#
#
# NB -- this was supposed to help with the 'scramble' function, which is used to build the (static) links in the
# desert maze.  It didn't.  The result still stinks.  Either the concept is NG or a better way of generating random
# links is needed.
#
my @randoms = (1804289383, 846930886, 1681692777, 1714636915, 1957747793, 424238335, 719885386, 1649760492, 596516649, 1189641421, 1025202362,
	       1350490027, 783368690, 1102520059, 2044897763, 1967513926, 1365180540, 1540383426, 304089172, 1303455736, 35005211, 521595368,
	       294702567, 1726956429, 336465782, 861021530, 278722862, 233665123, 2145174067, 468703135, 1101513929, 1801979802, 1315634022,
	       635723058, 1369133069, 1125898167, 1059961393, 2089018456, 628175011, 1656478042, 1131176229, 1653377373, 859484421, 1914544919,
	       608413784, 756898537, 1734575198, 1973594324, 149798315, 2038664370, 1129566413, 184803526, 412776091, 1424268980, 1911759956,
	       749241873, 137806862, 42999170, 982906996, 135497281, 511702305, 2084420925, 1937477084, 1827336327, 572660336, 1159126505,
	       805750846, 1632621729, 1100661313, 1433925857, 1141616124, 84353895, 939819582, 2001100545, 1998898814, 1548233367, 610515434,
	       1585990364, 1374344043, 760313750, 1477171087, 356426808, 945117276, 1889947178, 1780695788, 709393584, 491705403, 1918502651,
	       752392754, 1474612399, 2053999932, 1264095060, 1411549676, 1843993368, 943947739, 1984210012, 855636226, 1749698586, 1469348094,
	       1956297539, 1036140795, 463480570, 2040651434, 1975960378, 317097467, 1892066601, 1376710097, 927612902, 1330573317, 603570492,
	       1687926652, 660260756, 959997301, 485560280, 402724286, 593209441, 1194953865, 894429689, 364228444, 1947346619, 221558440,
	       270744729, 1063958031, 1633108117, 2114738097, 2007905771, 1469834481, 822890675, 1610120709, 791698927, 631704567, 498777856,
	       1255179497, 524872353, 327254586, 1572276965, 269455306, 1703964683, 352406219, 1600028624, 160051528, 2040332871, 112805732,
	       1120048829, 378409503, 515530019, 1713258270, 1573363368, 1409959708, 2077486715, 1373226340, 1631518149, 200747796, 289700723,
	       1117142618, 168002245, 150122846, 439493451, 990892921, 1760243555, 1231192379, 1622597488, 111537764, 338888228, 2147469841,
	       438792350, 1911165193, 269441500, 2142757034, 116087764, 1869470124, 155324914, 8936987, 1982275856, 1275373743, 387346491,
	       350322227, 841148365, 1960709859, 1760281936, 771151432, 1186452551, 1244316437, 971899228, 1476153275, 213975407, 1139901474,
	       1626276121, 653468858, 2130794395, 1239036029, 1884661237, 1605908235, 1350573793, 76065818, 1605894428, 1789366143, 1987231011,
	       1875335928, 1784639529, 2103318776, 1597322404, 1939964443, 2112255763, 1432114613, 1067854538, 352118606, 1782436840, 1909002904,
	       165344818, 1395235128, 532670688, 1351797369, 492067917, 1504569917, 680466996, 706043324, 496987743, 159259470, 1359512183,
	       480298490, 1398295499, 1096689772, 2086206725, 601385644, 1172755590, 1544617505, 243268139, 1012502954, 1272469786, 2027907669,
	       968338082, 722308542, 1820388464, 933110197, 6939507, 740759355, 1285228804, 1789376348, 502278611, 1450573622, 1037127828,
	       1034949299, 654887343, 1529195746, 392035568, 1335354340, 87755422, 889023311, 1494613810, 1447267605, 1369321801, 745425661,
	       396473730, 1308044878, 1346811305, 1569229320, 705178736, 1590079444, 434248626, 1977648522, 1470503465, 1402586708, 552473416,
	       1143408282, 188213258, 559412924, 1884167637, 1473442062, 201305624, 238962600, 776532036, 1238433452, 1273911899, 1431419379,
	       620145550, 1665947468, 619290071, 707900973, 407487131, 2113903881, 7684930, 1776808933, 711845894, 404158660, 937370163,
	       2058657199, 1973387981, 1642548899, 1501252996, 260152959, 1472713773, 824272813, 1662739668, 2025187190, 1967681095, 1850952926,
	       437116466, 1704365084, 1176911340, 638422090, 1943327684, 1953443376, 1876855542, 1069755936, 1237379107, 349517445, 588219756,
	       1856669179, 1057418418, 995706887, 1823089412, 1065103348, 625032172, 387451659, 1469262009, 1562402336, 298625210, 1295166342,
	       1057467587, 1799878206, 1555319301, 382697713, 476667372, 1070575321, 260401255, 296864819, 774044599, 697517721, 2001229904,
	       1950955939, 1335939811, 1797073940, 1756915667, 1065311705, 719346228, 846811127, 1414829150, 1307565984, 555996658, 324763920,
	       155789224, 231602422, 1389867269, 780821396, 619054081, 711645630, 195740084, 917679292, 2006811972, 1253207672, 570073850,
	       1414647625, 1635905385, 1046741222, 337739299, 1896306640, 1343606042, 1111783898, 446340713, 1197352298, 915256190, 1782280524,
	       846942590, 524688209, 700108581, 1566288819, 1371499336, 2114937732, 726371155, 1927495994, 292218004, 882160379, 11614769,
	       1682085273, 1662981776, 630668850, 246247255, 1858721860, 1548348142, 105575579, 964445884, 2118421993, 1520223205, 452867621,
	       1017679567, 1857962504, 201690613, 213801961, 822262754, 648031326, 1411154259, 1737518944, 282828202, 110613202, 114723506,
	       982936784, 1676902021, 1486222842, 950390868, 255789528, 1266235189, 1242608872, 1137949908, 1277849958, 777210498, 653448036,
	       1908518808, 1023457753, 364686248, 1309383303, 1129033333, 1329132133, 1280321648, 501772890, 1781999754, 150517567, 212251746,
	       1983690368, 364319529, 1034514500, 484238046, 1775473788, 624549797, 767066249, 1886086990, 739273303, 1750003033, 1415505363,
	       78012497, 552910253, 1671294892, 1344247686, 1795519125, 661761152, 474613996, 425245975, 1315209188, 235649157, 1448703729,
	       1679895436, 1545032460, 430253414, 861543921, 677870460, 932026304, 496060028, 828388027, 1144278050, 332266748, 1192707556,
	       31308902, 816504794, 820697697, 655858699, 1583571043, 559301039, 1395132002, 1186090428, 1974806403, 1473144500, 1739000681,
	       1498617647, 669908538, 1387036159, 12895151, 1144522535, 1812282134, 1328104339, 1380171692, 1113502215, 860516127, 777720504,
	       1543755629, 1722060049, 1455590964, 328298285, 70636429, 136495343, 1472576335, 402903177, 1329202900, 1503885238, 1219407971,
	       2416949, 12260289, 655495367, 561717988, 1407392292, 1841585795, 389040743, 733053144, 1433102829, 1887658390, 1402961682,
	       672655340, 1900553541, 400000569, 337453826, 1081174232, 1780172261, 1450956042, 1941690360, 410409117, 847228023, 1516266761,
	       1866000081, 1175526309, 1586903190, 2002495425, 500618996, 1989806367, 1184214677, 2004504234, 1061730690, 1186631626, 2016764524,
	       1717226057, 1748349614, 1276673168, 1411328205, 2137390358, 2009726312, 696947386, 1877565100, 1265204346, 1369602726, 1630634994,
	       1665204916, 1707056552, 564325578, 1297893529, 1010528946, 358532290, 1708302647, 1857756970, 1874799051, 1426819080, 885799631,
	       1314218593, 1281830857, 1386418627, 1156541312, 318561886, 1243439214, 70788355, 1505193512, 1112720090, 1788014412, 1106059479,
	       241909610, 1051858969, 1095966189, 104152274, 1748806355, 826047641, 1369356620, 970925433, 309198987, 887077888, 530498338,
	       873524566, 37487770, 1541027284, 1232056856, 1745790417, 1251300606, 959372260, 1025125849);
my $rand_count = $#randoms;

while (1) {
    my $a1 = shift;
    if (! defined $a1) { last; }
    if ($a1 eq "-index") {
	$index_only = 1;
    } elsif ($a1 eq "-sort" ) {
	$sort_rooms = 1;
    } elsif ($a1 eq "-single" ) {
	$cv_to_singlefile = 1;
	$cv_to_multifile = 0;
    } elsif ($a1 eq "-multi" ) {
	$cv_to_singlefile = 0;
	$cv_to_multifile = 1;
    } elsif ($a1 eq "-debug" ) {
	$debug = 1;
    } elsif ($a1 eq "-f" ) {
	$filename = shift;
    } elsif ($a1 eq "-opt") {
	$optimize = 1;
    } else {
	die "Argument $a1 not understood\n";
    }
}

# ****************************************************************
# Compare a string against a string, or a string against a list of strings, in which
# case it returns true if the comparand matches anything on the list.
# It returns the value of the thing you passed in, or 0.
#
# We currently think all values must be numbers but if it turns out we're trying to pass
# random strings in we'll change the comparisons to work with strings.
#
# Pretty much all blanks are thrown away.  The parsing is recursive descent (surprise).
#
# Lexing of '=' is sloppy indeed; it actually accepts '=', '==', '===', ...
#
# Expressions we interpret:
#
# expr == expr		exprs evaluate to integers
# expr == [b,c,d...]	True if expr is in the set [...].
#			expr must be numeric.  Returns true if expr==b OR expr==c OR expr==d OR...
#			Note that the [] set construction does NOT NEST.  You get one level.  Be happy with it.
# expr {+,-.*,/,%} expr The obvious.  Precedence is multiplication, addition, mod.
# ... (expr) ...	Evaluates the inner expr then recurses.  IOW they're parens, as you'd expect.
#
#			THERE IS NO UNARY MINUS.  Deal with it.

sub eval_expr ($$) {
    my ($lineno, $expr) = @_;
    my $result;
    if ($debug) { print STDERR "Eval_expr at line $lineno: '$expr'\n"; }
    if ($expr =~ /^\s* ! (.*)/x) {		# Leading "!" is negation.  Precedence is wobbly here.
	return ! &eval_expr($lineno, $1);
    } elsif ($expr =~ /^(.*?) != (.*)/x) {	# Change embedded "!=" to "=", recurse, and negate the result
	return ! &eval_expr ($lineno, "${1}=${2}");
    }

    if ($expr =~ /^\s*([0-9a-z_]+)\s*$/i) {	# A simple value.  If it's a number you'll get a number back.
	my $term = $1;
	if ($term !~ /^[0-9]+$/) {		# If it's not a number you'll get barf.
	    die "eval_expr:  Unexpected characters in term '$term' at line $lineno\n";
	}
	$result = $term;
    } elsif ($expr =~ /^(.*)				# Nested parens (we break these out to help with function calls, which are ragged)
		       (\( .*) \( ([^\(\)]+) \) (.* \))
		       (.*) $/x) {
	my ($lhs1,$lhs2,$middle,$rhs2,$rhs1) = ($1,$2,$3,$4,$5); 
	$middle = &eval_expr ($lineno, $middle);		# Evaluate the subexpression and recurse after pasting it back in
	$result = &eval_expr ($lineno, "${lhs1}${lhs2}${middle}${rhs2}${rhs1}");
    } elsif ($expr =~ /^\s*(.*)&scramble\s*\((.*?)\)(.*)/) { # SPECIAL -- "&scramble" returns a random value based on the input
	my ($lhs,$subex,$rhs) = ($1,$2,$3);
	$subex = &eval_expr($lineno, $subex);
	if ($subex !~ /^[0-9]*$/) { die "eval_expr: Line $lineno: '$expr' has botched scramble argument -- evals to '$subex'\n"; }
	my $rv = $randoms[$subex % scalar(@randoms)];
	##my $rv = $subex;			# Scrambling just made it all worse at 17, but it's OK at 13.
	$result = &eval_expr($lineno, "${lhs}${rv}${rhs}");
    } elsif ($expr =~ /^(.*)				# A parenthesized subexpression
		       \( ([^\(\)]+) \)
		       (.*) $/x) {
	my ($lhs,$middle,$rhs) = ($1,$2,$3); 
	$middle = &eval_expr ($lineno, $middle);		# Evaluate the subexpression and recurse after pasting it back in
	$result = &eval_expr ($lineno, "${lhs}${middle}${rhs}");
    } elsif ($expr =~ /^\s* (.*?) \s* =+ \s*	# Expr on the left
			\[\s* (.*?) \s* \]	# Set on the right
		        \s*$/x) {
	$result = 0;
	my ($lhs, $rhs) = ($1, $2);
	$lhs = &eval_expr ($lineno, $lhs); # Recurse in case the LHS is more complicated than a simple number
	foreach my $r (split /,/, $rhs) {
	    $r = &eval_expr ($lineno, $r);		# Recurse in case we think of a use for an expression in a set
	    if ($lhs eq $r) {
		$result = 1;
		last;
	    }
	}
    } elsif ($expr =~ /^\s*(.*?)\s*=+\s*(.*?)\s*$/) {	# Comparison of two simple values
	my ($lhs,$rhs) = ($1,$2);
	$lhs = &eval_expr ($lineno, $lhs);
	$rhs = &eval_expr ($lineno, $rhs);
	$result = $lhs == $rhs;
    } elsif ($expr =~ /^\s*(.*?)(%)(.*?)\s*$/) {	# Mod -- lowest precedence of the numeric operators
	my ($lhs,$op,$rhs) = ($1,$2,$3);
	$lhs = &eval_expr ($lineno, $lhs);
	$rhs = &eval_expr ($lineno, $rhs);
	$result = $lhs % $rhs;
    } elsif ($expr =~ /^\s*(.*?)([-+])(.*?)\s*$/) {	# Plus and minus
	my ($lhs,$op,$rhs) = ($1,$2,$3);
	$lhs = &eval_expr ($lineno, $lhs);
	$rhs = &eval_expr ($lineno, $rhs);
	if ($op eq "+") {
	    $result = $lhs + $rhs;
	} else {
	    $result = $lhs - $rhs;
	}
    } elsif ($expr =~ /^\s*(.*?)([\*\/])(.*?)\s*$/) {	# Times and division -- highest precedence of the ones we interpret
	my ($lhs,$op,$rhs) = ($1,$2,$3);
	$lhs = &eval_expr ($lineno, $lhs);
	$rhs = &eval_expr ($lineno, $rhs);
	if ($op eq "\*") {
	    $result = $lhs * $rhs;
	} else {
	    $result = $lhs / $rhs;
	}
    } else {
	die "eval_expr: near line $lineno:  Don't understand '$expr'\n";
    }
    if ($debug) { print STDERR "Eval_expr returning $result\n"; }
    return $result;
}

# ****************************************************************
# Define a macro, with or without an argument list

my %state_names;				# Map of state names to numbers
my @state_ilists;				# Inventory lists for the states, indexed by state number
my %simple_macros;				# All macros are entered in the simple-macros table
my %macro_args;					# A macro with arguments has an entry in the args table, as well
my $last_state_number = -1;

sub define_macro ($) {
    my ($inp) = @_;
    if ($inp =~ /^\s*(.*?)\((.*?)\)\s+(.*?)\s*$/) { # Macro with an argument list
	my ($al,$to) = ($2,$3);
	if ($debug) { print STDERR "define_macro: Defining '$1' with args '$al' and body '$to'\n"; }
	$simple_macros{$1} = $3;
	my @args = split /,/, $al;
	$macro_args{$1} = \@args;
    } elsif ($inp =~ /^\s*(.*?)\s+(.*?)\s*$/) { # Macro with no argument list
	if ($debug) { print STDERR "define_macro: Defining '$1' with body '$2'\n"; }
	$simple_macros{$1} = $2;
    } else {
	die "define_macro:  Didn't understand '$inp'\n";
    }
}

# ****************************************************************
# Preprocess macro definitions in one line.  Returns true if it eats the line.

my $pp_defining = 0;
my $pp_defining_state = 0;
my $pp_name = undef;
my $pp_text = "";
my $pp_state_name;
my $pp_base_state_name;
my $pp_new_inventory = [""];			# One blank line for the header text
my %pp_new_inventory_flags;

sub preprocess_defs ($$) {
    my ($lineno, $line) = @_;
    if ($debug) { print STDERR "preprocess_defs(line $lineno) processing '$line'\n"; }

    if ($pp_defining) {
	if ($line =~ /^#defend/) { # If it's the end of the def, record it.
	    if ($pp_defining_state) {
		die "preprocess_defs (line=$lineno): Defining a state, encountered a defend: '$line'\n";
	    }
	    $simple_macros{$pp_name} = $pp_text;
	    $pp_name = undef;
	    $pp_text = "";
	    $pp_defining = 0;
	} elsif ($line =~ /^#endstate/) {
	    if (! $pp_defining_state) {
		die "preprocess_defs (line=$lineno): Defining a macro, encountered an endstate: '$line'\n";
	    }
	    my $pp_state_number = $state_names{$pp_state_name}; # Get the state number for the state
	    if (! defined $pp_state_number) {			# Allocate it if necessary
		$last_state_number++;
		$pp_state_number = $last_state_number;
		$state_names{$pp_state_name} = $pp_state_number;
	    }
	    my $in_header = 0;
	    my $htext;
	    my $share_ilist = 1;		# If there are no changes to the ilist we should share it
	    foreach my $l (split /\n/,$pp_text) {
		$share_ilist = 0;		# Anything at all in the state => no sharing possible
		if ($in_header) {
		    if ($l =~ /^\s*([-+]):\s*(.*?)\s*$/x) {
			$in_header = 0;
			if ($1 eq "+") {
			    push @$pp_new_inventory, $2;
			    $pp_new_inventory_flags{$2} = 1;
			} else {
			    $pp_new_inventory_flags{$2} = -1;
			}
		    } else {
			$htext .= "\n$l";
		    }
		} elsif ($l =~ /^\s* h: \s* (.*?) \s*$/x) {
		    $in_header = 1;
		    $htext = $1;
		} elsif ($l =~ /^\s* \+: \s* (.*?) \s*$/x) {
		    push @$pp_new_inventory, $1;
		    $pp_new_inventory_flags{$1} = 1;
		} elsif ($l =~ /^\s* \-: \s* (.*?) \s*$/x) {
		    $pp_new_inventory_flags{$1} = -1;
		} else {
		    die "Parsing state (line=$lineno): Didn't understand '$l'\n";
		}
	    }
	    if ($pp_base_state_name) {
		my $osn = $state_names{$pp_base_state_name}; # Old state number
		my $oin = $shared_ilist_for_state{$osn}; # The old inventory number
		if (! defined $oin) {			 # If it isn't sharing, use its state number
		    $oin = $osn;
		}
		if ($share_ilist) {		# Are we sharing the base state's list?
		    $shared_ilist_for_state{$pp_state_number} = $oin;
		}

		my $old_inventory = $state_ilists[$osn];
		if (!defined $old_inventory) {
		    die "Line $lineno:  Building state $pp_state_name from $pp_base_state_name:  No old inventory list found\n";
		}
		$$pp_new_inventory[0] = $$old_inventory[0];	# Default to the header text from the old inventory list
		foreach my $i (1..$#$old_inventory) { # Any old inventory item which hasn't already been added or deleted, we should add.
		    my $item = $$old_inventory[$i];
		    if (! $pp_new_inventory_flags{$item}) {
			push @$pp_new_inventory, $item;
		    }
		}
	    } elsif ($share_ilist) {
		die "State ${pp_state_name}, ${pp_state_number}: We're supposed to share the ilist but there's no base state\n";
	    }
	    if ($htext) {			# If we have new header text, pick it up now (overwrite any old header)
		$$pp_new_inventory[0] = $htext;
	    }

	    if ($debug) { print STDERR "Set state $pp_state_name inventory to $#$pp_new_inventory elements, first is $$pp_new_inventory[0]\n"; }

	    if (!$share_ilist) {
		if ($debug) { print STDERR "State $pp_state_name, number $pp_state_number, got its own inventory list\n"; }
		$state_ilists[$pp_state_number] = $pp_new_inventory; # Save the list if we're not sharing.
	    } elsif ($debug) {
		if ($debug) { print STDERR "State $pp_state_name, number $pp_state_number, is sharing ilist $shared_ilist_for_state{$pp_state_number} \n"; }
	    }
	    $pp_text = "";
	    $pp_defining = 0;
	    $pp_defining_state = 0;
	    $pp_state_name = undef;
	    $pp_base_state_name = undef;
	    $pp_new_inventory = [""];
	    %pp_new_inventory_flags = ();
	} elsif ($line =~ /^#/ &&
		 ($line !~ /^#(?:end)?if/ && $line !~ /#\?/ && $line !~ /^#else/)) { # We skip the conditionals for now.
	    die "Line $lineno: Unexpected preprocessor directive while defining a macro or state: '$line'\n";
	} else {
	    if ($pp_text ne "") {
		$pp_text .= "\n";
	    }
	    $pp_text .= "${line}";
	}
	return 1;
    } elsif ($line =~ /^#defbegin/) {
	if ($line =~ /^#defbegin\s+(.*?)\((.*?)\)\s*$/) { # Macro with an argument list
	    my ($al) = ($2);
	    $pp_name = $1;
	    if ($debug) { print STDERR "preprocess_defs: Defining macro '$pp_name' with args '$al'\n"; }
	    my @args = split /,/, $al;
	    $macro_args{$pp_name} = \@args;
	    $pp_defining = 1;
	} elsif ($line =~ /^#defbegin\s+(.*?)\s*$/) {
	    $pp_name = $1;
	    if ($debug) { print STDERR "preprocess_defs: Defining macro '$pp_name' with no arguments\n"; }
	    $pp_defining = 1;
	} else {
	    die "preprocess_defs: Line $lineno: Didn't understand line $line\n";
	}
	return 1;
    } elsif ($line =~ /^#define\s*(.*)/) {
	define_macro ($1);
	return 1;
    } elsif ($line =~ /^\#state\s* \(		# State begin tag
		      \s* (.*?) \s*		# State name
		      (?:,\s* (.*?) \s*)?	# Optional name of state on which to build it
		       \)\s*$/x) {
	$pp_state_name = $1;
	$pp_base_state_name = $2;
	$pp_defining_state = 1;
	$pp_defining = 1;
    } elsif ($line =~ /^#(?:end)?if/ || $line =~ /#\?/ || $line =~ /^#else/) { # We skip the conditionals for now.
	return 0;
    } elsif ($line =~ /^#[a-zA-Z]/) {
	die "preprocess_defs:  line $lineno: Didn't understand '$line'\n";
    }

    return 0;
}

# ****************************************************************
# Expand all macros in an array of lines and return the newly expanded
# array along with a flag indicating whether we did anything
#

sub expand_macros_once ($$$) {
    my ($lineno,$input,$show) = @_;
    my $expanded_something = 0;
    my @output = ();

    foreach my $i (0..$#$input) { # We don't use "foreach <elt> (array)" 'cause it gives us a live copy of the line, I think
	my $l = $$input[$i];
	my $expanded_this_line = 0;
	#
	# Expand the simple ones...
	#
	foreach my $k (keys %simple_macros) {
	    if ($l !~ /\Q$k\E\b/) { next; }		# We do NOT require a word break BEFORE the macro, only after
	    $expanded_this_line = 1;
	    my $v = $simple_macros{$k};
	    if ($macro_args{$k}) {
		if ($l !~ /(\Q$k\E\s*\((.*?)\))/) {
		    die "Argument list missing, expanding macro '$k' near line $lineno\n";
		}
		my $sub_for = $1;
		my @actuals = split /,/,$2;
		my $formals = $macro_args{$k};
		if ($#$formals != $#actuals) { die "expand_macro_once(line ~ $lineno) Wrong number of arguments for '$k', expanding '$l'\n"; }
		foreach my $j (0..$#$formals) {	# As with the macro defs, we don't require a word break *before* the arg.
		    my $formal = $$formals[$j];
		    my $actual = $actuals[$j];
		    $v =~ s/\Q${formal}\E\b/${actual}/g; # Substitute into the macro definition
		}
		$l =~ s/\Q$k\E\s*\(.*?\)/$v/;	# Do NOT use '/g' here, as we need to re-eval the actuals every time
	    } else {
		$l =~ s/\Q$k\E\b/$v/g;
	    }
	}
	foreach my $k (keys %state_names) {
	    if ($l !~ /\Q$k\E\b/) { next; }		# We require a word boudary at the END of the state name, not the beginning!!
	    my $v = $state_names{$k};
	    $l =~ s/\Q$k\E\b/$v/g;
	}

	# We may have a multiline expansion.  To make sure things work right we need to split it into lines.
	if (!$expanded_this_line)  { # If we didn't expand it just put it on the output intact
	    push @output, $l;	     # If we try to split it we kill blank lines.
	} else {
	    $expanded_something = 1; # If we expanded it, split it into lines
	    my @lines = split /\n/,$l;
	    foreach my $j (0..$#lines) {
		chomp (my $piece = $lines[$j]);
		if ($j != $#lines || $piece ne "") { # Do NOT push the 'extra' blank line we get courtesy of split
		    push @output, "$piece";
		}
	    }
	}
    }
    return ($expanded_something,\@output);
}

# ****************************************************************
# Expand all macros in an array of lines repeatedly until it settles down

sub expand_macros ($$$) {
    my ($lineno,$lines,$show) = @_;
    my $expanded_something = 1;
    while ($expanded_something) {
	$expanded_something = 0;
	($expanded_something, $lines) = expand_macros_once ($lineno, $lines, $show);
    }
    return $lines;
}

# ****************************************************************
# Handle conditionals.  We do this very late so all expansions have already
# been done, and we can, consequently, conditionalize on the current state.
# We do this a line at a time because the room parser is doing its own substitutions
# a line at a time, and we need to get hold of the lines *after* that substitution
# has been done, since that's what puts the current state values into the text.
#
# An if/else/endif can span macro boundaries, which is weird; it's because we
# process the conditionals after macro expansion.
#
# Returns 1 if it eats the line, 0 otherwise.
#
# Nesting is the obvious, with else/endif associated with the nearest if.
#

#
# We're not called from a recursive descent parser here and we have no convenient way
# to recurse so we're just going to handle the nesting manually
#
my $pp_nest_level = 0;
my @saved_pp_start_line;
my @saved_pp_condition_skipping;
my @saved_pp_inside_if;
my @saved_pp_skip_else;
my @saved_pp_skip_whole_thing;

my $pp_start_line;
my $pp_condition_skipping;
my $pp_inside_if;
my $pp_skip_else;
my $pp_skip_whole_thing;			# Set => we're skipping a nested if construct

sub handle_conditions ($$) {
    my ($lineno, $line) = @_;
    my $result = 0;
    if ($debug) { print STDERR "handle_conditions(lineno=$lineno): '$line'\n"; }

    if ($line =~ /^#if\b/ && $pp_inside_if) {	# Whoops -- recursion time!
	push @saved_pp_start_line, $pp_start_line;
	push @saved_pp_condition_skipping, $pp_condition_skipping;
	push @saved_pp_inside_if, $pp_inside_if;
	push @saved_pp_skip_else, $pp_skip_else;
	push @saved_pp_skip_whole_thing, $pp_skip_whole_thing;

	if ($pp_condition_skipping) { $pp_skip_whole_thing = 1; } # If not skipping leave this set to whatever it was set to
	$pp_start_line = undef;
	$pp_condition_skipping = undef;
	$pp_inside_if = undef;
	$pp_skip_else = undef;

	$pp_nest_level++;
    }

    if (! $pp_inside_if) {
	if ($line =~ /^#else/ || $line =~ /^#endif/) {
	    die "WHOOPS -- line $lineno, text '$line': else or endif not inside an if\n";
	}
	if ($line =~ /^#if\b/) {
	    if ($debug) { print STDERR "Found 'if' at line $lineno\n"; }
	    $pp_start_line = $lineno;
	    $result = 1;
	    $pp_inside_if = 1;
	    $pp_skip_else = 1;
	    if ($line =~ /^#if\s*\((.*)\)\s*$/) {
		my $ok = eval_expr ($lineno,$1);
		if (! $ok) {
		    $pp_condition_skipping = 1;
		    $pp_skip_else = 0; # We will NOT skip the else
		}
	    } else {
		die "handle_conditions: Somewhere around $lineno: Didn't understand '$line'\n";
	    }
	}
    } elsif ($line =~ /^#elseif\b/) {
	$result = 1;
	if ($line =~ /^#elseif\s*\((.*)\)\s*$/) {
	    $pp_condition_skipping = $pp_skip_else; # If we had an accepted if, then we're skipping all else clauses
	    if (! $pp_condition_skipping) {	    # Not just skipping -> check the condition
		$pp_condition_skipping = ! eval_expr ($lineno,$1);
	    }
	    if (! $pp_condition_skipping) {
		$pp_skip_else = 1; # We want to skip any further 'else' clauses in this if, if we don't skip this one.
	    }
	} else {
	    die "handle_conditions: Somewhere around $lineno: Didn't understand '$line'\n";
	}
    } elsif ($line =~ /^#else\b/) {
	$pp_condition_skipping = $pp_skip_else;
	$result = 1;
    } elsif ($line =~ /^#endif\b/) {
	$pp_condition_skipping = 0;
	$pp_skip_else = 0;
	$pp_inside_if = 0;
	$result = 1;

	if ($pp_nest_level) {			# Time to pop the old state back
	    $pp_start_line = pop @saved_pp_start_line;
	    $pp_condition_skipping = pop @saved_pp_condition_skipping;
	    $pp_inside_if = pop @saved_pp_inside_if;
	    $pp_skip_else = pop @saved_pp_skip_else;
	    $pp_skip_whole_thing = pop @saved_pp_skip_whole_thing;

	    $pp_nest_level --;
	}
    } elsif ($pp_condition_skipping || $pp_skip_whole_thing) {
	$result = 1;
    } else {			# In this case we're in an 'if' but we're not skipping it.
	$result = 0;
    }
    return $result;
}

# ****************************************************************
# Call as: parse_room_worker ($sub_for, $to_term, $room_p, $room_start_line, $show);
#
# We have one (or more) builtin macro(s) as well.  We expand them here after all
# other expansions are done, because we want to be able to look up room names, and
# the room names are built from the state tag which is substituted in here when
# we instantiate the room.
#
# .RINDEX (room-name)  ... Expands into the (final, optimized) room number for "room-name"
#		     Note that if "room-name" is written as "Smoof-fooble-X" where "X" is
#		     the current room state, "X" must be substituted BEFORE .RINDEX is
#		     expanded, or it won't work.
#

my $roomno;
##my @room;
my @from_strings;
my @to_strings;

sub parse_room_worker ($$$) {
    my ($room, $room_start_line, $show) = @_;

    my $lineno = $room_start_line;
    my $get_room_name = 1;
    my $parsed_room = "";

    if ($debug) {
	print STDERR "parse_room_worker called for room at line $room_start_line with $#from_strings translations\n";
	foreach my $t (0..$#from_strings) {
	    print STDERR "   $from_strings[$t] --> $to_strings[$t]\n";
	}
    }

    $roomno++;
    foreach my $raw_l (@$room) {
	$lineno++;
	my $line = $raw_l;		# Copy it so we don't bash the original
	if (scalar(@from_strings)) {	# If we've got some substitutions to perform
	    foreach my $s (0..$#from_strings) {
		my $f = $from_strings[$s];
		my $t = $to_strings[$s];
		$line =~ s/\b${f}\b/${t}/g;	# For the state tags we require a word break before AND after
	    }
	}
	if (handle_conditions ($lineno,$line)) {
	    next;
	}
	if ($get_room_name) {
	    if ($line =~ /=/) { # If there's an equals, it's a substitution spec and not a room name.
		next;
	    }
	    $get_room_name = 0;
	    if ($line !~ /^(?: \|\{\{ )?
			   ( [a-z0-9-_]+ )
			   (?: \}\}= )?
			 /xi) {
		if ($line =~ /Dummy/) { # This is the dummy room at the end.  Discard it.
		    $get_room_name = 0;
		    $roomno --;
		    next;
		}
		die "Room name not found where expected on line $lineno\n";
	    }
	    my $rn = $1;
	    if (!$show) {
		if ($room_names{$rn}) {
		    die "Room $rn already defined at line $lineno\n";
		}
		if ($debug) { print STDERR "Setting $rn to number $roomno\n"; }
		$room_names{$rn} = $roomno;
	    } else {
		if (!defined $room_names{$rn}) {
		    die "On show pass, and room $rn not defined when we got to it\n";
		}
		if ($roomno != $room_names{$rn}) {
		    die "On show pass, and room number of '$rn' changed from $room_names{$rn} to $roomno\n";
		}
	    }
	    if ($cv_to_singlefile) {
		if ($show && $optimize) {
		    $parsed_room .= "|$alpha_room_ids{$rn}=\n";
		} else {
		    $parsed_room .= "|{{TheStenchIndex|${rn}}}=\n";
		}
	    } else {
		$parsed_room .= "$rn\n";
	    }
	} else {
	    #
	    # Expand our builtin macro(s).  They (or it) are wired in, hard coded, right here.
	    #
	    my $rname_macro = ".RINDEX";		# That's "Room Index"
	    while ($line =~ /${rname_macro}\s*\((.*?)\)/) {
		my $rn = $1;
		my $rnum = $alpha_room_ids{$rn};
		if (! defined $rnum) {
		    if ($show) { die "expand_macros_once, at line ${lineno}: ${rname_macro}(${1}): Room not defined\n"; }
		    $rnum = -1;
		}
		$room_used{$rn} = 1;		# Macro argument counts as a use of the room name
		$line =~ s/${rname_macro}\s*\((.*?)\)/$rnum/;
	    }

	    $rname_macro = ".ILIST";		# Inventory list for a state
	    while ($line =~ /${rname_macro}\s*\((.*?)\)/) {
		my $inum = $shared_ilist_for_state{$1};
		if (! defined $inum) {
		    $inum = $1;
		}
		$line =~ s/${rname_macro}\s*\((.*?)\)/$inum/;
	    }

	    if ($line =~ /(.*?) \[\[\.\.\/		# Lex out a link.  Start with stuff on the line before the link
			   (.*?) \| (.*)		# The pipe link itself ($2 and $3)
			   \]\] (.*)/x) { # Trailing stuff on the line
		my $line_prefix = $1;
		my $rname = ucfirst($2);
		my $link_text = $3;
		my $line_suffix = $4;
		if ($show && !defined($room_names{$rname})) {
		    print STDERR "Whoops! Room '$rname' at line $lineno is not defined!\n";
		} 
		$room_used{$rname} = 1;	# Note that someone links to this room
		if ($cv_to_singlefile) {
		    if (! $optimize) {
			$parsed_room .= "${line_prefix}{{Goto|{{TheStenchIndex|${rname}}}|${link_text}}}${line_suffix}\n";
		    } elsif ($show && defined $room_names{$rname}) {
			$parsed_room .= "${line_prefix}{{Goto|$alpha_room_ids{$rname}|${link_text}}}${line_suffix}\n";
		    } else {
			$parsed_room .= "${line_prefix}{{Goto|-1|${link_text}}}${line_suffix}\n";
		    }
		} else {
		    $parsed_room .= "${line_prefix}[[../${rname}|${link_text}]]${line_suffix}\n";
		}
	    } else {
		$parsed_room .= "${line}\n";
	    }
	}
    }
    push @room_array, $parsed_room;
}

# ****************************************************************
#
# Args:
#
#  \@room_line_array
#  \@subst_arrays
#  $room_start_line
#
# Pass in an array of lines, which is the room spec, and an array of substititions
# to be made, where each sub is a pair "string", "string".
# It also takes a starting line number, so it can figure out what line number to complain
# about when there's an error.

sub parse_room ($$$) {
    my ($room, $room_start_line, $show) = @_;

    #
    # I have no idea why, but we're getting an undef in slot 0 of room, apparently coming from nowhere.
    # --> I was setting the list to undef (aka "(undef)") instead of "()"  whoops
    # if (0 && !defined $$room[0]) { shift @$room; }

    if ($debug) {
	my $n = 0;
	print STDERR "Room (with $#$room + 1 lines):\n";
	foreach my $l (@$room) {
	    $n++;
	    print STDERR "Line $n: '${l}'\n";
	}
	print STDERR "End room.\n";
    }
    
    $room = expand_macros ($room_start_line, $room, $show); # Expand everything in it so we can parse it after expansion
    if ($debug) {
	my $n = 0;
	print STDERR "Room after macro expansion (with $#$room + 1 lines):\n";
	foreach my $l (@$room) {
	    $n++;
	    print STDERR "Line $n: '${l}'\n";
	}
	print STDERR "End room.\n";
    }

    @from_strings = ();
    @to_strings = ();

    my @to_string_list;
    my $line = $$room[0];
    if ($debug) {
	my $rl = scalar (@$room);
	print STDERR "Room lines: $rl; Line: $line\n";
    }
    if ($line =~ /^\s*(.+?)\s*=\s*(.+?)\s*(?:,(.*))?/) { # Sub strings of form "A = B, ..."
	my $how_many;
	while (defined $line && $line =~ /^ \s*(.+?)\s* = \s*(.+?)\s*
					    (?:;(.*))? $/x
	      ) {
	    my $sub_for = $1;
	    my @sub_to_list = split /,/,$2;
	    if (!defined $how_many) {
		$how_many = scalar(@sub_to_list); # Note this.  We use the number on the first list.
	    }
	    push @from_strings, $sub_for;	 # Array of from strings
	    push @to_string_list, \@sub_to_list; # Array of target lists

	    $line = $3;	# discard the head, which we've already used
	}
	foreach my $t (0..$how_many-1) { # For each target, set up the translations for one instantiation
	    foreach my $i (0..$#from_strings) { # Set up the global "to" list
		my $tl = $to_string_list[$i];
		$to_strings[$i] = $$tl[$t]; # Pick the current translation off the list for this 'from' variable
		if (! defined $to_strings[$i]) {
		    $to_strings[$i] = $$tl[0]; # Use the first one if we've run off the end.
		}
	    }
	    if ($debug) {
		print STDERR "Substituting for one instantiation:\n";
		foreach my $s (0..$#from_strings) {
		    print STDERR "  $from_strings[$s] --> $to_strings[$s]\n";
		}
	    }
	    parse_room_worker ($room, $room_start_line, $show);
	}
    } else {
	if ($debug) { print STDERR "Calling parse_room_worker with no translation\n"; }
	parse_room_worker ($room, $room_start_line, $show);
    }
}

# ****************************************************************
sub parse_file ($) {
    my ($show) = @_;
    print STDERR "parse_file(show=$show)\n";

    @room_array = ();
    $roomno = -1;

    my $room_line_no = 0;
    my $lineno = 0;
    my @room = ();
    my $in_room = 0;
    my $input_room_count = 0;

    open INFILE, $filename or die "Can't open input file";
    while (my $line = <INFILE>) {
	chomp($line);
	$lineno++;
	if (preprocess_defs($lineno,$line)) {
	    next;
	}
	if ($line =~ /^(<!--\s*)?=============*(\s*-->)?$/) {
	    if ($debug) { print STDERR "Found a room divider\n"; }
	    $in_room = 1;
	    if (scalar(@room) > 0) {	# Do we have an old one which needs to be parsed?
		if ($debug) { print STDERR "At line $lineno: Looks like room was defined, with last line $#room, so we're parsing it\n"; }
		parse_room (\@room, $room_line_no, $show);
		$input_room_count ++;
	    }
	    @room = ();
	    $room_line_no = $lineno; # Starting line number for the next room
	} elsif ($in_room) {
	    if ($debug) { print STDERR "Pushing line '$line' into room\n"; }
	    push @room, $line;
	}
    }
    close INFILE or die "Error closing file $filename";

    # If we had a last room which wasn't appended, append it now
    if (scalar(@room) > 0) {
	if ($debug) { print STDERR "At line $lineno: Looks like room was defined so we're parsing it\n"; }
	parse_room (\@room, $room_line_no, $show);
	$input_room_count ++;
	@room = ();
    }

    #
    # And now, add a "room" for each state, containing the inventory for that state
    #
    foreach my $s (sort keys %state_names) {
	$room_line_no = $lineno;
	@room = ();
	my $snumber = $state_names{$s};
	my $inv = $state_ilists[$snumber];
	if (defined $shared_ilist_for_state{$snumber}) {
	    next;			# Skip states that share someone else's inventory list
	}
	if (!defined $inv) {
	    print STDERR "Shared ilists:\n";
	    foreach my $k (keys %shared_ilist_for_state) {
		print STDERR "  $k --> $shared_ilist_for_state{$k}\n";
	    }
	    die "State $s, number $snumber, has no inventory list\n";
	}
	push @room, "================================================================";
	$lineno++;
	push @room, "01-Inventory-${snumber}";
	$lineno++;
	push @room, "<!-- Inventory for state $snumber -->";
	$lineno++;
	foreach my $line (@$inv) {
	    push @room, $line;
	    $lineno++;
	}
	push @room, ".NOINVENTORY";
	$lineno++;
	parse_room (\@room, $room_line_no, $show);
    }

    if ($show) {
	if ($cv_to_singlefile) {
	    if (defined $simple_macros{".TITLE"}) {
		chomp(my $ttext = $simple_macros{".TITLE"});
		print "{{title|${ttext}}}\n";
	    }
	    print "{{#switch:{{Get}}\n";
	}

	my $output_room_count = 0;
	foreach my $k (sort keys %room_names) {
	    if ($debug) { print STDERR "Printing room $k, key $room_names{$k}\n"; }
	    my $r = $room_array [$room_names{$k}];
	    $output_room_count++;
	    if ($cv_to_singlefile) {
		if (! $optimize) {
		    print "<!--================================================================-->\n";
		}
	    } else {
		print "================================================================\n";
	    }
	    print $r;
	}

	if ($cv_to_singlefile) {
	    $output_room_count++;
	    print "<!--================================================================-->\n";
	    print "<!-- Dummy room to soak up gotos that get lost in space -->\n";
	    print "|\n";
	    if (defined $simple_macros{".DUMMY"}) {
		my $rv = $simple_macros{".DUMMY"};
		print "$rv\n";
	    } else {
		print "''You have fallen through a hole in the air.''\n";
		print "\n";
		print "''This room does not exist.''\n";
		print "\n";
		print "''There is just one exit from the room.''\n";
		print "\n";
		print "* [[Special:Random|Leave the room]]\n";
		print "* {{Goto|0|Start over}}\n";
		print "\n";
		print "{{TheStench}}\n";
	    }
	    print "}}\n";
	}
	print STDERR "Read $input_room_count rooms, emitted $output_room_count rooms\n";
    }
}

# ****************************************************************

parse_file (0);		# Build the index

# Build the sorted index, which we use for optimized output as well as for dumping the index
my $room_no = 0;
foreach my $r (sort keys %room_names) {
    $alpha_room_ids{$r} = $room_no;
    $room_no++;
}

# If we're building the file, do that now
if (! $index_only) {
    parse_file (1);

    my $had_orphans = 0;
    foreach my $k (sort keys %room_names) {
	if (! defined $room_used{$k}) {
	    if (!$had_orphans) {
		print STDERR "Orphaned rooms:\n";
	    }
	    $had_orphans++;
	    print STDERR "  ${k}\n";
	}
    }
    my $had_undefs = 0;
    foreach my $k (sort keys %room_used) {
	if (! defined $room_names{$k}) {
	    if (!$had_undefs) {
		print STDERR "Undefined rooms:\n";
	    }
	    $had_undefs ++;
	    print STDERR "  ${k}\n";
	}
    }
    print STDERR "Total undefined rooms: ${had_undefs}; Total orphaned rooms: ${had_orphans}\n";
}

# If we're building the index, dump it
if ($index_only) {
    print "<noinclude>Template to convert room name to index</noinclude>\n";
    print "{{#switch: {{{1}}}\n";
    foreach my $r (sort keys %room_names) {
	print "| $r = $alpha_room_ids{$r}\n";
	$room_no++;
    }
    print "| -1}}\n\n";
    print "<noinclude>[[Category:Templates]]</noinclude>\n";
}