#!/usr/bin/perl

use Compress::Zlib;
use strict;

$| = 1;

#  Tables of properties descriptors.  These strings define the structure of
#  a TAF file.  Field keys are:
#
#  $,#,B,M      - string, integer, boolean, and multiline properties
#  E,F,T,Z      - string, integer, and boolean properties not in the TAF;
#                 set to "", FALSE, TRUE and zero on parsing (version < 4)
#  i,s,b        - string, integer, and boolean in the TAF, but not stored
#  [num]        - arrays of property, fixed size to num
#  V            - variable sized array of property, size in input file
#  W            - like V, but size - 1 in input file (version < 4)
#  <class>      - class of property, separate parse target (recurse)
#  ?[!]expr:    - conditional property based on expr
#  G[!]expr:    - conditional property based on expr using globals
#  |...|        - fixup specials for versions < 4
#  {special}    - because some things just defy description

#print "Loading \%Taf400\n";

our $sep;

my %Taf400 =
    ('_GAME_',  '<HEADER>Header <GLOBAL>Globals V<ROOM>Rooms '.
                'V<OBJECT>Objects V<TASK>Tasks V<EVENT>Events '.
                'V<NPC>NPCs V<ROOM_GROUP>RoomGroups V<SYNONYM>Synonyms '.
                'V<VARIABLE>Variables V<ALR>ALRs BCustomFont '.
                '?BCustomFont:$FontNameSize $CompileDate',
     'HEADER',  'MStartupText #StartRoom MWinText',
     'GLOBAL',  '$GameName $GameAuthor $DontUnderstand #Perspective '.
                'BShowExits #WaitTurns BDispFirstRoom BBattleSystem '.
                '#MaxScore $PlayerName BPromptName $PlayerDesc #Task '.
                '?!#Task=0:$AltDesc #Position #ParentObject '.
                '#PlayerGender #MaxSize #MaxWt '.
                '?GBattleSystem:<BATTLE>Battle BEightPointCompass '.
                'bNoDebug BNoScoreNotify BNoMap bNoAutoComplete '.
                'bNoControlPanel bNoMouse BSound BGraphics '.
                '<RESOURCE>IntroRes <RESOURCE>WinRes BStatusBox '.
                '$StatusBoxText #Unk1 #Unk2 BEmbedded',
     'BATTLE',  '#StaminaLo #StaminaHi #StrengthLo #StrengthHi #AccuracyLo '.
                '#AccuracyHi #DefenseLo #DefenseHi #AgilityLo #AgilityHi '.
                '#Recovery',
     'ROOM',    '$Short $Long ?GEightPointCompass:[12]<ROOM_EXIT>Exits '.
                '?!GEightPointCompass:[8]<ROOM_EXIT>Exits <RESOURCE>Res '.
                'V<ROOM_ALT>Alts ?!GNoMap:BHideOnMap',
     'ROOM_EXIT', '{V400_ROOM_EXIT:#Dest_#Var1_#Var2_#Var3}',
     'ROOM_ALT','$M1 #Type <RESOURCE>Res1 $M2 #Var2 <RESOURCE>Res2 '.
                '#HideObjects $Changed #Var3 #DisplayRoom',
     'RESOURCE','?GSound:$SoundFile,#SoundLen,ZSoundOffset '.
                '?GGraphics:$GraphicFile,#GraphicLen,ZGraphicOffset '.
                '{V400_RESOURCE}',

     'OBJECT',  '$Prefix $Short V$Alias BStatic $Description '.
                '#InitialPosition #Task BTaskNotDone $AltDesc '.
                '?BStatic:<ROOM_LIST1>Where BContainer BSurface #Capacity '.
                '?!BStatic:BWearable,#SizeWeight,#Parent '.
                '?BStatic:{OBJECT:#Parent} #Openable ?#Openable=5:#Key '.
                '?#Openable=6:#Key ?#Openable=7:#Key #SitLie '.
                '?!BStatic:BEdible BReadable ?BReadable:$ReadText '.
                '?!BStatic:BWeapon #CurrentState '.
                '?!#CurrentState=0:$States,BStateListed BListFlag '.
                '<RESOURCE>Res1 <RESOURCE>Res2 '.
                '?GBattleSystem:<OBJ_BATTLE>Battle $InRoomDesc '.
                '#OnlyWhenNotMoved',
     'OBJ_BATTLE', '#ProtectionValue #HitValue #Method #Accuracy',
     'ROOM_LIST1', '#Type {ROOM_LIST1}',
     'TASK',    'V$Command $CompleteText $ReverseMessage $RepeatText '.
                '$AdditionalMessage #ShowRoomDesc BRepeatable BReversible '.
                'V$ReverseCommand <ROOM_LIST0>Where $Question '.
                '?$Question:$Hint1,$Hint2 V<TASK_RESTR>Restrictions '.
                'V<TASK_ACTION>Actions $RestrMask <RESOURCE>Res',
     'TASK_RESTR', '#Type ?#Type=0:#Var1,#Var2,#Var3 ?#Type=1:#Var1,#Var2 '.
                   '?#Type=2:#Var1,#Var2 ?#Type=3:#Var1,#Var2,#Var3 '.
                   '?#Type=4:#Var1,#Var2,#Var3,$Var4 '.
                   '?#Type=12:iVar1,iVar2,iVar3 '.
                   # Type=12 is a workaround for comp release of Sophie's Adv
                   '$FailMessage',
     'TASK_ACTION','#Type ?#Type=0:#Var1,#Var2,#Var3 '.
                   '?#Type=1:#Var1,#Var2,#Var3 ?#Type=2:#Var1,#Var2 '.
                   '?#Type=3:#Var1,#Var2,#Var3,$Expr,#Var5 ?#Type=4:#Var1 '.
                   '?#Type=5:#Var1,#Var2 ?#Type=6:#Var1,#Var2,#Var3 '.
                   '?#Type=7:iVar1,iVar2,iVar3',

                 
     'ROOM_LIST0', '#Type {ROOM_LIST0}',
     'EVENT',      '$Short #StarterType ?#StarterType=2:#StartTime,#EndTime '.
                   '?#StarterType=3:#TaskNum #RestartType BTaskFinished '.
                   '#Time1 #Time2 $StartText $LookText $FinishText '.
                   '<ROOM_LIST0>Where #PauseTask BPauserCompleted #PrefTime1 '.
                   '$PrefText1 #ResumeTask BResumerCompleted #PrefTime2 '.
                   '$PrefText2 #Obj2 #Obj2Dest #Obj3 #Obj3Dest #Obj1 '.
                   '#Obj1Dest #TaskAffected [5]<RESOURCE>Res',
     'NPC',        '$Name $Prefix V$Alias $Descr #StartRoom $AltText #Task '.
                   'V<TOPIC>Topics V<WALK>Walks BShowEnterExit '.
                   '?BShowEnterExit:$EnterText,$ExitText $InRoomText '.
                   '#Gender [4]<RESOURCE>Res '.
                   '?GBattleSystem:<NPC_BATTLE>Battle',
     'NPC_BATTLE', '#Attitude #StaminaLo #StaminaHi #StrengthLo #StrengthHi '.
                   '#AccuracyLo #AccuracyHi #DefenseLo #DefenseHi '.
                   '#AgilityLo #AgilityHi #Speed #KilledTask #Recovery '.
                   '#StaminaTask',
     'TOPIC',      '$Subject $Reply #Task $AltReply',
     'WALK',       '#NumStops BLoop #StartTask #CharTask #MeetObject '.
                   '#ObjectTask #StoppingTask #MeetChar $ChangedDesc '.
                   '{WALK:#Rooms_#Times}',
     'ROOM_GROUP', '$Name {ROOM_GROUP:[]BList}',
     'SYNONYM',    '$Replacement $Original',
     'VARIABLE',   '$Name #Type $Value',
     'ALR',        '$Original $Replacement');

