'Copyright 2000 The American Cryptogram Association (ACA)
'3613 Piedmont Drive, Plano TX 75075-6234
'All rights reserved.

'Program code from the Computer Column
'for Nov/Dec 2000.  The program searches
'a word list for a keyword alphabet in
'a 6x6 square that matches corow and
'cocol patterns entered by user.

'This is a complete program and can be
'executed with the QBasic interpreter.
'It is the result of applying the changes
'described in Nov/Dec to the 5x5 program
'in the Sep/Oct 2000 Computer Column.  See
'the Sep/Oct Column for an explanation of
'how to use the program.

'12 routes are included in this version.
const NumRoutes=12
defint A-Z
dim shared RtOrder(12,36), Route$(12)
dim shared CoR$(16), CoC$(16)

'Get various inputs from user
Input "Enter Word File Name";Fi$
InitRoutes 'Copy data into arrays
Open Fi$ for Input As 1

For I=1 to 16
 Input "Enter CoRow string: ";CoR$(I)
 If Len(CoR$(I))<2 then
    CoRNum=I-1
    Exit For
 End If
Next I

For I=1 to 16
 Input "CoColumn string: ";CoC$(i)
 If Len(CoC$(I))<2 then
    CoCNum=I-1
    Exit For
 End If
Next I

'Main program loop
Al$= GetAlph$    'Get keyed alphabet
Do While Al$<>"" 'Do all keyed alphas
  For I=1 to NumRoutes 'Do each route

    'Put Al$ into Sq$ using route I
    Sq$ = AlphFromRoute$(I,Al$)

    'Check Co-Row/Co-Column strings
    For J=1 to CoRNum
      If CoRC(Cor$(J),Sq$,1)=0 then
        Goto NextRoute 'Failed test
      End If           'for Co-Row
    Next J
    For J=1 to CoCNum
      If CoRC(CoC$(J),Sq$,0)=0 then
        Goto NextRoute  'Failed test
      End If            'for Co-Col
    Next J
 
    'Get here only if Sq$ satisfies
    'all Co-Row/Column relationships
    'Show user the square
    Print "Alphabet: ";Al$
    Print "Route:    ";Route$(I)
    PrtSq Sq$
    Input "Press Enter";X$
  NextRoute:
  Next I         'Try next route
  Al$ = GetAlph$ 'Try next key word
Loop 'until key words are exhausted
End  'end of main program

Sub InitRoutes      'Copies data
For I=1 to NumRoutes'statements into
  Read Route$(I)    'arrays. RtOrder
  For J=1 to 36     'contains for
   Read RtOrder(I,J)'route I the 36
  Next J            'values used to
Next I              'reorder alphabet
End Sub 'InitRoutes 'into route form

Function AlphFromRoute$(I,Al$)
'Inputs: Route num I & Key alpha Al$
'Output: Al$ reordered as if written
'in by route I, out by horizontals,
  R$=""
  For J=1 to 36
    R$=R$+mid$(Al$,RtOrder(I,J),1)
  Next J
  AlphFromRoute$=R$
End Function 'AlphFromRoute$

Sub PrtSq(Sq$)
'Print alphabet Sq$ as 6x6 square
  RowPosn = 1
  For RowNum=1 to 6
    Print "    ";Mid$(Sq$,RowPosn,6)
    RowPosn = RowPosn+6
  Next RowNum
End Sub

Function GetAlph$()    'Reads next
  Dim Used(27)         'file line as
  Line Input #1, Word$ 'key & returns
  If Eof(1) Then       'keyed alpha-
    Close 1            'bet (or null
    GetAlph$=""        'string at end
    Exit Function      'of file).
  End If
  AL$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Word$=Ucase$(Word$)
  Tmp$=Word$+AL$       'Prepend key
  TmpLen=Len(Tmp$)     'to normal 26-
  Alph$=""             'ltr sequence.
  Redim Used(27)       'Rezero used
  For I=1 to TmpLen    'ltr flags.
    C$=Mid$(Tmp$,I,1)  'Cvt ltrs to
    A=ASC(C$)-64       'range of 1-26
    'Ignore punctuation if present
    If A<1 OR A>26 Then Goto NxtI
    If Used(A)=0 Then  'Add unused
      Used(A)=1        'ltr to Alph$
      Alph$=Alph$+Chr$(64+A) '& set
      If A=10 Then A=0 'its used flag
      If A<10 Then Alph$=Alph$+Chr$(48+A)
    End If
  NxtI:
  Next I         'Do next ltr in Tmp$
  GetAlph$=Alph$ 'Return keyed alpha
