infocom/tools/infocom-inv-xlat.perl

#!/usr/local/bin/perl
#
# infocom-inv-xlat.perl
#
# Perl script copyright (C) 1996 by James Hulsey.  All Rights Reserved
#
# This script is freeware.  
#
# This script converts the invisiclues files found at the int-fiction
# archive site into a format similar to the Scott Adams hints format
# so you can decode answers one at a time instead of reading all the
# hints at one. 
#
# To use the script, type (on UNIX)
#
# infocom-inv-xlat.perl <invisiclues file name> > <new file name>
#
# infocom-inv-xlat.perl must have the x bit set and /usr/local/bin/perl
# must exist on your system.
#

@lines = <>;
@savedLines = @lines;

# Pass 1, find the answer words that need to be encoded

$startToc = 0;
$inToc = 0;
$startHier = 0;
$inHier = 0;
$addSpace = 0;
$needSpace = 0;
$numWords = 0;
foreach $_ (@lines) {
  if (/TREASURE             VALUE  WHERE FOUND/) {
    $addSpace = 1; # Add spaces to this line
    $needSpace = 1;
  }
  if (/^For Your Amusement$/) {
    $addSpace = 0;
  }
  if ($addSpace && /^[A-Za-z0-9.]/) {
    s/^/  /;
  }
  if ($needSpace && /Have you tried:/) {
    $addSpace = 1; # Add spaces to next line
    $needSpace = 0;
  }
  if (/^\S/ || /^\s*$/) { # Match non-white space at start of line or
                          # line of all white space
    if (/Table of Contents/ || /TABLE OF CONTENTS/) {
      $startToc = 1;
    }
    elsif ($startToc && /^\s*$/) {
      $startToc = 0;
      $inToc = 1;
    }
    elsif ($inToc && /^\s*$/) {
      $inToc = 0;
    }
    elsif (!$inToc && /Hieroglyphic Dictionary/) {
      $startHier = 1;
    }
    elsif ($startHier && /^\s*$/) {
      $startHier = 0;
      $inHier = 1;
    }
    elsif ($inHier && /How Points Are Scored/) {
      $inHier = 0;
    }
    ; # skip the line
  } 
  else {
    if ($inToc) {
      ; # skip the line
    }
    else {
      chop;
      if ($inHier) { 
        if (!s/[^a-zA-Z0-9]+(\w)/$1/) { # Try to remove punct chars before 
          $_ = ""; # No match, remove the line
        }
      }
      s/^\s+([A-Z0-9]{1,2}\.|-) +//; # Remove new answer character
      @words = split;
      foreach $word (@words) {
        if ($wordList{$word} eq "") {
          $wordList{$word} = ++$numWords;
        }
      }
    }
  }
}

# Create a sorted word list 
$wordNum = 0;
foreach $word (sort keys(%wordList)) {
  $wordList{$word} = ++$wordNum;
  $listWords{$wordNum} = $word;
}
$numLen = length(sprintf("%d", $wordNum));