my %Taf390 = 
    ('_GAME_',  '<HEADER>Header <GLOBAL>Globals V<ROOM>Rooms V<OBJECT>Objects'.
                ' V<TASK>Tasks V<EVENT>Events V<NPC>NPCs'.
                ' V<ROOM_GROUP>RoomGroups V<SYNONYM>Synonyms'.
                ' V<VARIABLE>Variables V<ALR>ALRs BCustomFont'.
                ' ?BCustomFont:$FontNameSize $CompileDate sPassword',

     'HEADER',  'MStartupText #StartRoom MWinText',
     'GLOBAL',  '$GameName $GameAuthor $DontUnderstand #Perspective'.
                ' BShowExits #WaitTurns BDispFirstRoom BBattleSystem'.
                ' #MaxScore $PlayerName BPromptName $PlayerDesc #Task'.
                ' ?!#Task=0:$AltDesc #Position #ParentObject #PlayerGender'.
                ' #MaxSize #MaxWt'.
                ' ?GBattleSystem:<BATTLE>Battle'.
                ' BEightPointCompass bNoDebug'.
                ' BNoScoreNotify BNoMap bNoAutoComplete bNoControlPanel'.
                ' bNoMouse BSound BGraphics'.
                ' <RESOURCE>IntroRes <RESOURCE>WinRes'.
                ' FStatusBox EStatusBoxText iUnk1 iUnk2 FEmbedded',
     'BATTLE',  '#Stamina #Strength #Defense',
     'ROOM',    '$Short $Long $LastDesc'.
                ' ?GEightPointCompass:[12]<ROOM_EXIT>Exits'.
                ' ?!GEightPointCompass:[8]<ROOM_EXIT>Exits'.
                ' $AddDesc1 #Task1 $AddDesc2 #Task2'.
                ' #Obj $AltDesc #TypeHideObjects'.
                ' <RESOURCE>Res'.
                ' <RESOURCE>LastRes <RESOURCE>Task1Res <RESOURCE>Task2Res'.
                ' <RESOURCE>AltRes'.
                ' ?!GNoMap:BHideOnMap'.
                ' |V390_ROOM:_Alts_|',
     'ROOM_EXIT',  '{V390_V380_ROOM_EXIT:#Dest_#Var1_#Var2_ZVar3}',
     'RESOURCE',   '?GSound:$SoundFile,ZSoundLen,ZSoundOffset'.
                ' ?GGraphics:$GraphicFile,ZGraphicLen,ZGraphicOffset',
     'OBJECT',  '$Prefix $Short'.
                ' [1]$Alias BStatic $Description'.
                ' #InitialPosition #Task BTaskNotDone $AltDesc'.
                ' ?BStatic:<ROOM_LIST1>Where BContainer BSurface #Capacity'.
                ' ?!BStatic:BWearable,#SizeWeight,#Parent'.
                ' ?BStatic:{OBJECT:#Parent}'.
                ' #Openable |V390_OBJECT:_Openable_,Key|'.
                ' #SitLie ?!BStatic:BEdible BReadable'.
                ' ?BReadable:$ReadText ?!BStatic:BWeapon ZCurrentState'.
                ' FListFlag <RESOURCE>Res1 <RESOURCE>Res2'.
                ' ?GBattleSystem:<OBJ_BATTLE>Battle'.
                ' EInRoomDesc ZOnlyWhenNotMoved',
     'OBJ_BATTLE', '#ProtectionValue #HitValue #Method',
     'ROOM_LIST1', '#Type {ROOM_LIST1}',
     'TASK',    'W$Command $CompleteText $ReverseMessage $RepeatText'.
                ' $AdditionalMessage #ShowRoomDesc BRepeatable BReversible'.
                ' W$ReverseCommand <ROOM_LIST0>Where $Question'.
                ' ?$Question:$Hint1,$Hint2 V<TASK_RESTR>Restrictions'.
                ' V<TASK_ACTION>Actions |V390_TASK:$RestrMask| <RESOURCE>Res',
     'TASK_RESTR', '#Type ?#Type=0:#Var1,#Var2,#Var3 ?#Type=1:#Var1,#Var2'.
                ' ?#Type=2:#Var1,#Var2 ?#Type=3:#Var1,#Var2,#Var3'.
                ' ?#Type=4:#Var1,#Var2,#Var3,EVar4'.
                ',|V390_TASK_RESTR:Var1>0?#Var1++|'.
                ' $FailMessage',
     'TASK_ACTION','#Type |V390_TASK_ACTION:Type>4?#Type++|'.
                ' ?#Type=0:#Var1,#Var2,#Var3 ?#Type=1:#Var1,#Var2,#Var3'.
                ' ?#Type=2:#Var1,#Var2'.
                ' ?#Type=3:#Var1,#Var2,#Var3,|V390_TASK_ACTION:$Expr_#Var5|'.
                ' ?#Type=4:#Var1'.
                ' ?#Type=6:#Var1,ZVar2,ZVar3 ?#Type=7:#Var1,#Var2,#Var3',
     'ROOM_LIST0', '#Type {ROOM_LIST0}',
     'EVENT',   '$Short #StarterType ?#StarterType=2:#StartTime,#EndTime'.
                ' ?#StarterType=3:#TaskNum #RestartType BTaskFinished'.
                ' #Time1 #Time2 $StartText $LookText $FinishText'.
                ' <ROOM_LIST0>Where #PauseTask BPauserCompleted'.
                ' #PrefTime1 $PrefText1 #ResumeTask BResumerCompleted'.
                ' #PrefTime2 $PrefText2 #Obj2 #Obj2Dest #Obj3 #Obj3Dest'.
                ' #Obj1 #Obj1Dest #TaskAffected [5]<RESOURCE>Res',
     'NPC',     '$Name $Prefix [1]$Alias $Descr #StartRoom $AltText #Task'.
                ' V<TOPIC>Topics V<WALK>Walks BShowEnterExit'.
                ' ?BShowEnterExit:$EnterText,$ExitText $InRoomText #Gender'.
                ' [4]<RESOURCE>Res'.
                ' ?GBattleSystem:<NPC_BATTLE>Battle',
     'NPC_BATTLE', '#Attitude #Stamina #Strength #Defense #Speed #KilledTask',
     'TOPIC',   '$Subject $Reply #Task $AltReply',
     'WALK',    '#NumStops BLoop #StartTask #CharTask #MeetObject '.
                '#ObjectTask #StoppingTask ZMeetChar $ChangedDesc '.
                '{WALK:#Rooms_#Times}',
     'ROOM_GROUP', '$Name {ROOM_GROUP:[]BList}',
     'SYNONYM',    '$Replacement $Original',
     'VARIABLE',   '$Name ZType $Value',
     'ALR',        '$Original $Replacement'
     );

