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

'Bifid Crib Placer

CLS : DEFINT A-Z
PRINT "Bifid Crib Placer"
DIM PA(300): DIM BA(300)
DIM Crib(150): DIM Label(26, 2)
GOSUB GetCipher
TL = LEN(Ct$): K = 1
FOR I = 1 TO TL
 J = ASC(UCASE$(MID$(Ct$, I, 1)))
 IF J > 64 AND J < 91 THEN
  BA(K) = J - 64: K = K + 1
 END IF
NEXT I
TL = K - 1 :PRINT TL;"Text letters"
GOSUB GetCrib
CL = LEN(Cb$)
FOR I = 1 TO CL
 J = ASC(UCASE$(MID$(Cb$, I, 1)))
 Crib(I) = J - 64
NEXT I
FOR period = 4 TO 12
 PRINT "Period"; period; "OK at ";
 FOR Cpos = 1 TO TL - CL + 1
	GOSUB GetLabels
	GOSUB IsPositionPossible
 NEXT Cpos
 PRINT
NEXT period
END
'subroutines
GetCipher:
Ct$ = ""
INPUT "Name of ciphertext file"; Fil$
OPEN Fil$ FOR INPUT AS #1
WHILE NOT EOF(1)
   INPUT #1, c$
   Ct$ = Ct$ + c$
WEND
CLOSE #1
PRINT "Ciphertext is "; Ct$
RETURN

GetCrib:
INPUT "Enter Crib (NO BLANKS)"; Cb$
RETURN

GetLabels:
' reset label array to -1 (empty)
FOR I = 1 TO 26: FOR J = 1 TO 2
	Label(I, J) = -1
NEXT J, I
' TL = text length. Reset PA array
FOR I = 1 TO TL: PA(I) = -1: NEXT I
' CL = crib length, Cpos = crib start
FOR I = 1 TO CL
	PA(Cpos - 1 + I) = Crib(I)
NEXT I
'BA ciphertext array, PA crib array
N = period: NxtL = 0: BS = 1
DO 'crib index CP goes from 1 to TL
 'BI = 1 for row and 2 for Column
 Cnt = 0: BI = 1: CI = 1
 BP = BS: CP = BS
 WHILE Cnt < 2 * N
  c = PA(CP) 'c is crib entry
  b = BA(BP) 'b is cipher letter
  IF c <> -1 THEN 'c is real letter
   nb = Label(b, BI)
   nc = Label(c, CI)
   IF nb = -1 AND nc = -1 THEN
	Label(b, BI) = NxtL
	Label(c, CI) = NxtL
	NxtL = NxtL + 1
   ELSEIF nc = -1 THEN
	Label(c, CI) = nb
   ELSEIF nb = -1 THEN
	Label(b, BI) = nc
   ELSE 'merge labels
	FOR I = 1 TO 26: FOR J = 1 TO 2
	  IF Label(I, J) = nc THEN
	   Label(I, J) = nb
	  END IF
	NEXT J, I
   END IF
  END IF ' c <> -1
  Cnt = Cnt + 1
  CP = CP + 1
  IF (Cnt MOD N) = 0 THEN
   CI = CI + 1 'switch to columns
   CP = BS 'back to group's start
  END IF
  IF BI = 1 THEN
	BI = 2
  ELSE
	BI = 1
	BP = BP + 1 'next cipher let
  END IF
 WEND 'loop through this group
 BS = BS + period
 IF BS + period > TL THEN
  N = TL - BS + 1
 ELSE
  N = period
 END IF
LOOP UNTIL BS > TL
RETURN

IsPositionPossible:
FOR J = 1 TO NxtL - 1
 FOR K = 1 TO 2
   N = 0
   FOR I = 1 TO 26
	IF Label(I, K) = J THEN
	 N = N + 1 'letter count
	 IF N > 5 THEN 'too many!
	   RETURN
	 END IF
	END IF
NEXT I, K, J

FOR J = 1 TO 25
 L1 = Label(J, 1): L2 = Label(J, 2)
 IF L1 > -1 AND L2 > -1 THEN
  FOR K = J + 1 TO 26
   L3 = Label(K, 1): L4 = Label(K, 2)
   IF L1 = L3 AND L2 = L4 THEN
	RETURN 'two in same cell
   END IF
  NEXT K
 END IF
NEXT J
PRINT " "; Cpos;
RETURN