#!/usr/bin/perl

use strict;
my $exec_path = $0;
$exec_path =~ s|/[^/]*$|/|;
if ($exec_path eq $0) { $exec_path = ""; }
print "\${0} == '$0', \$exec_path == '$exec_path'.\n";
require $exec_path."parse-taf2.pl";
require $exec_path."inf-grammar.pl";

my ($gramfil, $customfil) = ('', ''); # FILES WITH SPECIAL GRAMMAR ROUTINES
my ($fn, $fileroot) = ('', '');

# my $fn = $ARGV[0];

my $OUTPUT_TO_CONSOLE = 0;
my $OUTPUT_ARROWS = 1;
my $GUESS_PARSE = 1;
my $SIMPLE_CONV = 1;
my $USE_STATIC_ALR = 1;
my $USE_ENDGAME = 1;
my $SWALLOW_TASKS = 1;
my $USE_HTML = 1;

my %capacities = ();

for (my $n = 0; $n < @ARGV; $n ++) {
    my $l = $ARGV[$n];
    if ($l eq '-help') {
	my $i="          ";
	print "Options:  -no-static-alr\n${i}-console-out\n${i}-no-parse\n${i}-gram (filename)\n${i}-custom (filename)\n${i}-gram=(filename)\n${i}-custom=(filename)\n${i}-no-swallow\n${i}-no-html\n";
	exit;
    } elsif ($l eq '-no-static-alr') {
	$USE_STATIC_ALR = 0;
    } elsif ($l eq '-console-out') {
	$OUTPUT_TO_CONSOLE = 1;
    } elsif ($l eq '-no-parse') {
	$GUESS_PARSE = 0; 
    } elsif ($l eq '-gram') {
	$gramfil = $ARGV[++$n];
    } elsif ($l eq '-no-swallow') {
	$SWALLOW_TASKS = 0;
    } elsif ($l =~ /^-no-html/) {
	$USE_HTML = 0;
    } elsif ($l eq '-custom') {
	$customfil = $ARGV[++$n];
    } elsif ($l =~ /^-gram=(.*)$/) {
	$gramfil = $1;
    } elsif ($l =~ /^-custom=(.*)$/) {
	$customfil = $1;
    } elsif ($l =~ /^-/) {
	die "Bad option '$l' in arguments\n";
    } else {
	$fn = $l;
    }
}
if ($fn eq '') { die "No taf file given\n"; }

#print "\$gramfil == '$gramfil', \$customfil == '$customfil', \$fn == '$fn'\n";

if ($fn =~ /(.*)\.taf$/i) {
    $fileroot = $1;
} else {
    die "Filename '$fn' doesn't have .taf extension.\n";
}


my %parsing_small_words = map { $_ => 1 } qw/in on of a the/;

#print "Loading $fn\n";
##$| = 1;  # Autoflush
my $root = parsefile ($fn);

#print "Dumped tree == \n";dumptree ($root, 0); print "\n*******\n";
#my $root = {};
#die "\n *** Finished reading *** \n";

#$| = 1;  # Autoflush

sub uniqify { # Remove all duplicates
    #sort keys %{(map { $_ => 1 } @_)};
    my %tmp = map { $_ => 1 } @_;
    sort keys %tmp;
}

my %small_words = map { $_ => 1 } (qw/a an of in on the and A An Of In On The And/, '');
my @size_words = qw/S_Tiny S_Small S_Normal S_Large S_Huge/;
my @weight_words = qw/W_VLight W_Light W_Normal W_Heavy W_VHeavy/;
sub expt { 
    my ($n, $pow, $rv) = @_; 
    $rv = 1;
    while ($pow > 0) { 
	$rv *= $n; 
	$pow --; 
    } 
    return $rv; 
}

sub id {
    my $obj = shift;
    return defined $obj ? $obj : "(undef)";
}

sub clipcond {
    my $s = shift;
    return (substr ($s, 0, 1) eq '(') ? clip($s) : $s;
}

sub clip {
    my $s = shift;
    return substr ($s, 1, length($s) - 2); 
}

sub check_rooms {
    #    print "Checking rooms after ", shift, ": ";
    my $when = shift;
    foreach my $r (@{$root->{Rooms}}) {
	if (ref $r ne 'ROOM') {
	    die "ERROR: Non-room in Rooms after $when!\n";
	}
    }
    foreach my $r (@{$root->{Objects}}) {
	if (ref $r ne 'OBJECT') {
	    die "ERROR: Non-object in Objects after $when!\n";
	}
    }
    foreach my $r (@{$root->{NPCs}}) {
	if (ref $r ne 'NPC') {
	    my $v = $r;
	    if (ref $r eq 'HASH') { $v = '{'.join (",", %$r).'}'; }
	    if (ref $r eq 'ARRAY') { $v = '['.join (",", @$r).']'; }
	    die "ERROR: Non-npc ($v) in NPCs after $when !\n";
	}
    }
    print "All hashtables OK! after $when\n";
}

my %adrift_objects = ();
my %inform_objects = ();
my %inform_object_count = ();
sub reduce_name {
    my $str = shift;
    
    $str =~ s/<[^>]*>//g;         # Remove html
    #print "Remove HTML -> ($str)\n";
    $str =~ s/\'//g;
    $str =~ s/[^_A-Za-z0-9 ]/ /g;  # Remove all non-alphanumeric chars
    #print "Remove non-alnum -> ($str)\n";
    $str =~ tr/A-Z-/a-z_/;          # Lowercase
    #print "Upper to lower -> ($str)\n";
    
    my @words = grep { !$small_words{$_} } (split / /, $str);
    if (@words) { $str = join "_", @words; } else { $str = 'obj'; }
    $str =~ s/__+/_/g;
    if (length($str) > 29) { $str = substr ($str, 0, 28); }
    
    if ($str =~ /^[_0-9]/) { $str = 'x'.$str; } # Prepend with letter if needed
    #print "Prepend letter -> ($str)\n";
    return $str;
}

sub get_inform_name {
    my ($str, $ht, $type) = @_;
    #print "gin($str)\n";
    if (!$ht) { $ht = 1; }
    if (!$type) { $type = 'Object'; }
    $str = reduce_name ($str);
    
    if ($adrift_objects{$str}) {
	#my %inform_object_count = ();
	my $n = $inform_object_count{$str};
	#print "($str, $n, ";
	if (!defined $n) { $n = 1; }
	while ($adrift_objects{$str . $n}) { ++ $n; }
	#print "$n)  ";
	$inform_object_count{$str} = $n + 1;
	$str = $str . $n;
    }
    $adrift_objects{$str} = $ht;
    if (ref $ht) { 
	$ht->{iname} = $str; 
	$inform_objects{$str} = { iname => $str, ht => $ht, class => [$type], attribs => []}; 
    }
    #print "Returning ($str)\n";
    return $str;
}
map { get_inform_name ($_, 1, 1); } (qw/Object Item Room Class Character Event Task Initialise Globals RoomGroup playerobj timer walk curwalk door before after runtask nothing daemon Banner/, @size_words, @weight_words);
my $playerobj = $inform_objects{playerobj} = { iname=>'playerobj', class=>['Character'], print_name=>'"yourself"', attribs=>['concealed'] };

print "Choosing Inform names\n";
#foreach (@{$root->{Tasks}}) { get_inform_name ('task', $_, 'Task'); }
for (my $n = 0; $n < @{$root->{Tasks}}; $n ++) {
    $root->{Tasks}->[$n]->{number} = $n;
    my $iname = get_inform_name ('task', $root->{Tasks}->[$n], 'Task');
    $inform_objects{$iname}->{run_name} = get_inform_name ('runtask', 1, 1);
    #$root->{Tasks}->[$n]->{run_name} = get_inform_name ('runtask', 1, 1);
}
foreach (@{$root->{RoomGroups}}) { 
    my $in = get_inform_name('RG_'.$_->{Name}, $_, 'RoomGroup'); 
    $_->{iname} = uc ($in);
    $adrift_objects{$_->{iname}} = $adrift_objects{$in};
}
foreach (@{$root->{Rooms}}) { get_inform_name ($_->{Short}, $_, 'Room'); }
foreach (@{$root->{Objects}}) { get_inform_name ($_->{Prefix}.' '.$_->{Short}, $_, 'Item'); }
foreach (@{$root->{NPCs}}) { get_inform_name ($_->{Name}, $_, 'Character'); }
#my %reserved_names = ();
#foreach (@{$root->{Rooms}}) { ++ $reserved_names{reduce_name($_->{Short})}; }
#foreach (@{$root->{Objects}}) { ++ $reserved_names{reduce_name($_->{Short})}; }
#foreach (@{$root->{NPCs}}) { ++ $reserved_names{reduce_name($_->{Name})}; }
foreach (@{$root->{Variables}}) { get_inform_name($_->{Name}, $_, 'Var'); }
foreach (@{$root->{Events}}) { get_inform_name ($_->{Short}, $_, 'Event'); }

my ($imnum, $sndnum, %images, %sounds, @images, @sounds) = (3, 3);

#if (@{$root->{ResourceList}}) {
#    print "RHolder == {", join (", ", %{$root->{ResourceHolder}}), "}\n";
#    print "RList == [", join (", ", @{$root->{ResourceList}}), "]\n";
#}

# Need to internalize resources
# Don't internalize Globals, Synonyms, ALRs

#foreach (@{$root->{NPCs}}) {
#    my $vwords = join (" ", $_->{Prefix}, $_->{Name}, @{$_->{Alias}});
#    $vwords =~ tr/A-Z/a-z/;
#    $inform_objects{$_->{iname}}->{vocab} = [ split / /, $vwords ];
#}

print "inames chosen\n";

my @scored_tasks = ();

my (@sit_objects, @lie_objects, @static_objects, @dynamic_objects, 
    @surface_objects, @container_objects, @stateful_objects, @objects,
    @integer_vars, @string_vars, @wearable_objects, %vars,
    @npcs, @inform_npcs, @inform_objs) = ();
# @inform_npcs and @inform_objs are those objects manually created by taf2inf

push @inform_npcs, 'playerobj';
$inform_objects{playerobj}->{vocab} = ['me', 'self'];