# Pass 2, print the codes
$chgWrap = 0;
$howPts = 0;
$secPsg = 0;
$cubeDet = 0;
$inAnswer = 0;
$addSpace = 0;
$needSpace = 0;
foreach $_ (@savedLines) {
  if (/TREASURE             VALUE  WHERE FOUND/) {
    $addSpace = 1; # Add spaces to this line
    $needSpace = 1;
  }
  if (/^For Your Amusement$/) {
    $addSpace = 0;
  }
  if ($addSpace && /^[A-Za-z0-9.]/) {
    s/^/  /;
  }
  if ($needSpace && /Have you tried:/) {
    $addSpace = 1; # Add spaces to next line
    $needSpace = 0;
  }
  if (/^\S+/ || /^\s*$/) {
    $haveAnsTag = 0;
    if (/Table of Contents/ || /TABLE OF CONTENTS/) {
      $startToc = 1;
    }
    elsif ($startToc && /^\s*$/) {
      $startToc = 0;
      $inToc = 1;
    }
    elsif ($inToc && /^\s*$/) {
      $inToc = 0;
    }
    elsif (/last resort/ || /That Which Can be Named/ || /seen everything/ ||
           /Things You Can Ask .../ ||
           /What things can I ask Belboz about?/ || /THE EVIDENCE: Part I/ ||
           /FOR YOUR AMUSEMENT/ || /^\(after you've finished the game\)$/ ||
           !$inToc && /How Points Are Scored/) {
      $chgWrap = 1;
    }
    elsif (/Magic Details/ || /FINAL COPY/) {
      $chgWrap = 0;
    }
    elsif (/How the Points Are Scored/) {
      if ($howPts) {
        $chgWrap = 1;
      }
      else {
        $howPts = 1;
      }
    }
    elsif (/Secret Passage Entrances/) {
      if ($secPsg) {
        $chgWrap = 1;
      }
      else {
        $secPsg = 1;
      }
    }
    elsif (/Details of Cubes' Effects on Spells/) {
      if ($cubeDet) {
        $chgWrap = 1;
      }
      else {
        $cubeDet = 1;
      }
    }
    elsif (!$inToc && /Hieroglyphic Dictionary/) {
      $startHier = 1;
    }
    elsif ($startHier && /^\s*$/) {
      $startHier = 0;
      $inHier = 1;
    }
    elsif ($inHier && /How Points Are Scored/) {
      $inHier = 0;
    }
    if ($inAnswer) { print "\n"; $inAnswer = 0; }
    print; # print the line exactly
  } 
  else {
    if ($inToc) {
      print; # print the line exactly
    } 
    else {
      chop;
      if ($inHier) {
        if (!/([^a-zA-Z0-9]+)(\w.*)/) { # Find lines with alphanum in them
          print $_; # No match, print the line
          @words = (); # empty array
        }
        else {
          print $1; # Print the punctuation exactly
          @words = split(/[ \t\n]+/, $2);
          $orgIndLen = length($1);
          $lnPos = $orgIndLen + 1;
        }
      }
      else {
        if (s/^(\s+)([A-Z0-9]{1,2}\. |- )( *)//) { # Remove & save new ans char
          print "\n";
          print $1, $2; # Print answer chars
          $orgIndLen = length($1) + length($2);
          $lnPos = $orgIndLen + 1;
          $haveAnsTag = 1;
        }
        else {
          s/^(\s+)//; 
          if (!$inAnswer) {
            $orgIndLen = length($1);
            $curIndLen = $orgIndLen;
            $lnPos = 81;
            $haveAnsTag = 0;
          }
          else {
            $curIndLen = length($1);
            if (/[0-9]{1,2} /) {
              $curIndLen = $orgIndLen;
            }
            if ($chgWrap && !$haveAnsTag && $curIndLen == $orgIndLen) {
              printf("\n%${orgIndLen}.${orgIndLen}s", ""); 
              $lnPos = $orgIndLen + 1;
            }
          }
        }
        $inAnswer = 1;
        @words = split;
      }
      foreach $word (@words) {
        $codeLen = length($wordList{$word}) + 1;
        $lnPos += $codeLen;
        if ($lnPos > 80) { 
          printf("\n%${orgIndLen}.${orgIndLen}s", ""); 
          $lnPos = $orgIndLen + $codeLen + 1;
        }
        print "$wordList{$word} ";
      }
      if ($inHier) { print "\n"; }
    }
  }
}

# Print list of numbers to decode words

print "\n\n\nWORD LIST\n\n";
print "Replace numeric code with the following text.\n";
print "Note that the punctuation is included.\n";
$lnPos = 81;
$fieldWidth = 16;
sub numerically { $a <=> $b; }
foreach $wordNum (sort numerically keys(%listWords)) {
  $wordOut = sprintf("%${numLen}d %s", $wordNum, $listWords{$wordNum});
  if ($lnPos + length($wordOut) > 80) { print "\n"; $lnPos = 1; }
  $width = (int(length($wordOut) / $fieldWidth) * $fieldWidth) + $fieldWidth;
  printf ("%-${width}.${width}s", $wordOut);
  $lnPos += $width;
}
print "\n\n[Invisiclues translated to codes by Perl script written by James Hulsey]\n";