use Getopt::Std;

$phxversion = "1.04";

get_arguments();

print STDOUT "Phoenix $phxversion (c) GAN10\n";
print STDOUT $gamename, " (", $gameauthor, ", ", $gamedate, ")\n";

open(GAMEIN, '<', $gamename.'.phx') or die "Can't open file in\n";

open(GAMEOUT, '>', $gamename.'.phxinf') or die "Can't open file out\n";

print GAMEOUT "! This Inform source code was automatically generated by\n";
print GAMEOUT "! Phoenix v$phxversion\n\n";

print GAMEOUT "Constant GAME_NAME = \"", $gamename ,"\";\n";
print GAMEOUT "Constant GAME_AUTHOR = \"", $gameauthor ,"\";\n";
print GAMEOUT "Constant GAME_DATE = \"", $gamedate ,"\";\n";

if ($debugv == 1) { print GAMEOUT "Constant DEBUGV;\n"; }
print GAMEOUT "Constant PHX_VERSION = \"$phxversion\";\n\n";

print GAMEOUT "Include \">phxdefs\";\n\n";

$keywords{RETRY} = "\$1000";
$keywords{DEST} = "\$2000";
$keywords{PASS} = "\$3000";
$keywords{ABORT} = "\$4000";
$keywords{LOOK} = "\$5000";
$keywords{NEXTCOMM} = "\$6000";
$keywords{LEAVE} = "\$7000";
$keywords{NONE} = "\$100";
$keywords{IGNORE} = "\$200";
$keywords{OBJECT} = "\$300";
$keywords{OBEY} = "\$400";
$keywords{PRINT} = "\$500";
$keywords{SAVE} = "\$600";
$keywords{SAVEND} = "\$700";
$keywords{RESTART} = "\$800";
$keywords{FINISH} = "\$900";
$keywords{MOVE} = "\$a00";
$keywords{RETURN} = "\$b00";
$keywords{MAY} = "\$10";
$keywords{REQUEST} = "\$20";
$keywords{MUST} = "\$30";
$keywords{CANT} = "\$40";
$keywords{REC} = "\$2";
$keywords{ANY} = "\$4";
$keywords{DIR} = "\$6";
$keywords{OBJ} = "\$8";
$keywords{SPECIAL} = "\$a;";

sub get_arguments {
    getopts('dg:');
    $debugv = $opt_d;
    $gamename = $opt_g;
    if ($gamename eq "Acheton") {
        $gameauthor = "David Seal, Jonathan Thackray and Jonathan Partington";
        $gamedate = "1978-80";
    } elsif ($gamename eq "Avon") {
        $gameauthor = "Jonathan R. Partington"; $gamedate = "1982";
    } elsif ($gamename eq "Hamil") {
        $gameauthor = "Jonathan R. Partington"; $gamedate = "1982";
    } elsif ($gamename eq "Murdac") {
        $gameauthor = "Jonathan R. Partington"; $gamedate = "1982";
    } elsif ($gamename eq "Fyleet") {
        $gameauthor = "Jonathan R. Partington"; $gamedate = "1985";
    } elsif ($gamename eq "Crobe") {
        $gameauthor = "Jonathan R. Partington"; $gamedate = "1986";
    } elsif ($gamename eq "Sangraal") {
        $gameauthor = "Jonathan R. Partington"; $gamedate = "1987";
    } elsif ($gamename eq "Spycatcher") {
        $gameauthor = "Jonathan R. Partington and Jonathan Thackray"; $gamedate = "1989";
    } elsif ($gamename eq "BrandX") {
        $gameauthor = "Peter Killworth and Jonathan Mestel"; $gamedate = "1983";
    } elsif ($gamename eq "Nidus") {
        $gameauthor = "Adam Atkinson"; $gamedate = "1986";
    } elsif ($gamename eq "Parc") {
        $gameauthor = "John Rennie"; $gamedate = "1983";
    } elsif ($gamename eq "Xeno") {
        $gameauthor = "Jonathan Mestel"; $gamedate = "1989";
    } elsif ($gamename eq "Mystic") {
        $gameauthor = "JRP1"; $gamedate = "?";
    } else {
        die "Game name not recognized\n";
    }
}

sub compile_object {
    $name = $_[0];
    $class = $_[1];
    print GAMEOUT "\n", $class, "  ";
    print GAMEOUT $name, "\n";
    print GAMEOUT "  with message__1 ", $rahash{$name}, ",\n";
    print GAMEOUT "  with message__2 ", $rbhash{$name}, ",\n";
    if ($class eq "Item") {
        print GAMEOUT "  with message__3 ", $rchash{$name}, ",\n";
    }
    if (defined $statehash{$name}) {
        print GAMEOUT "  with state ", $statehash{$name}, ",\n";
    }
    if (defined $exithash{$name}) {
        print GAMEOUT $exithash{$name};
    }
    if (defined $attrhash{$name}) {
        print GAMEOUT "   has ", $attrhash{$name}, ";\n";
    }
    else { print GAMEOUT ";\n"; }
}