my %Taf380 = 
    ('_GAME_',  '<HEADER>Header <GLOBAL>Globals V<ROOM>Rooms V<OBJECT>Objects'.
                ' V<TASK>Tasks V<EVENT>Events V<NPC>NPCs'.
                ' V<ROOM_GROUP>RoomGroups V<SYNONYM>Synonyms'.
                ' FCustomFont $CompileDate sPassword'.
                ' |V380_GLOBAL:_MaxScore_|'.
                ' |V380_OBJECT:_InitialPositions_|' ,
     'HEADER',  'MStartupText #StartRoom MWinText' ,
     'GLOBAL',  '$GameName $GameAuthor #MaxCarried |V380_MaxSize_MaxWt_|'.
                ' $DontUnderstand #Perspective'.
                ' BShowExits #WaitTurns FDispFirstRoom FBattleSystem'.
                ' EPlayerName FPromptName EPlayerDesc ZTask'.
                ' ZPosition ZParentObject ZPlayerGender'.
                ' FEightPointCompass TNoScoreNotify'.
                ' FSound FGraphics FStatusBox EStatusBoxText FEmbedded' ,
     'ROOM',    '$Short $Long $LastDesc'.
                ' [8]<ROOM_EXIT>Exits $AddDesc1 #Task1 $AddDesc2 #Task2'.
                ' #Obj $AltDesc #TypeHideObjects'.
                ' |V380_ROOM:_Alts_|' ,
     'ROOM_EXIT', '{V390_V380_ROOM_EXIT:#Dest_#Var1_#Var2_ZVar3}' ,
     'OBJECT',  '$Prefix $Short'.
                ' [1]$Alias BStatic $Description'.
                ' #InitialPosition #Task BTaskNotDone $AltDesc'.
                ' ?BStatic:<ROOM_LIST1>Where #SurfaceContainer'.
                ' FSurface ?#SurfaceContainer=2:TSurface'.
                ' FContainer ?#SurfaceContainer=1:TContainer'.
                ' #Capacity |V380_OBJECT:#Capacity*10+2|'.
                ' ?!BStatic:BWearable,#SizeWeight,#Parent'.
                ' ?BStatic:{OBJECT:#Parent}'.
                ' #Openable |V380_OBJECT:_Openable_,Key|'.
                ' #SitLie ?!BStatic:BEdible BReadable'.
                ' ?BReadable:$ReadText ?!BStatic:BWeapon ZCurrentState'.
                ' FListFlag EInRoomDesc ZOnlyWhenNotMoved' ,
     'ROOM_LIST1',  '#Type {ROOM_LIST1}' ,
     'TASK',    'W$Command $CompleteText $ReverseMessage $RepeatText'.
                ' $AdditionalMessage #ShowRoomDesc BRepeatable'.
                ' #Score BSingleScore'.
                ' [6]<TASK_MOVE>Movements BReversible'.
                ' W$ReverseCommand #WearObj1 #WearObj2'.
                ' #HoldObj1 #HoldObj2 #HoldObj3'.
                ' #Obj1 #Task BTaskNotDone'.
                ' $TaskMsg $HoldMsg $WearMsg $CompanyMsg'.
                ' BNotInSameRoom #NPC $Obj1Msg #Obj1Room'.
                ' <ROOM_LIST0>Where BKillsPlayer BHoldingSameRoom'.
                ' $Question'.
                ' ?$Question:$Hint1,$Hint2 #Obj2'.
                ' ?!#Obj2=0:#Obj2Var1,#Obj2Var2,$Obj2Msg'.
                ' BWinGame'.
                ' |V380_TASK:_Actions_| |V380_TASK:_Restrictions_|' ,
     'TASK_MOVE',   '#Var1 #Var2 #Var3' ,
     'ROOM_LIST0',  '#Type {ROOM_LIST0}' ,
     'EVENT',   '$Short #StarterType ?#StarterType=2:#StartTime,#EndTime'.
                ' ?#StarterType=3:#TaskNum #RestartType BTaskFinished #Time1'.
                ' #Time2 $StartText $LookText $FinishText <ROOM_LIST0>Where'.
                ' #PauseTask BPauserCompleted #PrefTime1 $PrefText1'.
                ' #ResumeTask BResumerCompleted #PrefTime2 $PrefText2'.
                ' #Obj2 #Obj2Dest #Obj3 #Obj3Dest #Obj1 #Obj1Dest'.
                ' #TaskAffected' ,
     'NPC',     '$Name $Prefix [1]$Alias $Descr #StartRoom $AltText #Task'.
                ' V<TOPIC>Topics V<WALK>Walks BShowEnterExit'.
                ' ?BShowEnterExit:$EnterText,$ExitText $InRoomText ZGender' ,
     'TOPIC',   '$Subject $Reply #Task $AltReply' ,
     'WALK',    '#NumStops BLoop #StartTask #CharTask #MeetObject'.
                ' ?!#MeetObject=0:|V380_WALK:_MeetObject_| #ObjectTask'.
                ' ZMeetChar {WALK:#Rooms_#Times}'.
                ' ZStoppingTask EChangedDesc' ,
     'ROOM_GROUP',  '$Name {ROOM_GROUP:[]BList}' ,
     'SYNONYM',     '$Replacement $Original');

our %compiled_funcs = ();

our ($V380_OBJ_IS_SURFACE, $V380_OBJ_IS_CONTAINER, $V380_OBJ_CAPACITY_MULT,
     $V380_OBJ_DEFAULT_SIZE, $V380_TASK_MOVEMENTS) = (2,1,10,2,6);


our (@lines, $ln);

###foreach (keys %Taf400) { $Taf400{$_} = [ split / /, $Taf400{$_} ]; }
#foreach (keys %Taf400) { $Taf400{$_} = eval parse_func($_); }
#print "(", join (", ", %Taf400), ")\n";

#print "Generating parsers\n";

sub compile_parser {
    my %hash = @_;
    %compiled_funcs = ();
    my $evalnum = 0;
    foreach my $k (keys %hash) {
	#print "  Making parser for $k: $evalnum\n"; $evalnum ++;
	#print "\$sep == $sep\n";
	my $x = parse_func($k, split / /, $hash{$k});
	#if ($k eq 'TASK_ACTION') { print $x, "\n"; die; }
	#print "parse_func($k, $hash{$k}) == \n$x\n\n";
	#$x =~ s/^pull();/\$ln++/g;
	#$x =~ s/^pull()/\$line[\$ln++]/g;
	#$x =~ s/^pullint()/checkint(\$line[\$ln++])/g;
	#$x =~ s/^pullbool()/checkbool(\$line[\$ln++])/g;
	
	eval "\$compiled_funcs{$k} = $x;";
	if (!defined ($compiled_funcs{$k})) {
	    print "Error compiling $k:$@\n$x\n";
	    die "Error compiling $k:$@\n$x\nError compiling $k:$@\n";
	}
    }
}

sub hexstr {
    join "", map { chr (hex $_) } @_;
}

#sub deob1 {
#    my $data = shift;
#    my ($rv, $st

sub deobfuscate {
    use integer;

    my $data = shift;
    my ($rv, $n, $s, $r) = ("", 0, 0xa09e86, 0);
    for ($n = 0; $n < length($data); $n ++) {
	$s = ($s * 0x43fd43fd + 0xc39ec3) & 0xFFFFFF;
	$r = ($s * 255) / 0x1000000;
	if ($r < 0) { $r += 255; }
	$rv .= chr ((ord substr ($data, $n, 1)) ^ $r);
    }
    #print "Returning '$rv'\n";
    return $rv;
}

sub parsefile {
    open FH, shift;
    my $buffer;
    local $/ = undef;
    $buffer = <FH>;
    close FH;

    #print "\$V390_SIG == $V390_SIG\n";
    my $file_hdr = deobfuscate (substr ($buffer, 0, 14));
    print "header is $file_hdr\n";

    $ln = 0;

    if ($file_hdr eq "Version 4.00\r\n") {
	print "Processing as version 4.00\n";
	$sep = chr(0xbd).chr(0xd0);
        $buffer = substr ($buffer, 22, length($buffer) - 22);
	#print uncompress ($buffer);
	#print "Decompressing ...\n";
	@lines = split /\r\n/, uncompress($buffer);
	compile_parser (%Taf400);
	#print "Done decompressing\n";
    } elsif ($file_hdr eq "Version 3.90\r\n") {
	print "Processing as version 3.90\n";
	$sep = chr(0x2a).chr(0x2a);
	@lines = split /\r\n/, deobfuscate ($buffer);
	compile_parser (%Taf390);
	$ln = 1;
    } elsif ($file_hdr eq "Version 3.80\r\n") {
	print "Processing as version 3.80\n";
	compile_parser (%Taf380);
	print "Compiled parser\n";
	$sep = chr(0x2a).chr(0x2a);
	@lines = split /\r\n/, deobfuscate ($buffer);
	$ln = 1;
    } else {
	print "Unrecognized file type\n";
	return {};
    }
    return readgame();
}

sub checkint {
    my $n = $_[0];
    if (!defined ($n)) {
	print "*** checkint(undef)\n";
	return 0;
    } elsif ($n =~ /^ *-?[0-9]+ *$/) {
	return $n - 0;
    } else {
	die "Bad Integer '$n' *****\n";
	return 0;
    }
}
sub checkbool {
    my $t1 = shift;
    my $tmp = checkint($t1);
    if ($tmp == 0 || $tmp == 1) {
	return $tmp;
    } else {
	die "Bad Boolean $t1 *****\n";
	return 1;
    }
}

