Program Columnar;  (* Incomplete Columnar, Keyword Search *)
                   (* COMPUTER SUPPLEMENT #6.4,  The Doc  *)

{$G+}                                                           { 80286 Code }
{$M 16384,0,655360}                              { stackSize,heapMin,heapMax }
Uses  DOS,Trigph;
Const bell=#7; cr=#13; lf=#10;
Type  arrInt=Packed Array[0..34] Of Integer;
      arrStr=Array[0..34] Of String;
      str10=Array[1..10] Of String;
Var   i,j,ll,lct,nl,
      numFiles,
      period,s,sl,wls:Integer;
      k,lc           :Array[0..34] Of Integer;
      hiScore        :Array[1..10] Of LongInt;
      cipherFile,
      cipherText,
      crib,
      ct1,ct2,
      dataFile,
      keyWord,
      keyType,
      plainText,
      title,tmp     :String;
      wrdLst        :Array[1..99] Of String[12];
      cmd,md        :arrStr;
      al,slt        :str10;
      f0,f1         :Text;
      h1,m1,s1,t1,
      h2,m2,s2,t2   :Word;

{****************************************************************************}

Procedure  ScoreTrigraphs(Var keyPhrase,plainText:String);
  Var  flag   :Boolean;
       i,j    :Integer;
       k,score:LongInt;
       tmp    :String;

  Function  TestDups(Var plainText:String; Var slt:str10): Boolean;
    Var  flag:Boolean;
         i   :Integer;
    Begin
      flag:=True;
      For i:=10 DownTo 1 Do                                  { Test for Dups }
        If plainText=slt[i] Then flag:=False;
      TestDups:=flag
    End;

  Begin
    score:=0;                                             { Score Trigraphs  }
    For i:=1 To lct-2 Do
      score:=score + tg[(Ord(plainText[i])  -64) * 676 +  { Base 26 Hundreds }
                        (Ord(plainText[i+1])-64) *  26 +  { Base 26 Tens     }
                         Ord(plainText[i+2])-64];         { Base 26 Units    }

    flag:=TestDups(plainText,slt);

    If flag And (hiScore[10]<score) Then             { New Score > Old Score }
      Begin
        al[10]:=keyPhrase;
        hiScore[10]:=score;
        slt[10]:=plainText;
        For i:=1 To 9 Do                                          { Exchange }
          For j:=i+1 To 10 Do
            If hiScore[i]<hiScore[j] Then
              Begin
                tmp:=al[i]; al[i]:=al[j]; al[j]:=tmp;
                k:=hiScore[i]; hiScore[i]:=hiScore[j]; hiScore[j]:=k;
                tmp:=slt[i]; slt[i]:=slt[j]; slt[j]:=tmp
              End
      End
  End;

{****************************************************************************}

                      (* Sort Keyword Alphabetically *)
Procedure  Sort(period:Integer);
  Var  i,j,temp:Integer;
       gulp    :String;
  Begin
    For i:=1 To period-1 Do
      For j:=0 To period-i Do
        If md[j]>md[j+1] Then
          Begin                                                   { Exchange }
            gulp:=md[j]; md[j]:=md[j+1]; md[j+1]:=gulp;
            temp:=k[j]; k[j]:=k[j+1]; k[j+1]:=temp
          End
  End;

{----------------------------------------------------------------------------}

                      (* Fill Columns With Ciphertext *)
Procedure  Fill(period,s:Integer; cipherText:String);
  Var  c,i,j,km,t:Integer;
       ld        :String;
  Begin
    i:=1;
    Repeat
      ld:=md[i];
      j:=period;
      Repeat
        If (md[j]=ld) And (j=i) Then
          Begin
            km:=k[i];
            t:=lc[km];
            cmd[km]:=Copy(cipherText,s,t);
            s:=s + lc[km]
          End;
        Dec(j)
      Until j<i;
      Inc(i)
    Until i>period
  End;

{----------------------------------------------------------------------------}

                          (* Convert to Plaintext *)
Procedure  Convert(lct,period:Integer);
  Var  col,i,p:Integer;
       temp   :String;
  Begin
    plainText:='';
    For i:=1 To lct Do
      Begin
        col:=i Mod period;
        p:=(i Div period) + 1;
        If col=0 Then
          Begin
            col:=period; p:=Pred(p)
          End;
        temp:=cmd[col];
        plainText:=Concat(plainText,temp[p])
      End
  End;

{****************************************************************************}

                              (* Main Program *)
Begin
  If ParamCount<>0 Then cipherFile:=ParamStr(1) Else
    Begin
      Write(cr,lf,' Enter Cipher File Name: '); ReadLn(cipherFile)
    End;

  Assign(f0,cipherFile);                                  { Open Cipher File }
  {$I-} Reset(f0); {$I+}
  If IOResult>0 Then Begin WriteLn(cr,lf,' *** Bad Filename ***'); Halt End;

  GetTime(h1,m1,s1,t1);
  ReadLn(f0,title);
  WriteLn(cr,lf,title);
  ReadLn(f0,keyType);                                             { Not Used }
  WriteLn(keyType);
  ReadLn(f0,crib);
  WriteLn(crib);
  ReadLn(f0,ct1);                                                 { 1st Line }
  WriteLn(ct1);
  ReadLn(f0,ct2);                                                 { 2nd Line }
  WriteLn(ct2);
  ct1:=Concat(ct1,ct2);
  ReadLn(f0,ct2);                                                 { 3rd Line }
  WriteLn(ct2,cr,lf);
  ct1:=Concat(ct1,ct2);
  cipherText:='';
  For i:=1 To Length(ct1) Do                             { Strip Punctuation }
    If ct1[i] In['A'..'Z','a'..'z'] Then
      cipherText:=Concat(cipherText,UpCase(ct1[i]));
  ReadLn(f0,tmp);                                     { Number of Data Files }
  If tmp[1] In['0'..'9'] Then numFiles:=Ord(tmp[1]) - 48 Else Halt;
  If tmp[2] In['0'..'9'] Then numFiles:=(numFiles*10)+Ord(tmp[2])-48;
  For i:=1 To numFiles Do ReadLn(f0,wrdLst[i]);
  Close(f0);                                             { Close Cipher File }
  lct:=Length(cipherText);
  WriteLn(' Length of ciphertext: ',lct,cr,lf);

  For i:=1 To 10 Do                                            { Null Scores }
    Begin
      al[i]:='';                                         { Keyword or Phrase }
      hiScore[i]:=0;                                     { Trigraph Scoring  }
      slt[i]:=''                                         { Plaintext         }
    End;

  wls:=1;
  Repeat
    dataFile:=wrdLst[wls];
    Assign(f0,dataFile);                                    { Open Data File }
    {$I-} Reset(f0); {$I+}
    If IOResult>0 Then
      Begin
        WriteLn(cr,lf,' ***  Bad Filename  ***',
                cr,lf,' ***  ',dataFile,'    ***');
        Halt
      End;
    WriteLn(cr,lf,dataFile:13);

    While Not EOF(f0) Do
      Begin
        ReadLn(f0,keyWord);
      { WriteLn(keyWord); }                           { 25% faster, no print }

        period:=Length(keyWord);
        sl:=lct Div period;                                 { Short Columns  }
        nl:=lct Mod period;                                 { # of Long Cols }
        ll:=sl + 1;                                         { Long Columns   }
        For i:=1 To period Do
          If i<=nl Then lc[i]:=ll Else lc[i]:=sl;

        For i:=1 To period Do                              { Reset Variables }
          Begin
            md[i]:=keyWord[i];
            k[i]:=i
          End;

        s:=1;
        Sort(period);
        Fill(period,s,cipherText);
        Convert(lct,period);

        ScoreTrigraphs(keyWord,plainText)
      End;
    Close(f0);                                             { Close Data File }
    Inc(wls)
  Until wls>numFiles;

  Delete(cipherFile,Pos('.',cipherFile),1);               { Open Output File }
  If Length(cipherFile)>8 Then cipherFile:=Copy(cipherFile,1,8);
  Assign(f1,cipherFile+'.ANS'); ReWrite(f1);
  For i:=1 To 10 Do
    Begin
      WriteLn(f1,hiScore[i]:6,'   ',al[i]{,cr,lf,slt[i]});
      ct2:=slt[i];
      For j:=1 To Length(ct2) Do
        Begin
          Write(f1,ct2[j]);
        { If (j Mod 5)=0 Then Write(f1,' '); }
          If (j Mod 65)=0 Then WriteLn(f1)
        End;
      WriteLn(f1)
    End;
  Close(f1);                                             { Close Output File }

  GetTime(h2,m2,s2,t2);
  WriteLn(bell,cr,lf,' Done...');
  WriteLn(' Finished: ',h2:2,':',m2:2,':',s2:2,':',t2:2);
  WriteLn(' Start   : ',h1:2,':',m1:2,':',s1:2,':',t1:2)
End.