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

'Numerical key word search

Input "Enter Name of Word File";F$
Input "Enter Pattern";P$
W$ = WordMatch$(F$,P$)
Do While W$<>""
  Print W$,
  W$ = WordMatch$("","")
Loop
Print "-> Done"

Defint A-Z
'Listing 1 -- Numerical key match
Function Matches(Word$,Init%) Static
Dim Pat[32]           'Call first
Word$=UCase$(Word$)   'with Init%=1
If Init% <> 0 Then    'to put pattern
  PatLen = Len(Word$) 'in array Pat()
  For I=1 to PatLen   '
    C$=Mid$(Word$,I,1)'Change digits
    C=Asc(C$)-Asc("0")'from chars to 
    If C>9 THEN C=C-7 'integers.
    Pat[C]=I
  Next I

  'Check for mistyped key
  For I=1 to PatLen
    If Pat[I]=0 Then
     Print "Error:";I;"is not in key"
     End   'Exit the program
    End If
  Next I
Else

 'Start here to check for a match
  Match=0 'Assume the match fails
  If Len(Word$)<>PatLen Then
    Goto MatchesEnd     'No match
  End If

  'See if pattern order is alphabetic
  Prev$="0"         
  For I=1 to PatLen 
    Cur = Pat[I]    
    Cur$= Mid$(Word$,Cur,1) 
    If Cur$ < Prev$ Then    
       Goto MatchesEnd  'No match
    End If
    Prev$=Cur$
  Next I
End If

Match=1       'Success: init or match
MatchesEnd:  
Matches=Match 'Return status
End Function  'Matches


'Each call to WordMatch$() returns
'from file Fi$ one word that matches
'the string in Patt$.  What counts as
'a match is determined by the helper
'function Matches().
Function WordMatch$(Fi$,Patt$) Static
If Init=0 Then 'If first call, open
  Init=1       'the file and init-
  Open Fi$ For Input As 1 'ialize
  Temp=Matches(Patt$,1)   'pattern
End If                    'array
Do While Not Eof(1)
  Line Input #1, Word$
  If Matches(Word$,0) Then
     WordMatch$=Word$
     Goto WordMatchEnd
  End If
Loop
  Close #1
  Init=0
  WordMatch$=""
WordMatchEnd:
End Function  'WordMatch$