# acrostic maker 2/28/92
# manny@tcomeng.COM or manny@wet.UUCP
#
# Sample usage:
#
#    perl acrostic.pl -w70 <sample.pzl >sample.lst
#
#=====================================================
# INPUT: SAMPLE.PZL
# quote without reagan there would have been
# quote no gorbachev
# word enough : sufficient
# word throw : cast
# word broad : wide
# word watch : timepiece
# word elevate : what otis machines do
# word avenue : street
# word neighbor : person next door
#=====================================================
# OUTPUT: SAMPLE.LST
# 
# 
# A.  SUFFICIENT                     ___ ___ ___ ___ ___ ___           
#                                     9  13   5   6  11   4            
#                                                                      
# B.  CAST                           ___ ___ ___ ___ ___               
#                                     3  15   8  20   1                
#                                                                      
# C.  WIDE                           ___ ___ ___ ___ ___               
#                                    28  17  33  10  23                
#                                                                      
# D.  TIMEPIECE                      ___ ___ ___ ___ ___               
#                                    19  12   7  39  24                
#                                                                      
# E.  WHAT OTIS MACHINES DO          ___ ___ ___ ___ ___ ___ ___       
#                                    16  22  18  26  25  14  27        
#                                                                      
# F.  STREET                         ___ ___ ___ ___ ___ ___           
#                                    38  42  29  31  21  30            
#                                                                      
# G.  PERSON NEXT DOOR               ___ ___ ___ ___ ___ ___ ___ ___   
#                                    32  41   2  34  40  37  35  36    
#                                                                      
# 
# +----+----+----+----+----+----+----+----+----+----+----+----+----+
# |B1  |G2  |B3  |A4  |A5  |A6  |D7  |@@@@|B8  |A9  |C10 |A11 |D12 |
# |    |    |    |    |    |    |    |@@@@|    |    |    |    |    |
# |    |    |    |    |    |    |    |@@@@|    |    |    |    |    |
# +----+----+----+----+----+----+----+----+----+----+----+----+----+
# |A13 |@@@@|E14 |B15 |E16 |C17 |E18 |@@@@|D19 |B20 |F21 |E22 |C23 |
# |    |@@@@|    |    |    |    |    |@@@@|    |    |    |    |    |
# |    |@@@@|    |    |    |    |    |@@@@|    |    |    |    |    |
# +----+----+----+----+----+----+----+----+----+----+----+----+----+
# |@@@@|D24 |E25 |E26 |E27 |@@@@|C28 |F29 |F30 |F31 |@@@@|G32 |C33 |
# |@@@@|    |    |    |    |@@@@|    |    |    |    |@@@@|    |    |
# |@@@@|    |    |    |    |@@@@|    |    |    |    |@@@@|    |    |
# +----+----+----+----+----+----+----+----+----+----+----+----+----+
# |@@@@|G34 |G35 |G36 |G37 |F38 |D39 |G40 |G41 |F42 |
# |@@@@|    |    |    |    |    |    |    |    |    |
# |@@@@|    |    |    |    |    |    |    |    |    |
# +----+----+----+----+----+----+----+----+----+----+
while ($_ = $ARGV[0], /^-/) {
  shift;
  if(/^-\?/){
    print "\nSample usage: perl ", $0, " [-q] [-w80] <acrostic.pzl";
    print "\n       (q=quiet, will not print letter pool)";
    print "\n       (w80=use line width 80)\n";
    exit;
  }
  /^-q/ && ($quiet=1);
  /^-w/ && ($lw=(substr($_,2)));
}
if($lw==0){$lw=80;}

$pad=" " x ($lw/2);$hw=int($lw/2)-1;
$alfabet="ABCDEFGHIJKLMNOPQRSTUVWXYZ";
#init letter locations
for($i=0;$i<26;$i++) {
  $loc{substr($alfabet,$i,1)}="";
}
$_=<STDIN>;
die "\nfile has no \'quote\' lines" if !/^quote/;
@q='';
while(/^quote/) {
  ($id,@x)=split;
  push(@q,@x);
  $_=<STDIN>;
}
# save original quotation
$quote=join(' ',@q);
$quote =~ tr/a-z/A-Z/;
$quote =~ s/^[ ]*//;

