#!/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";

You are viewing proxied material from gopher.661.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.