IllogiGames:Celestial Pirates/Cv dungeon
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";
}