sub evalcond {   ###  TODO:  Could be safer
    my ($root, $ht, $cond) = @_;
    if ($cond =~ /^B(.*)/) {
	#if (!defined ($ht->{$1})) {
	#    print "  Bad condition '$cond'; lbool $1 not defined, only (", join (", ", keys %$ht), ")\n";
	#    return 0;
	#}
	#return $ht->{$1};
	#return "if (!defined ($ht->{$1}) {\n print \"  Bad condition '$cond', lbool $1 not defined, only (\", join (\", \", keys \%$ht), \")\\\n\";\n return 0;\n }\n return $ht->{$1};";
	return $ht."->{$1}";
    } elsif ($cond =~ /^G(.*)/) {
	#if (!defined ($root->{Globals}->{$1})) {
	#    dumptree ($root, 1);
	#    print "  Bad condition '$cond'; gbool $1 not defined, only (", join (", ", keys %{$root}), ")\n";
	#    return 0;
	#}
	#return $root->{$1};
	return $root."->{Globals}->{$1}";
    } elsif ($cond =~ /^\#([^=]*)=(-?\d*)$/) {	
	#if (!defined ($ht->{$1})) {
	#    print "  Bad condition '$cond'; integer $1 not defined, only (", join (", ", keys %$ht), ")\n";
	#    return 0;
	#}
	#return ($ht->{$1} == checkint($2));
	return "$ht"."->{$1} == ".checkint($2);
    } elsif ($cond =~ /^\$(.*)/) {
	#if (!defined ($ht->{$1})) {
	#	 print "  Bad condition '$cond'; string $1 not defined, only (", join (", ", keys %$ht), ")\n";
	#	 return 0;
	#}
	#return ($ht->{$1} ne '');
	return $ht."->{$1} ne ''";
    }
    #print "  Bad condition '$cond' - no match\n";
    die "  Bad condition '$cond' - no match\n";
}
	

sub dumptree {
    my ($root, $depth) = @_;
    if (ref $root eq 'ARRAY') {
	my @ar = @$root;
	print "[";
	for (my $n = 0; $n < @ar; $n ++) {
	    dumptree ($ar[$n], $depth);
	    print ", " if ($n < @ar - 1);
	}
	print "]";
    } elsif (ref $root) {
	my @ar = sort keys %$root;
	my $st = "{";
	if (ref $root ne 'HASH') { $st = (ref $root) . ':' . $st; }
	my $newdepth = $depth + length($st) + 1;
	if (@ar) {
	    print "\n", " "x$depth, $st;
	    print " ", $ar[0], " => ";
	    dumptree ($root->{$ar[0]}, $newdepth);
	    print ",\n" if (@ar > 1);
	} else {
	    print $st;
	}
	for (my $n = 1; $n < @ar; $n ++) {
	    print " "x($newdepth);
	    print $ar[$n], " => ";
	    dumptree ($root->{$ar[$n]}, $newdepth + 2);
	    print ",\n" if ($n < @ar - 1);
	}
	print "}";
    } else {
	print $root;
    }
}

sub pull() {
    #print "   Pull '$lines[$ln]'\n";
    return $lines[$ln ++];
}
#sub pullint() { return "checkint (".pull().")"; }
#sub pullbool() { return "checkbool (".pull().")"; }
sub pullint() { return checkint (pull()); }
sub pullbool() { return checkbool (pull()); }