End Function     'GetAlph$
  
Function CoRC(S$,Sq$,R)
'Tests ltrs in S$ as CoRow or CoCol
'in Sq$.  R=1 means test for CoRow;
'         R=0 means test for CoCol.
'Function Returns 1 if all ltrs in
'S$ meet the test. In code below
'P1 is row (or col) of 1st ltr in S$.
'P2 is row (or col) of other ltrs.

  S$  = UCase$(S$)
  L   = len(S$)  
  P1  = instr(1,Sq$,mid$(S$,1,1))-1
  If R then P1=P1\6 else P1=P1 mod 6

  'Check ltrs after 1st against 1st
  For I=2 to L
   P2  = instr(1,Sq$,mid$(S$,I,1))-1
   If R then P2=P2\6 else P2=P2 mod 6
   If P1<>P2 then
     CoRC=0        'A test fails
     Exit Function 'Return 0
   End If
  Next I
  CoRC=1           'All tests succeed
End Function       'Return 1

'To add a route, add 7 more data
'statements below & change NumRoutes
'at top of program.
data   "horizontal"
data   1, 2, 3, 4, 5, 6
data   7, 8, 9,10,11,12
data  13,14,15,16,17,18
data  19,20,21,22,23,24
data  25,26,27,28,29,30
data  31,32,33,34,35,36
data   "alt horizontal"
data   1, 2, 3, 4, 5, 6
data  12,11,10, 9, 8, 7
data  13,14,15,16,17,18
data  24,23,22,21,20,19
data  25,26,27,28,29,30
data  36,35,34,33,32,31
data   "vertical"
data   1, 7,13,19,25,31
data   2, 8,14,20,26,32
data   3, 9,15,21,27,33
data   4,10,16,22,28,34
data   5,11,17,23,29,35
data   6,12,18,24,30,36
data   "alt vertical"
data   1,12,13,24,25,36
data   2,11,14,23,26,35
data   3,10,15,22,27,34
data   4, 9,16,21,28,33
data   5, 8,17,20,29,32
data   6, 7,18,19,30,31
data   "clockwise spiral"
data   1, 2, 3, 4, 5, 6
data  20,21,22,23,24, 7
data  19,32,33,34,25, 8
data  18,31,36,35,26, 9
data  17,30,29,28,27,10
data  16,15,14,13,12,11
data   "rev cclockwise spiral"
data  36,35,34,33,32,31
data  17,16,15,14,13,30
data  18, 5, 4, 3,12,29
data  19, 6, 1, 2,11,28
data  20, 7, 8, 9,10,27
data  21,22,23,24,25,26
data   "cclockwise spiral"
data   1,20,19,18,17,16
data   2,21,32,31,30,15
data   3,22,33,36,29,14
data   4,23,34,35,28,13
data   5,24,25,26,27,12
data   6, 7, 8, 9,10,11
data   "rev clockwise spiral"
data  36,17,18,19,20,21
data  35,16, 5, 6, 7,22
data  34,15, 4, 1, 8,23
data  33,14, 3, 2, 9,24
data  32,13,12,11,10,25
data  31,30,29,28,27,26
data   "upward diagonals"
data   1, 3, 6,10,15,21
data   2, 5, 9,14,20,26
data   4, 8,13,19,25,30
data   7,12,18,24,29,33
data  11,17,23,28,32,35
data  16,22,27,31,34,36
data   "alt upward diagonals"
data   1, 2, 6, 7,15,16
data   3, 5, 8,14,17,26
data   4, 9,13,18,25,27
data  10,12,19,24,28,33
data  11,20,23,29,32,34
data  21,22,30,31,35,36
data   "down diagonals"
data   1, 2, 4, 7,11,16
data   3, 5, 8,12,17,22
data   6, 9,13,18,23,27
data  10,14,19,24,28,31
data  15,20,25,29,32,34
data  21,26,30,33,35,36
data   "alt down diagonals"
data   1, 3, 4,10,11,21
data   2, 5, 9,12,20,22
data   6, 8,13,19,23,30
data   7,14,18,24,29,31
data  15,17,25,28,32,35
data  16,26,27,33,34,36