'Copyright 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$


'Program 2: Demo of GetCt$()

Input "Enter File Name";Nam$
Input "Which problem"; CiphId$
Ct$ = GetCt$(Nam$,CiphId$)
Print "CT length=";Len(Ct$)
Print "CT = ";Ct$

'Function GetCt$(Fi$,Id$)
'gets ciphertext from file Fi$.
'Scans file until Id string is
'found, then reads lines until
'it finds a slash.  Returns the
'the string between slashes, keeping
'only characters found in Filter$.
'Lower case changed to upper case
'unless lower case is in Filter$.
'Ciphers with numbers or punctuation
'can be input by including digits,
'space, comma, etc. in Filter$.

Function GetCt$(Fi$, Id$)
Delim$="/" 'Slashes must surround Ct
Lc$ = "abcdefghijklmnopqrstuvwxyz"
Filter$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Open Fi$ For Input As #1
Ct$ = ""
If Id$ = "" Then Goto IdOk
Id = 0       'Id not yet found
Do While Not Eof(1)
  Line Input #1, Lin$
  Id = Instr(1, Lin$, Id$)
  If Id > 0 Then Exit Do
Loop
If Id = 0 Then Goto Done
IdOk:
Sl = 0  'Slash not yet found
Do While Not Eof(1)
  Line Input #1, Lin$
  For I = 1 To Len(Lin$)
    C$ = Mid$(Lin$, I, 1)
    If C$ = Delim$ Then
      If Sl = 1 Then Goto Done
      Sl = 1 '1st slash found
      Goto nextchar
    End If
    If Sl = 0 Then Goto nextchar
    If Instr(1,Filter$,C$) Then
      Ct$ = Ct$ + C$
    Elseif Instr(1, Lc$, C$) Then
      C$ = Chr$(Asc(C$) - 32)
      Ct$ = Ct$ + C$
    End If
Nextchar:
  Next I
Loop  'while not eof
Done:
  Close #1
  GetCt$=Ct$
End Function  'GetCt$