# Translate reference $what to a Z-machine value

sub dereference {
    $what = $_[0];

    if ($what eq "()R") { $what = "0"; }

    if ($what =~ m/\(/) {
        ($inbrackets, $operator) = ($what =~ m/\((.*)\)(.)/);

        if ($inbrackets eq "") { $inbrackets = "0"; }

        if ($operator eq "O") {
            if (defined $varnumberhash{$inbrackets}) {
                return $varnumberhash{$inbrackets}."-1024";
            }
            $what = $inbrackets."-2048";
        }
        if ($operator eq "U") {
            $what = $inbrackets."-768";
        }
        if ($operator eq "N") {
            $what = $inbrackets."-512";
        }
        if ($operator eq "D") {
            $what = $inbrackets."-256";
        }
        if ($operator eq "R") {
            if (defined $varnumberhash{$inbrackets}) {
                return $varnumberhash{$inbrackets}."+1024";
            }
            $what = $inbrackets;
        }
        return $what;
    }

    for ($jj=0; $jj<$objcount; $jj++) {
        if ($objectarray[$jj] eq $what) {
            return $what."-2048";
        }
    }
    return $what;
}

sub compile_resolve {
    $what = $_[0];
    $what = dereference($what);
    print GAMEOUT "\@call Resolve $what -> sp; ";
}

sub end_routine {
    $nextr = $_[0];
    $in_routine = 0;
    print GAMEOUT "\n \@call_vn ", $nextr, "; \@rtrue; \n";
    if ($horizon >= $instrnumber) {
        print GAMEOUT "\n .i", $instrnumber, "; ";
        print GAMEOUT "\@call_vn ", $nextr, "; \@rtrue;\n";
    }
    if ($horizon > $instrnumber) {
        $i = $instrnumber + 1;
        while ($i <= $horizon) {
            print GAMEOUT "\n .i", $i, "; ";
            print GAMEOUT "\@call_vn ", $nextr, " ";
            print GAMEOUT $i - $instrnumber;
            print GAMEOUT "; \@rtrue;";
            $i = $i + 1;
        }
    }
    print GAMEOUT "\n;];\n";
    return $horizon-$instrnumber;
}

$varnumber = 0;
$in_routine = 0; $in_words = 0; $in_message = 0; $labelnumber = 1;
$horizon = 0;
$spn = 1;
$roomcount = 0; $objcount = 0;

while ($line = <GAMEIN>) {
  chop $line;
  if ($in_message == 1) {
      if ($line =~ m/^\//) { print "Rejecting as comment: $line\n";
          goto CONTINUELOOP; }
  } else {
      if ($line =~ m/\//) { ($line, $junk) = ($line =~ m/^(.*)\/(.*)$/); }
      $line =~ s/a/A/g;
      $line =~ s/b/B/g;
      $line =~ s/c/C/g;
      $line =~ s/d/D/g;
      $line =~ s/e/E/g;
      $line =~ s/f/F/g;
      $line =~ s/g/G/g;
      $line =~ s/h/H/g;
      $line =~ s/i/I/g;
      $line =~ s/j/J/g;
      $line =~ s/k/K/g;
      $line =~ s/l/L/g;
      $line =~ s/m/M/g;
      $line =~ s/n/N/g;
      $line =~ s/o/O/g;
      $line =~ s/p/P/g;
      $line =~ s/q/Q/g;
      $line =~ s/r/R/g;
      $line =~ s/s/S/g;
      $line =~ s/t/T/g;
      $line =~ s/u/U/g;
      $line =~ s/v/V/g;
      $line =~ s/w/W/g;
      $line =~ s/x/X/g;
      $line =~ s/y/Y/g;
      $line =~ s/z/Z/g;
  }
  UNSWITCHLINE:
  if ($in_message == 0) {
    if ($line =~ m/^\s*$/) { goto CONTINUELOOP; }
    ($line, $throwaway) = ($line =~ m/^(.*\S)(\s*)$/);
  }
  READLINE:

  if ($in_message == 1) {
      if ($line =~ m/^\s*!SWITCH/) {
          print GAMEOUT "  switch (_s) {\n";
          ($sw, $stuff) = ($line =~ m/^\s*(\S*)\s*(.*)$/);
          while ($line = <GAMEIN>) {
              chop $line;
              if ($line =~ m/^\//) {
                  ($line, $junk) = ($line =~ m/^(.*)\/(.*)$/);
              }
              if ($line =~ m/!MESSAGE/) { goto NOTASWITCHLINE; }
              $stuff = $stuff." ".$line;
          }
          NOTASWITCHLINE:
          $i = 0;
          for $chunk (split ' ', $stuff) {
              print GAMEOUT "      $i: return ", $chunk, "(_s);\n";
              $lastchunk = $chunk;
              $i = $i + 1;
          }
          print GAMEOUT "      default: return ", $lastchunk, "(_s);\n";
          print GAMEOUT "  }\n";
          goto UNSWITCHLINE;
      }
      if ($line =~ m/^\s*!END/) {
          print GAMEOUT ";];\n";
          $in_message = 0;
          goto CONTINUELOOP;
      }
      if ($line =~ m/^\s*!MESSAGE/) {
          print GAMEOUT ";];\n";
          goto OUTOFROUTINE;
      }

      $line =~ s/\"/~/g;
      $line =~ s/\@x31/"; PrintTextVar(); print "/g;
      $line =~ s/\@x32/"; PrintFirstWord(); print "/g;
      $line =~ s/\@x33/"; PrintSecondWord(); print "/g;
      $line =~ s/\@x34/", $varzero, "/g;
      $line =~ s/\@x35/", $varone, "/g;
      $line =~ s/\@x36/", $vartwo, "/g;
      $line =~ s/\@x37/", $varthree, "/g;

      if ($line eq '@@font-off@@') {
          print GAMEOUT "  font off;\n";
      } elsif ($line eq '@@font-on@@') {
          print GAMEOUT "  font on;\n";
      } else {
          print GAMEOUT "  print \"", $line, "\^\";\n";
      }

      goto CONTINUELOOP;
  }

  if ($line =~ m/^(.*):/) {
      ($routine_name, $junk) = ($line =~ m/^(.*)(:)/);
      $skipin = 0;
      if ($in_routine == 1) {
          $skipin = end_routine($routine_name);
          if ($skipin < 0) { $skipin = 0; }
      }
      print GAMEOUT "[ ", $routine_name;
      if ($skipin > 0) { 
          print GAMEOUT " skip_p;\n";
          for ($i = 1; $i <= $skipin; $i = $i + 1) {
              $k = $i + 1;
              print GAMEOUT " \@je skip_p $i ?i$k;";
          print GAMEOUT "\n";
          }
      } else { print GAMEOUT ";"; }
      $current_routine = $routine_name;
      $no_instructions = $no_instructions + 1;
      $in_routine = 1; $labelnumber = 1; $instrnumber = 1; $horizon = 0;
      goto CONTINUELOOP;
  }

  if ($in_words == 1) {
      if ($line =~ m/^!/) {
          $in_words = 0;
          print GAMEOUT "  0;\n";
          goto READLINE;
      }
      ($word, $meaning, $stuff) = ($line =~ m/^\s*(\S*)\s*(\S*)\s*(.*)$/);

      $wordshash{$word} = $no_words;
      $lexline = ""; $n = 0;

      if (defined $keywords{$meaning}) { $meaning = $meaning."__RV"; }

      print GAMEOUT $meaning, " ";
      if (($meaning eq "OBEY__RV") or ($meaning eq "PRINT__RV")) {
          ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
          print GAMEOUT $nextword, " ";
      } else {
          print GAMEOUT " 0 ";      
      }

      ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
      if (defined $keywords{$nextword}) { $nextword = $nextword."__RV"; }
      
      $mrmc = "0";
      if ($nextword eq "MAY__RV") { $mrmc = $nextword; }
      if ($nextword eq "REQUEST__RV") { $mrmc = $nextword; }
      if ($nextword eq "MUST__RV") { $mrmc = $nextword; }
      if ($nextword eq "CANT__RV") { $mrmc = $nextword; }
      print GAMEOUT $mrmc, " ";
      if ($mrmc ne "0") {
          ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
          if (defined $keywords{$nextword}) { $nextword = $nextword."__RV"; }
      }      

      $rados = "0";
      if ($nextword eq "REC__RV") { $rados = $nextword; }
      if ($nextword eq "ANY__RV") { $rados = $nextword; }
      if ($nextword eq "DIR__RV") { $rados = $nextword; }
      if ($nextword eq "OBJ__RV") { $rados = $nextword; }
      if ($nextword eq "SPECIAL__RV") { $rados = $nextword; }
      print GAMEOUT $rados, " ";
      if ($rados ne "0") {
          ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
          if (defined $keywords{$nextword}) { $nextword = $nextword."__RV"; }
      }      

      # So: [reference] [dlabel] [slabel] [integer]

      $ref = "0"; $dlabel = "0"; $slabel = "0"; $inte = "";


      if (not((defined $directionhash{$nextword})
          or (defined $specialhash{$nextword})
          or ($nextword =~ m/^[0-9 ]*$/))) {
          $ref = $nextword;
          if ($ref eq "NONE__RV") { $ref = "NONE"; }
          ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
      }

      if (defined $directionhash{$nextword}) {
          $dlabel = $nextword."_to";
          ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
      }

      if (defined $specialhash{$nextword}) {
          $slabel = $nextword;
          ($nextword, $stuff) = ($stuff =~ m/^\s*(\S*)\s*(.*)$/);
      }

      if ($nextword =~ m/^[0-9 ]*$/) {
          $inte = $nextword;
      }

      print GAMEOUT $ref, " ", $dlabel, " ", $slabel, " ! '", $word, "'\n";

      if ($inte ne "") {
          for $abbrevnum (split ' ', $inte) {
              $a = eval($abbrevnum);
              $wordshash{substr($word, 0, $a)} = $no_words;
          }
      }

      if (length($word) > 5) {
          $wordshash{substr($word, 0, 5)} = $no_words;
      }

      $no_words = $no_words + 1;
  }

  if ($in_routine == 1) {
    if ($line =~ m/^!/) {
        end_routine("");
        goto OUTOFROUTINE;
    }

    print GAMEOUT "\n .i", $instrnumber, "; ";

    if ($debugv == 1) {
        print GAMEOUT "if (tr__m) print \"[", $current_routine,
            ".", $instrnumber, ": ", $line, "]^\";";
    }

    $instrnumber = $instrnumber + 1;

    ($instruction, $arguments) = ($line =~ m/^\s*(\S*)\s*(.*)$/);

    if ($instruction =~ m/^SKIP/) {
        $nskip = -1;
        if ($instruction eq "SKIP") { $nskip = 1; }
        if ($instruction eq "SKIP1") { $nskip = 1; }
        if ($instruction eq "SKIP2") { $nskip = 2; }
        if ($instruction eq "SKIP3") { $nskip = 3; }
        if ($instruction eq "SKIP4") { $nskip = 4; }

        if ($nskip == -1) { print "*** Bad skip amount ***\n"; }

        ($parity, $ctype, $condition)
             = ($arguments =~ m/^\s*(\S*)\s*(\S*)\s*(.*)$/);

        $parity_string = "?";
        if ($parity eq "IF") { $parity_string = ""; }
        if ($parity eq "UNLESS") { $parity_string = "~"; }
        if ($parity_string eq "?") {
            print "*** IF or UNLESS expected ***\n";
        }

        if ($ctype eq "R") {
            ($ref1, $rel, $ref2)
                 = ($condition =~ m/^\s*(\S*)\s*(\S*)\s*(.*)$/);
            compile_resolve($ref2);
            compile_resolve($ref1);
            if ($rel eq "EQ") {
                print GAMEOUT "\@je sp sp";
                goto SKIPRDONE;
            }
            if ($rel eq "LT") {
                print GAMEOUT "\@jl sp sp";
                goto SKIPRDONE;
            }
            if ($rel eq "GT") {
                print GAMEOUT "\@jg sp sp";
                goto SKIPRDONE;
            }
            if ($rel eq "ADJ") {
                print GAMEOUT "\@call AdjComparison sp sp -> sp; ";
                print GAMEOUT "\@jz sp";
                goto FLIPPARITY;
            }
            print "*** EQ, LT, GT or ADJ expected ***";

        }

        if ($ctype eq "V") {
            ($vlabel, $rel, $number)
                 = ($condition =~ m/^\s*(\S*)\s*(\S*)\s*(.*)$/);
            if ($rel eq "EQ") {
                print GAMEOUT "\@je $vlabel $number";
                goto SKIPRDONE;
            }
            if ($rel eq "LT") {
                print GAMEOUT "\@jl $vlabel $number";
                goto SKIPRDONE;
            }
            if ($rel eq "GT") {
                print GAMEOUT "\@jg $vlabel $number";
                goto SKIPRDONE;
            }
            print "*** EQ, LT or GT expected ***";

        }

        if ($ctype eq "S") {
            ($olabel, $rel, $number)
                 = ($condition =~ m/^\s*(\S*)\s*(\S*)\s*(.*)$/);
            $olabel = dereference($olabel);
            print GAMEOUT "\@call_vs Resolve $olabel -> sp; ";
            print GAMEOUT "\@get_prop sp state -> sp; ";
            if ($rel eq "EQ") {
                print GAMEOUT "\@je sp $number";
                goto SKIPRDONE;
            }
            if ($rel eq "LT") {
                print GAMEOUT "\@jl sp $number";
                goto SKIPRDONE;
            }
            if ($rel eq "GT") {
                print GAMEOUT "\@jg sp $number";
                goto SKIPRDONE;
            }
            print "*** EQ, LT or GT expected ***";

        }

        if ($ctype eq "P") {
            ($plabel, $ref)
                 = ($condition =~ m/^\s*(\S*)\s*(.*)$/);
            compile_resolve($ref);
            print GAMEOUT "\@call TestProperty sp $plabel -> sp; ";
            print GAMEOUT "\@jz sp";
            goto FLIPPARITY;
        }

        if ($ctype eq "E") {
            compile_resolve($condition);
            print GAMEOUT "\@jz sp";
            goto FLIPPARITY;
        }

        if ($ctype eq "Q") {
            print GAMEOUT "\@call AskQuestion $condition -> sp; ";
            print GAMEOUT "\@jz sp";
            goto FLIPPARITY;
        }

        if ($ctype eq "H") {
            ($ref1, $ref2)
                 = ($condition =~ m/^\s*(\S*)\s*(.*)$/);
            compile_resolve($ref2);
            compile_resolve($ref1);
            print GAMEOUT "\@call IndirectlyContains sp sp -> sp; ";
            print GAMEOUT "\@jz sp";
            goto FLIPPARITY;
        }

        if ($ctype eq "M") {
            print GAMEOUT "\@call MiscTest_$condition -> sp; ";
            print GAMEOUT "\@jz sp";
            goto FLIPPARITY;
        }

        print "*** Can't do SKIP $ctype ***\n";
        goto INSTRDONE;

        FLIPPARITY: ;
        if ($parity_string eq "~") { $parity_string=""; }
        else { $parity_string="~"; }

        SKIPRDONE: ;
        if ($instrnumber + $nskip > $horizon) {
            $horizon = $instrnumber + $nskip;
        }
        print GAMEOUT " ?", $parity_string, "i", $instrnumber + $nskip, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq "MOVE") {
        ($ref1, $wow, $therest)
            = ($arguments =~ m/^\s*(\S*)\s*(\S*)\s*(.*)$/);
        $ref1 = dereference($ref1);
        if ($wow eq "WITH") {
            $withflag = "true";
        } else {
            $withflag = "false";
        }

        if ($therest =~ m/DESTROY/) {
            print GAMEOUT "\@call_vn2 Move__I $ref1 0 $withflag DESTROY__M; ";
            goto INSTRDONE;
        }

        ($first, $second)
            = ($therest =~ m/^\s*(\S*)\s*(.*)$/);

        if ($first eq "TO") {
            $destination = dereference($second);
            print GAMEOUT "\@call_vn2 Move__I $ref1 $destination $withflag TO__M; ";
            goto INSTRDONE;
        }

        if ($first eq "VIAEXIT") {
            print GAMEOUT "\@call_vn2 Move__I $ref1 $second",
                "_to $withflag VIAEXIT__M; ";
            goto INSTRDONE;
        }

        if ($first eq "DIR") {
            print GAMEOUT "\@call_vn2 Move__I $ref1 $second",
                "_to $withflag DIR__M; ";
            goto INSTRDONE;
        }

        if ($first eq "RANDOM") {
            print GAMEOUT "\@call_vn2 Move__I $ref1 $second $withflag RANDOM__M; ";
            goto INSTRDONE;
        }

        if ($first eq "RANDADJ") {
            print GAMEOUT "\@call_vn2 Move__I $ref1 0 $withflag RANDADJ__M; ";
            goto INSTRDONE;
        }

        print "*** Can't do MOVE $arguments ***\n";
        goto INSTRDONE;
    }

    $vsai = "";
    if ($instruction eq "LOAD") { $vsai = "\@add"; }
    if ($instruction eq "ADD") { $vsai = "\@add"; }
    if ($instruction eq "SUB") { $vsai = "\@sub"; }
    if ($instruction eq "MULT") { $vsai = "\@mul"; }
    if ($vsai ne "") {
        ($type1, $lab1, $type2, $lab2)
             = ($arguments =~ m/^\s*(\S*)\s*(\S*)\s*(\S*)\s*(\S*)$/);
        if ($type2 eq "V") { $source = $lab2; }
        if ($type2 eq "I") { $source = $lab2; }
        if ($type2 eq "R") {
            $source = "sp";
            print GAMEOUT "\@call RandomNumber $lab2 -> sp; ";
        }
        if ($type2 eq "S") {
            $source = "sp";
            compile_resolve($lab2);
            print GAMEOUT "\@get_prop sp state -> sp; ";
        }
        if ($type1 eq "V") {
            print GAMEOUT $vsai, " ";
            if ($instruction eq "LOAD") {
                print GAMEOUT "0 ", $source, " -> ", $lab1, "; ";
            } else {
                print GAMEOUT $lab1, " ", $source, " -> ", $lab1, "; ";
            }
        }
        if ($type1 eq "S") {
            if ($instruction eq "LOAD") {
                compile_resolve($lab1);
                print GAMEOUT "\@put_prop sp state ", $source, "; ";
            } else {
                compile_resolve($lab1);
                print GAMEOUT "\@get_prop sp state -> sp; ";
                print GAMEOUT $vsai, " sp ", $source, " -> sp; ";
                compile_resolve($lab1);
                print GAMEOUT "\@put_prop sp state sp; ";
            }
        }
        goto INSTRDONE;
    }

    if ($instruction eq "TEXT") {
        ($mlabel, $wow) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        print GAMEOUT "\@call_vn SetTextVariable$wow ", $mlabel, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq "GO") {
        print GAMEOUT "\@call_vn ", $arguments, "; ";
        print GAMEOUT "\@rtrue; ";
        goto INSTRDONE;
    }

    if ($instruction eq "GOSUB") {
        print GAMEOUT "\@call_vn ", $arguments, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq "PRINT") {
        print GAMEOUT "\@call_vn ", $arguments, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq "PRINTRET") {
        print GAMEOUT "\@call_vn ", $arguments, "; ";
        print GAMEOUT "\@rtrue; ";
        goto INSTRDONE;
    }

    if ($instruction eq "DESCRIBE") {
        ($withwithout, $reference) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        if ($reference eq "") {
            print GAMEOUT "\@call_vn Describe$withwithout 0; ";
        } else {
            compile_resolve($reference);
            print GAMEOUT "\@call_vn Describe$withwithout sp; ";
        }
        goto INSTRDONE;
    }

    if ($instruction eq "DESCRET") {
        ($withwithout, $reference) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        if ($reference eq "")
        {
            print GAMEOUT "\@call_vn Describe$withwithout 0; ";
        } else {
            compile_resolve($reference);
            print GAMEOUT "\@call_vn Describe$withwithout sp; ";
        }
        print GAMEOUT "\@rtrue; ";
        goto INSTRDONE;
    }

    if ($instruction eq "ASK") {
        print GAMEOUT "\@call_vn AskInstruction ", $arguments, " false; ";
        goto INSTRDONE;
    }

    if ($instruction eq "ASKANY") {
        print GAMEOUT "\@call_vn AskInstruction ", $arguments, " true; ";
        goto INSTRDONE;
    }

    if ($instruction eq "RETURN") {
        $tags = "";
        for $tag (split ' ', $arguments) {
            if (defined $keywords{$tag}) { $tag=$tag."__RV"; }
            $tags = $tags.$tag." + ";
        }
        $tags = $tags."0";
        if ($tags eq "LEAVE__RV + 0") {
            print GAMEOUT "\@throw 0 Leave_StackFrame; "; 
        } else {
            if ($tags eq "PASS__RV + 0") {
                print GAMEOUT "\@store Return_State Pass_State; \@rfalse; "; 
            } else {
                print GAMEOUT "\@store Return_State $tags; \@rfalse; ";
            }
        }
        goto INSTRDONE;
    }

    if ($instruction eq "RESOLVE") {
        ($vlabel, $reference) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        compile_resolve($reference);
        print GAMEOUT "\@call ResolveInstr sp -> ", $vlabel, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq "COMP") {
        ($plabel, $reference) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        compile_resolve($reference);
        print GAMEOUT "\@test_attr sp ", $plabel,
            " ?lab", $labelnumber, "; ";
        compile_resolve($reference);
        print GAMEOUT "\@set_attr sp ", $plabel, "; ";
        print GAMEOUT "jump lab", $labelnumber+1, "; ";
        print GAMEOUT ".lab", $labelnumber, "; ";
        compile_resolve($reference);
        print GAMEOUT "\@clear_attr sp ", $plabel, "; ";
        print GAMEOUT ".lab", $labelnumber+1, "; ";
        $labelnumber = $labelnumber + 2;
        goto INSTRDONE;
    }

    if ($instruction eq "SET") {
        ($plabel, $reference) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        compile_resolve($reference);
        print GAMEOUT "\@set_attr sp ", $plabel, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq "UNSET") {
        ($plabel, $reference) = ($arguments =~ m/^\s*(\S*)\s*(\S*)$/);
        compile_resolve($reference);
        print GAMEOUT "\@clear_attr sp ", $plabel, "; ";
        goto INSTRDONE;
    }

    if ($instruction eq '@@TEXTVARNAME@@') {
        print GAMEOUT "\@call_vn TextVarIsName; ";
        goto INSTRDONE;
    }

    if ($instruction =~ m/^\s*\//) { goto INSTRDONE; }
    if ($instruction =~ m/\*\*\*\*\*\*/) { goto INSTRDONE; }

    print "*** Can't do ", $instruction, " ***\n";

    INSTRDONE: ;
  } else {
    OUTOFROUTINE:
    ($one_word) = ($line =~ m/^\s*(\S*)\s*$/);

    if ($one_word eq "!WORDS") {
        print STDOUT "$no_instructions\nWords: ";
        print GAMEOUT "\n\n! Words\n\nArray Lexicon -->\n";
        $in_words = 1;
        $no_words = 0;
        goto CONTINUELOOP;
    }

    if ($one_word eq "!INSTRUCTIONS") {

        print STDOUT "\nObjects: ";

        for ($ct = 0; $ct < $objcount; $ct++) {
            compile_object($objectarray[$ct], "Item");
        }

        print STDOUT "$ct\nRooms: ";

        for ($ct=0; $ct < $roomcount; $ct++) {
            compile_object($roomarray[$ct], "Room");
        }

        print STDOUT "$ct\nInstructions: ";
        $no_instructions = 0;
        goto CONTINUELOOP;
    }

    ($start, $end) = ($line =~ m/^(\S*) +(.*)$/);

    if ($start eq "!MESSAGE") {
        if ($no_messages == 0) {
            print STDOUT "$no_words\nMessages: ";
        }
        $no_messages = $no_messages + 1;
        print GAMEOUT "\n[ $end _s; _s=_s;\n";
        $in_message = 1;
        goto CONTINUELOOP;
    }

    if ($start eq "!VAR") {
        ($name, $number) = ($end =~ m/^(\S*) (.*)$/);
        $varhash{$name} = $number;
    }

    if ($start eq "!PROP") {
        ($name, $rest) = ($end =~ m/^(\S*) (.*)$/);
        $attrhash{$name} = $rest;
    }

    if ($start eq "!VARIABLE") {
        if (defined $varhash{$end}) {
            print GAMEOUT "Global $end = $varhash{$end};\n";
        }
        else { print GAMEOUT "Global $end;\n"; }
        $varnumberhash{$end} = $varnumber;
        $vararray[$varnumber] = $end;
        if ($varnumber == 0) { $varzero = $end; }
        if ($varnumber == 1) { $varone = $end; }
        if ($varnumber == 2) { $vartwo = $end; }
        if ($varnumber == 3) { $varthree = $end; }
        $varnumber = $varnumber + 1;
    }

    if ($start eq "!PROPERTY") {
        ($name, $number) = ($end =~ m/^(\S*) (.*)$/);
        print GAMEOUT "Attribute ", $name,
            " alias attribute_", $number, ";\n";
    }

    if ($start eq "!DIRECTION") {
        print GAMEOUT "Property ", $end, "_to;\n";
        $directionhash{$end} = $end."_to";
    }

    if ($start eq "!SPECIAL") {
        print GAMEOUT "Constant ", $end, " = $spn;\n";
        $spn = $spn + 1;
        $specialhash{$end} = $end;
    }

    if ($start eq "!STATE") {
        ($name, $number) = ($end =~ m/^(\S*) (.*)$/);
        $statehash{$name} = $number;
    }

    if ($start eq "!WELCOME") {
        print GAMEOUT "\n[ Welcome; ", $end, "(); ];\n";
    }
    if ($start eq "!PRECOMMAND") {
        print GAMEOUT "\n[ PreCommand; ", $end, "(); ];\n";
    }
    if ($start eq "!POSTCOMMAND") {
        print GAMEOUT "\n[ PostCommand; ", $end, "(); ];\n";
    }

    if ($start eq "!POSSESSIONS") {
        ($name, $rest) = ($end =~ m/^(\S*) (.*)$/);
        for $poss (split ' ', $rest) {
            $possess[$possesscount++] = [$poss, $name];
        }
    }

    if ($start eq "!OBJECT") {
        ($name, $ra, $rb, $rc) = ($end =~ m/^(\S*) (\S*) (\S*) (\S*)$/);
        $objectarray[$objcount++] = $name;
        $rahash{$name} = $ra;
        $rbhash{$name} = $rb;
        $rchash{$name} = $rc;
    }

    if ($start eq "!ROOM") {
        ($name, $ra, $rb) = ($end =~ m/^(\S*) (\S*) (\S*)$/);
        $roomarray[$roomcount++] = $name;
        $rahash{$name} = $ra;
        $rbhash{$name} = $rb;
    }

    if ($start eq "!EXIT") {
        $exits = "";
        while ($line = <GAMEIN>) {
            chop $line;
            $line =~ s/a/A/g;
            $line =~ s/b/B/g;
            $line =~ s/c/C/g;
            $line =~ s/d/D/g;
            $line =~ s/e/E/g;
            $line =~ s/f/F/g;
            $line =~ s/g/G/g;
            $line =~ s/h/H/g;
            $line =~ s/i/I/g;
            $line =~ s/j/J/g;
            $line =~ s/k/K/g;
            $line =~ s/l/L/g;
            $line =~ s/m/M/g;
            $line =~ s/n/N/g;
            $line =~ s/o/O/g;
            $line =~ s/p/P/g;
            $line =~ s/q/Q/g;
            $line =~ s/r/R/g;
            $line =~ s/s/S/g;
            $line =~ s/t/T/g;
            $line =~ s/u/U/g;
            $line =~ s/v/V/g;
            $line =~ s/w/W/g;
            $line =~ s/x/X/g;
            $line =~ s/y/Y/g;
            $line =~ s/z/Z/g;
            if ($line =~ m/\//) {
                ($line, $junk) = ($line =~ m/^(.*)\/(.*)$/);
            }
            if ($line =~ m/^\s*$/) { goto CONTINUETHIS; }
            if ($line =~ m/^!/) { goto GETOUTOFTHIS; }
            ($junk, $thedir, $junkagain, $rest)
                 = ($line =~ m/^(\s*)(\S*)(\s*)(.*)(\s*)$/);
            $exits = $exits."  with ".$thedir."_to ".$rest.",\n";
            CONTINUETHIS: ;
        }
        GETOUTOFTHIS: $exithash{$end} = $exits;
        goto READLINE;
    }
  }
  CONTINUELOOP: ;
}

close(GAMEIN);

if ($in_message == 1) {
   print GAMEOUT ";];\n";
}

print GAMEOUT "\n\nInclude \">phxlib\";\n";

print GAMEOUT "[ InitialiseTree;\n";

for ($i=$possesscount-1; $i>=0; $i--) {
    print GAMEOUT "  \@insert_obj ", $possess[$i][0],
        " ", $possess[$i][1], ";\n";
}
print GAMEOUT "];\n\n";

print GAMEOUT "Constant least__room = ", $roomarray[0], ";\n";
print GAMEOUT "Constant number__rooms = ", $roomcount, ";\n";

print GAMEOUT "[ Read_Variable vn;\n";
foreach $tv (keys %varnumberhash) {
    print GAMEOUT "  if (vn==", $varnumberhash{$tv}, ") return ", $tv, ";\n";
}
print GAMEOUT "];\n\n";

print GAMEOUT "Array LexiconLookup -->\n";
foreach $tw (keys %wordshash) {
    print GAMEOUT "  '", $tw, "//' ", $wordshash{$tw}, "\n";
}
print GAMEOUT "  0;\n\n";

print GAMEOUT "Array DirectionLookup table\n";
foreach $tw (keys %directionhash) {
    print GAMEOUT $directionhash{$tw}, "\n";
}
print GAMEOUT ";\n\n";

if ($debugv == 1) {
    print GAMEOUT "[ Debug_Variables;\n";
    for ($i=0; $i<$varnumber; $i++) {
        $thev = $vararray[$i];
        print GAMEOUT "  print \"$thev=\", $thev, \" \";\n";
    }
    print GAMEOUT "  print \"^\";\n];\n\n";
#    print GAMEOUT "Array Objnames table\n";
#    for ($i=0; $i<$objcount; $i++) {
#        $theo = $objectarray[$i];
#        print GAMEOUT "  '", $theo, "' ", $i + 7, "\n";
#    }
#    print GAMEOUT ";\n\n";
#    print GAMEOUT "Array Roomnames table\n";
#    for ($i=0; $i<$roomcount; $i++) {
#        $ther = $roomarray[$i];
#        print GAMEOUT "  '", $ther, "' ", $i + $objcount + 7, "\n";
#    }
#    print GAMEOUT ";\n\n";
}

close(GAMEOUT);

print STDOUT "$no_messages\n";
print STDOUT $objcount, " objects, ", $roomcount, " rooms\n";
