'Copyright 1997-1999 The American Cryptogram Association (ACA)
'One Pidgeon Drive, Wilbraham MA 01095-2604
'All rights reserved.


'Program 1: Word Pattern 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
Function Matches(Word$,Init%) Static
Dim Pat[32]            'Call first
If Init% <> 0 Then     'with Init=1
  WLen = Len(Word$)    'to create
  PatLen=WLen-1        'the pattern
  For I=1 to PatLen    'in array
    C$=Mid$(Word$,I,1) 'Pat[]
    Pat[I]=Instr(I+1,Word$,C$)
  Next I
Else
  Match=0 'Assume the match fails
  If Len(Word$)<>Wlen Then
    Goto MatchesEnd
  End If
  For I=1 to PatLen     'Check each
    C$=Mid$(Word$,I,1)  'position in
    Posn=Instr(I+1,Word$,C$) 'the
    If Pat[I]<>Posn Then'current word
       Goto MatchesEnd  'with the
    End If              'pattern in
  Next I                'Pat[].
End If
Match=1    'Succesful init or match
MatchesEnd:
Matches=Match
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$