sub readprop {
    my ($root, $rv, $prop) = @_;

    #print "readprop($root, $rv, $prop)\n"; 
    if ($prop =~ /^\$(.*)/) {
	return $rv."->{$1} = pull();\n";
	#return "print \"Reading string $1 \$lines[\$ln]\\n\";\n$rv"."->{$1} = pull();\n";
    } elsif ($prop =~ /^\#(.*)/) {
	return $rv."->{$1} = pullint();\n";
	#return "print \"Reading int $1 \$lines[\$ln]\\n\";\n$rv"."->{$1} = pullint();\n";
    } elsif ($prop =~ /^B(.*)/) {
	return $rv."->{$1} = pullbool();\n";
	#return "print \"Reading bool $1 \$lines[\$ln]\\n\";\n$rv"."->{$1} = pullbool();\n";
    } elsif ($prop =~ /^M(.*)/) {
	#my $tmp = "";
	#my $x;
	#while (($x = pull()) ne $sep) {
	#    $tmp = $tmp . $x;
	#    if ($lines[$ln + 1] ne $sep) { $tmp .= '<br>'; }
	#}
	###$rv->{$1} = chomp $tmp;
	return "{\nmy \$tmp = \"\";\nmy \$x;\nwhile ((\$x = pull()) ne \$sep) {\n\$tmp .= \$x;\nif (\$lines[\$ln + 1] ne \$sep) {\n\$tmp .= '<br>';\n}\n}\n$rv"."->{$1} = \$tmp;\n}\n";
	#return "{\nprint \"Reading multistring $1 (\$sep)\\n\";\nmy \$tmp = \"\";\nmy \$x;\nwhile ((\$x = pull()) ne \$sep) {\nprint \"Pulled \$x\\n\";\nif (\$x eq \$sep) { print \"Matched!\\n\";}\n\$tmp .= \$x;\nif (\$lines[\$ln + 1] ne \$sep) {\n\$tmp .= '<br>';\n}\n}\nprint \"Final \\\$x == \$x\\n\";\n$rv"."->{$1} = \$tmp;\n}\n";
    } elsif ($prop =~ /^E(.*)$/) {
	return "$rv"."->{$1} = '';\n";
    } elsif ($prop =~ /^[FZ](.*)$/) {
	return "$rv"."->{$1} = 0;\n";
	#return "print \"Reading F/Z  $1\\n\";\n$rv"."->{$1} = 0;\n";
    } elsif ($prop =~ /^T(.*)$/) {
	return "$rv"."->{$1} = 1;\n";
    } elsif ($prop =~ /^[isb]/) {
	#print "Hit ignored prop $prop\n";
	#pull();
	#return "\$ln ++;\n";
	return "pull();\n";
    } elsif ($prop =~ /^\[(\d*)\]<(.*)>(.*)/) {
	#my ($n, $bt, $tagname, @tmp) = (checkint($1), $2, $3);
	#$rv->{$tagname} = \@tmp;
	#while ($n-- > 0) {
	#    push @tmp, readblock ($root, $bt, {});
	#}
	#return "{\nmy (\$n, \@tmp) = (".checkint($1).");\n$rv"."->{$3} = \\\@tmp;\nwhile (\$n-- > 0) {\npush \@tmp, ".readblock($root, $2, '{}').";\n}\n}\n";
	my $n = checkint ($1);
	return $rv."->{$3} = [ ". join (", ", (readblock($root, $2, '{}'))x$n)."];\n";
	#return "print \"Reading fixedarray($n: $3)\\n\";\n$rv"."->{$3} = [ ". join (", ", (readblock($root, $2, '{}'))x$n)."];\n";
    } elsif ($prop =~ /^\[(\d*)\]\$(.*)/) {
	return $rv."->{$2} = [ ". join (", ", 'pull()'). "];\n";
    } elsif ($prop =~ /^([VW])<(.*)>(.*)/) {
	#my ($n, $bt, $tagname, @tmp) = (checkint(pull()), $1, $2);
	#$rv->{$tagname} = \@tmp;
	#while ($n -- > 0) {
	#    push @tmp, readblock ($root, $bt, {});
	#}
	my $mod = ($1 eq 'V') ? '':' + 1';
	return "{\nmy (\$n, \@tmp) = (pullint()$mod);\n$rv"."->{$3} = \\\@tmp;\nwhile (\$n-- > 0) {\npush \@tmp, ".readblock($root, $2, '{}').";\n}\n}\n";
    } elsif ($prop =~ /^([VW])\$(.*)/) {
	#my $n = pullint();
	#my @lst = ();
	#$rv->{$1} = \@lst;
	#while ($n -- > 0) {
	#    push @lst, pull();
	#}
	my $mod = ($1 eq 'V') ? '':' + 1';
	return "{\nmy \$n = pullint()$mod;\nmy \@lst = ();\n$rv"."->{$2} = \\\@lst;\nwhile (\$n -- > 0) {\npush \@lst, pull();\n}\n}\n";
    
    } elsif ($prop =~ /^<(.*)>(.*)/) {
	#my ($bt, $tagname) = ($1, $2);
	#$rv->{$tagname} = {};
	#readblock ($root, $bt, $rv->{$tagname});
	return $rv.'->{'.$2.'} = {};'."\n".readblock($root, $1, $rv.'->{'.$2.'}').";\n";
    } elsif ($prop =~ /^\?(!?)([^:]*):(.*)/) {
	#my ($neg, $cond, @props) = ($1, $2, (split /,/, $3));
	###print "With condition '$prop', (\$neg eq '') -> ", ($neg eq ''), ',', (!defined($neg)), "; evalcond(\$root, \$rv, $cond) -> ", evalcond ($root, $rv, $cond), "\n";
	#my $cr = evalcond($root, $rv, $cond);
	#if (($neg eq '' && $cr) || ($neg eq '!' && !$cr)) {
	#    foreach my $p (@props) {
	#	readprop ($root, $rv, $p);
	#    }
	#}
	my $rstr = "if ($1". evalcond ($root, $rv, $2).") {\n";
	foreach my $p (split /,/, $3) { $rstr .= readprop ($root, $rv, $p); }
	return $rstr."}\n";
    } elsif ($prop =~ /^\{/) {
	return special($root, $rv, $prop);
	#return "SPECIAL($root, $rv, $prop);";
    } elsif ($prop =~ /^\|/) {
	return fixup ($root, $rv, $prop);
    } else {
	#print "Bad property line $prop\n";
	#return "die \"Bad property line '$prop'\\n\";\n";
	#return "die 'Bad property line \"$prop\"'.\"\\n\";";
	die "Bad property line '$prop'\n";
    }
}

sub readprops {
    my ($root, $rv, @props) = @_;
    #foreach my $p (@props) {
    #	readprop ($root, $rv, $p);
    #}
    my $rstr = '';
    foreach my $p (@props) { $rstr .= readprop ($root, $rv, $p); }
    return $rstr;
}

sub readblock {
    my ($root, $blocktype, $rv) = (@_);
    #bless $rv, $blocktype;
    ##$rv->{'0_BLOCKTYPE_'} = $blocktype;
    #readprops ($root, $rv, @{$Taf400{$blocktype}});
    #return $rv;
    #return '&{$Taf400{'.$blocktype.'}}('.$root.', '.$rv.')';
    return '&{$compiled_funcs{'.$blocktype.'}}('.$root.', '.$rv.')';
}

sub parse_func {
    #return readprops ('$root', '$rv', @_);
    my ($bt, @args) = @_;
    #print "$bt: << ", join (", ", @args), ">>\n";
    #return "sub {\nprint \"Parsing $bt\\n\";\nmy (\$head, \$this) = \@_;\nbless \$this, '$bt';\n".readprops('$head', '$this', @args)."return \$this;\n}\n";
    return "sub {\nmy (\$head, \$this) = \@_;\nbless \$this, '$bt';\n".readprops('$head', '$this', @args)."return \$this;\n}\n";
}

sub readgame {
    my $root = {ResourceHolder => {}, ResourceList => [], ResourceData => {}, ResourceCount => 0, ResourceOffset => 0};
    #print "\$sep == '$sep'\n";
    #eval (readblock ($root, "'_GAME_'", $root));
    #print "About to call ", $Taf400{'_GAME_'}, "\n";
    #&{$Taf400{'_GAME_'}}($root, $root);
    print "Parsing file...\n";
    &{$compiled_funcs{'_GAME_'}}($root, $root);
    print "Parsed!\n";
    #print "After read, \$root == ", %$root, "\n";
    return $root;
}

sub handle_rsc {
    my ($root, $fn, $flen, $type) = @_;
    if ($root->{ResourceHolder}->{$fn}) {
	my $i = $root->{ResourceHolder}->{$fn};
	my $ht = $root->{ResourceList}->[$i];
	if ($ht->{Name} ne '$fn') {
	    print "Error: ResourceList & Resource Holder out of sync\n";
	    return;
	}
	if ($flen > 0) {
	    print "Error: duplicate resource with positive length\n";
	    return;
	}
	if ($flen < 0 && -$flen != $i) {
	    print "Error: false length isn't the index\n";
	    return;
	}
    } else {
	$root->{ResourceHolder}->{name} = $root->{ResourceCount} ++;
	push (@{$root->{ResourceList}},
	      { Name => $fn, Len => $flen, Type => $type,
		Offset => ($flen ? ($root->{ResourceOffset}) : 0)});
	if ($flen) { $root->{ResourceOffset} += $flen; }
    }
}

sub special {
    my ($root, $rv, $sp) = @_;

    if ($sp eq '{V400_RESOURCE}') {
	###my $has_sound = $root->{Globals}->{Sound};
	###my $has_graph = $root->{Globals}->{Graphics};
	###handle_v400_rsc ($root, $rv, $has_sound, $has_graph);
	#if ($root->{Globals}->{Sound}) {
	#    handle_rsc ($root, $rv->{SoundFile}, $rv->{SoundLen}, 'Sound');
	#}
	#if ($root->{Globals}->{Graphics}) {
	#    handle_rsc ($root, $rv->{GraphicFile}, $rv->{GraphicLen}, 'Graphic');
	#}
	return "if ($root"."->{Globals}->{Sound}) {\nhandle_rsc ($root, $rv"."->{SoundFile}, $rv"."->{SoundLen}, 'Sound');\n}\nif ($root"."->{Globals}->{Graphics}) {\nhandle_rsc ($root, $rv"."->{GraphicFile}, $rv"."->{GraphicLen}, 'Graphic');\n}\n";
    } elsif ($sp eq '{V400_ROOM_EXIT:#Dest_#Var1_#Var2_#Var3}') {
	#if ($lines[$ln]) {
	#    readprops ($root, $rv, (split / /, '#Dest #Var1 #Var2 #Var3'));
	#} else {
	#    $ln ++;
	#}
	return "if (\$lines[\$ln]) {\n".readprops($root, $rv, (split / /, '#Dest #Var1 #Var2 #Var3'))."} else {\n\$ln ++;\n}\n";
    } elsif ($sp eq '{V390_V380_ROOM_EXIT:#Dest_#Var1_#Var2_ZVar3}') {
	#if ($lines[$ln]) {
	#    readprops ($root, $rv, (split / /, '#Dest #Var1 #Var2 ZVar3'));
	#} else {
	#    $ln ++;
	#}	
	return "if (\$lines[\$ln]) {\n".readprops($root, $rv, (split / /, '#Dest #Var1 #Var2 ZVar3'))."} else {\n\$ln ++;\n}\n";
    } elsif ($sp eq '{ROOM_LIST0}' || $sp eq '{ROOM_LIST1}') {
	### Parse room list w/ optional extra room

	#my $t = $rv->{Type};
	###print "** $sp -> (", join (", ", keys %{$rv}), ")\n";
	#if ($t == 0 || $t == 3 || $t == 4) { # No rooms, All rooms, NPC Part
	#} elsif ($t == 1) { # One Room
	#    readprop ($root, $rv, '#Room');
	#} elsif ($t == 2) { # Some Rooms
	#    my $nrooms = @{$root->{Rooms}};
	#    if ($sp eq '{ROOM_LIST1}') { ++ $nrooms; }
	#    $rv->{Rooms} = [ map { pullbool() } (1..$nrooms) ];
	#} else {
	#    print "Bad Roomlist type $t\n";
	#}
	return "{\nmy \$t = $rv"."->{Type};\nif (\$t == 0 || \$t == 3 || \$t == 4) {\n} elsif (\$t == 1) {\n".readprop($root, $rv, '#Room')."} elsif (\$t == 2) {\nmy \$nrooms = \@{$root"."->{Rooms}};\n".($sp eq '{ROOM_LIST1}'?"++ \$nrooms;\n":"").$rv."->{Rooms} = [ map { pullbool() } (1..\$nrooms) ];\n} else {\nprint \"Bad Roomlist type \$t\\n\";\n}\n}\n";
    } elsif ($sp eq '{OBJECT:#Parent}') {
	#my $t = $rv->{Where}->{Type};
	#if ($t == 4) { # NPC Part
	#    readprop ($root, $rv, '#Parent');
	#}
	return "{\nmy \$t = $rv"."->{Where}->{Type};\nif (\$t == 4) {\n".readprop($root, $rv, '#Parent')."}\n}\n";
    } elsif ($sp eq '{WALK:#Rooms_#Times}') {
	#my $ns = $rv->{NumStops};
	#my (@rooms, @times) = ();
	#for (my $n = 0; $n < $ns; $n ++) {
	#    push @rooms, pullint();
	#    push @times, pullint();
	#}
	#$rv->{Rooms} = \@rooms;
	#$rv->{Times} = \@times;
	return "{\nmy (\$ns, \@rooms, \@times) = ($rv"."->{NumStops});\nfor (my \$n = 0; \$n < \$ns; \$n ++) {\npush \@rooms, pullint();\npush \@times, pullint();\n}\n$rv"."->{Rooms} = \\\@rooms;\n$rv"."->{Times} = \\\@times;\n}\n"; 
    } elsif ($sp eq '{ROOM_GROUP:[]BList}') {
	#my $nr = @{$root->{Rooms}};
	#my @list = ();
	#for (my $n = 0; $n < $nr; $n ++) {
	#    push @list, pullbool();
	#}
	#$rv->{List} = \@list;
	#my @list2 = ();
	#my $on = 0;
	#for (my $n = 0; $n < $nr; $n ++) {
	#    if ($list[$n]) {
	#	push @list2, $on ++;
	#    }
	#}
	#$rv->{List2} = \@list2;
	return "{\nmy (\$nr, \@list, \@list2) = (scalar \@{$root"."->{Rooms}});\nfor (my \$n = 0; \$n < \$nr; \$n ++) {\npush \@list, pullbool();\n}\n$rv"."->{List} = \\\@list;\nfor (my \$n = 0; \$n < \$nr; \$n ++) {\nif (\$list[\$n]) {\npush \@list2, \$n;\n}\n}\n}\n";
	#return "{\nmy (\$nr, \@list, \@list2) = (scalar \@{$root"."->{Rooms}});\nfor (my \$n = 0; \$n < \$nr; \$n ++) {\nprint \"Reading \$n/\$nr\\n\";\npush \@list, pullbool();\n}\n$rv"."->{List} = \\\@list;\nfor (my \$n = 0; \$n < \$nr; \$n ++) {\nif (\$list[\$n]) {\npush \@list2, \$n;\n}\n}\n}\n";
    } else {
	print "Unknown special $sp\n";
    }
}

sub dynamic_object {
    my ($root, $n) = @_;
    my $m;
    my @objs = @{$root->{Objects}};
    for ($m = 0; $m < @objs && $n > 0; $m ++) {
	if (!$objs[$m]->{Static}) {
	    -- $n;
	}
    }
    return $m;
}

sub wearable_object {
    my ($root, $n) = @_;
    my $m;
    my @objs = @{$root->{Objects}};
    for ($m = 0; $m < @objs && $n > 0; $m ++) {
	if (!$objs[$m]->{Static} && $objs[$m]->{Wearable}) {
	    -- $n;
	}
    }
    return $m;
}


sub fixup {
    my ($root, $rv, $fixup) = @_;
    
    if ($fixup eq '|V390_TASK_ACTION:Type>4?#Type++|') {
	# Fixup a version 3.9 task action by incrementing Type > 4
	return "if ($rv"."->{Type} > 4) {\n$rv"."->{Type} ++;\n}\n";

    } elsif ($fixup eq '|V390_TASK_ACTION:$Expr_#Var5|') {
	# Handle either Expr or Var5 for version 3.9 task actions.
	return "if ($rv"."->{Var2} == 5) {\n".readprops($root,$rv,'$Expr','ZVar5')."\n} else {\n".readprops($root,$rv,'EExpr','#Var5')."\n}\n";

    } elsif ($fixup eq '|V390_OBJECT:_Openable_,Key|') {
	# Exchange openable values 5 and 6, and write -1 key for openable
        # objects.
	# Retrieve Openable, and if 5 or 6, exchange.
	return "{\nmy \$t = $rv"."->{Openable};\nif (\$t == 5 || \$t == 6) {\n$rv"."->{Openable} = (\$t == 5) ? 6 : 5;\n$rv"."->{Key} = -1;\n}\n}";

    } elsif ($fixup eq '|V390_TASK:$RestrMask|') {
	# Create a RestrMask that 'and's all the restrictions together
	return "{\nmy \$t = \@{$rv"."->{Restrictions}};\n$rv"."->{RestrMask} = (\$t == 0) ? '' : '#A'x(\$t-1).'#';\n}\n";
    } elsif ($fixup eq '|V390_TASK_RESTR:Var1>0?#Var1++|') {
	return "if ($rv"."->{Var1} > 0) {\n$rv"."->{Var1} ++;\n}\n";
    } elsif ($fixup eq '|V390_ROOM:_Alts_|') {
	return "parse_fixup_v390_v380_alts($root, $rv);\n";
    } elsif ($fixup eq '|V380_OBJECT:#Capacity*10+2|') {
	return "if ($rv"."->{SurfaceContainer} == $V380_OBJ_IS_CONTAINER) {\n$rv"."->{Capacity} = $rv"."->{Capacity} * $V380_OBJ_CAPACITY_MULT + $V380_OBJ_DEFAULT_SIZE;\n}\n";
    } elsif ($fixup eq '|V380_OBJECT:_Openable_,Key|') {
	return "{\nmy \$op = $rv"."->{Openable};\nif (\$op == 5) {\n\$op = 6;\n} elsif (\$op == 6) {\n\$op = 5;\n} elsif (\$op == 1) {\n\$op = 0;\n}\n$rv"."->{Openable} = \$op;\nif (\$op == 5 || \$op == 6) {\n$rv"."->{Key} = -1;\n}\n}\n";
    } elsif ($fixup eq '|V380_TASK:_Actions_|') {
	#if ($rv->{Score} != 0)        { pfva (4, 1, $rv->{Score}, 0 , 0); }
	#if ($rv->{KillsPlayer} != 0)  { pfva (6, 1, 2, 0, 0); }
	#if ($rv->{WinGame} != 0)      { pfva (6, 1, 0, 0, 0); }
	#foreach (@{$rv->{Movements}}) {
	#    pfvm($rv->{Var1}, $rv->{Var2}, $rv->{Var3});
	#}
	#$rv->{Actions} = 
	#    [$rv->{Score}       != 0 ? ({Type => 4, Var1 => $rv->{Score}}):(),
	#     $rv->{KillsPlayer} != 0 ? ({Type => 6, Var1 => 2}           ):(),
	#     $rv->{WinGame}     != 0 ? ({Type => 6, Var1 => 0}           ):(),
	#     map { parse_fixup_v380_movement($_->{Var1}, $_->{Var2}, $_->{Var3}) } @{$rv->{Movements}}
	#     ];
	#return "$rv"."->{Actions} =\n[$rv"."->{Score} != 0 ? ({Type => 4, Var1 => $rv"."->{Score}}):(),\n$rv"."->{KillsPlayer} != 0 ? ({Type => 6, Var1 => 2}):(),\n$rv"."->{WinGame} != 0 ? ({Type => 6, Var1 => 0}):(),\nmap { parse_fixup_v380_movement(\$_->{Var1}, \$_->{Var2}, \$_->{Var3})} @{$rv"."->{Movements}}\n];";
	#
	#$rv->{Actions} = 
	#    [$rv->{Score}       != 0 ? (make_act (4, 1, $rv->{Score})):(),
	#     $rv->{KillsPlayer} != 0 ? (make_act (6, 1, 2)):(),
	#     $rv->{WinGame}     != 0 ? (make_act (6, 1, 0)):(),
	#     map { parse_fixup_v380_movement($_->{Var1}, $_->{Var2}, $_->{Var3}) } @{$rv->{Movements}}
	#     ];
	return "$rv"."->{Actions} =\n[($rv"."->{Score} != 0) ? (make_act(4, 1, $rv"."->{Score})):(),\n($rv"."->{KillsPlayer} != 0) ? (make_act(6,1,2)):(),\n($rv"."->{WinGame} != 0) ? (make_act(6,1,0)):(),\nmap { parse_fixup_v380_movement(\$_->{Var1}, \$_->{Var2}, \$_->{Var3})} \@{$rv"."->{Movements}}\n];\n";
    } elsif ($fixup eq '|V380_TASK:_Restrictions_|') {
	#pfvor ($rv->{HoldingSameRoom}, $rv->{HoldObj1}, $rv->{HoldMsg});
	#pfvor ($rv->{HoldingSameRoom}, $rv->{HoldObj2}, $rv->{HoldMsg});
	#pfvor ($rv->{HoldingSameRoom}, $rv->{HoldObj3}, $rv->{HoldMsg});
	#pfvtr ($rv->{TaskNotDone}, $rv->{Task}, $rv->{TaskMsg});
	#pfvwr ($rv->{WearObj1}, $rv->{WearMsg});
	#pfvwr ($rv->{WearObj2}, $rv->{WearMsg});
	#pfvnr ($rv->{NotInSameRoom}, $rv->{NPC}, $rv->{CompanyMsg});
	#pfvorr ($rv->{Obj1}, $rv->{Obj1Room}, $rv->{Obj1Msg});
	#if ($rv->{Obj2} > 0) {
	#    pfvosr ($rv->{Obj2}, $rv->{Obj2Var1}, $rv->{Obj2Var2}, $rv->{Obj2Msg} );
	#}
	#$rv->{RestrMask} = (@{$rv->{Restrs}} > 0) ? '#'.'A#'x(@{$rv->{Restrs}}-1) : '';
	return "parse_fixup_v380_restrs($root, $rv);\n";
    } elsif ($fixup eq '|V380_OBJECT:_InitialPositions_|') {
	return "parse_fixup_v380_initial_positions($root, $rv);\n";
    } elsif ($fixup eq '|V380_MaxSize_MaxWt_|') {
	return "$rv"."->{MaxSize} = $rv"."->{MaxWt} = $rv"."->{MaxCarried} * $V380_OBJ_CAPACITY_MULT + $V380_OBJ_DEFAULT_SIZE;\n";
    } elsif ($fixup eq '|V380_GLOBAL:_MaxScore_|') {
	#{
	#    my $maxscore = 0;
	#    for my $t (@{$rv->{Tasks}}) {
	#	if ($t->{Score} > 0) {
	#	    $maxscore += $t->{Score};
	#	}
	#    }
	#    $root->{Globals}->{MaxScore} = $maxscore;
	#}
	return "{\nmy \$maxscore = 0;\nfor my \$t (\@{$rv"."->{Tasks}}) {\nif (\$t->{Score} > 0) {\n\$maxscore += \$t->{Score};\n}\n}\n$root"."->{Globals}->{MaxScore} = \$maxscore;\n}\n";
    } elsif ($fixup eq '|V380_WALK:_MeetObject_|') {
	#{
	#    my $object_count = @{$root->{Objects}};
	#    my $meetobj = $rv->{MeetObject};
	#    for (my $obj = 0; $obj < $object_count && $meetobj > 0; $obj ++) {
	#	if (!$root->{Objects}->[$obj]->{Static}) { 
	#	    -- $meetobj;
	#	}
	#    }
	#    $rv->{MeetObject} = $obj - 1;
	#}
	#return "{\nmy \$obj;\nmy \$object_count = \@{$root"."->{Objects}};\nmy \$meetobj = $rv"."->{MeetObject};\nfor (\$obj = 0; \$obj < \$object_count && \$meetobj > 0; \$obj ++) {\nif (!$root"."->{Objects}->[\$obj]->{Static}) {\n-- \$meetobj;\n}\n}\n$rv"."->{MeetObject} = \$obj - 1;\n}\n";
	return "$rv"."->{MeetObject} = dynamic_object($root, $rv"."->{MeetObject});\n";
    } elsif ($fixup eq '|V380_ROOM:_Alts_|') {
	return "parse_fixup_v390_v380_alts($root, $rv);\n";
	#} elsif ($fixup eq '|V380_POST|') {
    	# Handle stuff that can't be done when the data is loaded for 
    	# various reasons.
    	# For example, the wearable alts are done here because rooms are 
    	# defined in the file before the objects, so the file can't tell
    	# how to count to the wearable. 
        #
    	#foreach my $o (@{$root->{Rooms}}) {
    	#    foreach my $a (@{$o->{Alts}}) {
    	#	my $v2 = $a->{Var2};
    	#	if ($v2 == 2 || $v2 == 3) {
    	#	    $a->{Var2} = ($v2 == 2) ? 3 : 2;
    	#	    $a->{Var3} = wearable_object ($a->{Var3});
    	#	}
    	#    }
    	#}
	#return "
    }
    #print "Bad Fixup handler '$fixup'\n";
    #return "die 'Bad Fixup handler \"$fixup\"'.\"\\n\";";
    die "Bad Fixup handler '$fixup'\n";
}

sub parse_fixup_v380_initial_positions {
    my ($root, $rv) = @_;
    my @objs = @{$root->{Objects}};
    my $objs = @objs;
    my @object_type = map { $_->{SurfaceContainer} } @objs;
    #print "pfv380ip: objs == ({", join ("}, {", map { join (", ", keys %$_) } @objs), "})\n";
    #print "pfv380ip: o_t == (", join (", ", @object_type), ")\n";

    # Adjust each object's initial position if necessary.
    foreach my $object (@objs) {

	#Ignore static objects; we only want dynamic ones.
	if ($object->{Static}) {
	    next;
	}

	# If initial position is above on/in, increment.
	my $init = $object->{InitialPosition};

	if ($init > 2) {
	    ++ $object->{InitialPosition};
	}

	# If initial position is on or in, decide which, depending on
	# the type of the parent.  From this, expand initial position
	# into a version 4.0 value.
	if ($init == 2) {
	    my ($parent, $count) = ($object->{Parent}, 0);

	    # convert to container / surface index
	    for ( ; $parent < $objs && $count >= 0; $parent ++) {
		#print "\$object_type[$parent] == $object_type[$parent]\n";
		if ($object_type[$parent] == $V380_OBJ_IS_CONTAINER || 
		    $object_type[$parent] == $V380_OBJ_IS_SURFACE) {
		    $count --; 
		}
	    }
	    $parent --;

	    # If parent is surface, adjest position
	    if ($object_type[$parent] == $V380_OBJ_IS_SURFACE) {
		$object->{InitialPosition} = $init + 1;
	    }

	    # For both, adjust parent to be an object index for that type 
	    # of object only.
	    $count = 0;
	    my $index;
	    for ($index = 0; $index < $parent; $index ++) {
		if ($object_type[$index] == $object_type[$parent]) {
		    $count ++;
		}
	    }
	    $object->{Parent} = $count;
	}
    }
}
		    

sub parse_fixup_v380_restrs {
    my ($root, $rv) = @_;

    $rv->{Restrictions} =
	[$rv->{HoldObj1} ? (make_rest(0, 3, $rv->{HoldObj1} + 1, 
				      $rv->{HoldingSameRoom} ? 1 : 3, 0, 
				      $rv->{HoldMsg})) : (),
	 $rv->{HoldObj2} ? (make_rest(0, 3, $rv->{HoldObj2} + 1, 
				      $rv->{HoldingSameRoom} ? 1 : 3, 0, 
				      $rv->{HoldMsg})) : (),
	 $rv->{HoldObj3} ? (make_rest(0, 3, $rv->{HoldObj3} + 1, 
				      $rv->{HoldingSameRoom} ? 1 : 3, 0, 
				      $rv->{HoldMsg})) : (),
	 $rv->{Task} ? (make_rest(2, 2, $rv->{Task}, 
				  $rv->{TaskNotDone} ? 1 : 0, 0, 
				  $rv->{TaskMsg})) : (),
	 parse_fixup_v380_wear_restr ($root, $rv->{WearObj1}, $rv->{WearMsg}),
	 parse_fixup_v380_wear_restr ($root, $rv->{WearObj2}, $rv->{WearMsg}),
	 $rv->{NPC} == 1 ? (make_rest(3, 3, 0, $rv->{NotInSameRoom} ? 3 : 2, 
				      0, $rv->{CompanyMsg})) : (),
	 $rv->{NPC} > 1 ? (make_rest(3, 3, 0, $rv->{NotInSameRoom} ? 1 : 0, 
				     $rv->{NPC}, $rv->{CompanyMsg})) : (),
	 $rv->{Obj1} ? (make_rest(0, 3, $rv->{Obj1} + 1, 0, $rv->{Obj1Room}, 
				  $rv->{Obj1Msg})) : (),
	 $rv->{Obj2} > 0 ? (parse_fixup_v380_objstate_restr($root, $rv->{Obj2}, $rv->{Obj2Var1}, $rv->{Obj2Var2}, $rv->{Obj2Msg})) : ()
	 ];
    my $n = @{$rv->{Restrictions}};
    $rv->{RestrMask} = ($n > 0) ? '#'.'A#'x($n - 1) : '';
}

sub make_rest {
    my ($type, $num_args, $v1, $v2, $v3, $fail) = @_;
    return { Type => $type, 
	     Var1 => $v1, 
	     ($num_args > 1 ? (Var2 => $v2) : ()),
	     ($num_args > 2 ? (Var3 => $v3) : ()),
	     FailMessage => ($fail eq 'x' ? '': ($fail eq '' ? ' ': $fail)),
	 };
}

sub make_act {
    my ($type, $num_args, $v1, $v2, $v3) = @_;
    return { Type => $type,
	     Var1 => $v1,
	     ($num_args > 1 ? (Var2 => $v2) : ()),
	     ($num_args > 2 ? (Var3 => $v3) : ()),
	 };
}    

sub parse_fixup_v380_wear_restr {
    my ($root, $wearobj, $failmsg) = @_;
    return () if ($wearobj == 0);

    if ($wearobj == 1) {
	return (make_rest (0, 3, 1, 2, 0, $failmsg));
    } elsif ($wearobj == 2) {
	return (make_rest (0, 3, 0, 2, 0, $failmsg));
    }
    # Convert wearobj from worn index to dynamic index.
    $wearobj -= 2;
    my ($objs, $dynamic, $object) = (scalar @{$root->{Objects}}, 0, 0);
    for (; $object < $objs && $wearobj >= 0; $object ++) {
	if (!$root->{Objects}->[$object]->{Static}) {
	    $dynamic ++;
	    if ($root->{Objects}->[$object]->{Wearable}) {
		$wearobj --;
	    }
	}
    }
    return (make_rest (0, 3, $dynamic + 1, 2, 0, $failmsg));
}

sub parse_fixup_v380_objstate_restr {
    my ($root, $obj, $var1, $var2, $failmsg) = @_;

    if ($var1 == 0) { return (); }

    # First, open/closed restrictions
    if ($var1 == 3 || $var1 == 4) {
	my ($stateful, $object) = (0, 0);
	for (; $object <= $obj - 1; $object ++) {
	    if ($root->{Objects}->[$object]->{Openable} > 0) {
		++ $stateful;
	    }
	}
	# Create a v 4.0 restriction that checks an object's state
	# is open (var2 == 0) or closed (var2 == 1)
	return make_rest (1, 2, $stateful + 1, ($var1 == 3) ? 0 : 1, 0, $failmsg);
    }

    # convert obj from object to dynamic index
    my ($object_count, $dyn, $object) = (scalar @{$root->{Objects}}, 0, 0);
    for (; $object <= $obj - 1; $object ++) {
	if ($root->{Objects}->[$object]->{Static}) {
	    $dyn ++;
	}
    }
    
    # Create v 4.0 object location restrictions for the rest

    if ($var1 == 1) {
	return make_rest (0, 3, $dyn + 2, 4, $var2, $failmsg);
    } elsif ($var1 == 2) {
	return make_rest (0, 3, $dyn + 2, 5, $var2, $failmsg);
    } elsif ($var1 == 5) {
	return make_rest (0, 3, $dyn + 2, 1, $var2 + 1, $failmsg);
    } elsif ($var1 == 6) {
	return make_rest (0, 3, $dyn + 2, 2, $var2 + 1, $failmsg);
    }
    die "parse_fixup_v380_objstate_restr: invalid var1: $var1\n";
}

sub parse_fixup_v380_movement {
    my ($var1, $var2, $var3) = @_;
    if ($var1 == 0) {
	return ();
    } elsif ($var1 == 1) {
	return make_act (1, 3, 0, 0, $var2 - 2);
    } else {
	if    ($var1 == 2) {                    } # Ref obj
	elsif ($var1 == 3) { $var1 = 0;         } # All Held
	else               { $var1 = $var1 - 1; } # Dynamic Obj

	if ($var3 == 0) { # To Room
	    if ($var2 == 0) { # To hidden
		return make_act (0, 3, $var1, 0, 0);
	    } elsif ($var2 == 1) { # To player room
		return make_act (0, 3, $var1, 6, 0);
	    } else { # To particular room
		return make_act (0, 3, $var1, 0, $var2 - 1);
	    }
	} elsif ($var3 == 1 || $var3 == 2) { # To inside or to onto, resp
	    # Convert movement var2 and var3 into action var3 and var2,
	    # a simple conversion, but check that var2 is not 'not selected'
	    # first.
	    if ($var2 > 0) {
		return make_act (0, 3, $var1, $var3 + 1, $var2 - 1);
	    }
	} elsif ($var3 == 3 || $var3 == 4) { # Held by / Worn by, resp
	    # Convert movement var2 and var3 into action var3 and var2
	    # in this case a simple conversion, since v40 task actions
	    # are close here.
	    return make_act (0, 3, $var1, $var3 + 1, $var2==0 ? 0 : $var2 + 1);
	}
	die "Bad parse_fixup_v380_movement: invalid var3 == $var3\n";
    }
}
	    
# Helper for parse_fixup_v390_v380_room_alts().  Handles creation of
# version 4.0 room alts for version 3.9 and version 3.8 games.
#
sub parse_fixup_v390_v380_alts {
    #return;
    my ($root, $rv) = @_;
    #print "parse_fixup($root, $rv)\n";

    # $Short $Long $LastDesc ?GEightPointCompass:[12]<ROOM_EXIT>Exits'.
    # ?!GEightPointCompass:[8]<ROOM_EXIT>Exits $AddDesc1 #Task1 $AddDesc2
    # #Task2 #Obj $AltDesc #TypeHideObjects <RESOURCE>Res <RESOURCE>LastRes 
    # <RESOURCE>Task1Res <RESOURCE>Task2Res <RESOURCE>AltRes 
    # ?!GNoMap:BHideOnMap |V390_ROOM:_Alts_|',

    my @alts = ();

    # M1, type, Res1,   M2, Var2, Res2,   
    # hide_objects, changed,    var3, display_room

    if ($rv->{Obj} > 0) {
	my $typehideobjects = $rv->{TypeHideObjects};
	my $var2 = int($typehideobjects / 10);
	my $hide_objects = $typehideobjects % 10;

	push @alts, {M1 => $rv->{AltDesc}, Type => 2, Res1 => $rv->{AltRes},
		     M2 => "", Res2 => {}, Var2 => $var2, Var3 => $rv->{Obj},
		     HideObjects => $hide_objects, Changed=>"", 
		     #Var2 => ($var2 == 2 ? 3 : ($var2 == 3 ? 2 : $var2)),
		     #Var3 => ($var2 == 2 || $var2 == 3) ? wearable_object($root, $rv->{Obj}) : $rv->{Obj}, 
		     DisplayRoom => 0};
    }
    if ($rv->{Task2} > 0) {
	push @alts, {M1 => $rv->{AddDesc2}, Type => 0, Res1 => $rv->{Task2Res},
		     M2 => "", Var2 => $rv->{Task2}, Res2 => {},
		     HideObjects => 0, Changed => "",
		     Var3 => 0, DisplayRoom => 1};
    }
    if ($rv->{Task1} > 0) {
	push @alts, {M1 => $rv->{AddDesc1}, Type => 0, Res1 => $rv->{Task1Res},
		     M2 => "", Var2 => $rv->{Task1}, Res2 => {},
		     HideObjects => 0, Changed => "",
		     Var3 => 0, DisplayRoom => 1};
    }
    if ($rv->{LastDesc} ne '') {
	push @alts, {M1 => $rv->{LastDesc}, Type => 0, Res1 => $rv->{LastRes},
		     M2 => "", Var2 => 0,  Res2 => {},
		     HideObjects => 0, Changed => "",
		     Var3 => 0, DisplayRoom => 2};
    }
    $rv->{Alts} = \@alts;
 
    for my $k (qw/AddDesc1 Task1 AddDesc2 Task2 Obj AltDesc LastDesc
	       TypeHideObjects LastRes Task1Res Task2Res AltRes/) {
	delete $rv->{$k};
    }
}

1;