{
    ##################################################################
    #                                                                #
    #  PUT ANY OBJECTS WHICH ARE TO BE ADDED TO THIS ADVENTURE HERE  #
    #                                                                #
    ##################################################################

    ### If you need any special objects, put them in tmp_objs.
    ### The properties will probably be constrained to 
    ###  print_name, vocab, attribs, scoped_by, parent
    ###     (you'll need to run the program more than once to get the inames
    ###        for scoped_by and parent)
    my @tmp_objs = ();
    
    ### This is similar, if you need to add additional characters
    my @tmp_npcs = (); 
    
    ### If taf2inf picks bad inames, you can change them here.
    ### For each item to be changed, put the default iname, then the 
    ### one you want. 
    my @change_inames = ();  
    
    ### If there are any objects which have funny print_name s, and
    ### they are used by ALRs, you may want to add them to %the_objs

    #print "\$customfil == '$customfil'\n";
    if ($customfil ne '') {
	my $FH;
	open $FH, $customfil or print "* * * No file '$customfil' * * *\n";
	my $txt = join ("", <$FH>);
	#print "\nEval-ing custom text ''$txt''\n\n";
	eval $txt;
	print "\$? == $?, \$! == $!, \$@ == $@\n";
	die $! if ($!);
	die $@ if ($@);
    }
    #die;

    if ($fn eq 'paint2.taf') {
	@tmp_objs = ({print_name=>"meteor", vocab=>['meteor']},
		     {print_name=>"pit", vocab=>['pit'], scoped_by=>'meteor1'},
		     );
    }

    if ($fn eq 'Goldilocks.taf') {
	@change_inames = ('blackened_metal_poker',           'poker',
			  'packet_frozen_pork_chops',        'frozen_chops',
			  'packet_medium_rare_pork_chops',   'cooked_chops',
			  'magic_porridge_pot',              'pot');
	$adrift_objects{task44}{Command} = ['get matches from matchbox'];
	$adrift_objects{task235}{Command} = ['cut pergola'];
	$adrift_objects{task237}{Command} = ['put oil on secateurs'];
	$adrift_objects{task238}{Command} = ['put oil on catch', 'put oil on window'];
	$adrift_objects{task243}{Command} = ['climb twenty foot pole'];
	$adrift_objects{task244}{Command} = ['turn on mechanism'];
	$adrift_objects{task246}{Command} = ['tell prince about beauty'];
	$adrift_objects{task250}{Command} = ['x cheese'];
	$adrift_objects{task251}{Command} = ['get oil can'];
	$adrift_objects{task255}{Command} = ['work out with dumbells'];
	$adrift_objects{task256}{Command} = ['x dynamite'];
	$adrift_objects{task257}{Command} = ['get sticks from toaster'];
    }    

    # CUSTOM AREA ENDS HERE
    
    for (my $n = 0; $n < @change_inames; $n += 2) {
	my ($old_iname, $new_iname)  = @change_inames[$n,$n+1];
	my $old_obj = $inform_objects{$old_iname};
	if (!defined ($old_obj)) {
	    print "Error changing inames: No object with $old_iname defined\n";
	} elsif (! ref $old_obj) {
	    print "Error changing inames: $old_iname wasn't an object\n";
	} elsif (defined $inform_objects{$new_iname}) {
	    print "Error changing inames: Have object named $new_iname\n";
	} else {
	    $old_obj->{iname} = $new_iname;
	    $inform_objects{$new_iname} = $old_obj;
	    delete $inform_objects{$old_iname};
	    if ($old_obj->{ht}) {
		$old_obj->{ht}->{iname} = $new_iname;
	    }
	    $adrift_objects{$new_iname} = $adrift_objects{$old_iname};
	    delete $adrift_objects{$old_iname};
	}
    }
    
    foreach my $o (@tmp_npcs) {
	my $in_name = defined($o->{iname}) ? $o->{iname} : $o->{print_name};
	my $real_iname = get_inform_name ($in_name, 1, 'Character');
	$o->{iname} = $real_iname;
	if (!defined ($o->{class})) { $o->{class} = ['Character']; }
	if (!defined ($o->{name}) && defined ($o->{vocab})) {
	    $o->{name} = join (" ", map { my $tmp = $_; $tmp =~ s/\'/^/g; if (length($tmp) == 1) { $tmp .= '//'; }; "'$tmp'" } @{$o->{vocab}});
	}
	$inform_objects{$real_iname} = $o;
	push @inform_npcs, $real_iname;
	my $par = $o->{parent};
	if ($par) {
	    if (!defined ($inform_objects{$par})) {
		print "Bad iname $par for parent of $real_iname\n";
	    } else {
		pushcontent ($par, $real_iname);
	    }
	}
    }
    
    foreach my $o (@tmp_objs) {
	my $in_name = defined($o->{iname}) ? $o->{iname} : $o->{print_name};
	my $real_iname = get_inform_name ($in_name, 1, 'Item');
	$o->{iname} = $real_iname;
	if (!defined ($o->{class})) { $o->{class} = ['Item']; }
	if (!defined($o->{name}) && defined ($o->{vocab})) {
	    $o->{name} = join (" ", map { my $tmp = $_; $tmp =~ tr/\'/^/; if (length($tmp) == 1) { $tmp .= '//'; }; "'$tmp'" } @{$o->{vocab}});
	    #$o->{name} = join (" ", map { length($_) == 1 ? "'$_//'" : "'$_'" } @{$o->{vocab}});
	}
	$inform_objects{$real_iname} = $o;
	push @inform_objs, $real_iname;
	my $par;
	if ($par = $o->{scoped_by}) {
	    if (!defined ($inform_objects{$par})) {
		print "Bad iname $par for scoper of $real_iname\n";
	    } else {
		pushscope($o->{scoped_by}, $real_iname);
		#delete $o->{scoped_by};
	    }
	} elsif ($par = $o->{parent}) {
	    if (!defined ($inform_objects{$par})) {
		print "Bad iname $par for parent of $real_iname\n";
	    } else {
		pushcontent ($par, $real_iname);
	    }
	}
    }
}


print "Special handling done\n";

##############################################################
#                                                            #
#           PREPARSE THE VARIOUS FUNCTION LINES              #
#                                                            #
##############################################################

my $VERBOSE_PREPARSE = 0;

sub expand_str {
    local $_;
    my $s = shift;
    if ($s =~ /^[-+!\"\#]/) { return ($s); } 

    my @tmp = expand_string ($s, [ split //, $s ], 0, length($s), "");
    return map { s/  +/ /g; s/^ +//; s/ +$//; $_ } @tmp;
}

# compute cartesian product of two lists (all strings formed by concatenating
#       a string from the first with a string from the second)
#
sub cprod { 
    my ($l1, $l2) = @_;
    my @rv = ();
    foreach my $x (@$l1) { push @rv, map { $x . $_ } @$l2; }
    return @rv;
}

# Workhorse function for expand_str
#    Arguments are:  $str:          the string to be analyzed
#                    $astr:         reference to an array of the characters
#                    $start, $end:  which substring of $str to handle
#                    $prefix:       string prepended to all values
#
sub expand_string {
    my ($str, $astr, $start, $end, $prefix) = @_;
    my ($depth, $ch, $n) = (0);
    my @rv = ($prefix);
    my @tmp = ();
    
    for ($n = $start; $n < $end; $n ++) {
	$ch = $astr->[$n];
	if ($ch eq '{' || $ch eq '[') {
	    if ($depth == 0) {
		@tmp = $ch eq '{' ? (""):();
		$ch = '}';
		if ($start != $n) {
		    @rv = cprod (\@rv, [ substr ($str, $start, $n - $start)]);
		}
		$start = $n + 1;
	    }
	    ++ $depth;
	} elsif ($ch eq ']' || $ch eq '}') {
	    -- $depth;
	    if (0) { '['; }   # Balance quoted braces
	    if ($depth == 0) {
		push @tmp, expand_string ($str, $astr, $start, $n, "");
		@rv = cprod (\@rv, \@tmp);		
		$start = $n + 1;
	    }
	} elsif ($ch eq '/' && $depth == 1) {
	    push @tmp, expand_string ($str, $astr, $start, $n, "");
	    $start = $n + 1;
	}
    }
    return @rv if ($start == $end);
    return cprod (\@rv, [ substr ($str, $start, $end - $start) ]);
}

sub matchlist {
    my ($pattern, $objects) = @_;
    if (!defined $pattern) { return (); }
    if ($VERBOSE_PREPARSE) {
	print "      matchlist ($pattern, ";
	if (@$objects > 5) { print scalar @$objects, " objs"; }
	else { print join (", ", @$objects); }
	print ")\n";
    }
    if ($pattern eq '*') { return @$objects; }
    my @rv = ();
    if (!ref $pattern) {
	foreach my $o (@$objects) {
	    if ($VERBOSE_PREPARSE) {
		print "       matchlist: grep { \$_ eq $pattern } [(", join (") (", @{$inform_objects{$o}->{vocab}}), ")] -> [(", join (") (", grep { $_ eq $pattern } @{$inform_objects{$o}->{vocab}}), ")]\n";
	    }
	    if (grep { $_ eq $pattern } @{$inform_objects{$o}->{vocab}}) {
		push @rv, $o;
	    }
	}
    } else {
	my $p = $$pattern;
	foreach my $o (@$objects) {
	    ###dumptree($inform_objects{$o}, 2);
	    if ($VERBOSE_PREPARSE) {
		print "       matchlist: grep { \$_ =~/$p/ } [(", join (") (", @{$inform_objects{$o}->{vocab}}), ")] -> [(", join (") (", grep { $_ =~ /$p/ } @{$inform_objects{$o}->{vocab}}), ")]\n";
	        print "\$pattern == $pattern\n";
	    }

	    if (grep { $_ =~ /$p/ } @{$inform_objects{$o}->{vocab}}) {
		push @rv, $o;
	    }
	}
    }
    if ($VERBOSE_PREPARSE) { print "          -> ", join (", ", @rv), "\n"; }
    return @rv;
}

my %grammar = get_grammar($gramfil); # From inf-grammar.pl

my @life_acts = qw/Attack Kiss WakeOther Ask Tell Answer/;
#my @room_acts = (qw/-1 -2 REFCHAR REFOBJ REFNUM n_obj s_obj e_obj w_obj
#		 nw_obj ne_obj sw_obj se_obj u_obj d_obj in_obj out_obj/);
my @room_acts = (qw/-1 REFCHAR REFOBJ REFNUM n_obj s_obj e_obj w_obj
		 nw_obj ne_obj sw_obj se_obj u_obj d_obj in_obj out_obj/);
sub parse_line {
    my ($t, @tokens) = @_;
    my ($actor) = ('player');

    my $curtoken = 0;
    my $nonwild = 0;
    my $goodscope = '1';

    my @actors = (@npcs, @inform_npcs);
    ###print "Parsing actor: \@npcs == (", join (", ", @npcs), "); \@inform_npcs == (", join (", ", @inform_npcs), "); \@actors == (", join (", ", @actors), ")\n";
    my @tmp = matchlist ($tokens[0], \@actors);
    while (@tmp) {
	@actors = @tmp;
	if ($tokens[$curtoken] ne '*') { $nonwild = 1; }
	@tmp = matchlist ($tokens[++$curtoken], \@actors);
    }
    if ($curtoken > 0 && $nonwild == 1) {
	#print "Possible actors are (", join (", ", @actors), ") pre-scope\n";
	#my @actors1 = grep { check_scope_char($t, $_) } @actors; # CAAS
	my @actors1 = grep { check_scope_char($t, 'playerobj', $_) } @actors;
	#print "Possible actors are (", join (", ", @actors), ") post-scope\n";
	if (@actors1 == 1) {
	    $actor = $actors[0];
	} elsif (@actors1 == 0 && @actors == 1) {
	    $goodscope = '0';
	    $actor = $actors[0];
	} else {
	    $curtoken = 0;
	}
    }
    #if ($actor) { 
    #	print "Matched actor (<", join ("> <", @tokens[0..$curtoken-1]), ">) ";
    #}
    #print "Rest is (<", join ("> <", @tokens[$curtoken..$#tokens]), ">)\n";

    my $tmp = match_gramline ( $t, [$goodscope], [ 'noun=ADirection' ], 
			   [ @tokens[$curtoken..$#tokens] ] );
    if ($tmp) {
	#print "  Matched as movement\n";
	#return ($actor, 'Go', @$tmp);
	my @tmp = ('Go', $tmp->[1], -1);
	if ($t->{Where}->{Type} == 1) {
	    @tmp = (1, roomname($t->{Where}->{Room}), 'before', @tmp);
	} else {
	    @tmp = (1, 'playerobj', 'orders', @tmp);
	}
	#print "returning Go order (", join (", ", @tmp), ")";
	return @tmp;
    }

    ##my $gramlines = $grammar{"'".$tokens[$curtoken]."'"};
    ##print "\$tokens[\$curtoken] == $tokens[$curtoken]; keys grammar == (", join (", ", keys %grammar), ")\n";
    ##if ($gramlines) {
    foreach my $v (keys %grammar) {
	#if ($VERBOSE_PREPARSE) {
	#    print "Comparing ($v) against ($tokens[$curtoken])\n";
	#}
	my $pat = ref $tokens[$curtoken] ? $ {$tokens[$curtoken]} : '';
	if ($v eq $tokens[$curtoken] || ($pat && $v =~ /$pat/)) {
	    if ($VERBOSE_PREPARSE) { 
		print "  Matches $v\n";
	    }
	    my $gramlines = $grammar{$v};
	    #print "\$gramlines == $gramlines\n";
	    foreach my $gl (@$gramlines) {
		#print "\n  Trying grammar line (", join (", ", @$gl), ")\n";
		my @gll = @$gl;
		my $act = shift @gll;
		my $dir = shift @gll;
		#$tmp = match_gramline ( $t, [$goodscope], \@gll, 
		#		       [ @tokens[$curtoken+1..$#tokens] ] );
		$tmp = match_gramline ( $t, [$goodscope, $actor], \@gll, #CAAS
				       [ @tokens[$curtoken+1..$#tokens] ] );
		# Changes to make actor always scoped marked CAAS
		if ($VERBOSE_PREPARSE) {
		    print "   match_gramline -> (", id($tmp), ")\n";
		}
		if ($tmp) {
		    #my ($scope, $do, $io) = @$tmp;
		    my ($scope, $outact, $do, $io) = @$tmp;
		    if ($VERBOSE_PREPARSE) {
			print "matched as (scope:", id($scope), ", actor:", id($actor), ", act:", id($act), ", do:", id($do), ", io:", id($io), ") ";
		    }
		    if (!defined $do) { $do = -1; }
		    if (!defined $io) { $io = -1; }
		    my $has_do = !grep {$_ eq $do} (@room_acts);
		    my $has_io = !grep {$_ eq $io} (@room_acts);
		    if ($dir eq 'rev') { ($do, $io) = ($io, $do); }
		    
		    if ($actor ne 'playerobj' && $actor ne 'player') {
			return ($scope, $actor, 'orders', $act, $do, $io);
		    } elsif ($has_do && $act eq 'AskFor') {
			return ($scope, $do, 'orders', 'Give', 'playerobj', $io);
		    } elsif ($has_io && ($act eq 'Give' || $act eq 'Show')) {
			return ($scope, $io, 'life', $act, $do, -3);
		    } elsif ($has_do && grep {$_ eq $act} @life_acts && 
			     $inform_objects{$do}{class}[0] eq 'Character') {
			return ($scope, $do, 'life', $act, -3, $io);
		    } elsif ($has_io && !$has_do && $act eq 'ThrowAt') {
			return ($scope, $io, 'before', 'ThrownAt', $do, -3);
		    } elsif ($has_io && ($act eq 'PutOn' || $act eq 'Insert')){
			return ($scope, $io, 'before', 'Receive', $do, -3);
		    } elsif ($has_do) {
			return ($scope, $do, 'before', $act, -3, $io);
		    } elsif ($t->{Where}->{Type} == 1) {
			return ($scope, roomname($t->{Where}->{Room}),
				'before', $act, $do, $io);
		    }
		    return ($scope, 'playerobj', 'orders', $act, $do, $io);
		}
	    }
	}
    }
    if ($VERBOSE_PREPARSE) {
	print "All grammar lines failed, returning.\n";
    }
    return ();
}

my %dirlist = (qw/n n_obj   north n_obj       s s_obj    south s_obj  
	       w w_obj      west w_obj        e e_obj    east e_obj   
	       ne ne_obj    northeast ne_obj  nw nw_obj  northwest nw_obj
	       se se_obj    southeast se_obj  sw sw_obj  southwest sw_obj
	       u u_obj      up u_obj          d d_obj    down d_obj
	       out out_obj  in in_obj/);

# Returns a list (direct_object, indirect_object), plus additional '-1's to
# fill to length.  d_o & i_o may also be -2 (skipped with wildcard),
# REFOBJ, REFCHAR, or the iname of the appropriate character / object
#
sub match_gramline {
    my ($t, $head, $g_toks, $t_toks) = @_;
    my $in_act = $head->[1]; # CAAS
    my @gl = @$g_toks;
    my @tl = @$t_toks;
    my @h  = @$head;
    my $nonwild = 0;
    if ($VERBOSE_PREPARSE) {
	print "    match_gramline ([", join (", ",@gl), "], [", join (", ",@tl), "])\n";
    }

    if (@gl == 0) {
	while ($tl[0] eq '*') {
	    shift @tl;
	}
	if (@tl == 0) {
	    return $head;
	}
	return ();
    }

    my $curtok = 0;
    my $used_wild = 0;
    while (@tl > 0 && $tl[0] eq '*') {
	if ($VERBOSE_PREPARSE) {
	    print "     Shifting (", $tl[0], ") off \@tl, leaving [(", join (") (", @tl), ")]\n";
	}
	shift @tl;
	$used_wild = 1;
    }
    if ($VERBOSE_PREPARSE) {
	print "     After shifting stars, left with [(", join (") (", @tl), ")]\n";
    }

    my $this_g = shift @gl;
    if ($this_g =~ /^'(.*)'$/) {
	my $pat = ref $tl[$curtok] ? $ {$tl[$curtok]} : '';
	if ($1 eq $tl[$curtok] || ($pat && $1 =~ /$pat/)) {
	    #if ($1 =~ /$tl[$curtok]/) {
	    if ($VERBOSE_PREPARSE) {
		print "    simple match from $1 to $tl[$curtok]\n";
	    }
	    return match_gramline ($t, $head, \@gl, [@tl[$curtok+1..$#tl]]);
	} elsif ($used_wild) {
	    if ($VERBOSE_PREPARSE) {
		print "    wildcard match of $1\n";
	    }
	    return match_gramline ($t, $head, \@gl, [@tl[$curtok..$#tl]]);
	}
    } elsif ($this_g eq 'noun=ADirection') {
	my %matches = ();
	#print "Matching ADirection to ($tl[$curtok])\n";
	if (ref $tl[$curtok]) {
	    my $pat = $ {$tl[$curtok]};
	    foreach (keys %dirlist) {
		###if ($_ =~ /^$tl[$curtok]$/) { $matches{$dirlist{$_}} = 1; }
		if ($_ =~ /$pat/) { $matches{$dirlist{$_}} = 1; }
	    }
	} else {
	    foreach (keys %dirlist) {
		###if ($_ =~ /^$tl[$curtok]$/) { $matches{$dirlist{$_}} = 1; }
		if ($_ eq $tl[$curtok]) { $matches{$dirlist{$_}} = 1; }
	    }
	}
	#print "On matching ADirection, values were (", join (", ", keys %matches), ")\n";
	if (keys %matches == 1) { 
	    return match_gramline ($t, [@h, keys %matches], \@gl,
				   [@tl[$curtok+1..$#tl]]);
	}
	if (%matches) { return (); }
	if ($used_wild) {
	    return match_gramline ($t, [@h, -1], \@gl, [@tl[$curtok..$#tl]]);
	}
    } elsif ($this_g eq 'creature') {
	if ($tl[$curtok] eq 'a' || $tl[$curtok] eq 'an' || 
	    $tl[$curtok] eq 'the') {
	    $curtok ++;
	}
	if ($tl[$curtok] eq "%character%") { 
	    return match_gramline ($t, [ @h, 'REFCHAR'], \@gl,
				   [@tl[$curtok+1..$#tl]]);
	}
        my @actors = (@npcs, @inform_npcs);
	my @tmp = matchlist ($tl[0], \@actors);
	
        while (@tmp) {
	    @actors = @tmp;
	    if ($tl[$curtok] ne '*') { $nonwild = 1; }
	    else { $used_wild = 1; }
	    @tmp = matchlist ($tl[++$curtok], \@actors);

	    if ($VERBOSE_PREPARSE) {
		print "     characters matching ", $tl[$curtok-1], ": (", join (", ", @tmp), ")\n";
	    }
	}
	if ($curtok > 0 && $nonwild == 1) {
	    #my @actors1 = grep { check_scope_char($t, $_) } @actors;
	    my @actors1 = grep { check_scope_char($t, $in_act, $_) } @actors;

	    ## If only one actor passes the scope check, go on as good scope
	    ## If no actor passes the scope check, but only one passed the
	    ## vocab check, go on as bad scope.
	    ## Otherwise, fail.
	    ##
	    if (@actors1 == 0 && @actors == 1) {
		$h[0] = '0'; # Bad scope
		push @actors1, $actors[0];
	    } elsif (@actors1 != 1) {
		return ();
	    }

	    if ($tl[$curtok - 1] eq '*') { -- $curtok; }
	    return match_gramline ($t, [@h, $actors1[0]], \@gl,
				   [@tl[$curtok..$#tl]]);
	} elsif (($curtok > 0 && $nonwild == 0) || $used_wild) {
	    return match_gramline ($t, [@h, -1], \@gl, [@tl[$curtok..$#tl]]);
	}
    } elsif ($this_g eq 'noun' || $this_g eq 'held' || $this_g eq 'worn' || 
	     $this_g eq 'multiheld' || $this_g eq 'multiexcept' || 
	     $this_g eq 'multi' || $this_g eq 'multiinside') {
	if ($tl[$curtok] eq 'some') {
	    $curtok ++;
	    if ($tl[$curtok] eq 'of') { $curtok ++; }
	}
	if ($tl[$curtok] eq 'a' || $tl[$curtok] eq 'an' || 
	    $tl[$curtok] eq 'the') {
	    $curtok ++;
	}
	if ($tl[$curtok] eq '%object%') {
	    return match_gramline ($t, [ @h, 'REFOBJ'], \@gl,
				   [@tl[$curtok+1..$#tl]]);
	} elsif ($tl[$curtok] eq '%character%') {
	    return match_gramline ($t, [ @h, 'REFCHAR'], \@gl,
				   [@tl[$curtok+1..$#tl]]);
	}	    
	#$nonwild = 0;
	my @objs = (@objects, @inform_objs, @npcs, @inform_npcs);
	my @tmp = matchlist ($tl[$curtok], \@objs);
	if ($VERBOSE_PREPARSE) {
	    print "     initial objects matching ", $tl[$curtok], ": (", join (", ", @tmp), ")\n";
	}
	while (@tmp) {
	    @objs = @tmp;
	    if ($tl[$curtok] ne '*') { $nonwild = 1; }
	    else { $used_wild = 1; }
	    @tmp = matchlist ($tl[++$curtok], \@objs);
	    if ($VERBOSE_PREPARSE) {
		print "     objects matching ", $tl[$curtok-1], ": (", join (", ", @tmp), ")\n";
	    }
	}
	if ($curtok > 0 && $nonwild == 1) {
	    #print "    Before checking scope, left with (", join (", ", @objs), ")\n";
	    #my @objs1 = grep { check_scope_obj($t, $this_g, $_) } @objs;
	    my @objs1 = grep { check_scope_obj($t, $in_act, $this_g, $_) } @objs;
	    #print "    After checking scope, left with (", join (", ", @objs), ")\n";
	    ###if (@objs != 1) { return (); }

	    ## As with NPCs, if only one object passes the scope check,
	    ## proceed with that object as good scope.
	    ## If no object passes the scope check, but only one passed the
	    ## vocab check, proceed with that object as bad scope
	    if (@objs1 == 0 && @objs == 1) {
		push @objs1, $objs[0];
		$h[0] = '0';
	    } elsif (@objs1 != 1) {
		return ();
	    }

	    if ($tl[$curtok - 1] eq '*') { -- $curtok; }
	    return match_gramline ($t, [@h, $objs1[0]], \@gl, 
				   [@tl[$curtok..$#tl]]);
	} elsif (($curtok > 0 && $nonwild == 0) || $used_wild) {
	    #return match_gramline ($t, [@h, -2], \@gl, [@tl[$curtok..$#tl]]);
	    return match_gramline ($t, [@h, -1], \@gl, [@tl[$curtok..$#tl]]);
	}
    } elsif ($this_g eq 'topic') {
	#TODO
    } elsif ($this_g eq 'special' || $this_g eq 'number') {
	##my $val = '';
	##if ($tl[$curtok] eq '%number%') { $val = 'REFNUM'; }
	##elsif ($tl[$curtok] =~ /^'(\d*)'$/) { $val = $1; }
	##if ($val) {
	##    return match_gramline ($t, [ @$head, $val], \@gl, [@tl[1..$#tl]]);
	##}
	if ($tl[0] eq '%number%') {
	    return match_gramline ($t, [ @h, 'REFNUM'], \@gl, [@tl [1..$#tl]]);
	} elsif ($tl[0] =~ /^\^(\d*)\$$/) {
	    return match_gramline ($t, [ @h, $1 ], \@gl, [@tl [1..$#tl]]);
	} elsif ($used_wild) {
	    #return match_gramline ($t, [ @h, -2 ], \@gl, \@tl);
	    return match_gramline ($t, [ @h, -1 ], \@gl, \@tl);
	}
    } else {
	print "Bad grammar token $this_g";
    }
    return ();
}

#  Tokens: (held, multi, multiexcept, multiheld, multiinside, noun, worn)
#
#  Crude check to see if restrictions of 'task' force 'obj' to be in scope
#  Unfortunately, this ignores that the restrictions may use an "or", making
#  a restriction optional.  
#
#     *** DUE TO LAXNESS, THE 'HELD' TYPE TOKENS NEED ONLY BE VISIBLE
#
#  -  If the noun need only be visible (multi, m_e, m_i or noun), the object
#       is part of an NPC, and that NPC is forced into scope, PASS
#  -  ... visible, and there is a restriction Object must be visible to player
#       or (Object visible to NPC && that NPC is forced into scope), PASS
#  -  If there is a restriction "Object must be in/on the X", and X is forced
#       into scope, PASS
#  -  If there is a restriction "Object must be worn by player", PASS
#  -  If object is static, and it exists in all rooms where the task is
#       executable, PASS.  Otherwise, FAIL.
#
sub check_scope_obj {
    #my ($t, $token, $obj) = @_;
    my ($t, $in_act, $token, $obj) = @_;
    local $_;

    #print "     Checking the scope of $obj against task ", $t->{iname}, " as $token\n";

    my $io = $inform_objects{$obj};

    if ($io->{class}->[0] eq 'Character') { 
	#return check_scope_char($t, $obj);
	return check_scope_char($t, $in_act, $obj);
    }

    if ($io->{parent}) {
	my %par = %{$inform_objects{$io->{parent}}};
	if ($par{add_to_scope} && grep { $_ eq $obj } @{$par{add_to_scope}}) {
	    #if (($par{class}[0] eq 'Character' && check_scope_char ($t, $par{iname})) || ($par{class}[0] eq 'Object' && check_scope_object ($t, 'noun', $par{iname}))) {
	    #	#print "      PASS by recursive check!\n";
	    #	return 1;
	    #}
	    if (($par{class}[0] eq 'Character' && check_scope_char ($t, $in_act, $par{iname})) || ($par{class}[0] eq 'Object' && check_scope_object ($t, $in_act, 'noun', $par{iname}))) {
		#print "      PASS by recursive check!\n";
		return 1;
	    }
	}
    }
    
    if (grep {$_ eq 'static'} @{$io->{attribs}}) {
	my $tw  = $t->{Where};
	if ($io->{ht}) {  # If object is created by ADRIFT
	    my $htw = $io->{ht}->{Where};
	    ##dumptree ($tw, 3);
	    ##dumptree ($htw, 3);
	    #print "Static object; task: type ", id($tw->{Type}), ", Room ", id($tw->{Room}), ", Rooms: ", (defined ($tw->{Rooms}) ? (join "", @{$tw->{Rooms}}) : "(undef)"), "\n";
	    #print "obj: type ", id($htw->{Type}), ", Room ", id($htw->{Room}), ", Rooms: ", (defined ($htw->{Rooms}) ? (join "", @{$htw->{Rooms}}) : "(undef)"), "\n";
	    if ($tw->{Type} == 0 || $htw->{Type} == 3) { 
		#print "      PASS AT STAGE 1\n";
		return 1; 
	    } 
	    # TASK IN NONE or OBJECT IN ALL
	    if ($tw->{Type} == 3 || $htw->{Type} == 0) { 
		#print "      FAIL AT STAGE 2\n";
		return 0; 
	    } 
	    # TASK IN ALL  or OBJECT IN NONE

	    if ($tw->{Type} == 1) { # TASK IN ONE
		my $rn = $tw->{Room};
		#print "", ((($htw->{Type} == 1 && $htw->{Room} == $rn + 1) ||
		#	    ($htw->{Type} == 2 && $htw->{Rooms}[$rn + 1])) ? 
		#	   'PASS' : 'FAIL'), " at stage 3\n";
		return ($htw->{Type} == 1 && $htw->{Room} == $rn + 1) ||
		    ($htw->{Type} == 2 && $htw->{Rooms}[$rn+1]);
	    }
	    if ($tw->{Type} != 2) { die "FALLTHROUGH check_scope_obj";}
	    if ($htw->{Type} != 2) { 
		#print "      FAIL at stage 4\n";
		return 0; 
	    }
	    for (my $n = 0; $n < @{$root->{Rooms}}; $n ++) {
		if ($tw->{Rooms}->[$n] > $htw->{Rooms}->[$n+1]) {
		    #print "      FAIL AT STAGE 5\n";
		    return 0;
		}
	    }
	    #print "      PASS AT STAGE 6\n";
	    return 1;
	} 
	## Okay, so the object's created by taf2inf

	my $fi = $io->{found_in};
	if ($fi eq '[ ; rtrue; ]' || $tw->{Type} == 0) { return 1; }
	if ($tw->{Type} == 3) { return 0; }
	if (defined $io->{parent}) {  # OBJ in 1 room
	    return $tw->{Type} == 1 && roomname($tw->{Room}) eq $io->{parent};
	}
	if ($tw->{Type} == 1) {
	    if (defined $fi && substr($fi, 0, 1) ne '[' && ']') {
		my $rn = roomname($tw->{Room});
		if ((' '.$fi.' ') =~ / $rn /) { return 1; }
	    }
	    return 0;
	}
	if ($tw->{Type} != 2) { die "FALLTHROUGH check_scope_obj"; }
	for (my $n = 0; $n < @{$root->{Rooms}}; $n ++) {
	    if ($tw->{Rooms}->[$n]) {
		my $rn = roomname($tw->{Room});
		if ((' '.$fi.' ') !~ / $rn /) { return 0; }
	    }
	}
	return 1;
    }

    foreach my $r (@{$t->{Restrictions}}) {
	if ($r->{Type} == 0) {  # Object Type
	    my ($v1, $v2, $v3) = ($r->{Var1}, $r->{Var2}, $r->{Var3});
	    if (($v1 == 2 && $obj eq 'REFOBJ') ||
		($v1 > 2 && $obj eq $dynamic_objects[$v1 - 3])) {
		#if ($v2 == 0) { # Object must be in room } HOW ???
		if ($v2 == 2) {
		    #if ($v3 < 2 || check_scope_char ($t, charname($v3 - 2))) {
		    #	return 1; 		    
		    #}
		    if ($v3 < 2 || check_scope_char ($t, $in_act, charname($v3 - 2))) { # CAAS
			return 1; 		    
		    }
		} elsif ($r->{Var2} == 1 && $token ne 'worn') { # HELD BY
		    #if ($v3 < 2 || check_scope_char ($t, charname($v3 - 2))) {
		    #	return 1; 		    
		    #}
		    if ($v3 < 2 || check_scope_char ($t, $in_act, charname($v3 - 2))) { # CAAS
			return 1; 		    
		    }
		#} elsif ($r->{Var2} == 3 && $token ne 'multiheld' &&
		#	 $token ne 'worn' && $token ne 'held') { # VISIBLE TO
		} elsif ($r->{Var2} == 3 && $token ne 'worn') { # VISIBLE TO
		    #if ($v3 < 2 || check_scope_char ($t, charname($v3 - 2))) {
		    #	return 1; 		    
		    #}
		    if ($v3 < 2 || check_scope_char ($t, $in_act, charname($v3 - 2))) { #CAAS
			return 1; 		    
		    }
		} elsif (($v2 == 4 || $v2 == 5) && $v3 > 0 &&
			 ($token eq 'noun' || $token eq 'multiexcept' ||
			  $token eq 'multi' || $token eq 'multiinside')) {
		    my $par = ($v2 == 4) ? $container_objects[$v3 - 1] :
			$surface_objects[$v3 - 1];
		    #if (check_scope_obj ($t, 'noun', $par)) { return 1; }
		    if (check_scope_obj ($t, $in_act, 'noun', $par)) { return 1; } #CAAS
		}
	    }
	}
    }
    return 0;
}

# Check if the restrictions of "task" force "actor" to be in scope
#
sub check_scope_char {
    #my ($task, $actor) = @_;
    my ($task, $in_act, $actor) = @_; # CAAS
    if ($actor eq 'playerobj') { return 1; }  # Player always in scope
    if ($actor eq $in_act) { return 1; }  # Actor always in scope CAAS

    foreach my $r (@{$task->{Restrictions}}) {
	if ($r->{Type} == 3 && $r->{Var2} == 0) {  # Character in same room as
	    if (($r->{Var1} == 0 && $r->{Var3} == 1 && $actor eq 'REFCHAR') ||
		($r->{Var1} == 1 && $r->{Var3} == 0 && $actor eq 'REFCHAR') ||
		(($r->{Var1} == 0 && $r->{Var3} > 1 && 
		 $root->{NPCs}[$r->{Var3}-2]{iname} eq $actor) ||
		($r->{Var3} == 0 && $r->{Var1} > 1 && 
		 $root->{NPCs}[$r->{Var1}-2]{iname} eq $actor))) {
		return 1;
	    }
	}
    }
    return 0;
}

sub parse_task_commands {
    my $t = shift;
    #if ($t->{iname} eq 'task115') { $VERBOSE_PREPARSE = 1; }
    #else { $VERBOSE_PREPARSE = 0; }
    
    if ($VERBOSE_PREPARSE) {
	print "\nHandling task ", $t->{iname}, ", block (", join (", ", @{$t->{Command}}), ")\n";
    }
    my $io = $inform_objects{$t->{iname}};
    $io->{Parsed} = []; $io->{Failed} = [];
    my @cmds = map { expand_str($_) } @{$t->{Command}};
    #if (@cmds > 20) { print "Over 20 commands in task ", $t->{iname}, "\n"; }
    my %tree = ();
    foreach my $cmd (@cmds) {
	#print "\$cmd == $cmd; ";
	$cmd =~ tr/A-Z/a-z/;
	#print "\$cmd == $cmd.\n";
	if ($cmd =~ /^[-+\#!\"]/) { 
	    push @{$io->{Parsed}}, $cmd;
	    next;
	}
	my @l = split / +/, $cmd;
	#print "\nsplit '$cmd' into ('", join ("', '", @l), "')\n";
	my @tokens = ();
	while (@l) {
	    $_ = shift @l;
	    if ($_ eq '*') {
		push @tokens, $_;
	    } elsif ($_ =~ /^([^\*]+)\*(.*)/) {
		push @tokens, "^$1.*\$";
		unshift @l, "*$2";
	    } elsif ($_ =~ /^\*([^\*]*)\*(.*)/) {
		push @tokens, "*";
		if ($1) { push @tokens, "^.*$1.*\$"; }
		unshift @l, "*$2";
	    } elsif ($_ =~ /^\*/) {
		push @tokens, "*", "^.$_";
	    } else {
		push @tokens, $_;
	    }
	}
	#print "Attempting to parse line: '$cmd' (<", join ("> <", map { ref $_ ? '['.$$_.']' : $_ } @tokens), ">)\n";
	foreach (@tokens) {
	    if ($_ =~ /^\^/) { 
		my $y = $_;
		$y =~ s/([^^\$A-Za-z0-9]\*\.)/\\$1/g;  
		$_ = \$y; 
	    }
	}
	#print "Attempting to parse line: '$cmd' (<", join ("> <", map { ref $_ ? '['.($ {$_}).']' : $_ } @tokens), ">)\n";

	my ($scope, $owner, $prop, $act, $do, $ind) = parse_line ($t, @tokens);
	#if (defined $scope) { print "  -> (", id($owner), ", ", id($act), ", ", id($do), ", ", id($ind), ")\n"; }
	if (!defined $scope) {
	    push @{$io->{Failed}}, $cmd;
	} else {
	    #$action = defined $action ? $action : '-1';
	    $do  = defined $do  ? $do : '-1';
	    $ind = defined $ind ? $ind : '-1';
	    push @{$io->{Parsed}}, $cmd;
	    push @{$tree{$scope}{$owner}{$prop}{$act}{$do}{$ind}}, $cmd;
	}
    }
    $t->{tree} = \%tree;

    #print "Calling form_tree_list\n";
    my @tree_list = form_tree_list(\%tree);
    #print "tree_list -> (", join (" / ", map { '['.(join ", ", @$_).']' } @tree_list), ")\n";
    #print "Called!\n";
    $t->{tree_list} = \@tree_list;
    $t->{tree} = \%tree;
    my @tree_vals = (()x6);
    #print "Setting tree_vals\n";
    for (my $n = 0; $n < 6; $n ++) {
	$tree_vals[$n] = [ uniqify (map { $_->[$n] } @tree_list) ];
    }
    #print "Set!\n";
    foreach ([1, 'owner', 'Globals'], [4, 'noun', ''], [5, 'second', '']) {
	if (@{$tree_vals[$_->[0]]} == 1) {
	    $io->{$_->[1]} = $tree_vals[$_->[0]]->[0];
	} else {
	    $io->{$_->[1]} = $_->[2];
	}
    }

    if (@{$io->{Failed}}) { 
	$io->{ParserCall} = 1;
	#print "After everything, ";
	#if (@{$io->{Failed}}) { print "failed on (", join (", ", @{$io->{Failed}}), ")\n"; }
	#if (@{$io->{Parsed}}) { print "succeed on (", join (", ", @{$io->{Parsed}}), ")\n"; }
	#print "total actions were:\n";
	#dumptree (\%tree, 0);
	#dump_tree_list (\%tree);
	#foreach my $l (@tree_list) {
	#    print "[", join (", ", @$l), "]\n";
	#}
	#print "\n";
    } else {
	$io->{ParserCall} = 0;
    }
    #print "Returning from p_t_c\n";
}

sub form_tree_list {
    my ($tree, @stack) = @_;
    local $_;
    if (ref $tree eq 'HASH') {
	return map { form_tree_list ($tree->{$_}, @stack, $_) } keys %$tree;
    } elsif (ref $tree eq 'ARRAY') {
	#return map { [ @stack, $_ ] } @$tree;
	return [ @stack, '['. join (", ", @$tree). ']' ];
    } else {
	return [ @stack, $tree ];
    }
}

# Dump a tree, but show keys as a list
sub dump_tree_list {
    my ($tree, @stack) = @_;
    if (ref $tree eq 'HASH') {
	foreach my $k (keys %$tree) {
	    dump_tree_list ($tree->{$k}, @stack, $k);
	}
    } elsif (ref $tree eq 'ARRAY') {
	print " -> ", join (" => ", @stack, '['.join (", ", @$tree).']'), "\n";
    } else {
	print " -> ", join (" => ", @stack, $tree), "\n";
    }
}

sub pushtrack {
    my ($tn, $track) = @_;
    #print "pushtrack ($_[0], ", join (", ", @{$_[1]}), ")\n";
    my $t = $inform_objects{taskname($tn)};
    if ($track->[1] == 1) { $t->{needtrack} = 1; }
    push @{$t->{track}}, $track;
}

sub pushcall {
    my ($tn, $track) = @_;
    push @{$inform_objects{(taskname($tn))}->{call}}, $track;
}

sub pushcontent {
    my ($parent, $child) = @_;
    push @{$inform_objects{$parent}->{children}}, $child;
    $inform_objects{$child}->{parent} = $parent;
}

# Pushes object $child onto object $parent 's add_to scope
# Takes inames for both arguments;
sub pushscope {
    my ($parent, $child) = @_;
    my $parobj = $inform_objects{$parent};
    push @{$parobj->{add_to_scope}}, $child;
    $inform_objects{$child}->{scoped_by} = $parent;
    if ($OUTPUT_ARROWS) {
	push @{$parobj->{children}}, $child;
	$inform_objects{$child}->{parent} = $parent;
	#$inform_objects{$child}->{first_turn} = '[ ; remove self; ]';
	push @{$inform_objects{$child}->{attribs}}, 'absent';
    } else {
	$inform_objects{$child}->{parent} = '1';
    }
}

sub indent {
    if (@_ < 2 && !(grep /^!/, @_)) { 
	if ($_[0] =~ /^print_ret (\".*)/) { #"
	    return "[ ; ".$1." ]";
	} else { 
	    return "[ ; " . (join "", @_) . " ]"; 
	}
    }

    my $rv = "[ ;";
    my $depth = 3;
    my $cont = 0;
    for my $l (@_) {
	my $label = ""; # Holds an extra space if this line is a label
	if ($l =~ /^\}/) { -- $depth; } 
	elsif ($l =~ /^[^!\"]*:/) { $cont = -1; $label = " ";}

	if ($l =~ /^print_ret (\".*)/) { $l = $1; };  #"
	$rv = $rv . "\n" . "    "x($depth+$cont) . $label . $l;
	if ($label eq ' ') { 
	    $cont = 0; 
	} elsif ($l =~ /^!/ || $l eq '') {
	} elsif ($l =~ /\{$/) {
	    ++ $depth;
	} elsif ($l =~ /;$/) {
	    if ($cont > 0) { $cont --; }
	} elsif ($l !~ /\}$/) {
	    $cont ++;
	}
    }
    return $rv."\n        ]";
}

#### MOVE THIS TO SPECIAL AREA
foreach (@{$root->{Objects}}) {
    #$_ = shift;
    my $in = $_->{iname};
    my $tn = $_->{Short};

    push @objects, $in;
    if ($_->{SitLie} & 1) { 
	push @sit_objects, $in; 
	push @{$inform_objects{$in}->{attribs}}, 'sittable'; 
    }
    if ($_->{SitLie} & 2) { 
	push @lie_objects, $in; 
	push @{$inform_objects{$in}->{attribs}}, 'lieable'; 
    }
    if ($_->{Static}) { push @static_objects, $in; }
    else { 
	push @dynamic_objects, $in; 
	if ($_->{Wearable}) { push @wearable_objects, $in; }
    }

    if ($_->{Surface}) { 
	push @surface_objects, $in; 
	$vars{'on_'.$tn} = $vars{'onin_'.$tn} = [ 5, "(ListContents) $in" ];
    }
    if ($_->{Container}) { 
	push @container_objects, $in; 
	$vars{'in_'.$tn} = $vars{'onin_'.$tn} = [ 5, "(ListContents) $in" ];
    }
    if ($_->{Openable} || $_->{CurrentState}) { push @stateful_objects, $in; }
    if ($_->{Openable}) { $vars{'status_'.$tn} = [ 5, "(ShowOpen) $in" ]; }
    if ($_->{CurrentStatus}) { $vars{'state_'.$tn} = [ 5, "(ObjState) $in" ];}
}
@npcs = map { $_->{iname} } @{$root->{NPCs}};

print "Generated object lists\n";

sub showar {
    foreach (@_) {
	if (@$_ == 1) { next; }
	#my $listname = shift @$_;
	print shift @$_," == [";
	for (my $n = 0; $n < @$_; $n ++) {
	    #print "$listname"."[$n] == ".$_->[$n], "\n";
	    print "$n: ",$_->[$n],",  ";
	}
	print "]\n";
    }
    print "\n";
}
#showar (['sit', @sit_objects], ['lie', @lie_objects], ['static', @static_objects], ['dynamic', @dynamic_objects], ['wearable', @wearable_objects], ['surface', @surface_objects], ['container', @container_objects], ['stateful', @stateful_objects], ['int var', @integer_vars], ['string var', @string_vars], ['character', map { $_->{iname} } @{$root->{NPCs}}]);

#  heshe  himher  modified  time  number  t_number  text  
foreach ([author => [ 0, $root->{Globals}->{GameAuthor} ]],
	 [character => [ 5, "(the) REFCHAR" ]],
	 [obstate => [ 5, "(ObjState) REFOBJ" ]],
	 [obstatus => [ 5, "(ShowOpen) REFOBJ" ]],
	 [maxscore => [ 3, 'MAX_SCORE' ]],       [number => [ 3, 'REFNUM' ]],
	 [object => [ 5, "(the) REFOBJ" ]],    	 [turns => [ 3, 'turns' ]],
	 [player => [ 5, "(object) player" ]], 	 [score => [ 0, 'score' ]],
	 [theobject => [ 5, "(the) REFOBJ"]],    [title => [ 4, 'Story' ]]) {
    $vars{$_->[0]} = $_->[1];
}
if ($root->{Globals}->{PromptName}) { 
    $vars{player} = [ 5, "(PrintString) player_name" ]; 
}

foreach (@{$root->{Variables}}) {
    #print "Processing normal variable '", $_->{Name}, "'\n";
    if ($_->{Type} == 0) { 
	my $tn = $_->{Prefix}.$_->{Name};
	$tn =~ s/[^A-Za-z]//;
	$tn =~ tr/A-Z/a-z/;

	push @integer_vars, $_->{iname}; 
	$vars{$_->{Name}} = [ 3, 'Globals.'.$_->{iname} ];
	$vars{"t_$tn"} = [ 5, "(LanguageNumber) Globals.".$_->{iname} ];
    } elsif ($_->{Type} == 1) { 
	push @string_vars, $_->{iname}; 
	$vars{$_->{Name}} = [ 4, 'Globals.'.$_->{iname} ];
    } else { 
	print "Bad Variable Type on (", join (", ", %$_), ")\n"; 
    }    
}
#print "Known variables are (", join ("  ", keys %vars), ")\n";

my @alr;   # ALR->[2] == 0 if unused, 1 if used, 2 if an func

my %alr_funcs = ();
{
    my $alrnum = 0;
    my @alr1 = ();
    foreach (@{$root->{ALRs}}) {
	my $s1 = $_->{Original}; 
	my $s2 = $_->{Replacement}; 
	#print "'$s1', '$s2' -> ";
	##$s1 =~ s/(\W)/\\$1/g;
	##$s1 =~ s/([^A-Za-z <>0-9])/\\$1/g;
	$s1 =~ s/([\(\)\[\]\.\?\*\/])/\\$1/g;
	##$s2 =~ s/(\W)/\\$1/g;
	##$s2 =~ s/([^A-Za-z <>0-9\.\?\*])/\\$1/g;
	##$s2 =~ s/([\(\)\[\]\.\?\*])/\\$1/g;
	##$s2 =~ s/([\/])/\\$1/g;
	#print "'$s1', '$s2'\n";
	push @alr1, [$s1, $s2, 0, $_->{Original}, $_->{Replacement}];
    }
    use sort 'stable';
    @alr = sort { length ($b->[3]) <=> length($a->[3]) } @alr1;

    foreach (@alr) { # Check to see if it's a probable function (like [ROPE=7])
	if ($_->[3] =~ /^(\[?[^0-9]+?)(-?[0-9]+)\]?$/) {
	    $alr_funcs{$1}->{$2} = $_->[4];
	    $_->[2] = 2;
	}
    }
}
foreach (keys %alr_funcs) {
    my $in = $alr_funcs{$_}->{iname} = get_inform_name ('ALR_'.$_, 1, 1);
    $alr_funcs{$_}->{iname} = uc($in);
    $adrift_objects{$alr_funcs{$_}->{iname}} = $adrift_objects{$in};
}
my @alr_func_names = sort { length($b) <=> length($a) } keys %alr_funcs;

my @dirnames = (qw/n_to e_to s_to w_to u_to d_to in_to out_to/, 
		$root->{Globals}->{EightPointCompass} ? 
		qw/ne_to se_to sw_to nw_to/ : ());

# When called with two arguments, second arg is for debugging 
#         (finding out where a bad call came from)
sub roomname { 
    my $n = shift; 
    #my $m = shift; print "roomname ($n, $m) -> ";

    if ($n < @{$root->{Rooms}}) {     
	#print $root->{Rooms}->[$n]->{iname}, "\n"; 
	return $root->{Rooms}->[$n]->{iname}; 
    }
    $n = $n - @{$root->{Rooms}};
    if ($n < @{$root->{RoomGroups}}) {
	#print "RandRG (". $root->{RoomGroups}->[$n]->{iname}.")\n";
	return "RandRG (". $root->{RoomGroups}->[$n]->{iname}.")";
    }
    #print "*** OOB Room ***\n";
    return "*** OOB Room number ***";
}

#sub roomname { my ($n, $v) = @_; my $rn = $root->{Rooms}->[$n]->{iname}; 
#	       print "roomname ($n, $v) -> $rn\n"; return $rn; }
sub roomobj { return $adrift_objects{roomname(shift)}; }

sub taskname { return $root->{Tasks}->[shift]->{iname}; }
sub taskobj { return $adrift_objects{taskname(shift)}; }
# 
sub tasktrack { 
    my ($tn, $mode) = @_;
    my $to = $inform_objects{taskname($tn)};
    return $to->{owner}.'.'.$to->{iname};
}

sub objectname { return $root->{Objects}->[shift]->{iname}; }
sub objectobj { return $adrift_objects{objectname(shift)}; }

sub eventname { return $root->{Events}->[shift]->{iname}; }
sub eventobj { return $adrift_objects{eventname(shift)}; }

sub charname { 
    #my $n = shift;
    my ($n, $m) = @_;
    die "OOB character no. $n: $m" if ($n < 0 || $n >= @npcs);
    return $root->{NPCs}->[$n]->{iname}; 
}
sub charobj { return $adrift_objects{charname(shift, 1)}; }

sub roomgroupname { return $root->{RoomGroups}->[shift]->{iname}; }

#sub cvt_dict {
#    my $wd = shift;
#    my $rv = cvt_dict_1 ($wd);
#    print "cvt_dict ($wd) -> <$rv>\n";
#    return $rv;
#}

sub cvt_dict {
    my $word = shift;
    $word =~ s/\'/^/g;
    if (length ($word) == 1) {
	return $word.'//';
    }
    return $word;
}

# remove the n-leftmost characters from a string
sub lcut {
    my ($str, $n) = @_;
    return substr ($str, $n, length($str) - $n);
}

my %char_cvt = 
    (split / +/, '163 @LL   187 @>>   171 @<<   191 @??   161 @!!   223 @ss   254 @th   222 @Th   240 @et   208 @Et   255 @:y   253 @'."'".'y   221 @'."'".'Y   252 @:u   251 @^u   250 @'."'".'u   249 @`u   220 @:U   219 @^U   218 @'."'".'U   217 @`U   248 @/o   246 @:o   245 @~o   244 @^o   243 @'."'".'o   242 @`o   216 @/O   214 @:O   213 @~O   212 @^O   211 @'."'".'O   210 @`O   241 @~n   209 @~N   239 @:i   238 @^i   237 @'."'".'i   236 @`i   207 @:I   206 @^I   205 @'."'".'I   204 @`I   235 @:e   234 @^e   233 @'."'".'e   232 @`e   203 @:E   202 @^E   201 @'."'".'E   200 @`E   231 @cc   199 @cC   230 @ae   198 @AE   229 @oa   228 @:a   227 @~a   226 @^a   225 @'."'".'a   224 @`a   197 @oA   196 @:A   195 @~A   194 @^A   193 @'."'".'A   192 @`A');

my %used_zchars = ();

# TODO: Test to make sure escaping non-zscii characters works okay
#       1)  Does it always print the curly brackets when followed by number?
#       2)  Does it ever print the curly brackets when not followed by number?
#       3)  What if the special character's at the end of the string?
#       4)  What if two special characters are adjacent?
#       5)  Does it ever skip characters around a special char?
#
# If second argument is 1, don't make code.  (Suppress HTML / variables)
sub reformat {
    my ($str, $full) = @_;
    my $verbose = 0;
    #if ($str =~ /violently/) { $verbose = 1; }
    if ($verbose) { print "Reformating '$str'\n"; }
    
    if (!defined ($full)) { $full = 0; }

    if (defined $str) { 
	### Perform static alr substitutions (removed for speed during testing)
	if ($USE_STATIC_ALR) {
	    foreach my $alr (@alr) {
		my $s1 = $alr->[0];
		if ($str =~ /$s1/) {
		    my $s2 = $alr->[1];
		    #print "ALR changing '$s1'->'$s2' on '$str' to ";
		    $str =~ s/$s1/$s2/g;
		    # If the alr is not a function, mark it as used.
		    if ($alr->[2] == 0) { $alr->[2] = 1; } 
		    #print "'$str'\n";
		}
	    }
	}
	#if ($str =~ /[\.\?\!]$/) { $str .= ' '; }
	my ($lindex, $mindex, $lstr, $l) = (0, 0, '', length($str));
	# Replace all OOB characters with escaped versions.
	while ($mindex < $l) {
	    my $ch = substr ($str, $mindex, 1);
	    my $och = ord ($ch);

	    if ($och < 32 || $och > 126 || 
		$och == 64 || $och == 94 || $och == 126) { # @, ^, ~
		if ($lindex != $mindex) { 
		    $lstr .= substr ($str, $lindex, $mindex - $lindex); 
		}
		if ($och == 10) { $lstr .= '^'; }
		elsif ($char_cvt{$och}) {
		    $lstr .= $char_cvt{$och};
		} else {
		    #if ($mindex == $l || ord(substr($str, $mindex+1, 1)) < 48
		    #	|| ord(substr($str, $mindex+1, 1)) > 57) {
		    #	$lstr .= "\@\@$och";
		    #} else {
		    #	$lstr .= "\@\@{$och}";
		    #}
		    my $zchar = sprintf ('@{%x}', $och);
		    #$lstr .= sprintf ('@{%x}', $och);
		    #$used_zchars{$och} = 1;
		    $lstr .= $zchar;
		    $used_zchars {$zchar} = 1;
		}
		$lindex = ++ $mindex;
	    } else {
		++ $mindex;
	    }
	}
	if ($lindex != $mindex) { 
	    $lstr .= substr ($str, $lindex, $mindex); 
	}
	   
	$lstr =~ s/\\\"/~/g;
	$lstr =~ s/\"/~/g;  #"
	$lstr =~ s/<[bB][rR]\\?>/^/g;

	if (!$full && $lstr ne '' && $USE_HTML) {
	    if ($verbose) { print "Before entering inner loop, \$lstr == '$lstr'\n"; }
	    my @tree = ();
	    # @tree consists of a list of blocks containing a numerical 
	    #       tag and enclosed text.
	    # Tag 0:  Plain text
	    # Tag 1:  Stackable HTML
	    # Tag 2:  ALR function
	    # Tag 3:  integer variable
	    # Tag 4:  string variable
	    # Tag 5:  variable-like function
	    #
	    my @rules = ("<", "%", "&lt;", "&gt;", @alr_func_names);
	    if ($verbose) { print "\@rules == (", join (", ", @rules), ")\n"; }
	    while ($lstr ne '') {
		if ($verbose) { print "    Inner loop, \$lstr == '$lstr'\n"; }
		my ($bestrule, $bestmatch) = (-1, length($lstr));
		for (my $rulenum = 0; $rulenum < @rules; $rulenum ++) {
		    my $tmp = index ($lstr, $rules[$rulenum]);
		    if ($tmp != -1 && $tmp < $bestmatch) {
			$bestrule = $rulenum;
			$bestmatch = $tmp;
		    }
		}
		if ($bestmatch > 0) {
		    if ($verbose) { print "First, trim ", substr($lstr, 0, $bestmatch), "\n"; }
		    push @tree, [ 0, substr ($lstr, 0, $bestmatch) ];
		    $lstr = lcut ($lstr, $bestmatch);
		}
		if ($bestrule == -1) { next; }
		if ($verbose) { print "Using $bestrule (", $rules[$bestrule],") on '$lstr'\n"; }

		if ($bestrule == 0 &&
		       $lstr =~ /^<([^>%\[\]]*)>(.*)$/) {  # handle HTML
		    $lstr = $2;
		    my $tagword = $1;
		    my $lword = lc($1);
		    if ($lword eq 'i') { push @tree, [ 1, 'S_ITAL']; }
		    elsif ($lword eq '/i') { push @tree, [ 1, 'S_UNITAL']; }
		    elsif ($lword eq 'b') { push @tree, [ 1, 'S_BOLD']; }
		    elsif ($lword eq '/b') { push @tree, [ 1, 'S_UNBOLD']; }
		    elsif ($lword eq 'u') { push @tree, [ 1, 'S_UNDER']; }
		    elsif ($lword eq '/u') { push @tree, [ 1, 'S_UNUNDER']; }
		    elsif ($lword eq 'c') { push @tree, [ 1, 'S_SEC']; }
		    elsif ($lword eq '/c') { push @tree, [ 1, 'S_UNSEC']; }
		    elsif ($lword eq 'center' || $tagword eq 'centre') {
			push @tree, [ 1, 'S_CENTER' ]; }
		    elsif ($lword eq 'right') { push @tree, [ 1, 'S_RIGHT'];}
		    elsif ($lword eq '/right' || $tagword eq '/center' ||
			   $lword eq '/centre') {
			push @tree, [ 1, 'S_LEFT' ];
		    } elsif ($lword eq 'cls') { 
			push @tree, [ 5, "(ClearScreen) 0" ];
		    } elsif ($lword =~ /^wait ([0-9]*)$/) {
			push @tree, [ 5, "(Delay) $1" ];
		    } elsif ($lword eq 'waitkey') {
			push @tree, [ 5, "(WaitKey) 0"];
		    } else { push @tree, [ 5, "(ignore) \"<$tagword>\"" ]; }
		} elsif ($bestrule == 1 &&
			 $lstr =~ /^%([^<>%\[\]]*)%(.*)$/ && $vars{$1}) {
		    # Handle variable
		    push @tree, $vars{$1};
		    $lstr = $2;
		} elsif ($bestrule == 0 || $bestrule == 1) {
		    push @tree, [ 0, substr ($lstr, 0, 1) ];
		    $lstr = lcut ($lstr, 1);
		} elsif ($bestrule == 2 || $bestrule == 3) {
		    push @tree, [ 0, $bestrule == 2 ? "<" : ">" ];
		    $lstr = lcut ($lstr, 3);
		} elsif ($bestrule < 4 + keys %alr_funcs) {
		    my $rule = $rules[$bestrule];
		    my $func = $alr_funcs{$rule};
		    $lstr = lcut ($lstr, length($rule));
		    #print "  \$rule == $rule; \$func == (", join (", ", map { "$_->".$func->{$_} } keys %$func), "); \$lstr == $lstr\n";
		    if ($lstr =~ /^%([^<>%\[\]]*)%\]?(.*)$/ && $vars{$1}) {
			$lstr = $2;
			push @tree, [2,"(".$func->{iname}.") ".$vars{$1}->[1]];
			$func->{used} = 1;
		    } else {
			push @tree, [ 0, $rule ];
		    }				     
		} else {
		    # ERROR - shouldn't happend but
		    print "Ultimate fallthrough handling '$str': '$lstr'; \$bestrule == $bestrule: Rule was ", $rules[$bestrule], "; 4 + \%alr_funcs == ", (4+%alr_funcs), "; \@rules == ", (scalar @rules), ";\n";

		    push @tree, [ 0, $lstr ];
		    $lstr = "";
		}
	    }
	    my @tree2 = ();
	    foreach (@tree) {
		my $lt2 = $tree2[$#tree2];  # Last element of tree2
		if (@tree2 && $_->[0] == 0 && $lt2->[0] == 0) {
		    $lt2->[1] = $lt2->[1] . $_->[1];
		} elsif (@tree2 && $_->[0] == 1 && $lt2->[0] == 1) {
		    my $tag = $_->[1];
		    my @l = @{$lt2->[1]};
		    my %ts = (S_BOLD=>'S_UNBOLD',   S_UNBOLD=>'S_BOLD', 
			      S_ITAL=>'S_UNITAL',   S_UNITAL=>'S_ITAL',
			      S_UNDER=>'S_UNUNDER', S_UNUNDER=>'S_UNDER',
			      S_SEC=>'S_UNSEC',     S_UNSEC=>'S_SEC');
		    my $tag2 = $ts{$tag};
		    if ($tag2) { @l = ((grep { $_ ne $tag2 } @l), $tag); }
		    elsif ($tag eq 'S_RIGHT' || $tag eq 'S_LEFT' ||
			   $tag eq 'S_CENTER') {
			@l = ((grep {$_ ne 'S_RIGHT' && $_ ne 'S_LEFT' &&
					 $_ ne 'S_CENTER'} @l), $tag);
		    } else {
			print "*** Spurious tag '$tag' in '$str' ***\n";
		    }
		    $tree2[-1]->[1] = \@l;
		} elsif ($_->[0] == 1) {
		    push @tree2, [1, [$_->[1]]];
		} else {
		    push @tree2, $_;
		}
	    }
	    #     Go through tree2, and convert anything like 
	    #     (..., [HTML, S_ITAL], [STRING, "xyz"], [HTML, S_UNITAL], ...)
	    #     to (..., [FUNC, S_I, "xyz"], ...)
	    for (my $n = 0; $n < @tree2 - 2; $n ++) {
		if ($tree2[$n]->[0] == 1 && $tree2[$n+2]->[0] == 1 &&
		    ($tree2[$n+1]->[0] == 0 || $tree2[$n+1]->[0] == 4) &&
		    (@{$tree2[$n][1]} == 1) && (@{$tree2[$n+2][1]} == 1)) {
		    my ($t1, $t2, $t) = ($tree2[$n][1][0], $tree2[$n+2][1][0]);
		    if ($t1 eq 'S_ITAL' && $t2 eq 'S_UNITAL') { $t = 'S_I'; }
		    elsif ($t1 eq 'S_BOLD' && $t2 eq 'S_UNBOLD') { $t = 'S_B';}
		    elsif ($t1 eq 'S_UNDER' && $t2 eq 'S_UNUNDER') { $t = 'S_U'; }
		    if (defined $t) {
			$tree2[$n][0] = 2; 
			if ($tree2[$n+1][0] == 0) {
			    $tree2[$n][1] = "($t) \"".$tree2[$n+1][1]."\"";
			} else {
			    $tree2[$n][1] = "($t) ".$tree2[$n+1][1];
			}
			$tree2[$n+1][0] = $tree2[$n+2][0] = 6; 
		    }
		}
	    }

	    my $rv = join (", ", map {
		if ($_->[0] == 0) { '"'.$_->[1].'"' }
		elsif ($_->[0] == 1) {
		    (@{$_->[1]} > 1) ?
			"(Style) (".join (" | ", @{$_->[1]}).")" :
			    "(Style) ".$_->[1]->[0] }
		elsif ($_->[0] == 2) { $_->[1] }
		elsif ($_->[0] == 3) { $_->[1] }
		elsif ($_->[0] == 4) { "(string) ".$_->[1] }
		elsif ($_->[0] == 5) { $_->[1] }
		elsif ($_->[0] == 6) { }
		else { "Bad type (".@$_.")" }
	    } @tree2);
	    
	    if ($verbose) { print "returning '$rv'\n"; }
	    if (@tree2 == 1 && $tree2[0]->[0] == 0) { return $rv; }
	    return bless \$rv, 'FORMATTED';
	} else { # Skipping variable / html evaluation
	    if ($verbose) { print "returning '$lstr'\n"; }
	    return '"'.$lstr.'"'; 
	}
    } else { 
	print "\n\nReformating undefined string\n\n";
	return "*** UNDEF ***"; 
    }
}

sub deref_str {
    my ($str, $pcmd) = @_;
    if (!defined $pcmd) { $pcmd = 'print_ret'; }
    if (ref $str) { return "$pcmd ".$$str; }
    #return "$pcmd ".$str;
    my $MAX_STR_SIZE = 4000;
    if (length ($str) < $MAX_STR_SIZE) { return "$pcmd ".$str; }
    #print "Breaking '$pcmd $str' into: ";
    my $rv = "$pcmd ";
    while (length ($str) > $MAX_STR_SIZE) {
    	my $lhs = substr ($str, 0, $MAX_STR_SIZE);
	$str = substr ($str, $MAX_STR_SIZE);
	$rv = $rv . $lhs . '", "';
    }
    $rv .= $str;
    #print " <$rv>\n";
    return $rv;
}

# returns a list of all functions necessary to show those resources
sub showrsc {
    my $ht = shift;
    return (showrsc1 ($ht->{SoundFile}, 'S', $ht),
	    showrsc1 ($ht->{GraphicFile}, 'G', $ht));
}

sub showrsc1 {
    my ($fn, $ft, $ht) = @_;
    if (($ft eq 'S' && !$root->{Globals}->{Sound}) ||
	($ft eq 'G' && !$root->{Globals}->{Graphics})) {
	return ();
    }
    if ($fn ne '') {
	if ($ft eq 'S') {
	    if (!defined $sounds{$fn}) {
		my $ffn = $fn;
		$ffn =~ s|^.*\\||;
		$ffn =~ s|\..*||;
		$sounds{$fn} = [uc(get_inform_name('SND_'.$ffn, 1, 1)),
				$ffn, $sndnum ++];
	    }
	    push @sounds, $fn;
	    my ($in) = @{$sounds{$fn}};
	    return "PlaySound ($in);";
	} else {
	    if (!defined $images{$fn}) {
		my $ffn = $fn;
		$ffn =~ s|^.*\\||;
		$ffn =~ s|\..*||;
		print "\$ffn == '$fn' -> '$ffn'\n";
		push @images, $fn;
		$images{$fn} = [uc(get_inform_name('PIC_'.$ffn, 1, 1)), 
				$ffn, $imnum ++];
				
	    }
	    my ($in) = @{$images{$fn}};
	    return "ShowImage ($in);";
	}
	#return ((($ft eq 'S') ? 'PlaySound' : 'ShowImage')."($fn);");
    }
    return ();
}

sub showstr {
    my ($str, $pcmd, $prefix) = @_;
    if ($pcmd eq '') { $pcmd = 'print_ret'; }
    if ($pcmd ne 'print' && $pcmd ne 'print_ret') {
	print "Bad print command '$pcmd' with '$str'\n";
    }
    if ($str ne '') {
	if (!defined($prefix)) { $prefix = ''; }
	return (deref_str(reformat($prefix.$str), $pcmd) . ';'); 
    }
    return ();
}

#####################################################################
#                                                                   #
#                                                                   #
#                        CONVERT ROOM                               #
#                                                                   #
#                                                                   #
#####################################################################


sub convert_room {
    my $r = shift;
    my $iname = $r->{iname};
    my $io = $inform_objects{$iname};
    $io->{print_name} = reformat ($r->{Short});
    if (ref $io->{print_name}) { 
	$io->{short_name} = $io->{print_name};
	$io->{print_name} = reformat ($r->{Short}, 1);
    }

    for (my $n = 0; $n < @{$r->{Exits}}; $n ++) {	
	my $ex = $r->{Exits}->[$n];
	if (%$ex) {
	    my $val = roomname($ex->{Dest} - 1, 1);
	    if ($ex->{Var1} == 0 && $ex->{Var2} == 0 && $ex->{Var3} == 0) {
		if ($ex->{Dest} > 1 + @{$root->{Rooms}}) {
		    $val = "[ ; return $val; ]";
		}
		# covert random of roomgroup to function call, 
		# Otherwise, a normal exit
	    } elsif ($ex->{Var3} == 0) {
		my $pre = $ex->{Var2} ? '~~' : '';
		#$val = ("[ ; if (${pre}Globals.". taskname($ex->{Var1}-1). 
		#	") return $val; ]");
		$val = ("[ ; if (".$pre.tasktrack($ex->{Var1}-1).") return $val; ]");
		pushtrack ($ex->{Var1}-1, ['ROOM_EXIT', 1, $iname]); 
	    } elsif ($ex->{Var3} == 1) {
		my $obj = $stateful_objects[$ex->{Var1} - 1];
		my $ht = $inform_objects{$obj}->{ht};
		my $v2 = $ex->{Var2};
		my $cond = '';
		#print ("\$obj == $obj;  \$ht == (", join (", ", %$ht), 
		#       ");  \$v2 == $v2\n");
		if ($ht->{Openable}) {
		    if ($v2 == 0) { 
			$cond = "$obj has open"; 
		    } elsif ($v2 == 1) { 
			$cond = "$obj hasnt open";
		    } elsif ($v2 == 2 && $ht->{Key} >= 0) {
			$cond = "$obj has locked"; 
		    }
		    if ($ht->{Key} >= 0) { $v2 -= 2; } else { $v2 -= 1; }
		} else {
		    $v2 += 1;
		}
		if ($cond eq '') { $cond = "$obj.state == $v2"; }
		#$val = ("[ ; if (". $stateful_objects[$ex->{Var1}-1].
		#	".state == ". $ex->{Var2}. ") return $val; ]");
		$val = "[ ; if ($cond) return $val; ]";
		#print "\$cond == $cond; \$val == $val\n\n";
	    } else {
		$val = ("**FALLTHROUGH $val ". $ex->{Var1}. ", ". $ex->{Var2}.
			", ". $ex->{Var3});
	    }
	    $io->{$dirnames[$n]} = $val;
	    #print "\$io->{$dirnames[$n]} (\$dirnames[$n]) == '$val'\n";
	}
    }
    if (@{$r->{Alts}}) {
	my @prog = ();  # Code for room.description
	my @prog2 = ();  # Code for room.short_name

	my @phaselens = (0, 0, 0);
	foreach my $a (@{$r->{Alts}}) { $phaselens[$a->{DisplayRoom}] ++; }
	my $need_final = 1;
	
	for my $phase (0, 1, 2) {
	    my $pre = ($phase == 0 ? '' : ' ');  
	    # If this is phase 1 or 2, the rdesc's been printed, so
	    # prepend a space to the text to make it look better.
 
	    for my $alt (@{$r->{Alts}}) {
		if ($alt->{DisplayRoom} == $phase) {
		    $phaselens[$phase] --;
		    my $cond = '1';

		    if ($alt->{Type} == 0) { #Task
			if ($alt->{Var2}) { 
			    #$cond = 'Globals.'. taskname($alt->{Var2}-1);
			    $cond = tasktrack($alt->{Var2}-1);
			    pushtrack ($alt->{Var2}-1, ['ROOM_ALT',1,$iname]);
			}
		    } elsif ($alt->{Type} == 1) { #Object State
			if ($alt->{Var2}) {
			    my $v2 = $alt->{Var3} - 1;
			    my $obj = objectname($alt->{Var2}-1);
			    my $ht = $inform_objects{$obj}->{ht};

			    if ($ht->{Openable} > 0) {
				if ($v2 == 0) {
				    $cond = "$obj has open";
				} elsif ($v2 == 1) {
				    $cond = "$obj hasnt open && $obj hasnt locked";
				} elsif ($v2 == 2 && $ht->{Key} >= 0) {
				    $cond = "$obj has locked";
				}
				if ($ht->{Key} >= 0) { $v2 -= 2; } 
				else { $v2 -= 1; }
			    } else {
				$v2 += 1;
			    }
			    if ($cond eq '') { $cond = "$obj.state == $v2"; }
			}
		    } elsif ($alt->{Type} == 2) { #Player State
			if ($alt->{Var3} == 0) { # No Object
			    my $type = $alt->{Var2};
			    if ($type == 1 || $type == 3 || $type == 4) {
				$cond = '0';
			    }
			} else {
			    my $ob = $dynamic_objects[$alt->{Var3} - 1];
			    if ($alt->{Var2} == 0) { 
				$cond = "$ob notin player"; 
			    } elsif ($alt->{Var2} == 1) {
				$cond = "$ob in player";
			    } elsif ($alt->{Var2} == 2) {
				$ob = $wearable_objects[$alt->{Var3} - 1];
				$cond = "~~Wornby($ob, player)";
			    } elsif ($alt->{Var2} == 3) {
				$ob = $wearable_objects[$alt->{Var3} - 1];
				$cond = "Wornby($ob, player)";
			    } elsif ($alt->{Var2} == 4) {
				$cond = "IndirectlyContains(location, $ob)";
			    } elsif ($alt->{Var2} == 5) {
				$cond = "~~IndirectlyContains(location, $ob)";
			    } else {
				$cond = "*** FALLTHROUGH ***".%$alt;
			    }
			}
		    } else { 
			$cond = "*** FALLTHROUGH ***".%$alt;
		    }
		    # M1 returns if phase 0 or 1, or if phase 2 and last alt 
		    my $pcmd = 'print'.($phase == 2 && $phaselens[2] > 0 ? '':'_ret');
		    # M2 returns if last alt
		    my $pcmd2 = 'print'.($phaselens[0] + $phaselens[1] + $phaselens[2] == 0 ? '_ret' : '');
		    my $c1 = "if ($cond)";

		    my @l1 = (showrsc ($alt->{Res1}), 
			      showstr ($alt->{M1}, $pcmd, $pre));

		    my @l2 = (showrsc ($alt->{Res2}), 
			      showstr ($alt->{M2}, $pcmd2, $pre));
		    if (grep /^print_ret/, @l1 && grep /^print_ret/, @l2) {
			$need_final = 0;
		    }

		    if ($cond eq '1') {  # Always show first alt
			if ($pcmd eq 'print_ret' && $alt->{M1} ne '') { $need_final = 0; }
			push @prog, @l1;
			foreach my $l (@l2) { push @prog, "! Can't show $l"; }
		    } elsif ($cond eq '0') {  #Always show second alt
			if ($pcmd2 eq 'print_ret' && $alt->{M2} ne '') { $need_final = 0; }
			push @prog, @l2;
			foreach my $l (@l1) { push @prog, "! Can't show $l"; }
		    } elsif (!@l1) { #First is empty
			if (!@l2) { #Both first & second empty
			    if ($pcmd eq 'print_ret') {
				push @prog, $c1, '"";';
			    } else {  ! Useless code
				push @prog, $c1, ";";
			    }
			} elsif (@l2 > 1) { #1st empty, 2nd needs braces
			    #push @prog, "if ($cond)", '"";', "else {",@l2,"}";
			    if ($pcmd eq 'print_ret') {
				push @prog, $c1, '"";', 'else {', @l2, '}';
			    } else {
				push @prog, "if (~~($cond)) {", @l2, "}";
			    }
			} else { #First empty, second needs no braces
			    if ($pcmd eq 'print_ret') {
				push @prog, $c1, '"";', 'else', @l2;
			    } else {
				push @prog, "if (~~($cond))", @l2;
			    }
			    #push @prog, "if (~~($cond))", @l2, "else", '"";';
			}
		    } else { # First is present
			if (@l1 > 1 && @l2 > 1) { # Both need braces
			    push @prog, "$c1 {", @l1, "} else {", @l2, "}";
			} elsif (@l1 > 1 && @l2) { # Only 1st needs brace
			    push @prog, "$c1 {", @l1, "} else", @l2;  
			} elsif (@l1 > 1) { # First needs brace, no 2nd
			    push @prog, "$c1 {", @l1, "}";
			} elsif (@l2 > 1) { # Only 2nd needs brace
			    push @prog, $c1, @l1, "else {", @l2, "}";
			} elsif (@l2) { # Neither need brace
			    push @prog, $c1, @l1, "else", @l2;
			} else { # First doesnt need brace, 2nd absent
			    push @prog, "$c1", @l1;
			}
		    }
		    if ($alt->{Changed} ne '') {
			push @prog2, $c1, showstr ($alt->{Changed}, 'print');
		    }
		}
	    }
	    if ($phase == 0 && $r->{Long} ne '') {
		if ($phaselens[1] == 0 && $phaselens[2] == 0) {
		    push @prog, (showrsc ($r->{Res}),
				 showstr ($r->{Long}, 'print_ret'));
		    $need_final = 0;
		} else {
		    push @prog, (showrsc ($r->{Res}),
				 showstr ($r->{Long}, 'print'));
		}
	    }
	}
	if (@prog) { 
	    if ($need_final) { push @prog, '"";'; }
	    $io->{description} = bless \@prog, 'INDENTED'; 
	}
	if (@prog2) { 
	    #if (@prog2 == 2) { 
	    #	@prog2 = ($prog2[0].' {', $prog2[1], 'rtrue;', '}');
	    #} else {
	    for (my $n = 2; $n < @prog2; $n ++) {
		$prog2[$n] = 'else '. $prog2[$n];
	    }
	    #}
	    push @prog2, 'else', "print ".$io->{print_name}.";", 'rtrue;';
	    $io->{short_name} = bless \@prog2, 'INDENTED'; 
	} elsif (ref $io->{print_name}) {
	    $io->{short_name} = bless ['print '.$io->{print_name}.';', 
				       'rtrue' ], 'INDENTED';
	    $io->{print_name} = reformat($r->{Short}, 1);
	}
    } else { # No alts
	my @rsc = showrsc ($r->{Res});
	my $str = reformat ($r->{Long});
	if (@rsc || ref $str) {
	    $io->{description} = bless [ @rsc, deref_str ($str).';' ], 'INDENTED';
	} else {
	    $io->{description} = $str;
	}
    }
}


#####################################################################
#                                                                   #
#                                                                   #
#                        CONVERT OBJECTS                            #
#                                                                   #
#                                                                   #
#####################################################################

my %theobjs = ();  # Maps "The red candy" to 'red_candy'
#   Used in reverse-matching ALRS (You eat the red candy.  Not bad, ...)
#            ==>  red_candy.before.Eat

my %static_wheres = ();  # Maps a list of rooms joined by or's to
                         # all static objects that are in exactly those rooms

sub push_static_where {
    my ($wherestr, $iname) = @_;

    if (!$static_wheres{$wherestr}) { 
	$static_wheres{$wherestr} = [$iname]; 
    } else {
	push @{$static_wheres{$wherestr}}, $iname;
    }
    #print "p_s_w ($wherestr, $iname) -> ",
    #	join (", ", @{$static_wheres{$wherestr}}), "\n";
}
	 
sub convert_obj_1 {
    my $o = shift;
    my $iname = $o->{iname};
    #print "Converting object $iname\n";
    my $io = $inform_objects{$iname};
    my $pn = $o->{Short};
    my @attribs = @{$io->{attribs}};
    if ($o->{Prefix} ne '') { $pn = $o->{Prefix} . ' ' . $pn; }

    my $vwords = join (" ", $o->{Prefix}, $o->{Short}, @{$o->{Alias}});
    $vwords =~ tr/A-Z/a-z/;
    my @vocab = grep { !$small_words{$_} } split / /, $vwords;
    #my @vocab = grep { !$small_words{$_} } @{$io->{vocab}};
    $inform_objects{$o->{iname}}->{vocab} = [ @vocab ];

    #foreach (@vocab) {
    #	$_ =~ s/'/^/g; /'/; 
    #	if (length($_) == 1) { $_ .= '//'; }	
    #}
    @vocab = map { cvt_dict ($_) } @vocab;
    $io->{name} = "'".join ("' '", uniqify (@vocab))."'";
    
    #print "Converting object $iname, quarterway\n";

    if ($pn =~ /^(a|an|A|An|the|The) (.*)/) {
	$io->{article} = reformat($1);
	$theobjs{'the '.$2} = $iname;
	$theobjs{'The '.$2} = $iname;
	$theobjs{$pn} = $iname;
	$theobjs{$2} = $iname;
	$pn = $2;
	my $pn1 = reformat($pn);
	if (ref $pn1) { 
	    $io->{print_name} = reformat ($pn, 1);
	    $io->{short_name} = "[ ; print $$pn1; ]";
	} else {
	    $io->{print_name} = $pn1;
	}
    } else {
	my $pn1 = reformat($pn);
	$theobjs{'the '.$pn} = $iname;
	$theobjs{'The '.$pn} = $iname;
	$theobjs{$pn} = $iname;
	if (ref $pn1) { 
	    $io->{print_name} = reformat ($pn, 1);
	    $io->{short_name} = "[ ; print ".$$pn1."; ]";
	} else {
	    $io->{print_name} = $pn1;
	}
	push @attribs, 'proper';
    }

    #print "Converting object $iname, halfway\n";

    if ($root->{Globals}->{BattleSystem}) {
	if ($o->{ProtectionValue}) { $io->{armor_str} = $o->{ProtectionValue};}
	if ($o->{HitValue}) { $io->{weapon_str} = $o->{HitValue}; }
	if ($o->{Method}) { $io->{method} = $o->{Method}; } # ???
	if ($o->{Accuracy}) { $io->{accuracy} = $o->{Accuracy}; }
    }
    
    if ($o->{Static}) {
	push @attribs, 'static';
	my $w = $o->{Where};
	#print "\$w == (", join (", ", %$w), ")\n";
	if ($w->{Type} == 4) { # NPC Part
	    if ($o->{Parent} == 0) {
		pushscope ('playerobj', $iname);
	    } else {
		pushscope (charname($o->{Parent}-1, 2), $iname);
	    }
	} elsif ($w->{Type} == 3) { # All Rooms
	    push_static_where ('1', $iname);
	    $io->{found_in} = '[ ; rtrue; ]'; 
	} elsif ($w->{Type} == 0) { # No Rooms
	    push_static_where ('0', $iname);
	} elsif ($w->{Type} == 1) { # One Room
	    #print "\$w->{Room} == ", $w->{Room}, "\n";
	    push_static_where (roomname($w->{Room}-1, 2), $iname);
	    pushcontent (roomname($w->{Room}-1, 2), $iname, 1);
	} else { # Some Rooms
	    my @rl = ();
	    for (my $rn = 1; $rn < @{$w->{Rooms}}; $rn ++) {
		if ($o->{Where}->{Rooms}->[$rn]) { push @rl, roomname($rn-1,3); }
	    }
	    #print "For object $iname, found in (", join (", ", @rl), ")\n";
	    my $wherestr = join ' or ', @rl;
	    #print "\$wherestr == $wherestr\n";
	    push_static_where ($wherestr, $iname);
	    my $wherestr1 = conv_where ('location', $wherestr, \@rl);
	    #print "\$wherestr1 == ", id($wherestr1), "\n";

	    if (@rl == 1) {
		pushcontent ($rl[0], $iname, 2);
	    } elsif ($wherestr1) {
		$io->{found_in} = "[ ; return $wherestr1; ]";
	    } elsif (@rl < 64) {
		$io->{found_in} = join ' ', @rl;
	    } else {
		$io->{found_in} = "[ ; return (location == $wherestr); ]";
	    }

	    #if (@rl == 1) {
	    #	pushcontent ($rl[0], $iname, 2);
	    #} elsif (@rl < 64) {
	    #	$io->{found_in} = join ' ', @rl;
	    #} else {
	    #	$io->{found_in} = "[ ; return (location == ".join(" or ", @rl)."); ]";
	    #}
	}
    } else { #Dynamic
	my ($loc, $par) = ($o->{InitialPosition}, $o->{Parent});
	if ($loc == 0) { # Hidden, do nothing
	} elsif ($loc == 1) { # Held by player / NPC
	    if ($par == 0) {
		pushcontent ('playerobj', $iname, 3);
	    } else {
		pushcontent (charname($par-1, 3), $iname, 3);
	    }
	} elsif ($loc == 2) { # In container
	    pushcontent ($container_objects[$par], $iname, 4);
        } elsif ($loc == 3) { # On Surface
	    pushcontent ($surface_objects[$par], $iname, 5);
	} elsif ($loc < 4 + @{$root->{Rooms}}) { # In Room
	    pushcontent (roomname($loc-4, 4), $iname, 6);
	} elsif ($loc == 4 + @{$root->{Rooms}}) { # Worn by someone
	    if ($par == 0) {
		pushcontent ('playerobj', $iname, 7);
		push @attribs, 'worn';
	    } else {
		pushcontent (charname($par-1, 4), $iname, 8);
		push @attribs, 'npcworn';
	    }
	} else {
	    print "Bad location $loc\n";
	}
    }

    if ($o->{Container}) { 
	push @attribs, 'container'; 
	#$io->{BulkSizeCap} = $o->{Capacity};
	my $cn = int ($o->{Capacity}/10);
	my $sn = expt (3, $o->{Capacity} % 10) * $cn;
	my $sw = $size_words[$o->{Capacity} % 10];
	if ($cn == 0) { $io->{capacity} = 0; }
	#elsif ($cn == 1) { $io->{capacity} = $sw; }
	#else { $io->{capacity} = "$sn, ! $cn * $sw"; }	    
	else {
	    my $tmp = $sw;
	    if ($cn > 1) { $tmp = $sw . "_" . $cn; }
	    $io->{capacity} = $tmp;
	    $capacities{$tmp} = $sn;
	}
	if ($o->{Openable} == 0) { push @attribs, 'open'; }
    }
    
    if ($o->{Surface}) { push @attribs, 'supporter'; }
    if ($o->{Readable}) { $io->{read_text} = reformat ($o->{ReadText}); }
    if (!$o->{Static}) {
	if ($o->{Edible}) { push @attribs, 'edible'; }
	if ($o->{Wearable}) { push @attribs, 'clothing'; }
	my $sn = int ($o->{SizeWeight} / 10);
	if ($sn != 2) { $io->{size} = $size_words[$sn]; }
	my $wn = $o->{SizeWeight} % 10;
	if ($wn != 2) { $io->{weight} = $weight_words[$wn]; }
    }
    if ($o->{SitLie} != 0) { push @attribs, 'enterable', 'transparent'; }
    if ($o->{CurrentState} != 0) { 
	$io->{state} = $o->{CurrentState} - 1; 
	my @statelist = split /\|/, $o->{States};
	foreach (@statelist) { if ($_ !~ /[\.\?\!]$/) { $_ .= '.'; } }
	$io->{states} = '"'.join ('" "', @statelist).'"';
	#$io->{states} = '"'.join ('" "', '--', split /\|/, $o->{States}).'"';
    }

    if ($o->{Openable} > 0) { push @attribs, 'openable'; }
    if ($o->{Openable} == 5) { push @attribs, 'open'; }
    elsif ($o->{Openable} == 7) { push @attribs, 'locked'; }
    if ($o->{Openable} > 0 && $o->{Key} != -1) { 
	push @attribs, 'lockable'; 
	$io->{with_key} = $dynamic_objects[$o->{Key}]; 
    }
    $io->{attribs} = \@attribs;
}

sub convert_obj_2 {
    my $o = shift;
    my $iname = $o->{iname};
    my $io = $inform_objects{$iname};
    my @attribs = @{$io->{attribs}};
    
    if ($o->{Task} == 0) {
	my @res = showrsc($o->{Res1});
	my $os = ($o->{StateListed} ? ", (ObjState) self;" : ';');
	if (showrsc ($o->{Res2})) { print "Can't show ",$o->{iname},"->{Res2}: no task\n"; }
	my $desc = reformat ($o->{Description});
	#my $desc1 = ref $desc ? $$desc : $desc;

	#if ($o->{StateListed}) {
	#    $io->{description} = bless [ @res, deref_str($desc). ", (ObjState) self;" ], 'INDENTED';
	#} elsif (@res) {
	#    $io->{description} = bless [ @res, deref_str($desc1) ],'INDENTED';
	#} else {
	#    $io->{description} = $desc;
	#}
	if (@res) { $desc = bless [ @res, deref_str($desc).$os ], 'INDENTED'; }
	$io->{itemdesc} = $desc;
    } else {
	pushtrack ($o->{Task}-1, ['OBJ_ALT', 1, $iname]); 
	my $os = ($o->{StateListed} ? ", (ObjState) self;" : ';');
	my @l1 = (showrsc($o->{Res1}), 
		  deref_str(reformat($o->{Description})) . $os);
	my @l2 = (showrsc($o->{Res2}),
		  deref_str(reformat($o->{AltDesc})) . $os);
	if (@l1 > 1 || @l2 > 1) {
	    print "\@l1 == ('", join ("', '", @l1), "')\n";
	    print "\@l2 == ('", join ("', '", @l2), "')\n";
	}
	# Swap lists if necessary, so that @l1 is first.
	if (!$o->{TaskNotDone}) { my @l3 = @l1; @l1 = @l2; @l2 = @l3; }
	    
	#my @l = ('if (Globals.'.taskname($o->{Task}-1).')'.(@l1==1 ?'':' {'), 
	#	 @l1,    (@l1 == 1 ? '':'} ').'else'.(@l2 == 1 ? '':' {'), 
	#	 @l2,    (@l2 == 1 ? () : ('}')));

	my @l = ('if ('.tasktrack($o->{Task} - 1).')'.(@l1==1 ? '':' {'), 
		 @l1,    (@l1 == 1 ? '':'} ').'else'.(@l2 == 1 ? '':' {'), 
		 @l2,    (@l2 == 1 ? () : ('}')));

	$io->{itemdesc} = bless \@l, 'INDENTED';
    }

    if ($o->{InRoomDesc} ne '') {
	my $v = $o->{OnlyWhenNotMoved};
	if ($v == 0) {
	    $io->{describe} = reformat($o->{InRoomDesc});
	} elsif ($v == 1) {
	    $io->{initial} = reformat($o->{InRoomDesc});
	} elsif ($v == 2) {
	    if (!defined ($io->{parent})) {
		$io->{initial} = reformat ($o->{InRoomDesc});
	    } else {
		$io->{describe} = bless [ 'if (self in '.$io->{parent}.')', showstr ($o->{InRoomDesc}, 'print_ret') ], 'INDENTED';
	    }
	} else {
	    $io->{describe} = "*** Bad value for OWNM: $v";
	}
    } else { 
	if ($o->{Static} && $o->{ListFlag} == 0) {
	    push @attribs, 'scenery';
	} elsif (!$o->{Static} && $o->{ListFlag} == 1) {
	    $io->{initial} = '[ ; rtrue; ]';
	}
    }

    $io->{attribs} = \@attribs;
}


#####################################################################
#                                                                   #
#                                                                   #
#                        CONVERT CHARACTER                          #
#                                                                   #
#                                                                   #
#####################################################################

sub convert_character_1 {
    my $o = shift;
    my $iname = $o->{iname};
    my $io = $inform_objects{$iname};

    my $pn = $o->{Name};
    my @attribs = @{$io->{attribs}};
    
    if ($pn =~ /^(a|an|A|An|the|The) (.*)/) {
	$theobjs{'the '.$2} = $iname;
	$theobjs{'The '.$2} = $iname;
	$theobjs{$2} = $iname;
	if ($o->{Prefix} ne '') { $io->{prefix} = reformat ($o->{Prefix}); }
	$io->{article} = reformat($1);
	$pn = $2;
	my $pn1 = reformat($2);
	if (ref $pn1) { 
	    $io->{print_name} = reformat ($pn, 1);
	    $io->{short_name} = "[ ; print $$pn1; ]";
	} else {
	    $io->{print_name} = $pn1;
	}
    } else {
	$theobjs{'the '.$pn} = $iname;
	$theobjs{'The '.$pn} = $iname;
	$theobjs{$pn} = $iname;
	my $pn1 = reformat($pn);
	if (ref $pn1) { 
	    $io->{print_name} = reformat ($pn, 1);
	    $io->{short_name} = "[ ; print $$pn1; ]";
	} else {
	    $io->{print_name} = $pn1;
	}

	push @attribs, 'proper';
    }
    my $vwords = join (" ", $pn, $o->{Prefix}, @{$o->{Alias}});

    $vwords =~ tr/A-Z/a-z/;
    my @vocab = grep { !$small_words{$_} } split / /, $vwords;
    $io->{vocab} = [ @vocab ];
    #my @vocab = @{$io->{vocab}};
    #my @vocab = grep { !$small_words{$_} } @{$io->{vocab}};
    #foreach (@vocab) {
    #	$_ =~ s/'/^/g; /'/; 
    #	if (length($_) == 1) { $_ .= '//'; }
    #}
    @vocab = map {cvt_dict ($_) } @vocab;
    $io->{name} = "'".join ("' '", @vocab)."'";
    $io->{attribs} = \@attribs;
}

sub convert_character_2 {
    my $o = shift;
    my $iname = $o->{iname};
    my $io = $inform_objects{$iname};
    my @attribs = @{$io->{attribs}};

    #$io->{name} = "'".join ("' '", 
    #			    map { length($_) == 1 ? "$_//" : $_ } @vocab)."'";

    #print "Alternate descriptions for ", $o->{Name}, "\n";
    my @reslines = map { my @r = showrsc($o->{Res}->[$_]);
			 (@r > 0) ? (join "", "! Res $_: ", @r) : ()
			 } (0..3);


    my @desclines = (@reslines);
    if ($o->{Task} > 0) {
	pushtrack ($o->{Task}-1, ['CHAR_DESC', 1, $iname]); ####
	#print "reformat AltText (", $o->{AltText}, ")\n";
	#push @desclines, ("if (Globals".taskname($o->{Task}-1).")",
	#		  showstr(reformat($o->{AltText}), 'print_ret'));
	push @desclines, ("if (".tasktrack($o->{Task}-1).")",
			  showstr(reformat($o->{AltText}), 'print_ret'));
    }
    my $descl = reformat($o->{Descr});
    if (@desclines || ref $descl eq 'INDENTED') {
	if ($o->{Descr} ne '') {
	    #push @desclines, 'print_ret '.$descl.';';
	    push @desclines, deref_str($descl).';';
	}
	#$io->{description} = bless [@desclines], 'INDENTED';
	$io->{npcdesc} = bless [@desclines], 'INDENTED';
    } else {
	#$io->{description} = $descl;
	$io->{npcdesc} = $descl;
    }
    #print "\@desclines == (", join (", ", @desclines), "); \$io->{description} == ", $io->{description}, (ref $io->{description} eq 'INDENTED' ? ('['.@{$io->{description}}.']'):''),"\n";

    if ($o->{Gender} == 0) { push @attribs, 'male'; }
    elsif ($o->{Gender} == 1) { push @attribs, 'female'; }

    if ($o->{StartRoom}) {
	pushcontent (roomname($o->{StartRoom} - 1, 5), $iname, 9);
    }

    my @daemonlines = ();

    if (@{$o->{Walks}}) {
	push @daemonlines, 'if (self.curwalk)', 'self.curwalk();';
	foreach my $w (@{$o->{Walks}}) {
	    my $wname = get_inform_name ('walk', 1, 1);
	    $w->{iname} = $wname;
	    my @wlines;
	    if (@{$w->{Times}} == 1 && $w->{Times}->[0] == 1) {
		my $str;
		my $r = $w->{Rooms}->[0];
		if ($r == 0) { $str = "nothing"; }
		elsif ($r == 1) { $str = "real_location"; }
		elsif (($r -=  2) < @{$root->{Rooms}}) {
		    $str = roomname ($r, 7);
		} elsif (($r -= @{$root->{Rooms}}) < @{$root->{RoomGroups}}) {
		    $str = "RandRG (".roomgroupname($r).");";
		}
		@wlines = ("self.moveto ($str);");
		if (!$w->{Loop}) { push @wlines, "self.curwalk = nothing;"; }
	    } else {
		my $steps = 0;
		@wlines = ('switch (++ self.walktime) {');
		for my $ws (0..$#{$w->{Rooms}}) {
		    my $r = $w->{Rooms}->[$ws];
		    if ($r == 0) { # Hidden
			push @wlines, "$steps: self.moveto (nothing);";
		    } elsif ($r == 1) { # FollowPlayer
			push @wlines, "$steps: self.moveto (real_location);";
		    } elsif ($r < 2 + @{$root->{Rooms}}) {
			push @wlines, "$steps: self.moveto (".roomname($r-2,7).");";
		    } elsif ($r < 2 + @{$root->{Rooms}} + @{$root->{RoomGroups}}) {
			#push @wlines, "$steps:  self.moveRG (".
			#	roomgroupname($r-@{$root->{Rooms}}-2).");";
			push @wlines, "$steps: self.moveto (RandRG (".
			    roomgroupname($r-@{$root->{Rooms}}-2).");";
		    } else {
			push @wlines, "$steps: *** TOO HIGH $r ***;";
		    }
		    $steps = $steps + $w->{Times}->[$ws];
		}
		if ($w->{Loop}) {
		    if ($w->{Times}->[-1] == 1) {
			push @wlines, "self.walktime = -1;";
		    } else {
			push @wlines, ($steps - 1).": self.walktime = -1;";
		    }
		} else {
		    push @wlines, "$steps: self.curwalk = nothing;";
		}
		push @wlines, '}';
	    }
	    if ($w->{StartTask}) {
		pushtrack ($w->{StartTask}-1,  ##### START_CHAR_WALK
			   ['START_CHAR_WALK', 0, $iname, $wname]);
	    } else {
		$io->{curwalk} = $wname;
	    }

	    if ($w->{StoppingTask}) {
		pushtrack ($w->{StoppingTask}-1,  #### STOP_CHAR_WALK
			   ['STOP_CHAR_WALK', 0, $iname, $wname]);
	    }	

	    if ($w->{CharTask}) {
		my $target = 'player';
		if ($w->{MeetChar} > 0) {
		    $target = charname ($w->{MeetChar} - 1, 5);
		}
		pushcall ($w->{CharTask}-1, ['CHAR_WALK_MEET_CHAR', 1,$iname]);
		push @wlines, "if ($target in RealLoc(self)) {",
		    "!! EXEC ".taskname($w->{CharTask}-1), "}";
	    }
	    
	    if ($w->{ObjectTask}) {
		my $target = $dynamic_objects[$w->{MeetObject} - 1];
		pushcall ($o->{ObjectTask}, ['CHAR_WALK_MEET_CHAR', 1,$iname]);
		push @wlines, "if ($target in RealLoc(self)) {",
		    "!! EXEC ".taskname($w->{ObjectTask} - 1), "}";
	    }

	    $io->{$w->{iname}} = bless \@wlines, 'INDENTED';
	}
    }

    if ($root->{Globals}->{BattleSystem}) {
	my $bo = $o->{Battle};
	if ($bo->{StaminaLo} == $bo->{StaminaHi}) {
	    $io->{stamina} = $io->{max_stamina} = $bo->{StaminaHi};
	} else {		
	    $io->{first_turn} = "[ ; self.stamina = self.max_stamina = randomfrom (". $bo->{StaminaLo}. ", ". $bo->{StaminaHi}. "); ]";
	}
	$io->{str} = $bo->{StrengthLo}. " ". $bo->{StrengthHi};
	$io->{acc} = $bo->{AccuracyLo}. " ". $bo->{StrengthHi};
	$io->{def} = $bo->{StrengthLo}. " ". $bo->{StrengthHi};
	$io->{agi} = $bo->{StrengthLo}. " ". $bo->{StrengthHi};
	$io->{alignment} = 'ALIGN_'.('ALLY','NEUTRAL','ENEMY')[$bo->{Attitude}];
	if ($bo->{KilledTask} > 0) {
	    pushcall ($bo->{KilledTask}-2, ['DEATH_EXEC', 1, $o->{iname}]);
	    $io->{on_death} = bless ['!! EXEC '.taskname($bo->{KilledTask} - 2)], 'INDENTED';
	}
	if ($bo->{StaminaTask} > 0) {
	    pushcall ($bo->{StaminaTask}-1, ['LOWSTAM_EXEC', 1, $o->{iname}]);
	    push @daemonlines, ('if (self.stamina < self.max_stamina / 10)', 
				'!! EXEC '.taskname($bo->{StaminaTask} - 1));
	}
	if ($bo->{Recovery} != 0) {
	    push @daemonlines, ('if (self.stamina < self.max_stamina && turns % '.$bo->{Recovery}.' == 0)', 'self.stamina = self.stamina + 1;');
	}
    }

    if (@daemonlines) {
	$io->{daemon} = bless \@daemonlines, 'INDENTED';
    }
    
    @desclines = ();
    foreach my $w (@{$o->{Walks}}) {
	if ($w->{ChangedDesc} ne '') {
	    push @desclines, ("if (self.curwalk == ".$w->{iname}.")",
			      'print_ret '.reformat($w->{ChangedDesc}).';');
	}
    }
    if ($o->{InRoomText} ne '#') {
	my $tmp = reformat ($o->{InRoomText});

	if (@desclines || ref $tmp) {
	    push @desclines, deref_str ($tmp).';';
	    $io->{describe} = bless \@desclines, 'INDENTED';
	} else {
	    $io->{describe} = $tmp;
	}

    }    
        
    if ($o->{ShowEnterExit}) {
	$io->{showmove} = 'true';
	if ($o->{EnterText}) {
	    my $et = reformat($o->{EnterText});
	    if (ref $et) { $io->{entertext} = "[ ; print $$et; ]"; }
	    else { $io->{entertext} = $et; }
	}
	if ($o->{ExitText}) { 
	    my $et = reformat($o->{ExitText});
	    if (ref $et) { $io->{exittext} = "[ ; print $$et; ]"; }
	    else { $io->{exittext} = $et; }
	}
    }
    if (defined ($o->{Res})) {
	my @rscs = ();
	for my $n (0..$#{@{$o->{Res}}}) {
	    my $r = $o->{Res}->[$n];
	    if ($root->{Sound} && $r->{SoundFile} ne '') { 
		push @rscs, $n, $r->{SoundFile}; 
	    }
	    if ($root->{Graphics} && $r->{GraphicFile} ne '') { 
		push @rscs, $n, $r->{GraphicFile}; 
	    }
	}
    }
    if (@{$o->{Topics}}) {
	my @deflines = ();
	my @asklines = ();
	my @theselines;
	if ($SIMPLE_CONV) {
	    @asklines = ('switch (second) {');
	    foreach my $t (@{$o->{Topics}}) {
		my @words = uniqify (grep !/^$/, split /[,\' ]+/, $t->{Subject});
		if (!@words) { @words = ('blank,word'); }
		if (grep /^\*$/, @words) {
		    @theselines = ('default:')
		} else {
		    @theselines = ("'".join ("', '", @words)."':");
		}
		if ($t->{Task}) {
		    #push @theselines, ('if (Globals.'.taskname($t->{Task}-1).')',
		    #		   showstr ($t->{AltReply}, 'print_ret'));
		    push @theselines, ('if ('.tasktrack($t->{Task}-1).')',
				       showstr ($t->{AltReply}, 'print_ret'));
		    pushtrack ($t->{Task}-1, ['ASK_RESTR',1,$iname]); ####
		}
		if ($t->{Reply} ne '') {
		    push @theselines, showstr ($t->{Reply}, 'print_ret');
		}
		if ($theselines[0] eq 'default:') {
		    @deflines = @theselines;
		} else {
		    push @asklines, @theselines;
		}
	    }
	    push @asklines, @deflines, '}';
	    if ((@{$o->{Topics}} == 1) && ($asklines[1] eq 'default:')) {
	        pop @asklines; # remove closing rbrace
	        shift @asklines; # remove opening switch / lbrace
	        shift @asklines; # remove default:
	    }
	} else { # COMPLEX CONV
	    foreach my $t (@{$o->{Topics}}) {
		my @lines = split /, */, $t->{Subject};
		my @conds = ();
		my $haswild = 0;
		foreach my $l (@lines) {
		    if ($l eq '*') { $haswild = 1; next; }
		    my @words = split / /, $l;
		    my $cond = "MatchTopic ('".join ("', '", map { my $tmp = $_; $tmp =~ s/\'/^/; length($tmp) == 1 ? $tmp.'//' : $tmp } @words). "')";
		    push @conds, $cond;
		}
		my @text;
		if ($t->{Task}) {
		    pushtrack ($t->{Task} - 1, ['ASK_RESTR', 1, $iname]);
		    my $cc1 = "if (".tasktrack($t->{Task} - 1).")";
		    my $cc2 = "if (~~".tasktrack($t->{Task} - 1).")";
		    if ($t->{AltReply} ne '' && $t->{Reply} ne '') {
			@text = ($cc1, showstr($t->{AltReply}), 'else', 
				 showstr($t->{Reply}));
		    } elsif ($t->{AltReply} ne '') {
			@text = ($cc1, showstr($t->{AltReply}));
		    } elsif ($t->{Reply} ne '') {
			@text = ($cc2, showstr($t->{Reply}));
		    } else {
			@text = ($cc1, "; ! No text for Reply or AltReply;");
		    }
		} else {
		    @text = (showstr ($t->{Reply}));
		}
		if ($haswild) { push @deflines, @text; }
		if (@conds) {
		    my $cond = 'if ('.(join " || ", @conds).')';
		    #my @cline;
		    #if (@conds < 2) { 
		    #    @cline = ("if (".(join (" || ", @conds)).")");
		    #} else { @cline = ("if (".$conds[0]." ||",
		    #		   (map { $_ . " ||" } @conds[1..$#conds-1]),
		    #		   $conds[$#conds].")"); }
		    
		    if (@text == 1) {
			#push @asklines, @cline, @text;
			push @asklines, $cond, @text;
		    } else {
			#push @asklines, (@cline[0..$#cline-1],
			#		     $cline[$#cline].' {', @text, '}');
			push @asklines, ($cond.' {', @text, '}');
			# Probably don't need special treatment,
			# but I want to avoid hanging elses
		    }
		}
	    }
	    push @asklines, @deflines;
	}
	push @{$io->{lifes}->{Ask}}, @asklines;
    }
    $io->{attribs} = \@attribs;
}

#my @levels = [ ['
#
#sub conv_expr {
#    my $expr = shift;
#    my $orig_expr = $expr;
#    my @atoms = ();
#    while ($expr ne '') {
#	if ($expr =~ /^(\&\&|==|<>|>=|<=|\|\||!=|[a-z]*|%[^%]*%|+|-|\*|\/|\&|\||\(|\)|,|\^|=|>|<)(.*)/) {
#	    push @atoms, $1;
#	    $expr = $2;
#	}
#    }
#    return parse_list (@atoms);
#}

#####################################################################
#                                                                   #
#                                                                   #
#                        CONVERT TASK                               #
#                                                                   #
#                                                                   #
#####################################################################

sub convert_task {
    my $tasknum = shift;
    my $o = $root->{Tasks}->[$tasknum];
    my $iname = $o->{iname};
    my $io = $inform_objects{$iname};

    if ($o->{Reversible}) { 
	#print "Reversible task:  ", join (", ", keys %$o), "\n";
	$io->{Revlines} = $o->{ReverseCommand}; 
    }
    if (!$GUESS_PARSE) {
	$io->{ParserCall} = 0;
	if (grep /^[^\#]/, @{$io->{Fwdlines}}) { $io->{ParserCall} = 1; }
	$io->{Fwdlines} = $o->{Command};
	$io->{Parsed} = [];
	$io->{Failed} = $o->{Command};
	$io->{call} = [];
    }

    if ($o->{Question} ne '') {
	$io->{Hint} = reformat($o->{Question}).' '.reformat($o->{Hint1}).' '.
	    reformat($o->{Hint2});
    }


    #print "Converting where: ", $o->{Where}->{Type}, "\n";
    if ($o->{Where}->{Type} == 3 || @{$root->{Rooms}} == 1) {  # All Rooms
	$io->{where} = '1';
    } elsif ($o->{Where}->{Type} == 0) {  # No Rooms
	$io->{where} = '0';
    } elsif ($o->{Where}->{Type} == 1) { # One Room
	$io->{where} = 'real_location == '.roomname ($o->{Where}->{Room},8);
    } else {
	my @tmp1 = map { if ($o->{Where}->{Rooms}->[$_]) {(roomname($_,9))} else {()}} (0..$#{$root->{Rooms}});
	my $tmp1 = join (" or ",  @tmp1);
	my $tmp2 = conv_where ('real_location', $tmp1, \@tmp1);
	$io->{where} = defined ($tmp2) ? $tmp2 : 'real_location == '.$tmp1;
    }
    #print " result '", $io->{where}, "'\n";
    my @restrs = ();
    
    my ($t_own, $t_noun, $t_sec) = ($io->{owner}, $io->{noun}, $io->{second}); 
    foreach my $r (@{$o->{Restrictions}}) {
	my @this = ();
	my ($v1, $v2, $v3) = ($r->{Var1}, $r->{Var2}, $r->{Var3});
	if ($r->{Type} == 0) { # Object Location Restriction
	    if ($v2 > 12 || $v2 < 0) {
		@this = ('*** BAD RESTR ***'.%$r, '*** BAD RESTR ***'.%$r);
	    } elsif ($v1 == 0 || $v1 == 1) { # No Object
		if ($v1 == 1) { $v2 = ($v2 + 6 % 12); }
		if ($v2 == 0 || $v2 == 6) {
		    if ($v3 == 0) { # Hidden
			@this = ('NoHidden()', '(~~NoHidden())');
		    } else { # In a room
			my $rn = roomname ($v3 - 1,10);
			@this = ("(~~children($rn))", "children($rn)");
		    }
		} elsif ($v2 == 1 || $v2 == 7) { # Held by
		    my $on = 'player'; # v3 == 0
		    if ($v3 == 1) { 
			$on = 'REFCHAR';
			if ($t_noun eq 'REFCHAR') { $on = 'noun'; }
			elsif ($t_sec eq 'REFCHAR') { $on = 'second'; }
		    } # By ref. character
		    elsif ($v3 > 1) { $on = charname ($v3 - 2, 6); }
		    @this = ("(~~children($on))", "children($on)");
		} elsif ($v2 == 2 || $v2 == 8) { # Worn by
		    my $on = 'player';
		    if ($v3 == 1) { 
			$on = 'REFCHAR';
			if ($t_noun eq 'REFCHAR') { $on = 'noun'; }
			elsif ($t_sec eq 'REFCHAR') { $on = 'second'; }
		    } # By ref. character
		    elsif ($v3 > 1) { $on = charname($v3 - 2, 7); }
		    @this = ("NoneWorn($on)", "(~~NoneWorn($on))");
		} elsif ($v2 == 3 || $v2 == 8) { # Visible to
		    my $on = 'player';
		    #if ($v3 == 1) { $on = 'REFCHAR'; }
		    if ($v3 == 1) { 
			$on = 'REFCHAR';
			if ($t_noun eq 'REFCHAR') { $on = 'noun'; }
			elsif ($t_sec eq 'REFCHAR') { $on = 'second'; }
		    } # By ref. character
		    elsif ($v3 > 1) { 
			$on = charname($v3 - 2, 8); 
			if ($on eq $t_own) { $on = 'self'; }
		    }
		    @this = ("(~~$on.canSee(nothing))", "$on.canSee(nothing)");
		} elsif ($v2 == 4 || $v2 == 9) { # In object
		    if ($v3 == 0) {
			@this = ("** nothing notin 0**", "** nothing in 0 **");
		    } else {
			my $so = $container_objects[$v3-1];
			if ($so eq $t_own) { $so = 'self'; }
			@this = ("(~~child($so))", "child($so)");
		    }
		} elsif ($v2 == 5 || $v2 == 10) { # On object
		    if ($v3 == 0) {
			@this = ("** nothing notin 0**", "** nothing in 0 **");
		    } else {
			my $so = $surface_objects[$v3-1];
			@this = ("(~~child($so))", "child($so)");
		    }
		} else {
		    @this = ("Fallthrough v2 == $v2", "Fallthrough v2 == $v2");
		}
		# End No Object / Any Object restrictions
	    } else {  # Var1 >= 2
		my $obj = '** FALLTHROUGH **'.%$r;
		#if ($v1 == 2) { $obj = 'REFOBJ'; }
		if ($v1 == 2) {
		    if ($t_noun eq 'REFOBJ') { $obj = 'noun'; }
		    elsif ($t_sec eq 'REFOBJ') { $obj = 'second'; }
		    else { $obj = 'REFOBJ'; }
		} else { 
			$obj = $dynamic_objects[$v1-3]; 
		    if ($obj eq $t_own) { $obj = 'self'; }
		}
		if ($v2 == 0 || $v2 == 6) { # in room
		    if ($v3 == 0) {
			@this = ("(~~parent($obj))", "parent($obj)"); 
		    } else {
			my $ro = roomname ($v3 - 1, 11);
			@this = ("$obj in $ro", "$obj notin $ro");
		    }
		} elsif ($v2 == 1 || $v2 == 7) { # Held by
		    my $npc = 'player';
		    if ($v3 == 0) {  }
		    #elsif ($v3 == 1) { $npc = 'REFCHAR'; }
		    elsif ($v3 == 1) {
			if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
			elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
			else { $npc = 'REFCHAR'; }
		    } elsif ($v3 > 1) { 
			$npc = charname ($v3 - 2, 9); 
			if ($npc eq $t_own) { $npc = 'self'; }
		    }
		    @this = ("$obj in $npc", "$obj notin $npc");
		} elsif ($v2 == 2 || $v2 == 8) { # Worn by
		    my ($npc, $attr);
		    if ($v3 == 0) { 
			$npc = 'player';
		    } elsif ($v3 == 1) {
			#$npc = 'REFCHAR';
			if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
			elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
			else { $npc = 'REFCHAR'; }			
		    } else { 
			$npc = charname($v3 - 2, 10);
			if ($npc eq $t_own) { $npc = 'self'; }
		    }
		    @this = ("Wornby ($obj, $npc)", "(~~Wornby ($obj, $npc))");
		} elsif ($v2 == 3 || $v2 == 9) { # Visible To
		    my $npc;
		    if ($v3 == 0) { $npc = 'player'; }
		    elsif ($v3 == 1) { 
			#$npc = 'REFCHAR'; 
			if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
			elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
			else { $npc = 'REFCHAR'; }			
		    } else { 
			$npc = charname($v3 - 2, 11); 
			if ($npc eq $t_own) { $npc = 'self'; }
		    }
		    @this = ("$npc.canSee($obj)", "(~~$npc.canSee($obj))");
		} elsif ($v2 == 4 || $v2 == 5 || $v2 == 10 || $v2 == 11) {   
		    if ($v3 == 0) {
			my $a = ($v2 % 6 == 4) ? 'container' : 'supporter';
			@this=("parent($obj) has $a", "parent($obj) hasnt $a");
		    } else {
			my $o2 = ($v2 % 6 == 4) ? $container_objects[$v3 - 1] :
			    $surface_objects[$v3 - 1];
			if ($o2 eq $t_own) { $o2 = 'self'; }
			@this = ("$obj in $o2", "$obj notin $o2");
		    }
		}
	    }
	    if ($v2 > 6) { @this = reverse @this; }
	    # End object location type restrictions
	} elsif ($r->{Type} == 1) { # Object state restrictions
	    my ($v1, $v2) = ($r->{Var1}, $r->{Var2});
	    if ($v1 == 0) { 
		#@this = ("REFOBJ.state == $v2", "REFOBJ.state ~= $v2"); 
		my $obj = 'REFOBJ';
		if ($t_noun eq 'REFOBJ') { $obj = 'noun'; }
		elsif ($t_sec eq 'REFOBJ') { $obj = 'second'; }
		@this = ("$obj.state == ".($v2-1), "$obj.state ~= ".($v2-1));
	    } else {
		#print "\$v1 == ", $v1, "; length stateful_objects == ", (scalar @stateful_objects), "\n";
		my $obj = $stateful_objects[$v1-1];
		my $hobj = $inform_objects{$obj}->{ht};
		if ($obj eq $t_own) { $obj = 'self'; }
		#print "\$obj == $obj; \$inform_objects{$obj} == (", join (", ", %{$inform_objects{$obj}}), ")\n";
		
		if ($hobj->{Openable} > 0) {
		    if ($v2 == 0) {
			@this = ("$obj has open", "$obj hasnt open");
		    } elsif ($v2 == 1) {
			@this = ("$obj hasnt open", "$obj has open");
		    } elsif ($v2 == 2 && $hobj->{Key} >= 0) {
			@this = ("$obj has locked", "$obj hasnt locked");
		    }
		    if ($hobj->{Key} >= 0) { $v2 -= 2; } else { $v2 -= 1; }
		} else { 
		    $v2 = $v2 + 1;
		}
		if (!@this) { # Then its stateful
		    @this = ("$obj.state == ".($v2-1), 
			     "$obj.state ~= ".($v2-1));
		}
	    }
	    #if ($v1 >= 6) { @this = reverse @this; }
	    # End object state restrictions
	} elsif ($r->{Type} == 2) { #Task state
	    my $v1 = $r->{Var1};
	    if ($v1 == 0) { # No task
		@this = ("** NO TASK DONE ** ", "** NO TASK NOT DONE **");
	    } else {
		#my $tn = taskname($v1 - 1);
		#my $tt_own = $root->{Tasks}->[$tn - 1]->{owner};
		my $tt = tasktrack($v1-1);
		#if (!defined $tt_own) { $tt_own = 'Globals'; }
		
		#if ($r->{Var2}) {
		#    @this = ("$tt_own.$tn == 0", "$tt_own.$tn");
		#} else {
		#    @this = ("$tt_own.$tn",      "$tt_own.$tn == 0");
		#}
		if ($r->{Var2}) {
		    @this = ("$tt == 0", "$tt");
		} else {
		    @this = ("$tt",      "$tt == 0");
		}
		#if ($r->{Var2}) {
		#    @this = ("(~~Globals.$tn)", "Globals.$tn");
		#} else {
		#    @this = ("Globals.$tn", "(~~Globals.$tn)");
		#}
		pushtrack ($v1-1, ['TASK_RESTR', 1, $iname]);
	    }
	    # End task state restriction
	} elsif ($r->{Type} == 3) { # Player & Chars
	    my ($v1, $v2, $v3) = ($r->{Var1}, $r->{Var2}, $r->{Var3});
	    #my $npc = ($v1 == 0 ? 'player' : 
	    #	       ($v1 == 1 ? 'REFCHAR' : charname ($v1 - 2, 12)));
	    my $npc = 'player';
	    if ($v1 == 1) {
		if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
		elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
		else { $npc = 'REFCHAR'; }
	    } elsif ($v1 > 1) {
		$npc = charname($v1 - 2, 13);
		if ($npc eq $t_own) { $npc = 'self'; }
	    }
	    if ($v2 == 0) {
		#my $npc2 = ($v3 == 0 ? 'player' : 
		#	    ($v3 == 1 ? 'REFCHAR' : charname ($v3 - 2, 14)));
		my $npc2 = 'player';
		if ($v3 == 1) {
		    if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
		    elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
		    else { $npc = 'REFCHAR'; }
		} elsif ($v3 > 1) {
		    $npc = charname ($v3 - 2, 15);
		    if ($npc eq $t_own) { $npc = 'self'; }
		}
		@this = ("RealLoc($npc) == RealLoc($npc2)",
			 "RealLoc($npc) ~= RealLoc($npc2)");
	    } elsif ($v2 == 1) {
		#my $npc2 = ($v3 == 0 ? 'player' : 
		#	    ($v3 == 1 ? 'REFCHAR' : charname ($v3 - 2, 16)));
		my $npc2 = 'player';
		if ($v3 == 1) {
		    if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
		    elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
		    else { $npc = 'REFCHAR'; }
		} elsif ($v3 > 1) {
		    $npc = charname ($v3 - 2, 17);
		    if ($npc eq $t_own) { $npc = 'self'; }
		}
		@this = ("RealLoc($npc) == RealLoc($npc2)",
			 "RealLoc($npc) ~= RealLoc($npc2)");
		
		@this = ("RealLoc($npc) ~= RealLoc($npc2)",
			 "RealLoc($npc) == RealLoc($npc2)");
	    } elsif ($v2 == 2) {
		@this = ("$npc.isAlone()", "(~~$npc.isAlone())");
	    } elsif ($v2 == 3) {
		@this = ("(~~$npc.isAlone())", "$npc.isAlone()");
	    } elsif ($v2 == 4 || $v2 == 5 || $v2 == 6) {
		my $o2 = ($v2 == 5 ? $sit_objects[$v3-1] :
			  $lie_objects[$v3-1]);
		if ($o2 eq $t_own) { $o2 = 'self'; }
		my $p = (('')x4,'P_Standing','P_Sitting','P_Lying')[$v2];
		@this = ("($npc in $o2 && $npc.posture == $p)", 
			 "($npc notin $o2 || $npc.posture ~= $p)");
	    } elsif ($v2 == 7) { # GENDER
		if ($v3 == 0) { 
		    @this = ("$npc has male", "$npc hasnt male");
		} elsif ($v3 == 1) {
		    @this = ("$npc has female", "$npc hasnt female");
		} else {
		    @this = ("** GENDER RESTR **", "** GENDER RESTR **");
		}
	    } else {
		@this = ("** BAD CHAR RESTR **", "** BAD CHAR RESTR **");
	    }
	    # End Character type restrictions
	} elsif ($r->{Type} == 4) { # Variables
	    my ($var, $type);
	    if ($r->{Var1} == 0) { 
		($var, $type) = ('REFNUM', 0); 
		if ($t_noun eq 'REFNUM') { $var = 'noun'; }
		elsif ($t_sec eq 'REFNUM') { $var = 'second'; }
	    }
	    elsif ($r->{Var1} == 1) { ($var, $type) = ('REFTEXT', 1); }
	    else { my $tmp = $root->{Variables}->[$r->{Var1}-2];
		   #($var, $type) = ($tmp->{Name}, $tmp->{Type}); 
		   ($var, $type) = ('Globals.'.$tmp->{iname}, $tmp->{Type}); 
	       }
	    
	    if ($type == 0) { # Integer
		my $comp  = ('<','<=','==','>=','>','~=') [$r->{Var2} % 10];
		my $comp2 = ('>=','>','~=','<','<=','==') [$r->{Var2} % 10];
		my $rval = $v2 < 6 ? $v3 : $integer_vars[$v3-1];
		@this = ("$var $comp $rval", "$var $comp2 $rval");
	    } elsif ($type == 1) { # String
		my $rval = ($r->{Var3} == 0) ? $r->{Var4} : 
		    $string_vars[$r->{Var3} - 1];
		@this = ("CMP_STR($var, $rval)", "(~~CMP_STR($var, $rval))");
		if ($r->{Var2} == 1) { @this = reverse @this; }
	    } else {
		@this = ("** BAD VAR RESTR **", "** BAD VAR RESTR **");
	    }
	} else {
	    @this = ("** UNKNOWN RESTR **", "** UNKNOWN RESTR **");
	}
	push @restrs, [@this, $r->{FailMessage}];
    }
    #print "\n\nOn task ", $o->{iname}, "\n";
    #foreach my $r (@restrs) { print "[", join ("|", @$r), "]\n"; }


    #my @acts = ("!! TRACK $iname");
    my @acts = ();
    my $execs_task = 0;
    foreach my $a (@{$o->{Actions}}) {
	my $type = $a->{Type};
	if ($type == 0) { # Move Object Action
	    my ($v1, $v2, $v3) = ($a->{Var1}, $a->{Var2}, $a->{Var3});
	    my ($dest, $attr) = ('');
	    if ($v2 == 0 && $v3 == 0) { $dest = 'nothing'; }
	    elsif ($v2 == 0) { $dest = roomname($v3 - 1, 12); }
	    elsif ($v2 == 1) { $dest = 'RandRG ('.roomgroupname($v3).')'; }
	    elsif ($v2 == 2) { $dest = $container_objects[$v3]; }
	    elsif ($v2 == 3) { $dest = $surface_objects[$v3]; }
	    elsif ($v2 < 7) {
		if ($v3 == 0) { $dest = 'player'; }
		elsif ($v3 == 1) { 
		    $dest = 'REFCHAR'; 
		    if ($t_noun eq 'REFCHAR') { $dest = 'noun'; }
		    elsif ($t_sec eq 'REFCHAR') { $dest = 'second'; }
		} else { 
		    $dest = charname ($v3 - 2, 18); 
		    if ($dest eq $t_own) { $dest = 'self'; }
		}

		if ($v2 == 5) {$attr = ($dest eq 'player') ? 'worn':'npcworn';}
		elsif ($v2 == 6) { $dest = "parent ($dest)"; }
	    }
	    
	    if ($v1 == 0) { push @acts, "MoveAllHeld ($dest);"; }
	    elsif ($v1 == 1) { push @acts, "MoveAllWorn ($dest);"; }
	    elsif ($v1 == 2) { 
		my $obj = 'REFOBJ';
		if ($t_noun eq 'REFOBJ') { $obj = 'noun'; }
		elsif ($t_sec eq 'REFOBJ') { $obj = 'second'; }
		push @acts, "move $obj to $dest;";  
	    }
	    else { my $do = $dynamic_objects[$v1 - 3];
		   #print "\$do == ", (defined $do ? $do : '<UNDEF>'),
		   #"  \$dest == ", (defined $dest ? $dest : '<UNDEF>'), "\n";
		   if (defined $attr) { push @acts, "give $do $attr;"; }
		   if ($dest eq 'nothing') { push @acts, "remove $do;"; }
		   else {
		       if ($do eq $t_own) {
			   push @acts, "move self to $dest;";
		       } else {
			   push @acts, "move $do to $dest;"; 
		       } 
		   }	 
	       }      
	} elsif ($type == 1) { # Move player / chars
	    my ($v1, $v2, $v3) = ($a->{Var1}, $a->{Var2}, $a->{Var3});
	    my $dest;
	    if ($v2 == 0) { # To room
		if ($v1 == 0) { ++ $v3; } # Can't move player to hidden
		if ($v3 == 0) { $dest = 'nothing'; }
		else { $dest = roomname($v3 - 1,13); }
	    } elsif ($v2 == 1) { # To Roomgroup
		$dest = "RandomRG(".roomgroupname($v3).")";
	    } elsif ($v2 == 2) { # To same room as
		if ($v3 == 0) { $dest = 'real_location'; }
		elsif ($v3 == 1) { 
		    $dest = "parent(REFCHAR)"; 
		    if ($t_noun eq 'REFCHAR') { $dest = "parent(noun)"; }
		    elsif ($t_sec eq 'REFCHAR') { $dest = "parent(second)"; }
		} else { 
		    my $npc = charname($v3 - 2, 19);
		    if ($npc eq $t_own) { $npc = 'self'; }
		    $dest = "parent($npc)"; 
		}
	    } elsif ($v2 == 3) { # To standing on
		$dest = ($v3 == 0) ? 'real_location' : $sit_objects[$v3 - 1];
		if ($dest eq $t_own) { $dest = 'self'; }
		push @acts, 'player.posture = P_Standing;';
	    } elsif ($v2 == 4) { # To sitting on
		$dest = ($v3 == 0) ? 'real_location' : $sit_objects[$v3 - 1];
		if ($dest eq $t_own) { $dest = 'self'; }
		push @acts, 'player.posture = P_Sitting;';
	    } elsif ($v2 == 5) { # To lying on
		$dest = ($v3 == 0) ? 'real_location' : $lie_objects[$v3 - 1];
		if ($dest eq $t_own) { $dest = 'self'; }
		push @acts, 'player.posture = P_Lying;';
	    } else {
		$dest = '** BAD DESTINATION **'; 
	    }
	    if ($dest eq 'nothing') { 
		#if ($v1 == 1) { push @acts, "remove REFCHAR;"; }
		#else { push @acts, "remove ".charname($v1-2).";"; }
		if ($v1 == 1) {
		    my $npc = 'REFCHAR';
		    if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
		    elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
		    push @acts, "remove $npc;";
		} else {
		    my $npc = charname($v1 - 2, 20);
		    if ($npc eq $t_own) { $npc = 'self'; }
		    push @acts, "remove $npc;";
		}
	    } else {
		if ($v1 == 0) { 
		    if ($dest eq roomname($o->{ShowRoomDesc}-1)) {
			$o->{MoveShowRoomDesc} = 1;
		    } else {
			push @acts, "PlayerTo ($dest, 1);"; 
		    }
		} elsif ($v1 == 1) {
		    my $npc = 'REFCHAR';
		    if ($t_noun eq 'REFCHAR') { $npc = 'noun'; }
		    elsif ($t_sec eq 'REFCHAR') { $npc = 'second'; }
		    push @acts, "move $npc to $dest;";
		} else {
		    my $npc = charname($v1 - 2, 21);
		    if ($npc eq $t_own) { $npc = 'self'; }
		    push @acts, "move $npc to $dest;";
		}
		#elsif ($v1 == 1) { push @acts, "move REFCHAR to $dest;"; }
		#else { push @acts, "move ".charname($v1-2)." to $dest;"; }
	    }
	} elsif ($type == 2) { # Change Object Status
	    my ($obj, $v2) = ($stateful_objects[$a->{Var1}], $a->{Var2});
	    my $ht = $inform_objects{$obj}->{ht};
	    if ($obj eq $t_own) { $obj = 'self'; }
	    if ($ht->{Openable} > 0 && $ht->{Key} >= 0) { # Lockable
		if ($v2 == 0) { push @acts, "give $obj open ~locked;"; }
		elsif ($v2 == 1) { push @acts, "give $obj ~open ~locked;"; }
		elsif ($v2 == 2) { push @acts, "give $obj ~open locked;"; }
		$v2 = $v2 - 2;
	    } elsif ($ht->{Openable} > 0) { # Openable
		if ($v2 == 0) { push @acts, "give $obj open ~locked;"; }
		elsif ($v2 == 1) { push @acts, "give $obj ~open ~locked;"; }
		$v2 = $v2 - 1;
	    }
	    #if ($v2 > 0) { push @acts, "$obj.state = $v2;"; }
	    if ($v2 > 0) { push @acts, "$obj.state = ".($v2-1).";"; }
	} elsif ($type == 3) { # Change Variable
	    my ($v1, $v2, $v3, $expr, $v5) = 
		($a->{Var1}, $a->{Var2}, $a->{Var3}, $a->{Expr}, $a->{Var5});
	    my $tafvar = $root->{Variables}->[$v1];
	    #print "  (", (join " ", @{$root->{Variables}}), ": $v1)\n";
	    #print "  keys \%\$tafvar == (", join (" ", keys %$tafvar), ")\n";
	    my $vn = 'Globals.'.$tafvar->{iname};
	    my $act = "$vn = FALLTHROUGH;";
	    if ($tafvar->{Type} == 0) { # Integer
		if ($v2 == 0) { $act = "$vn = $v3;"; }
		elsif ($v2 == 1 && $v3 < 0) { $act = "$vn = $vn - ".(-$v3).";";} 
		elsif ($v2 == 1) { $act = "$vn = $vn + $v3;"; }
		elsif ($v2 == 2) { $act = "$vn = randomfrom ($v3, $v5);"; }
		elsif ($v2 == 3) { $act = "$vn = $vn + randomfrom ($v3, $v5);"; }
		elsif ($v2 == 4) { 
		    if ($t_sec eq 'REFNUM') { $act = "$vn = second;"; }
		    elsif ($t_noun eq 'REFNUM') { $act = "$vn = noun;"; }
		    else { $act = "$vn = REFNUM;"; }
		}
		elsif ($v2 == 5) { $act = "$vn = $expr;"; } ## TODO TODO
	    } elsif ($tafvar->{Type} == 1) { # String
		if ($v2 == 0) { $act = "$vn = \"$expr\";"; }
		elsif ($v2 == 1) { $act = "$vn = REFTEXT;"; }
		elsif ($v2 == 2) { $act = "$vn = $expr;"; } ## TODO TODO
	    }
	    push @acts, $act;
	} elsif ($type == 4) { # Change Score
	    my $v1 = $a->{Var1};
	    if ($v1 < 0) { push @acts, "score = score - ". (-$v1).";"; }
	    else {
		#push @scored_tasks, $o->{iname};
		#push @acts, ("if (ScoredTasks.".$o->{iname}.") {",
		#	     "score = score + $v1;",
		#	     "ScoredTasks.".$o->{iname}." = true;", "}");
		push @acts, "Achieved(".scalar @scored_tasks."); ! $iname;";
		push @scored_tasks, [ $iname, $v1 ];
	    }
	} elsif ($type == 5) { # Execute / Unset task
	    my ($v1, $v2) = ($a->{Var1}, $a->{Var2});
	    # (taskname($a->{Var2}));
	    if ($a->{Var1} == 0) { 
		$execs_task = 1;
		pushcall ($v2, ['TASK_EXEC', 1, $o->{iname}]);
		push @acts, "!! EXEC ".taskname($v2);
	    } elsif ($a->{Var1} == 1) {
		pushtrack ($v2, ['TASK_UNDO', 0, $o->{iname}]);
		push @acts, "!! UNDO ".taskname($v2);
	    } else {
		push @acts, "** FALLTHROUGH EXEC / UNDO ACTION **".join(",",%$a).';';
	    }
	} elsif ($type == 6) { # End game
	    my $v1 = $a->{Var1};
	    #if ($v1 == 0) { push @acts, 'EndGame(2);'; }  # WIN
	    #elsif ($v1 == 1) { push @acts, 'EndGame(3);'; }  # DON'T WIN
	    #elsif ($v1 == 2) { push @acts, 'EndGame(1);'; }  # DIE
	    #elsif ($v1 == 3) { push @acts, 'EndGame(4);'; }  # DIE SILENT
	    #else { push @acts, "** FALLTHRU ENDGAME **" . join(",",%$a).';'; }
	    if ($v1 >= 0 && $v1 <= 3) {
		my $n = (2,3,1,4)[$v1];
		if ($USE_ENDGAME) { push @acts, "return EndGame($n);" }
		else { push @acts, "deadflag = $n;"; }
	    } else { push @acts, "** FALLTHRU ENDGAME **". join(",",%$a).';'; }
	} elsif ($type == 7) {
	    push @acts, "** FALLTHROUGH BATTLE **".join(",",%$a).';'; 
	} else { push @acts, "** FALLTHROUGH ACTION **".join(",",%$a).';'; }
    }

    push @acts, (showrsc ($o->{Res}));
    my @text = ();
    if ($o->{CompleteText} ne '') {
	push @text, showstr ($o->{CompleteText}, 'print');
    }
    if ($o->{ShowRoomDesc}) { 
	if ($o->{MoveShowRoomDesc}) {
	    push @text, "PlayerTo(".roomname($o->{ShowRoomDesc}-1,14).");";
	} else {
	    push @text, "ShowRoomDesc(".roomname($o->{ShowRoomDesc}-1,14).");";
	}
    }
    if ($o->{AdditionalMessage} ne '') {
	push @text, showstr ($o->{AdditionalMessage}, 'print');
    }
    if ($execs_task) {
	@acts = ("!! TRACK $iname", @text, @acts);
    } else {
	@acts = ("!! TRACK $iname", @acts, @text);
    }
    if ($acts[$#acts] =~ /^print /) {
	$acts[$#acts] =~ s/^print /print_ret /;
    } elsif ($o->{CompleteText} ne ''  ||  $o->{ShowRoomDesc} || 
	     $o->{AdditionalMessage} ne '' || $execs_task) {
	#push @acts, 'rtrue;';
	push @acts, 'print_ret "";';
    }

    if (!$o->{Repeatable}) {
	pushtrack ($o->{number}, ['TASK_REPT', 1, $iname]);  #####
	if ($o->{RepeatText} ne '') {
	    @acts = ("if (".tasktrack($o->{number}).")", 
		     showstr ($o->{RepeatText}, 'print_ret'),
		     'else {', @acts, '}');
	} else {
	    @acts = ("if (~~".tasktrack($o->{number}).") {", @acts, "}");
	}
    }

    my $rm = $o->{RestrMask}.'A';
    
    my @prereqs = ();
    while (@restrs && substr ($rm, 1, 1) eq 'A' && $restrs[0]->[2] ne '') {
	#print "  Handling ", @{$restrs[0]}, ":  \$rm == '$rm', \@restrs == (", join (", ", @restrs), "); \@prereqs == (", join (", ", @prereqs), ")\n";
    	my @r = @{shift @restrs};
    	push @prereqs, ((@prereqs ? 'else ':''). 'if ('.clipcond($r[1]).')',
    			showstr ($r[2], 'print_ret'));
    	$rm = substr ($rm, 2, length($rm));
    }
    my $rn = 0;
    my $cond = '';

    if ($rm) {
	chop $rm;
	foreach (split //, $rm) {
	    if ($_ eq '(' || $_ eq ')') { $cond .= $_; }
	    elsif ($_ eq 'A') { $cond .= ' && '; }
	    elsif ($_ eq 'O') { $cond .= ' || '; }
	    elsif ($_ eq '#') { $cond .= $restrs[$rn]->[0]; $rn ++; }
	    else { print "Bad char $_ in $rm\n"; }
	}
    }
    if ($rn != @restrs) { print "#s in '$rm' doesn't match restrictions.\n"; }

    
    my @code = ();
    if ($io->{where} ne '1') {
	#my $wcond = $io->{where} eq '0' ?'0':"real_location == ".$io->{where};
	push @code, "if (".$io->{where}.") {";
    }

    push @code, @prereqs;
    my ($openc, $closec);
    if (@prereqs) {
	if ($cond) { $openc = "else if ($cond) {"; }
	else { $openc = "else {"; }
    } else {
	if ($cond) { $openc = "if ($cond) {"; }
	else { $openc = ''; }
    }
    if ($openc) { push @code, $openc; $closec = 1;}
		
    push @code, @acts;
    
    foreach (@restrs) {
	if ($_->[2] ne '') {
	    if ($closec) {
		$closec = 0;
		push @code, "} else if (".clipcond($_->[1]).")";
	    } else {
		push @code, "else if (".clipcond($_->[1]).")";
	    }
	    #push @code, 'print_ret '.reformat($_->[2]).';';
	    push @code, showstr ($_->[2], 'print_ret');
	}
    }
    if ($closec) { push @code, "}"; }
    if ($io->{where} ne '1') { push @code, "}"; }
    $io->{code} = bless \@code, 'INDENTED';

    if (0) { print "}"; }  # Balance quoted braces

    if ($GUESS_PARSE) {
	foreach my $action_line (@{$o->{tree_list}}) {
	    my ($scope, $owner, $prop, $act, $do, $io) = @$action_line;
	    my ($c1, $c2);
	    if ($do eq '-2' || $do eq '-3' || $do eq 'REFOBJ' || 
		$do eq 'REFNUM' || $do eq 'REFCHAR' || 
		($do eq '-1' && !get_n_objs($act, 1))) {  
		$c1 = ''; # Either the action takes no object, or the first
		# is same as owner, or is skipped by a wildcard
	    } elsif ($do eq '-1') {
		$c1 = 'noun == nothing';
		# Command can take an object, but it's being called without
	    } else {
		$c1 = "noun == $do";
	    }
	    if ($io eq '-2' || $io eq '-3' || $io eq 'REFOBJ' || 
		$io eq 'REFNUM' || $io eq 'REFCHAR' || 
		($io eq '-1' && !get_n_objs($act, 2))) {  
		$c2 = '';
	    } elsif ($io eq '-1') {
		$c2 = 'second == nothing';
	    } else {
		$c2 = "second == $io";
	    }
	    pushcall ($tasknum, ['PARSER_CALL', 1, $owner, $prop, $act, $do, $io]);
	    my @list = ("!! EXEC ".$o->{iname});
	    if ($c1 && $c2) { @list = ("if ($c1 && $c2) {", @list, "}"); }
	    elsif ($c1 || $c2) { @list = ("if ($c1"."$c2) {", @list, "}"); }
	    if ($scope == 0) { unshift @list, "! POSSIBLY BAD SCOPE"; }
	    push @{$inform_objects{$owner}->{$prop.'s'}->{$act}}, @list;
	}
    }


		
					 
    # TODO:  Handle Reverse-type actions
}


#####################################################################
#                                                                   #
#                                                                   #
#                        CONVERT EVENT                              #
#                                                                   #
#                                                                   #
#####################################################################

sub convert_event {
    my $o = shift;
    my $iname = $o->{iname};
    my $io = $inform_objects{$iname};

    $io->{print_name} = reformat ($o->{Short}, 1);

    my @reslines = map { my @r = showrsc($o->{Res}->[$_]); 
		     (@r > 0) ? (join ("", "! Res $_: ", @r)) : () 
		     } (0..4);

    if ($o->{StarterType} == 1) {  # Immediate 
	$io->{first_turn} = '[ ; StartTimer (self, 0); ]';
    } elsif ($o->{StarterType} == 2) {  # Random Delay
	if ($o->{StartTime} == $o->{EndTime}) {
	    $io->{first_turn} = "[ ; StartTimer (self, ".$o->{StartTime}.");]";
	} else {
	    $io->{first_turn} = '[ ; StartTimer (self, randomfrom('.
		$o->{StartTime}.', '.$o->{EndTime}.')); ]';
	}
    } elsif ($o->{StarterType} == 3) { # Task
	pushtrack ($o->{TaskNum}-1, ['EVENT_START', 0, $iname]); 
    } else {
	print "Bad Starter type on event\n";
    }

    my $wherecond = '';

    if ($o->{Where}->{Type} == 3) { # All rooms
	$wherecond = '1';
    } elsif ($o->{Where}->{Type} == 0) { # No rooms
	$wherecond = '0';
    } elsif ($o->{Where}->{Type} == 1) { # One Room
	$wherecond = 'real_location == '.roomname($o->{Where}->{Room});
    } else {
	#$wherecond = 'real_location == '.join (" or ", map { $o->{Where}->{Rooms}->[$_] ? roomname($_) : () } (0..$#{$o->{Where}->{Rooms}}));
	my @tmp1 = map { $o->{Where}->{Rooms}->[$_] ? roomname($_) : () } (0..$#{$o->{Where}->{Rooms}});
	my $tmp1 = join (" or ", @tmp1);
	my $tmp2 = conv_where ('real_location', $tmp1, \@tmp1);
	$wherecond = defined($tmp2) ? $tmp2 : 'real_location == '.$tmp1;
    }

    my @slines = (); # code to be run on start
    if ($o->{Time1} == $o->{Time2}) {
	push @slines, "self.time_left = ".$o->{Time1}.";";
    } else {
	push @slines, "self.time_left = randomfrom(".$o->{Time1}.", ".
	    $o->{Time2}.");";
    }
    if ($o->{Obj1}) {
	if ($o->{Obj1Dest} == 0) {
	    push @slines, "remove ".objectname($o->{Obj1} - 1).";";
	} elsif ($o->{Obj1Dest} == 1) {
	    push @slines, "move ".objectname($o->{Obj1} - 1)." to player;";
	} elsif ($o->{Obj1Dest} == 2) {
	    push @slines, "move ".objectname($o->{Obj1} - 1).
		" to real_location;";
	} else {
	    push @slines, "move ".objectname($o->{Obj1} - 1)." to ".
		roomname ($o->{Obj1Dest} - 3).";";
	}
    }
    if ($o->{StartText} ne '') {
	if ($wherecond ne '1') { push @slines, "if ($wherecond)"; }
	#push @slines, "print ".reformat($o->{StartText}).';';
	push @slines, showstr ($o->{StartText}, 'print');
    }
    if (@slines) { $io->{on_start} = bless \@slines, 'INDENTED'; }

    
    my @flines = ();
    if ($o->{Obj2}) {
	if ($o->{Obj2Dest} == 0) {
	    push @flines, "remove ".objectname($o->{Obj2} - 1).";";
	} elsif ($o->{Obj2Dest} == 1) {
	    push @flines, "move ".objectname($o->{Obj2} - 1)." to player;";
	} elsif ($o->{Obj2Dest} == 2) {
	    push @flines, "move ".objectname($o->{Obj2} - 1).
		" to real_location;";
	} else {
	    push @flines, "move ".objectname($o->{Obj2} - 1)." to ".
		roomname ($o->{Obj2Dest} - 3).';';
	}
    }
    if ($o->{Obj3}) {
	if ($o->{Obj3Dest} == 0) {
	    push @flines, "remove ".objectname($o->{Obj3} - 1).";";
	} elsif ($o->{Obj3Dest} == 1) {
	    push @flines, "move ".objectname($o->{Obj3} - 1)." to player;";
	} elsif ($o->{Obj3Dest} == 2) {
	    push @flines, "move ".objectname($o->{Obj3} - 1).
		" to real_location;";
	} else {
	    push @flines, "move ".objectname($o->{Obj3} - 1)." to ".
		roomname ($o->{Obj3Dest} - 3). ';';
	}
    }
    if ($o->{FinishText} ne '') {
	if ($wherecond ne '1') { push @flines, "if ($wherecond)"; }
	#push @flines, "print ".reformat($o->{FinishText}).";";
	push @flines, showstr ($o->{FinishText}, 'print');
    }
    
    if ($o->{RestartType} == 0) { # Don't Restart
	# Do nothing
    } elsif ($o->{RestartType} == 1) {  # Restart immediately
	push @flines, 'self.start();';
    } elsif ($o->{RestartType} == 2) {  # Restart after dealy
	push @flines, 'self.first_turn();';
    } else {
	print "Bad restart type for task $iname\n";
    }
    if ($o->{TaskAffected}) {
	if ($o->{TaskFinished} == 0) {
	    pushcall ($o->{TaskAffected}-1, ['EVENT_EXEC', 1, $iname]);
	    push @flines, "!! EXEC ".taskname($o->{TaskAffected}-1);
	} else {
	    pushcall ($o->{TaskAffected}-1, ['EVENT_UNDO', 0, $iname]);
	    push @flines, "!! UNDO ".taskname($o->{TaskAffected}-1);
	}
    }
    if (@flines) { $io->{on_finish} = bless \@flines, 'INDENTED'; }

    if ($o->{PrefText1} ne '' || $o->{PrefText2} ne '' || @reslines) {
	my @lines = ('self.time_left --;', @reslines);
	if ($o->{PrefText2} ne '') {
	    #push @lines, "if (self.time_left == ".$o->{PrefTime2}.
	    #	($wherecond ne '1' ? " && $wherecond" : "").")",
	    #	"print ".reformat ($o->{PrefText2}).';';
	    push @lines, "if (self.time_left == ".$o->{PrefTime2}.
		($wherecond ne '1' ? " && $wherecond" : "").")",
		showstr ($o->{PrefText2}, 'print');
	}
	if ($o->{PrefText1} ne '') {
	    #push @lines, "if (self.time_left == ".$o->{PrefTime1}.
	    #	($wherecond ne '1' ? " && $wherecond" : "").")",
	    #	"print ".reformat ($o->{PrefText1}).';';
	    push @lines, "if (self.time_left == ".$o->{PrefTime1}.
		($wherecond ne '1' ? " && $wherecond" : "").")",
		showstr ($o->{PrefText1}, 'print');
	}
	push @lines, "if (self.time_left <= 0)", "self.finish();";
	$io->{daemon} = bless \@lines, 'INDENTED';
    }
    if ($o->{PauseTask} > 1) {
	pushtrack ($o->{PauseTask} - 2, ['EVENT_PAUSE', 0, $iname]); ####
    }
    if ($o->{ResumeTask} > 1) {
	pushtrack ($o->{ResumeTask} - 2, ['EVENT_RESUME', 0, $iname]);####
    }
    if ($o->{LookText} ne '') {
	$io->{on_look} = reformat($o->{LookText});
    }
}


#####################################################################
#                                                                   #
#                                                                   #
#                        CONVERT ROOMGROUP                          #
#                                                                   #
#                                                                   #
#####################################################################

my %rg_where = ();

sub convert_roomgroup {
    my $o = shift;
    my $iname = $o->{iname};
    
    my @list = @{$o->{List}};
    my @rooms = (); # All rooms in roomgroup
    my @rooms2 = (); 
    for (my $n = 0; $n < @list; $n ++) {
	if ($list[$n]) {
	    #print "Making ", roomname($n), " of class $iname\n";
	    push @rooms, roomname($n);
	    push @{$inform_objects{roomname($n)}->{class}}, $iname;
	    #print "(", join (", ", @{(roomobj($n)->{class})}), ")\n";
	} else {
	    push @rooms2, roomname($n);
	}
    }
    $rg_where{(join " or ", @rooms)} = "ofclass $iname";
    my $w2 = join " or ", @rooms2;
    if (!$rg_where{$w2}) { $rg_where{$w2} = "notofclass $iname"; }
    $inform_objects{$iname}->{rooms} = \@rooms;
}

sub conv_where {
    my ($loc, $wherestr, $rl) = @_;
    my $ws1 = conv_where_1 ($wherestr, $rl);
    if ($ws1) {
	if ($ws1 =~ /^notofclass (.*)$/) {
	    return "~~$loc ofclass $ws1";
	} else {
	    return "$loc $ws1";
	}
    }
    return;
}

# Return a simple expression for the roomlist if possible, or zero
# otherwise.  Cache results.
sub conv_where_1 {
    my ($wherestr, $rl) = @_;
    my $tmp = $rg_where{$wherestr};

    #print "conv_where_1 ($wherestr, (", join (", ", @$rl), "))\n";

    if (defined $tmp) { return $tmp; }  # Something already processed

    # All rooms but one
    my ($n, $numrooms) = (scalar @$rl, scalar @{$root->{Rooms}});
    #print "\$n == $n, \$numrooms == $numrooms\n";
    #if ($n == $numrooms - 1) {
    #	for ($n = 0; $n < $numrooms; $n ++) {
    #	    if ($n == $numrooms - 1 || $rl->[$n] ne $root->{Rooms}->[$n]->{iname}) {
    #		return "~= ".$root->{Rooms}->[$n]->{iname};
    #	    }
    #	}
    #	print "Error: Fallthrough in conv_where($wherestr)\n";
    #	return '0';
    #}
    if ($n > 7 * $numrooms / 10) {
	my @rv = ();
	my $count = 0;
	for ($n = 0; $n < $numrooms; $n ++) {
	    if ($rl->[$count] ne $root->{Rooms}->[$n]->{iname}) {
		push @rv, $root->{Rooms}->[$n]->{iname};		
	    } else {
		++ $count;
	    }
	}
	return "~= ".join (" or ", @rv);
	#print "Error: Fallthrough in conv_where($wherestr)\n";
	#return '0';
    }
    return '0';
}

if (my $t = $root->{Globals}->{Task}) {
    pushtrack ($t - 1, ['OBJ_DESC', 1, 'playerobj']); ####
    $playerobj->{description} = 
	#bless [ "if (".taskname($t-1).")", 
	#       'print_ret "'.reformat ($root->{Globals}->{AltDesc}).'";',
	#       'print_ret "'.reformat ($root->{Globals}->{PlayerDesc}).'";'
	#       ], 'INDENTED';
	#bless [ "if (Globals.".taskname($t-1).")", 
	#       showstr ($root->{Globals}->{AltDesc}, 'print_ret'),
	#       showstr ($root->{Globals}->{PlayerDesc}, 'print_ret')
	#       ], "INDENTED";
	bless [ "if (".tasktrack($t-1).")", 
	       showstr ($root->{Globals}->{AltDesc}, 'print_ret'),
	       showstr ($root->{Globals}->{PlayerDesc}, 'print_ret')
	       ], "INDENTED";
} else {
    $playerobj->{description} = 
	reformat ($root->{Globals}->{PlayerDesc});
}
my $pn = reformat ($root->{Globals}->{PlayerName});
if (ref $pn) {
    $playerobj->{print_name} = reformat ($root->{Globals}->{PlayerName}, 1);
    $playerobj->{short_name} = bless [ "print_ret ".$pn.";" ], 'INDENTED';
}
$playerobj->{posture} = $root->{Globals}->{Position}; # TODO Make symbolic

sub convert_globals {
    my $n_objs = int ($root->{Globals}->{MaxSize}/10);
    my $s_objs = $root->{Globals}->{MaxSize}%10;
    my $tmp = $size_words[$s_objs];
    if ($n_objs > 1) { $tmp = $tmp . "_" . $n_objs; }
    $playerobj->{max_size} = $tmp;
    $capacities{$tmp} = $n_objs * expt(3, $s_objs);
    #$playerobj->{max_size} = $n_objs*expt(3, $s_objs).
    #    ", ! $n_objs * $size_words[$s_objs]";
    $n_objs = int ($root->{Globals}->{MaxWt}/10);
    $s_objs = $root->{Globals}->{MaxWt}%10;
    #print "Processing max_wt:  ", $root->{Globals}->{MaxWt}, ": $n_objs $s_objs\n";
    $tmp = $weight_words[$s_objs];
    if ($n_objs > 1) { $tmp = $tmp . "_" . $n_objs; }
    $capacities{$tmp} = $n_objs * expt (3, $s_objs);
    $playerobj->{max_wt} = $tmp;
    #$playerobj->{max_wt} = $n_objs*expt(3, $s_objs).
    #	", ! $n_objs * $weight_words[$s_objs]";
}
if ($root->{Globals}->{ParentObject} > 0) {
    pushcontent ($dynamic_objects[$root->{Globals}->{ParentObject} - 1],
		 'playerobj', 10);
    pushcontent (roomname($root->{Header}->{StartRoom}),
		 $dynamic_objects[$root->{Globals}->{ParentObject} - 1], 11);
} else {
    pushcontent (roomname($root->{Header}->{StartRoom}), 'playerobj', 12);
}
if ($root->{Globals}->{PlayerGender} == 1) {
    push @{$playerobj->{attribs}}, 'male';
} elsif ($root->{Globals}->{PlayerGender} == 2) {
    push @{$playerobj->{attribs}}, 'female';
} # Else if 3, prompt for gender

## TODO: Handle Synonyms

#####################################################
#                                                   #
#  Finally, start calling the conversion routines!  #
#                                                   #
#####################################################

print "Reached the conversions!\n";

check_rooms("initializing");

foreach my $o (@{$root->{RoomGroups}}) {
    convert_roomgroup($o);
}
check_rooms("roomgroups");

foreach my $o (@{$root->{Objects}}) {
    #print "converting object ", $o->{iname} , "\n";
    convert_obj_1($o);
}
check_rooms("objects");

foreach my $o (@{$root->{NPCs}}) {
    convert_character_1($o);
}
check_rooms("characters");

if ($GUESS_PARSE) {
    #parse_task_commands($adrift_objects{task127});
    #die;
    #foreach my $t (@{$root->{Tasks}}) {

    #CUSTOM
    #$inform_objects{stans_body}{vocab} = ["stan's", "body"];
    #$inform_objects{teds_body}{vocab}  = ["ted's",  "body"];
    #$inform_objects{robs_body}{vocab}  = ["rob's",  "body"];

    my $numtasks = @{$root->{Tasks}};
    for (my $n = 0; $n < $numtasks; $n ++) {
	if (($n + 1) % 100 == 0) {
	    print "Preparsed ", ($n + 1), " / $numtasks tasks.\n";
	}
    	parse_task_commands($root->{Tasks}->[$n]);
    }
    print "Preparsed all tasks.\n";
} else {
    foreach my $t (@{$root->{Tasks}}) {
    	$t->{Parsed} = [];
    	$t->{Failed} = $t->{Fwdlines};
	if (defined $t->{call}) { print "*** t->{call} was defined ***\n"; }
	else { $t->{call} = []; }
	$inform_objects{$t->{iname}}->{owner} = 'Globals';
    }
}

for (my $tasknum = 0; $tasknum < @{$root->{Tasks}}; $tasknum ++) {
    convert_task ($tasknum);
    if (($tasknum + 1) % 100 == 0) {
	print "Converted ", ($tasknum + 1), " / ", scalar @{$root->{Tasks}}, 
	      " tasks\n";
    }
}
check_rooms("Tasks");

foreach my $o (@{$root->{Objects}}) {
    convert_obj_2($o);
}
check_rooms("objects");

foreach my $o (@{$root->{NPCs}}) {
    convert_character_2($o);
}

foreach my $r (@{$root->{Rooms}}) {
    convert_room($r);
}
check_rooms("rooms");

foreach my $o (@{$root->{Events}}) {
    convert_event ($o);
}
check_rooms("Events");

convert_globals();
check_rooms("globals");
    
# Does task need to be tracked?

for (my $tn = 0; $tn < @{$root->{Tasks}}; $tn ++) {
    my $t = $inform_objects{taskname($tn)};
    my @fl = @{$t->{code}};
    my @funclines = ();
    for my $n (0..$#fl) {
	if ($fl[$n] =~ /^!! TRACK (.*)$/) {
	    # 1: ROOM_EXIT   ROOM_ALT   OBJ_ALT   CHAR_DESC ASK_RESTR
	    # 1:  TASK_RESTR TASK_REPT OBJ_DESC
	    # 0:  START_CHAR_WALK STOP_CHAR_WALK TASK_UNDO EVENT_START
	    # 0:  EVENT_PAUSE EVENT_RESUME
	    #['ROOM_EXIT', 1, $iname];       ['ROOM_ALT',1,$iname];
	    #['OBJ_ALT', 1, $iname];         ['CHAR_DESC', 1, $iname];
	    #['START_CHAR_WALK', 0, $iname, $wname];
	    #['STOP_CHAR_WALK', 0, $iname, $wname];
	    #['ASK_RESTR',1,$iname];         ['TASK_RESTR', 1, $iname];
	    #['TASK_UNDO', 0, $o->{iname}];  ['TASK_REPT', 1, $iname];
	    #['EVENT_START', 0, $iname];     ['EVENT_PAUSE', 0, $iname];
	    #['EVENT_RESUME', 0, $iname];    ['OBJ_DESC', 1, 'playerobj'];
	    if ($t->{needtrack}) { 
		push @funclines, $t->{owner}.".".$t->{iname}." = true;";
		$inform_objects{$t->{owner}}->{$t->{iname}} = 0;
	    }
	    #print "Trackifying task #".$tn."\n";
	    foreach (@{$t->{track}}) {
		if ($_->[1] == 0) {
		    my $tt = $_->[0];
		    if ($tt eq 'START_CHAR_WALK') {
			push @funclines, $_->[2].".curwalk = ".$_->[2].".".$_->[3].";";
		    } elsif ($tt eq 'STOP_CHAR_WALK') {
			#push @funclines, $_->[2].".curwalk = nothing;";
			push @funclines, "if (".$_->[2].".curwalk == ".$_->[2].".".$_->[3].")", $_->[2].".curwalk = 0;";
		    } elsif ($tt eq 'EVENT_START') {
			push @funclines, $_->[2].".start();";
		    } elsif ($tt eq 'EVENT_PAUSE') {
			push @funclines, $_->[2].".pause();";
		    } elsif ($tt eq 'EVENT_RESUME') {
			push @funclines, $_->[2].".resume();";
			# TODO ??
		    } elsif ($tt eq 'TASK_UNDO') {
			# Do nothing
		    } else {
			print "Bad track action [", join (", ", @$_), "]\n";
		    }
		}
	    }
	} else {
	    push @funclines, $fl[$n];
	}
    }
    $t->{code} = bless \@funclines, 'INDENTED';
}

check_rooms("checking TRACK lines");

# If any task is executed by iname.prop, and said task is only
# called by iname.prop, swallow all code from that task.
# Also, if dontret is 1, change all swallowed print_ret statements to print.
sub swallowtask {
    if ($SWALLOW_TASKS == 0) { return; }
    my ($prop, $dontret, $l, $obj) = @_;    
    #print "\n\nAttempting to swallow tasks into $prop\n";
    my @l = @$l;
    my $changed = 0;
    my @rv = ();
    
    while (@l) {
	my $line = shift @l;
	#print "Processing line $line\n";
	if ($line =~ /^!! EXEC (.*)$/) {
	    #print "    Hit EXEC line '$line'\n";
	    my $swallowfunc = $1;
	    #my $callcount = 0;
	    my $io = $inform_objects{$swallowfunc};
	    #print "\nregarding the swallow of $1 == {", join (", ", map { $_.'->'.$io->{$_}} keys %$io), "}\n";
	    #print ("      \$io->{ParserCall} == ", $io->{ParserCall},
	    #	   "  \@{\$io->{call}} == ", @{$io->{call}}, "\n");
	    
	    # If the parser cannot call the action,  (ParserCall == 0)
	    # and there is only one task/event/walk that calls it, swallow

	    my @tgrep = (grep { $_->[1] == 1 } @{$io->{call}});

	    #print "   \$io->{ParserCall} == ", $io->{ParserCall}, "\n   grep -> ([", join ("], [", map { join ", ", @$_ } @tgrep), "])\n   \$io->{owner} == ", $io->{owner}, "\n";

	    if ($io->{ParserCall} == 0 && scalar @tgrep == 1) {
		#scalar (grep { $_->[1] == 1 } @{$io->{call}}) == 1) {
		#print "        Swallowing!\n";
		#print "  fullswallowing $1 into $prop\n";
		#print "keys(", join (", ",keys %{$inform_objects{$1}}), ")\n";
		my $ioo = $inform_objects{$1};
		push @rv, "! Swallowed $1: ".(@{$ioo->{Failed}} ? "Unparsed lines: ".join (" // ", @{$ioo->{Failed}})."  ||  ":"")." Parsed lines: ".join (" // ", @{$ioo->{Parsed}}).(@{$io->{track}} ? (" Tracked by: ".join (", ", map { '['.join (", ", @$_).']' } @{$io->{track}})):'');
		$io->{swallowed} = $prop;
		$io->{full_swallowed} = 1;
		my @l1 = @{$io->{code}};
		if ($dontret) {
		    foreach my $x (@l1) { $x =~ s/^print_ret /print /g; }
		    @l1 = grep !/^rtrue;$/, @l1; 
		    @l1 = grep !/^print \"\";$/, @l1; 
		}
		@l = (@l1, @l);
		$changed = 1;
	    } elsif ($io->{owner} ne 'Globals') {
		#print "  Partial swallow\n";
		#if ($io->{ParserCall} != 0) {
		#    push @rv, "! Partswallow b/c unparsed cmds";
		#} elsif (scalar @tgrep != 1) {
		#    push @rv, "! Partswallow b/c called multiple ways.";
		#}
		$changed = 1;
		if ($obj eq $io->{owner}) {
		    if (@l == 0) {
			push @rv, "return self.".$io->{run_name}.'();';
		    } else {
			push @rv, "if (self.".$io->{run_name}.'()) rtrue;';
		    }
		} else {
		    if (@l == 0) {
			push @rv, "return ".$io->{owner}.'.'.$io->{run_name}.'();';
		    } else {
			push @rv, "if (".$io->{owner}.'.'.$io->{run_name}."()) rtrue;";
		    }
		}
	    } else {
		#print "        NOT Swallowing $1!\n";
		#print "        NOT Swallowing $1!:  \$io->{ParserCall} == ", $io->{ParserCall}, "; grep -> ([", join ("], [", map { join ", ", @$_ } @tgrep), "]), \$io->{owner} == ", $io->{owner}, "\n";
		push @rv, $line;
	    }
	} elsif ($line =~ /^!! UNDO (.*)$/) {
	    my $task = $inform_objects{$1};
	    my $owner = 
	    $changed = 1;
	    
	    foreach (@{$task->{track}}) {
		if ($_->[1] == 0) {
		    my $tt = $_->[0];
		    if ($tt eq 'START_CHAR_WALK') {
			push @rv, "if (".$_->[2].".curwalk == ".$_->[2].".".$_->[3].")", $_->[2].".curwalk = 0;";
		    } elsif ($tt eq 'STOP_CHAR_WALK') {
			# Do nothing
		    } elsif ($tt eq 'EVENT_START') {
			push @rv, $_->[2].".stop();";
		    } elsif ($tt eq 'EVENT_PAUSE') {
			push @rv, $_->[2].".resume();";
		    } elsif ($tt eq 'EVENT_RESUME') {
			# Do nothing?
		    } elsif ($tt eq 'TASK_UNDO') {
			# Do nothing
		    } else {
			print "Bad task track line '$tt'!\n";
		    }
		}
	    }
	    if ($task->{needtrack}) {
		#push @rv, "Globals.$1 = 0;";
		push @rv, $task->{owner}.'.'.$1.' = 0;'
	    }
	} elsif ($line =~ /^$obj\.(.*)/) {
	    push @rv, 'self.'.$1;
	    $changed = 1;
	} else {  # Normal line, do nothing
	    push @rv, $line;
	}
    }
    if ($changed) {
	return (1, \@rv);
    } else {
	return (0);
    }
}


### If any task is executed by iname.prop, and said task is only
### called by iname.prop, swallow all code from that task.
### Also, if dontret is 1, change all swallowed print_ret statements to print.
###
sub propswallow {
    if ($SWALLOW_TASKS == 0) { return; }

    my ($iname, $prop, $dontret) = @_;

    my $l = $inform_objects{$iname}->{$prop};
    if (ref $l eq 'INDENTED') {
	my ($changed, $new) = swallowtask ("$iname"."->{$prop}", $dontret, 
					   $l, $iname);
	if ($changed) { 
	    $inform_objects{$iname}->{$prop} = bless $new, 'INDENTED';
	}
    }
}

sub match_arrays {
    my ($arr1, $arr2) = @_;
    if (@$arr1 != @$arr2) { return 0; }
    for (my $n = 0; $n < @$arr1; $n ++) {
	if ($arr1->[$n] ne $arr2->[$n]) { return 0; }
    }
    return 1;
}

# Collect matching calls of $taskname into a single call.
# Arguments tell which calls do match
sub change_call {
    #change_call ($1, $io, $prop, $thiskey, @matching_keys);
    my ($taskname, $owner, $prop, $newname, $call1, @other_callers) = @_;
    my %ht = map { $_ => 1 } (@other_callers);
    #print "change_call (taskname == $taskname, owner == $owner, prop == $prop, newname == $newname, call1 == $call1, other_callers = @other_callers):\n  [", (map { ("{", join (", ", @$_), "}") } (@{$inform_objects{$taskname}->{call}})), "]\n";
    my @tmp = ();
    foreach (@{$inform_objects{$taskname}{call}}) {
	#print "(", join (", ", @$_), "): ", (id($_->[0] eq 'PARSER_CALL')), ',', (id($_->[2] eq $owner)), ',', (id($_->[3] eq $prop)), ',', (id($ht{$_->[4]})), ',', (id($_->[4] eq $call1)), "|\n";
	if ($_->[0] eq 'PARSER_CALL' && $_->[2] eq $owner &&
	    $_->[3] eq $prop) {
	    if ($_->[4] eq $call1) {
		#print "  fusing @$_\n";
		push @tmp, [ @{$_}[0..3], "($newname)", 
			    @{$_}[5..(scalar @$_ - 1)] ];
	    } elsif (!$ht{$_->[4]}) {
		#print "  push1  @$_\n";
		push @tmp, $_;
	    } else {
		#print "  skip   @$_\n";
	    }
	} else {
	    #print "  push2  @$_\n";
	    push @tmp, $_;
	}
    }
    $inform_objects{$taskname}{call} = \@tmp;
    #print "  [", (map { ("{", join (", ", @$_), "}") } (@{$inform_objects{$taskname}->{call}})), "]\n\n";
}


# $io->{prop} is the basis for a switch statement.
# If any cases are identical, merge them.
# If a merged case calls any tasks, change those task's call line.
#
sub fuse_switch {
    my ($io, $prop) = @_;
    my $ht = $io->{$prop};
    my @unused_keys = keys %{$io->{$prop}};
    #my %rv = ();
    #my $changed = 0;
    while (@unused_keys) {
	my $thiskey = pop @unused_keys;

	my (@matching_keys, @unmatched_keys) = ($thiskey);
	my ($tempkey, $was_match);
	
	while ($tempkey = pop @unused_keys) {
	    if (match_arrays ($ht->{$thiskey}, $ht->{$tempkey})) {
		#$changed = 1;
		push @matching_keys, $tempkey;
	    } else {
		push @unmatched_keys, $tempkey;
	    }
	}
	if (@matching_keys > 1) {
	    my $name = join (", ", sort (@matching_keys));
	    foreach my $line (@{$ht->{$thiskey}}) {
		if ($line =~ /^!! EXEC (.*)$/) {
		    #my $call_array = $inform_objects{$1}->{call};
		    change_call ($1, $io->{iname}, 
				 substr($prop, 0, length($prop)-1), 
				 $name, @matching_keys);
		}
	    }
	    $ht->{$name} = $ht->{$thiskey};
	    foreach ($thiskey, @matching_keys) { delete $ht->{$_}; }
	    #$rv{$name} = $ht{$thiskey};
	} #else {
	#    $rv{$thiskey} = $ht{$thiskey};
	#}
	@unused_keys = @unmatched_keys;
    }
}

foreach my $t (map {$_->{iname}} @{$root->{Tasks}}) {
    if (!$inform_objects{$t}->{swallowed}) {
	propswallow ($t, 'code', 1);
    }
}


foreach my $c (@inform_npcs, map {$_->{iname}} @{$root->{NPCs}}) {
    #print "In loop ($c, 'daemon')\n";
    propswallow ($c, 'daemon', 0);
    foreach my $k (keys %{$inform_objects{$c}}) {
	if ($k =~ /^walk/) {
	    propswallow ($c, $k, 0);
	}
    }
}
if ($root->{Globals}->{BattleSystem}) {
    foreach my $c (map {$_->{iname}} @{$root->{NPCs}}) {
	#print "In loop ($c, 'daemon')\n";
	propswallow ($c, 'on_death', 0);
    }
}
foreach my $e (map {$_->{iname}} @{$root->{Events}}) {
    propswallow ($e, 'on_finish', 0);
}
foreach my $iname ((map { $_->{iname}} 
		    (@{$root->{Objects}}, @{$root->{Rooms}}, @{$root->{NPCs}},
		     @{$root->{Events}},  @{$root->{RoomGroups}})),
		   @inform_npcs, @inform_objs) {
    my $io = $inform_objects{$iname};
    for my $prop ('befores', 'afters', 'lifes', 'orderss') {
	if ($io->{$prop}) {
	    fuse_switch ($io, $prop);
	    foreach my $act (keys %{$io->{$prop}}) {
		#print "trying to swallow iname ", id($iname), ", prop ", id($prop), ", act ", id($act), "\n";
		my ($changed, $new) = 
		    swallowtask ("$iname.$prop:$act", 0, 
				 $io->{$prop}->{$act}, $iname);
		if ($changed) {
		    $io->{$prop}->{$act} = $new;
		}
	    }
	}
    }
}

foreach my $t (map {$_->{iname}} @{$root->{Tasks}}) {
    my $io = $inform_objects{$t};
    if ($io->{owner} ne 'Globals' && !$io->{swallowed}) {	
	my $owner = $inform_objects{$io->{owner}};
	my @code = ( "! Swallowed $t" );
	if (@{$io->{Failed}}) { 
	    push @code, "! Unparsed: ".join (" // ", @{$io->{Failed}});
	}
	if (@{$io->{Parsed}}) { 
	    push @code, "! Parsed: ".join (" // ", @{$io->{Parsed}});
	}
	if (@{$io->{call}}) {
	    push @code, "! Called by ". join (", ", map { '['.join (", ", @$_).']' } @{$io->{call}});
	}
	if (@{$io->{track}}) {
	    push @code, "! Tracked by ". join (", ", map { '['.join (", ", @$_).']' } @{$io->{track}});
	}
	push @code, @{$io->{code}};
	#$owner->{$t->{run_name}} = bless [ "! Swallowed $t: Unparsed lines: ".join (" // ", @{$io->{Failed}}, "  ||  Parsed lines: ", @{$io->{Parsed}}), @{$io->{code}} ], 'INDENTED';
	$owner->{$io->{run_name}} = bless \@code, 'INDENTED';
	$io->{swallowed} = 'helper '.$io->{owner}.'.'.$io->{run_name};
    }
}

check_rooms("swallowing tasks");

# Library messages
my %lm = ();
sub pushlm {
    my ($action, $num, $anum) = @_;
    if ($num == -1) { $lm{$action} = reformat ($alr[$anum]->[4]); }
    else { $lm{$action}->{$num} = reformat($alr[$anum]->[4]); }
    if ($alr[$anum]->[2] == 0) { $alr[$anum]->[2] = 1; }
}

sub pushmsg {
    my ($do, $prop, $action, $anum) = @_;
    if ($do = $theobjs{$do}) {
	push (@{$inform_objects{$do}->{$prop.'s'}->{$action}}, 
	      showstr ($alr[$anum]->[4], 'print_ret'));
	if ($alr[$anum]->[2] == 0) { $alr[$anum]->[2] = 1; }
    }
}

foreach (my $n = 0; $n < @alr; $n ++) {
    my $l = $alr[$n]->[3];

    if ($l eq 'Zzzzz.  Bored are you?') {
	pushlm ('Sleep', -1, $n);
    } elsif ($l eq "I'm afraid you are dead!") {
	pushlm ('OnDeath', -1, $n);
    } elsif ($l eq "Wheee-boinng.") {
	pushlm ('Jump', -1, $n);
    } elsif ($l eq "That smells normal.") {
	pushlm ('Smell', -1, $n);
    } elsif ($l =~ /^(I|You) can\'t eat (.*).$/) {
	pushmsg ($2, 'before', 'Eat', $n);
    } elsif ($l =~ /^(I|You) can\'t take (.*).$/) {
	pushmsg ($2, 'before', 'Take', $n);
    } elsif ($l =~ /^(I|You) can\'t open (.*)!$/) {
	pushmsg ($2, 'before', 'Open', $n);
    } elsif ($l =~ /^(I|You) can\'t climb (.*).$/) {
	pushmsg ($2, 'before', 'Climb', $n);
    } elsif ($l eq "I really don't think there's any need for language like that!") {
	pushlm ('Strong', -1, $n);
	pushlm ('Mild', -1, $n);
    } elsif ($l =~ /^(I|You) eat (.*).  Not bad, but it could do with a pinch of salt!$/) {
	pushmsg ($2, 'after', 'Eat', $n);
    } elsif ($l =~ /^(I|You) might need (.*).$/) {
	pushmsg ($2, 'before', 'Break', $n);
    } elsif ($l =~ /^I\'m sorry, but XYZZY doesn\'t do anything special in this game!$/) {
    } elsif ($l =~ /^(I|You) shake (.*), but nothing happens.$/) {
	pushmsg ($2, 'before', 'Shake', $n);
    } elsif ($l =~ /^(.*) avoids (my|your) feeble attempts.$/) {
	pushmsg ($1, 'life', 'Attack', $n);
    } elsif ($l =~ /^Use the format \"ask (.*) about \[subject\]\".$/) {
	pushmsg ($1, 'before', 'TalkTo', $n);
    } elsif ($l =~ /^(.*) does not respond to your question.$/) {
	pushmsg ($1, 'life', 'Ask', $n);
    } elsif ($l =~ /^(.*) doesn\'t seem interested in (.*).$/) {
	my ($do, $io) = ($theobjs{$1}, $theobjs{$2});	
	if ($do && $io) {
	    push (@{$inform_objects{$do}{lifes}{Give}}, "if (noun == $io)", 
		  showstr ($alr[$n]->[4], 'print_ret'));
	    if ($alr[$n]->[2] == 0) { $alr[$n]->[2] = 1; }
	} else {
	    print "'$l' ($1,$do) / ($2,$io)\n";
	}
    } elsif ($l =~ /^(.*) refuses to give you (.*)!$/) {
	my ($do, $io) = ($theobjs{$1}, $theobjs{$2});
	if ($do && $io) {
	    push (@{$inform_objects{$io}{befores}{Take}}, "if (self in $do)", 
		  showstr ($alr[$n]->[4], 'print_ret'));
	    if ($alr[$n]->[2] == 0) { $alr[$n]->[2] = 1; }
	}
    }
	
}

# $You can't go in any direction! 
# Time passess...
# The game is now in its <I>verbose</I> mode, which always gives long descriptions of locations (even if you've been there before).
# The game is now in its <I>brief</I> printing mode, which always gives long descriptions of places never before visited and short descriptions otherwise.
# Game score change notification is now <I>on</I>, and the game will tell you of any changes in the score.
# Game score change notification is now <I>off</I>, and the game will be silent on changes in the score.
# $You can't go in that direction, but $you can go 
# (Getting off $the_player_parent first)
# (Standing up first)
# (You move |I move |%player% moves)dirnames[$direction].
# $YouAre as well as can be expected, considering the circumstances.
# $YouAre standing on
# $YouAre sitting down on
# $YouAre lying down on
# $YouAre wearing
# There's nothing special about $NPC.
# That's interesting, but it doesn't mean much. -> So tell me, are you trying to answer a rhetorical question?
# Aaarrrrgggghhhhhh!



#####################################################################
#                                                                   #
#                                                                   #
#                          OUTPUT SOURCE                            #
#                                                                   #
#                                                                   #
#####################################################################


my $FH;
if ($OUTPUT_TO_CONSOLE) {
    open $FH, ">&STDOUT" or die "Can't dup STDOUT: $!\n";
} else {
    open $FH, ">$fileroot.inf" or die "Can't open $fileroot.inf for output: $!\n";
}

my %ignored_props = map { $_ => 1 } qw/ht iname children parent attribs print_name class already_printed vocab befores afters orderss lifes/;
my @sortprops = qw/name article short_name prefix description npcdesc itemdesc add_to_scope state states initial describe found_in n_to s_to e_to w_to ne_to se_to nw_to sw_to u_to d_to in_to out_to before after life with_key curwalk entertext exittext showmove first_turn on_start daemon on_finish on_look size weight max_size max_wt capacity posture/;
my %sortprops = map { $sortprops[$_] => $_ + 1 } (0..$#sortprops);
sub sort_comp {
    my $t1 = $sortprops{$a};
    my $t2 = $sortprops{$b};
    #print "Comparing $a->", id($t1), ", $b->", id($t2), "\n";
    if (defined $t1 && defined $t2) { return $t1 - $t2; }
    elsif (defined $t1) { return -1; }
    elsif (defined $t2) { return 1; }
    elsif (defined($ignored_props{$a}) == defined($ignored_props{$b})) {
        return $a cmp $b; }
    elsif ($ignored_props{$a}) { return 1; }
    #elsif ($ignored_props{$b}) { return -1; }
    return -1;
}

sub show_inf_obj {
    my ($in, $depth) = @_;
    #print $FH "! show_inf_obj (", (defined $in ? $in : '<UNDEF>'), ")\n";
    my $obj = $inform_objects{$in};

    if ($obj->{already_printed}) {
	print $FH "! * * * Error: reprinting $in * * *\n\n";
	print " * * * Error: reprinting $in * * *\n\n";
    }
    $obj->{already_printed} = 1;

    for my $p (qw/after before orders life/) {
	if ($obj->{$p}) {
	    print "$in already has '$p' defined: ", $obj->{$p}, "\n";
	}
	if ($obj->{$p.'s'}) {
	    my @tmp = ();
	    foreach (sort keys %{$obj->{$p.'s'}}) {
		#push @tmp, $_.': '.$obj->{$p.'s'}->{$_}.';';
		my $x = $obj->{$p.'s'}->{$_};
		if (ref $x eq 'ARRAY') {
		    if (@$x == 1) {
			if ($x->[0] =~ /^print_ret \"(.*)$/) {
			    push @tmp, "$_:  \"$1";
			} elsif ($x->[0] =~ /^!/) {
			    push @tmp, "$_:", $x->[0];
			} else {
			    push @tmp, "$_:  ".$x->[0];
			}
		    } else {
			push @tmp, $_.':', @$x;
		    }
		} else {
		    $x = ref $x ? $$x : $x;
		    if ($x =~ /^print_ret \"(.*)$/) {
			$x = "\"$1";
		    }
		    push @tmp, "$_:  ", $x;
		}
	    }
	    $obj->{$p} = bless \@tmp, 'INDENTED';
	    delete $obj->{$p.'s'};
	}
    }

    #print $FH "! \$obj == (", join (",", %$obj), ")\n";
    
    my $cl = $obj->{class};
    my @cl;
    if (!defined($cl) || @{$cl} == 0) { @cl = ('Object'); }
    else { @cl = @$cl; }
    if ($OUTPUT_ARROWS) { 
	print $FH shift @cl, " ->" x $depth, " ", $obj->{iname}, " ", $obj->{print_name};
    } else {
	print $FH shift @cl, " ", $obj->{iname}, " ", $obj->{print_name};
	if ($obj->{parent} && $obj->{parent} ne '1') { 
	    print $FH " ", $obj->{parent}; 
	}
    }
    if (@cl) { print $FH "\n class  ", join (" ", @cl); }

    print $FH "\n with   ";
    my $first_line = 1;
    foreach my $k (sort sort_comp keys %$obj) {
	if (!$ignored_props{$k}) {
	    if ($first_line) {
		print $FH "$k ";
		$first_line = 0;
	    } else {
		print $FH ",\n        $k ";
	    }
	    my $v = $obj->{$k};
	    #if (ref $v) { print $FH "[ ;", join ("", @{$v}), "]"; }
	    if (ref $v eq 'INDENTED') { print $FH indent (@$v); }
	    elsif (ref $v eq 'FORMATTED') { print $FH indent ('print_ret '.$$v.';'); }
	    elsif (ref $v eq 'ARRAY') { print $FH join (' ', @$v); }
	    else { print $FH "$v"; }
	}
    }
    if (!defined ($obj->{attribs})) { print "ERROR: No attribs for ", %$obj, "\n"; }
    if (@{$obj->{attribs}}) {
	print $FH ",\n has    ", (join " ", @{$obj->{attribs}});
    }
    print $FH ";\n\n";

    if ($OUTPUT_ARROWS) {
	foreach my $c (@{$obj->{children}}) {
	    show_inf_obj ($c, $depth + 1);
	}	
    } else {
	foreach my $c (@{$obj->{children}}, @{$obj->{add_to_scope}}) {
	    show_inf_obj ($c, 0);
	}	
    }
}
my @full_list = ((map { $_->{iname} } (@{$root->{Rooms}}, @{$root->{Objects}},
				       @{$root->{NPCs}},  @{$root->{Events}})),
		 @inform_npcs, @inform_objs);

my %all_props = ();
foreach my $o (@full_list) { 
    foreach (keys %{$inform_objects{$o}}) { 
	if (!$ignored_props{$_} && !$sortprops{$_}) { 
	    $all_props{$_} = 1; 
	    #if ($_ =~ /^task/) {
	    #	print $o, ".", $_, " == ", $inform_objects{$o}->{$_}, "\n";
	    #}
	} 
    }
}
print "Unknown props == (", join (", ", sort keys %all_props), ")\n\n\n";


print $FH "!% +language_name=english".($root->{Globals}->{Perspective}+1)."\n";

if (%used_zchars) {
    print $FH "\n";
    foreach (sort keys %used_zchars) {
	print $FH "Zcharacter table + '$_';\n";
    }
    print $FH "\n";
}

print $FH "Constant STORY ", reformat ($root->{Globals}->{GameName}, 1), ";\n";
print $FH "Constant HEADLINE \"^Copyright (c) ", $root->{CompileDate}, " by ", clip(reformat($root->{Globals}->{GameAuthor}, 1)),"^\";\n";
#print $FH "Constant P_Sitting  1;\n";
#print $FH "Constant P_Standing 2;\n";
#print $FH "Constant P_Lying    3;\n";
print $FH "Constant PERSON ".($root->{Globals}->{Perspective}+1).";\n";
print $FH "!!! To use ADRIFT sizes, uncomment the next line\n!Constant USE_SIZES;\n";
print $FH "#Ifdef USE_SIZES;\nReplaceInsertSub;\nReplaceAttemptToTakeObject;\n#Endif;\n"; # Add code to set the capacity variables
if ($root->{Globals}->{MaxScore} > 0) {
    print $FH "Constant MAX_SCORE ", $root->{Globals}->{MaxScore}, ";\n";
} else {
    print $FH "Constant NO_SCORE;\n";
}

#foreach (sort keys %capacities) { }
foreach (sort { if ($a !~ /(.*)_(.*)/) { return $a cmp $b; } my ($a1, $a2) = ($1, $2); if ($b !~ /(.*)_(.*)/ || $1 ne $a1) { return $a cmp $b; } return $a2 <=> $2; } keys %capacities) {
    #if ($_ =~ /_[0-9]/) {
    print $FH "Constant $_ ", $capacities{$_}, ";\n";
    #}
}
print $FH "\n";

if (@images || @sounds) {
    print $FH "\n";
    for (my $n = 0; $n < @images; $n ++) {
	my @tmp = @{$images{$images[$n]}};
	print $FH "Constant $tmp[0] $tmp[2];\n";
    }
    for (my $n = 0; $n < @sounds; $n ++) {
	my @tmp = @{$sounds{$sounds[$n]}};
	print $FH "Constant $tmp[0] $tmp[2];\n";
    }
    print $FH "\n";
}

if (@scored_tasks) {
    print $FH "!Constant TASKS_PROVIDED;  ! Uncomment if PrintTaskName done\n";
    print $FH "Constant NUMBER_TASKS = ", scalar @scored_tasks, ";\n";
    print $FH "Array task_scores -> ", join (" ", map { $_->[1] } @scored_tasks), ";\n\n";
    print $FH "[ PrintTaskName tasknum; ! If you want full score, change strings below to\n    ! what you want, then uncomment TASKS_PROVIDED, else delete the routine\n";
    print $FH "    switch (tasknum) {\n";
    for (my $n = 0; $n < @scored_tasks; $n ++) {
	my $io = $inform_objects{$scored_tasks[$n]->[0]};
	print $FH "        $n: ", reformat ($io->{iname}. ": ". $io->{ht}->{Command}->[0], 1), ";\n";
    }
    print $FH "    }\n";
    print $FH "];\n\n";
}

print $FH "Include \"Parser\";\n";

if (%lm) {
    print $FH "\nObject  LibraryMessages\n  with  before [ ;\n";
    foreach my $act (sort keys %lm) {
	if ($act eq 'OnDeath') { next; }
	my $f = $lm{$act};
	if (ref $f eq 'HASH') {
	    print $FH " "x9, $act, ":\n";
	    foreach (sort keys %$f) {
		print $FH " "x12, "if (lm_n == $_)\n", " "x16, $f->[$_], ";\n";
	    }
	} elsif (ref $f eq 'ARRAY') {
	    print $FH " "x9, $act, ":\n";
	    print $FH " "x12, "! Huh, array ref in LibraryMessages\n";
	    print $FH " "x12, "{", join (", ", @$f), "}\n";
	} else {
	    print $FH " "x9, $act, ":", " "x(10-length($act)), $f, ";\n";
	}
    }
    print $FH " "x8, "];\n\n";
}

print $FH "Include \"VerbLib\";\n";
print $FH "Include \">taflib\";\n\n\n";

foreach my $rg (@{$root->{RoomGroups}}) {
    my $in = $rg->{iname};
    print $FH "! Member rooms are ", join (" ", @{$inform_objects{$in}->{rooms}}), "\n";
    print $FH "Class $in\n";
    print $FH "    class Room;\n\n";
}

#foreach my $o (@full_list) { show_inf_obj ($o, 0); }

if (1) {
    # Show all rooms, and recursively show all objects originally on the map
    foreach my $o (map { $_->{iname} } @{$root->{Globals}->{Rooms}} ) {
	show_inf_obj ($o, 0);
    }
    # Next, recursively show any objects not initially on the map
    foreach my $o (@full_list) {  
	my $obj = $inform_objects{$o};
	if (!$obj->{parent} && !$obj->{already_printed}) {
	    show_inf_obj($o, 0);
	}
    }
    # If anything remains, it's a bug:
    foreach my $o (@full_list) {  
	if (!$inform_objects{$o}->{already_printed}) {
	    print $FH "!*** FALLTHROUGH OBJECT $o ***\n";
	    show_inf_obj($o, 0);
	}
    }
}

#foreach my $e (map {$_->{iname}} @{$root->{Events}}) {
#    show_inf_obj($e);
#}

foreach (keys %alr_funcs) {
    #my %f = %{$alr_funcs{$_}};
    #print $FH "[ $f{iname} var;\n";
    #my @l = grep /^[0-9]*$/, sort { $a <=> $b } keys %f;
    #for (my $n = 0; $n < @l; $n ++) {
    # 	print $FH "    ", ($n == 0 ? '' : 'else '), "if (var == $l[$n])\n";
    #	my $tmp = reformat ($f{$l[$n]});
    #	print $FH "        print ", (ref $tmp ? $$tmp : $tmp), ";\n";
    #}
    #print $FH "    else\n";
    #print $FH "        print \"$_\", var;\n";
    #print $FH "];\n\n";

    my %f = %{$alr_funcs{$_}};
    my @l = grep /^[0-9]*$/, sort { $a <=> $b } keys %f;
    print $FH "[ $f{iname} var;\n";
    print $FH "    switch (var) {\n";
    foreach (my $n = 0; $n < @l; $n ++) { 
	my $tmp = reformat ($f{$l[$n]});
	print $FH "     ", $l[$n], ": print ", (ref $tmp ? $$tmp : $tmp),";\n";
    }
    print $FH "     default: print \"$_\", var;\n";
    print $FH "    }\n";
    print $FH "];\n\n";
}

#    ('_GAME_',  'V<SYNONYM>Synonyms BCustomFont ?BCustomFont:$FontNameSize ',
#     'GLOBAL',  '$DontUnderstand BShowExits #WaitTurns BStatusBox '.
#                'bNoDebug BNoScoreNotify BNoMap bNoAutoComplete '.
#                'bNoControlPanel bNoMouse $StatusBoxText #Unk1 #Unk2',

print $FH "\n\n[ Initialise x;\n";
print $FH "    player = playerobj;\n";
print $FH "    location = parent(player);\n";
print $FH "    objectloop(x provides first_turn)\n";
print $FH "        x.first_turn();\n";
print $FH "    Style(0);  ! Set the colors\n";
print $FH "    ClearScreen(); ! And initialise the screen\n";
if ($root->{Globals}->{PlayerGender} == 3) {
    print $FH "    ! PromptForGender();\n";
}
if (!$root->{Globals}->{EightPointCompass}) {
    foreach (qw/ne_obj nw_obj se_obj sw_obj/) {
	print $FH "    remove $_;\n";
    }
}
if ($root->{Globals}->{PromptName}) {
    print $FH "    ! PromptForName();\n";
}
foreach (showrsc ($root->{Globals}->{IntroRes})) {
    print $FH "    $_\n";
}
#print $FH "    print ", reformat ($root->{Header}->{StartupText}), ";\n";
print $FH "    ", showstr ($root->{Header}->{StartupText}, 'print'), "\n";
if (! $root->{Globals}->{DispFirstRoom}) {
    print $FH "    ! TODO TODO Don't show first room\n";
}
print $FH "    rtrue;\n";
print $FH "];\n\n";

print $FH "[ EndGame type;\n";
print $FH "    deadflag = type;\n";
print $FH "    if (type == 2) { ! WIN\n";
foreach (showrsc ($root->{Globals}->{WinRes})) {
    print $FH "        $_\n";
}
#print $FH "    print ", reformat ($root->{Header}->{WinText}), ";\n";
print $FH "        ", showstr ($root->{Header}->{WinText}, 'print'), "\n";
print $FH "    } else if (type == 1) { ! DIE\n";
if ($lm{OnDeath}) {
    my $msg = $lm{OnDeath};
    print $FH "        print ".(ref $msg ? $$msg : $msg).";\n";
} else {
    print $FH "        print \"I'm afraid you are dead!^\";\n";
}
print $FH "    } else { ! DIE SILENTLY\n";
print $FH "    }\n";
print $FH "    ScoreSub();\n";
print $FH "    DisplayStatus();\n";
print $FH "    AfterGameOver();\n";
print $FH "];\n\n";

print $FH "Object Globals with\n";
foreach my $t (@{$root->{Tasks}}) {
    my $it = $inform_objects{$t->{iname}};
    #print $FH "! ", join (" ", %$it), "\n";
    #if ($it->{needtrack}) {
    if ($it->{needtrack} && $it->{owner} eq 'Globals') {
	print $FH " "x8, $t->{iname}, ", ! ";
	print $FH $t->{Command}->[0], " ";
	foreach (@{$it->{track}}) {
	    print $FH "[", join (", ", @$_), "] ";
	}
	print $FH "\n";
    }
}
foreach my $v (@{$root->{Variables}}) {    
    if ($v->{Type} == 0) { 
	print $FH ' 'x8, $v->{iname}, ' ', $v->{Value}, ",\n";
    } else {
	print $FH ' 'x8, $v->{iname}, ' ', reformat($v->{Value},1), ",\n";
    }
}
print $FH ";\n\n";

print $FH "Include \"Grammar\";\n";

print $FH "end;\n";


if (!$OUTPUT_TO_CONSOLE) {
    close $FH;
    open $FH, ">$fileroot.tsk" or die "Can't open $fileroot.inf for output: $!\n";
}


sub show_task {
    my $t = shift;
    if ($t->{full_swallowed}) { return; }

    print $FH "\n\n";
    if ($t->{swallowed}) {
	print $FH " TASK ", $t->{iname}, " was swallowed into ", $t->{swallowed}, "\n";
	if (!$t->{full_swallowed}) {
	    if (defined $t->{tree_list}) {
		print $FH " tree_list -> [", join ("], [", map { join (", ", @$_) } @{$t->{tree_list}}), "]\n";
	    }
	    if (@{$t->{Failed}}) { print $FH " Failed -> [", join (", ", @{$t->{Failed}}), "]\n"; } 
	    if (@{$t->{Parsed}}) { print $FH " Parsed -> [", join (", ", @{$t->{Parsed}}), "]\n"; }

	    if (@{$t->{call}}) { print $FH " call   -> [", (map { ("{", join (", ", @$_), "}") } (@{$t->{call}})), "]\n"; }
	    if (@{$t->{track}}) { print $FH " track  -> [", (map { ("{", join (", ", @$_), "}") } (@{$t->{track}})), "]\n"; }
	    print $FH ("owner: ", id($t->{owner}), ", noun: ", id($t->{noun}),
		       ", second: ", id($t->{second}), "\n");
	}
	next;
    } else {
	print $FH "TASK ", $t->{iname}, "\n";
    }
    if (@{$t->{Failed}}) { 
	print $FH " -) [", join (", ", @{$t->{Failed}}), "] [", join (", ", (defined $t->{Parsed} ? @{$t->{Parsed}} : ())), "]\n";
    }
    foreach my $k (sort keys %$t) {
	my $v = $t->{$k};
	if ((ref $v eq 'ARRAY' && @$v == 0) || $k eq 'ParserCall' || 
	    $k eq 'needtrack' || $k eq 'class' || $k eq 'ht' || 
	    ($k eq 'where' && $v eq '1'))  { next; }
	print $FH "  $k ";
	if ($k eq 'restrs') {
	    print $FH "{ ";
	    foreach my $r (@$v) {
		print $FH "<", join ("|", @$r), ">";
	    }
	    print $FH "}\n";
	} elsif (ref $v eq 'FORMATTED') {
	    print $FH indent ('print_ret '.$$v.';');
	} elsif (ref $v eq 'INDENTED') {
	    print $FH indent (@$v), "\n";
	} elsif ($k eq 'track' || $k eq 'call') {
	    print $FH "[", (map { ("{", join (", ", @$_), "}") } (@$v)), "]\n";
	} elsif (ref $v eq 'ARRAY') {
	    print $FH "[", join ("|", @$v), "]\n";
	} else {
	    print $FH "'$v'\n";
	    if (!defined $v) { print $t->{iname}.".$k is uninitialized!\n"; }
	}
    }
}

foreach my $t (map {$inform_objects{$_->{iname}}} @{$root->{Tasks}}) {
    if ((defined ($t->{call}) && @{$t->{call}}) || @{$t->{Failed}} > 0) {
	show_task($t);
    } else {
	$t->{uncallable} = 1;
    }
}

print $FH "\n\nUncallable Tasks:\n";

foreach my $t (map {$inform_objects{$_->{iname}}} @{$root->{Tasks}}) {
    if ($t->{uncallable}) {
	show_task($t);
    }
}

#print $FH "\%theobjs == (", join (", ", sort keys %theobjs), ")\n\n\n";

print $FH "Unused ALR lines:\n";
foreach (@alr) {
    if ($_->[2] == 0) {
	print $FH "    ", $_->[3], " -> ", $_->[4], "\n";
    }
}
print $FH "\nUsed ALR lines:\n";
foreach (@alr) {
    if ($_->[2] == 1) {
	print $FH "    ", $_->[3], " -> ", $_->[4], "\n";
    }
}
print $FH "\nALR Function lines:\n";
foreach (@alr) {
    if ($_->[2] == 2 || $_->[2] == 3) {
	print $FH "    ", $_->[3], " -> ", $_->[4], "\n";
    }
}

close $FH;