# squeeze spaces
$wq=join('',@q);
# drop non-alpha
$w=join('',split(/\W/,$wq));
$w =~ tr/a-z/A-Z/; #translate to uppercase
$qlen=length $w;
(!$quiet) && print "\nquotation:\n",$quote;
#print "\n",$w;

for($i=0;$i<length $w;$i++) {
  $c=substr($w, $i, 1);

  # update location strings (ie. letter C found in 7, 11, etc..)
  $loc{$c}=$loc{$c} . " " . ($i+1);
  $lcount{$c}+=1;
}

die "\nfile has no \'word\' lines" if !/^word/;

$wc=0;
$found=1;
while(/^word/ && $found) {
  chop;
  s/^word//;
  ($word,$clue)=split(/:/);
  $word=join('',split(' ',$word));
  $word =~ tr/a-z/A-Z/;
  $clue =~ s/^[ ]*//;
  $clues[$wc]=$clue;
  $words[$wc]=$word;
  $wsoln[$wc]="";
  @wd=split(/ */,$word);

  #build and print pool
  $pool='';
  foreach $b (sort keys %lcount) {
    $pool .= $b x $lcount{$b};
  }
(!$quiet) &&  print "\npool=", $pool;
(!$quiet) &&  print "\nword=", $word;

  foreach $c (@wd) {
#    print "\n", "c=", $c, $lcount{$c};
    if ($lcount{$c}<1)
      {$found=0;}
    else {
      $lcount{$c}-=1;      #decrement (remove from pool);
    }
  }
  $_=<STDIN>;
  $wc+=1;
}

#build and print pool
  $pool='';
  foreach $b (sort keys %lcount) {
    $pool .= $b x $lcount{$b};
  }
(!$quiet) && print "\npool=", $pool;

# pool not empty?
if(!($found)) {
  print "\nWord not found in pool";
  exit;}
if(length ($pool)>0) {
  print "\nmore letters remain in pool";
  exit;}
#print "\n", length $pool;
#foreach $wc (@clues) {
#  print "\n", $wc;
#}

# print "\n", @words;
print "\n";
$wc=0;
foreach $word (@words) {
  @wd=split(//,$word);
  $h1="";$h2="";
  foreach $c (@wd) {
    $s=$loc{$c};
    ($p,@r)=split(' ',$s);
    $s=join(' ',@r);
    # return assoc array
    $loc{$c}=$s;
    $qsol[$p-1]=$wc;
    $wsoln[$wc]=$wsoln[$wc] . " " . ($p);
    $h1=$h1 . "___ ";
    $h2=$h2 . sprintf("%3d ",$p);
  }
#  print "\n", $wc, $word, $wsoln[$wc], $clues[$wc];
  $t=substr($alfabet,$wc,1) . ".  " . $clues[$wc];
  $t =~ tr/a-z/A-Z/;
  $h1 .= $pad;
  $t  .= $pad;
  $h1=substr($h1,0,$hw) . $h2;
  $g="";
  until($g =~ /^[\s]+$/) {
    $g=substr($t,0,$hw) . " " . substr($h1,0,$hw);
    $h1=substr($h1,$hw+1) . $pad;
    $t=substr($t,$hw+1) . $pad;
    print "\n", $g;
  }
  $wc+=1;
}

#for($i=0;$i<$qlen;$i++) {
#  print " ", substr($w,$i,1), "x=", $qsol[$i],
#  substr($alfabet,$qsol[$i],1), $i+1;
#}

$cols=int(($lw-1)/5);
$rows=int(length($quote)/$cols)+1;
print "\n";
$i=0;$j=0;$more=1;
print "\n+","----+" x $cols;
for($row=0;$row<$rows && $more;$row++){
  $h1="";$h2="";$h3="";
  for($col=0;$col<$cols && $more;$col++){
    $c=substr($quote,$i,1);
    if($c=~/[A-Z]/) {
      $j++;
      $a=substr($alfabet,$qsol[$j-1],1) . ($j);
      $h1.= sprintf("%-4s",$a) . "|";
      $h2.="    |";
    }
    else{
      $h1.= "@@@@|";
      $h2.= "@@@@|";
    }
    $h3.="----+";
    $i++;
    if($i==length($quote)){$more=0;}
  }
  print "\n","|",$h1;
  print "\n","|",$h2;
  print "\n","|",$h2;
  print "\n","+",$h3;
}
print "\n";