program TriSquare;	{ MA2009 Computer Column by Cary Davids. Drags tip }
{ to find matches, then accepts input. WINDOWS VERSION }
{ 200 levels of undo during input.  Allows row and column swapping in }
{ order to transform squares to a form where a keyword can be obtained. }
{	Con must be in a file in a continuous string, followed by tip on the }
{ next line.  Solution and squares are written to a text file upon }
{ quitting program from an input request. Version January 24, 2010}
 label
	12, 13, 14, 15;
 const
	nb = 20;					{ number of trigrams displayed per line }
  ns = 23;					{ size of center square }
	nw = 16;					{ # of rows in top square, # of columns in left square }
	maxstack = 200;		{ size of save stack }
 type
	square = array[1..25, 1..25] of char;
 type
  next = record
    row: integer;
    col: integer;
   end;
 type
  stackentry = record	{ what is saved on the stack: 2 'next' records, 3 squares }
    nextls: next;
    nextts: next;
		ctrs: square;
		lefts: square;
		tops: square;
   end;
 type
  matchrec = record	{ match information; nm keeps track of how many }
    tip: string[255];		{ tip string }
    ct: string[255]			{ ct string }
   end;
 type
	stacktype = record	{ define stack used to save squares and nexts }
		top: 0..maxstack;	{ represents current depth of stack }
		entry: array[1..maxstack] of stackentry
	end;
 var
  str1, str2, str3, outstr, tip, dig, trig, title, tip1, tip2: string[255];
  str, sol: packed array[1..600] of char;
  Infile, Outfile: text;
  i, j, kl, np, lt, nm, kmax, len1, len2, lt1, lt2: integer;
  p1r, p1c, c1c, p2r, p2c, c2r, c2c, c3r: integer;
	match: array [1..150] of matchrec;
  nextl, nextt: next;	{ next free slots in squares }
  ctr, left, top: square;
  len, centr, centc, lc, tr: integer;
  p1fnd, p2fnd, c1fnd, c2fnd, c3fnd, fndindex: integer;
	manflag, popflag, pushflag: boolean;
	S: stacktype;

 function upperc(str7: string): string;	{ returns uppercase of a string }
 var
	i, len: integer;
	str1: string[255];
 begin
	str1 := str7;					{ assume already uppercase }
	len := length(str7);
	for i := 1 to len do		
		if( ord(str7[i]) > 96) and (ord(str7[i]) < 123) then	{ only change it if it is lowercase }
			str1[i] := upCase(str1[i]);		{ change letter by letter }
	upperc := str1;
 end;

 function lowerc (C: char): char;	{ returns lowercase of a letter }
 begin
  lowerc := C;		{ only change it if it is a capital letter }
  if ord(C) > 64 then
   if ord(C) < 91 then
    lowerc := char(ord(C) + 32);
 end;	{ of function lowerc }

 procedure DisplayCipher;
	var
		i, j, k: integer;
 begin
	k := 1;		{ line counter }
		while nb * (k - 1) < np do
			begin
				write(' ');
				for i := 1 to nb do
					begin
						for j := 1 to 3 do
							if j + 3 * (i - 1) + 3 * nb * (k - 1) <= 3*np then
								write(str[j + 3 * (i - 1) + 3 * nb * (k - 1)]);
						write(' ');
					end;
				writeln;
				write(' ');
				for i := 1 to nb do
					for j := 1 to 2 do
						if j + 2 * (i - 1) + 2 * nb * (k - 1) <= 2*np then { only up to end of sol }
							write(lowerc(sol[j + 2 * (i - 1) + 2 * nb * (k - 1)]), ' ');
				writeln;
				writeln;
				k := k + 1;
			end;	{ of while }
 end;	{ of procedure DisplayCipher }

 procedure DrawSquares;
  var
   i, j: integer;
 begin  
		for i := nextt.row + 1 downto 1 do			{  draw top square }
			begin
				write(' ');							{ initial space }
				for j := 1 to nw do
					write('  ');
				write('| ');
				for j := 1 to ns do
					write(top[i, j], ' ');
				writeln;
			end;
		write(' ');									{ initial space }
		for i := 1 to nw do					{ horizontal boundary }
			write('--');
		write('|');
		for i := 1 to ns - 1 do
			write('--');
		writeln('--');
		for i := 1 to nextl.row + 1 do					{ draw left and center squares }
			begin
				write(' ');							{ initial space }
				for j := nw downto 1 do
					write(left[i, j], ' ');
				write('| ');
				for j := 1 to ns do
					write(ctr[i, j], ' ');
				writeln;
			end;
 end;		{ of procedure DrawSquares }

 function CheckTop: boolean;		{ Counts the number of characters }
	{ in the rows & cols of the top square, returns true if more than 5 }
  var
   i, j, k: integer;
 begin
  CheckTop := false;	{ assume it is OK }
  for i := 1 to nw do	{ do each row }
   begin
    k := 0;				{ start with 0 }
    for j := 1 to ns do
     if ord(top[i, j]) > 64 then
      k := k + 1;
    if k > 5 then
     begin
      CheckTop := true;
      exit;	{ get out }
     end;
   end;	{ of i loop }
  for j := 1 to ns do	{ do each column }
   begin
    k := 0;				{ start with 0 }
    for i := 1 to nw do
     if ord(top[i, j]) > 64 then
      k := k + 1;
    if k > 5 then
     begin
      CheckTop := true;
      exit;	{ get out }
     end;
   end;	{ of i loop }
 end; { of function CheckTop }

 function CheckLeft: boolean;		{ Counts the number of characters }
	{ in the rows & cols of the left square, returns true if more than 5 }
  var
   i, j, k: integer;
 begin
  CheckLeft := false;	{ assume it is OK }
  for i := 1 to ns do	{ do each row }
   begin
    k := 0;				{ start with 0 }
    for j := 1 to nw do
     if ord(left[i, j]) > 64 then
      k := k + 1;
    if k > 5 then
     begin
      CheckLeft := true;
      exit;	{ get out }
     end;
   end;	{ of i loop }
  for j := 1 to nw do	{ do each column }
   begin
    k := 0;				{ start with 0 }
    for i := 1 to ns do
     if ord(left[i, j]) > 64 then
      k := k + 1;
    if k > 5 then
     begin
      CheckLeft := true;
      exit;	{ get out }
     end;
   end;	{ of j loop }
 end; { of function CheckLeft }

 function CheckCtr: boolean;		{ Counts the number of characters }
	{ in the rows & cols of the center square, returns true if more than 5 }
  var
   i, j, k: integer;
 begin
  CheckCtr := false;	{ assume it is OK }
  for i := 1 to ns do	{ do each row }
   begin
    k := 0;				{ start with 0 }
    for j := 1 to nw do
     if ord(ctr[i, j]) > 64 then
      k := k + 1;
    if k > 5 then
     begin
      CheckCtr := true;
      exit;	{ get out }
     end;
   end;	{ of i loop }
  for j := 1 to ns do	{ do each column }
   begin
    k := 0;				{ start with 0 }
    for i := 1 to ns do
     if ord(ctr[i, j]) > 64 then
      k := k + 1;
    if k > 5 then
     begin
      CheckCtr := true;
      exit;	{ get out }
     end;
   end;	{ of j loop }
 end; { of function CheckCtr }

 procedure GetSolution;	{		Get a trigram of the ct, }
	{ look up each letter, get coords in alphabet square }
  var
   j1, i, j: integer;
 begin
	for i := 1 to 2 * np do		{ start with blank sol }
		sol[i] := '.';
  for j1 := 1 to np do			{ np is number of trigrams }
   begin
    lc := nw;								{ start with dot }
    tr := nw;								{ start with dot }
    centc := ns;						{ start with dot }
    centr := ns;						{ start with dot }
    for i := 1 to ns do			{ search left square }
     for j := 1 to nw do
      if str[3 * j1 - 2] = left[i][j] then
       lc := j;							{ left column coord }
    for i := 1 to nw do			{ search top square }
     for j := 1 to ns do
      if str[3 * j1] = top[i][j] then
       tr := i;							{ top row coord }
    for i := 1 to ns do			{ search center square }
     for j := 1 to ns do
      if str[3 * j1 - 1] = ctr[i][j] then
       begin
				centr := i;					{ row coord }
				centc := j;					{ column coord }
				sol[2 * j1 - 1] := left[centr, lc];
				sol[2 * j1] := top[tr, centc];
       end;
   end;
 end;		{ of procedure GetSolution }

 procedure CombColsL (c1, c2: integer);	{ An internal column transfer in left square }
  var
   org, dest, j: integer;
 begin
  if c1 < c2 then
   begin	{ move all to col c1 from col c2 }
    org := c2;
    dest := c1;
   end
  else
   begin	{ move all to col c2 from col c1 }
    org := c1;
    dest := c2;
   end;
  for j := 1 to ns do
   begin
    if ord(left[j, org]) > 64 then
     begin
      left[j, dest] := left[j, org];
      left[j, org] := '.';
     end;
   end;	{ of j-loop }	 
{		Now clean up vacant columns by bringing last column back to empty one }
  for j := 1 to ns do
   if ord(left[j, nextl.col - 1]) > 64 then		{ last col in this square }
    begin
     left[j, org] := left[j, nextl.col - 1];
     left[j, nextl.col - 1] := '.';
    end;
  nextl.col := nextl.col - 1;		{ Reset next.col }
 end;	{ procedure CombColsL }

 procedure CombColsTC (c1, c2: integer);	{ Combine columns in top and center }
  var
   org, dest, j: integer;
 begin
  if c1 < c2 then
   begin	{ move all to col c1 from col c2 }
    org := c2;
    dest := c1;
   end
  else
   begin	{ move all to col c2 from col c1 }
    org := c1;
    dest := c2;
   end;
  for j := 1 to nw do
   begin
    if ord(top[j, org]) > 64 then
     begin
      top[j, dest] := top[j, org];
      top[j, org] := '.';
     end;
   end;	{ of j-loop }
  for j := 1 to ns do
   begin
    if ord(ctr[j, org]) > 64 then
     begin
      ctr[j, dest] := ctr[j, org];
      ctr[j, org] := '.';
     end;
   end;	{ of j-loop }
{		Now clean up vacant columns by bringing last column back to empty one }
  for j := 1 to nw do
   if ord(top[j, nextt.col - 1]) > 64 then		{ last col in this square }
    begin
     top[j, org] := top[j, nextt.col - 1];
     top[j, nextt.col - 1] := '.';
    end;
  for j := 1 to ns do
   if ord(ctr[j, nextt.col - 1]) > 64 then		{ last col in this square }
    begin
     ctr[j, org] := ctr[j, nextt.col - 1];
     ctr[j, nextt.col - 1] := '.';
    end;
  nextt.col := nextt.col - 1;		{	Reset nextt.col }
 end;	{ procedure CombColsTC }

 procedure CombRowsLC (r1, r2: integer);	{ Combine rows in left and center }
  var
   org, dest, j: integer;
 begin
  if r1 < r2 then
   begin	{ move all to row r1 from row r2 }
    org := r2;
    dest := r1;
   end
  else
   begin	{ move all to row r2 from row r1 }
    org := r1;
    dest := r2;
   end;
  for j := 1 to nw do
   if ord(left[org, j]) > 64 then
    begin
     left[dest, j] := left[org, j];
     left[org, j] := '.';
    end;	{ of j-loop }
  for j := 1 to ns do
   if ord(ctr[org, j]) > 64 then
    begin
     ctr[dest, j] := ctr[org, j];
     ctr[org, j] := '.';
    end;	{ of j-loop }
{		Now clean up vacant rows by bringing last row up to empty one }
  for j := 1 to nw do
   if ord(left[nextl.row - 1, j]) > 64 then		{ last row in this square }
    begin
     left[org, j] := left[nextl.row - 1, j];
     left[nextl.row - 1, j] := '.';
    end;	{ of j-loop }
  for j := 1 to ns do
   if ord(ctr[nextl.row - 1, j]) > 64 then		{ last row in this square }
    begin
     ctr[org, j] := ctr[nextl.row - 1, j];
     ctr[nextl.row - 1, j] := '.';
    end;	{ of j-loop }
{		Reset next.row }
  nextl.row := nextl.row - 1;
 end;	{ procedure CombRowsLC }

 procedure CombRowsT (r1, r2: integer);	{ An internal row transfer in top square }
  var
   org, dest, j: integer;
 begin
  if r1 < r2 then
   begin	{ move all to row r1 from row r2 }
    org := r2;
    dest := r1;
   end
  else
   begin	{ move all to row r2 from row r1 }
    org := r1;
    dest := r2;
   end;
  for j := 1 to ns do
   begin
    if ord(top[org, j]) > 64 then
     begin
      top[dest, j] := top[org, j];
      top[org, j] := '.';
     end;
   end;	{ of j-loop }
{		Now clean up vacant rows by bringing last row down to empty one }
  for j := 1 to ns do
   if ord(top[nextt.row - 1, j]) > 64 then		{ last row in this square }
    begin
     top[org, j] := top[nextt.row - 1, j];
     top[nextt.row - 1, j] := '.';
    end;
{		Reset next.row }
  nextt.row := nextt.row - 1;
 end;	{ procedure CombRowsT }

 procedure ProcTrig (ptd, ctt: string);	{ ptd=ptext digram, ctt=cttrigram }
{		Enter with pt digram and ct digram. }
  var
   j, k: integer;
 begin

{ 		Check for presence of any of the 5 letters in its appropriate square }

  p1fnd := 0;							{ first pt letter not here already }
  p2fnd := 0;							{ second pt letter not here already }
  c1fnd := 0;							{ first ct letter not here already }
  c2fnd := 0;							{ second ct letter not here already }
  c3fnd := 0;							{ third ct letter not here already }
  for j := 1 to ns do			{ look in each row }
   for k := 1 to nw do		{ look at all columns }
    if ptd[1] = left[j, k] then		{ first plaintext here already }
     begin
      p1fnd := 1;					{ found this letter already placed }
      p1r := j;						{ save its row number }
      p1c := k;						{ save its column number }
     end;		{ of j,k loop }
  for j := 1 to nw do			{ look in each row }
   for k := 1 to ns do		{ look at all columns }
    if ptd[2] = top[j, k] then		{ second plaintext here already }
     begin
      p2fnd := 1;					{ found this letter already placed }
      p2r := j;						{ save its row number }
      p2c := k;						{ save its column number }
     end;		{ of j,k loop }
  for j := 1 to ns do			{ look in each row }
   for k := 1 to nw do		{ look at all columns }
    if ctt[1] = left[j, k] then		{ first ciphertext here already }
     begin
      c1fnd := 1;					{ found this letter already placed }
    {  c1r := j;						 save its row number REMOVED 8/4/08}
      c1c := k;						{ save its column number }
     end;		{ of j,k loop }
  for j := 1 to ns do			{ look in each row }
   for k := 1 to ns do		{ look at all columns }
    if ctt[2] = ctr[j, k] then		{ found intersection letter here already at j,k }
     begin		{ consolidate everything, including other intersection letters! }
      c2fnd := 1;					{ found this letter already placed }
      c2r := j;						{ save its row number }
      c2c := k;						{ save its column number }
     end;		{ of j,k loop }
  for j := 1 to nw do			{ look in each row }
   for k := 1 to ns do		{ look at all columns }
    if ctt[3] = top[j, k] then		{ third ciphertext here already }
     begin
      c3fnd := 1;					{ found this letter already placed }
      c3r := j;						{ save its row number }
 {     c3c := k;						 save its column number REMOVED 8/4/08 }
     end;		{ of j,k loop }

{		There are 32 possible conditions. Calculate fndindex=binary combination of 5 bits.}
{		Enter having values of c1c,c2r,c2c,c3r,p1r,p1c,p2r,p2c for found letters }

  fndindex := p1fnd + 2 * p2fnd + 4 * c1fnd + 8 * c2fnd + 16 * c3fnd;
  case fndindex of
   0: 	{ found no letters so place all 5 letters }
    begin
     left[nextl.row, nextl.col] := ptd[1];	{ put first pt letter in left square }
     centr := nextl.row;				{ here is  row number for intersection }
     nextl.row := nextl.row + 1;		{ increase row number for next letter }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     nextl.col := nextl.col + 1;			{ finished on left, increase column number for next letter }

     top[nextt.row, nextt.col] := ptd[2];	{ put second pt letter in top square }
     centc := nextt.col;					{ here is its column number }
     nextt.col := nextt.col + 1;			{ get ready for next top letter }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[nextt.row, nextt.col] := ctt[3];	{ put this ct letter in top square }
       nextt.col := nextt.col + 1;			{ get ready for next letter }
      end;
     nextt.row := nextt.row + 1;		{ finished on top, get ready for next letter }
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 0 }
   1: 	{ found p1 in left, so use its row as centr }
    begin
     centr := p1r;
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     top[nextt.row, nextt.col] := ptd[2];	{ put second pt letter in top square }
     centc := nextt.col;					{ here is its column number }
     nextt.col := nextt.col + 1;			{ get ready for next letter }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[nextt.row, nextt.col] := ctt[3];	{ put this ct letter in top square }
       nextt.col := nextt.col + 1;			{ get ready for next letter }
      end;
     nextt.row := nextt.row + 1;		{ get ready for next letter }
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 1 }
   2: 	{ found p2 in top, so use its column as centc }
    begin
     left[nextl.row, nextl.col] := ptd[1];	{ put first pt letter in left square }
     centr := nextl.row;				{ here is  row number for intersection }
     nextl.row := nextl.row + 1;		{ increase row number for next letter }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     nextl.col := nextl.col + 1;			{ finished on left, increase column number for next letter }
     centc := p2c;
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put second ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;	{ increase column number for next letter but not row }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;  { of case 2 }
   3: 	{ found p1 in left, and p2 in top}
    begin
     centr := p1r;						{ here is  row number for intersection }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     centc := p2c;						{ here is  column number for intersection }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put this ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 3 }
   4: 	{ found c1 in left, so use its column for p1 }
    begin
     centr := nextl.row;				{ here is  row number for intersection }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, c1c] := ptd[1];	{ put first pt letter in left square in same column as c1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     top[nextt.row, nextt.col] := ptd[2];	{ put second pt letter in top square }
     centc := nextt.col;					{ here is its column number }
     nextt.col := nextt.col + 1;			{ get ready for next letter }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[nextt.row, nextt.col] := ctt[3];	{ put this ct letter in top square }
  {     nextt.row := nextt.row + 1;	 get ready for next letter REMOVED 8/3/08 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     nextt.row := nextt.row + 1;		{ get ready for next letter ADDED JULY12/06, CORRECTED POSITION 1/07}
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 4.0 }
   5: 	{ found p1 in left, c1 in left, so use p1r as centr }
    begin
     centr := p1r;
     if c1c <> p1c then					{ columns must be identical }
				CombColsL(c1c, p1c);
     top[nextt.row, nextt.col] := ptd[2];	{ put second pt letter in top square }
     centc := nextt.col;					{ here is its column number }
     nextt.col := nextt.col + 1;			{ get ready for next letter }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[nextt.row, nextt.col] := ctt[3];	{ put this ct letter in top square }
{nextt.row := nextt.row + 1;	 get ready for next letter MOVED DOWN 4/27/08 }
       nextt.col := nextt.col + 1;			{ get ready for next letter }
      end;
     nextt.row := nextt.row + 1;	{ get ready for next letter }
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 5 }
   6: 	{ found c1 in left and p2 in top: put p1 in c1c, c3 in p2r }
    begin
     centr := nextl.row;				{ here is  row number for intersection }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, c1c] := ptd[1];	{ put first pt letter in left square in same column as c1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     centc := p2c;						{ here is top column number }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put this ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 6 }
   7: 	{ found p1 and c1 in left, and p2 in top}
    begin
     centr := p1r;						{ here is  row number for intersection }
     if c1c <> p1c then					{ if columns are not identical }
      CombColsL(p1c, c1c);
     centc := p2c;						{ here is top column number }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put this ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 7 }
   8: 	{ found c2 in center }
    begin
     p1r := c2r;							{ here is row for left pt }
     left[p1r, nextl.col] := ptd[1];		{ put first pt letter in left square in same row as c2 }
		 if ptd[1] <> ctt[1] then					{ if letters are not identical Added 9/1/08}
				begin
					left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square in same col as p1 }
					nextl.row := nextl.row + 1;		{ increase row number for next letter }
				end;
     nextl.col := nextl.col + 1;			{ get ready for next letter }
     p2c := c2c;							{ here is column for top pt }
     top[nextt.row, p2c] := ptd[2];	{ put second pt letter in top square in same col as c2 }
		 if ptd[2] <> ctt[3] then					{ if letters are not identical Added 9/1/08}
				begin
					top[nextt.row, nextt.col] := ctt[3];	{ put third ct letter in top square in same row as p2 }
					nextt.col := nextt.col + 1;			{ increase column number for next letter }
				end;
			nextt.row := nextt.row + 1;		{ get ready for next letter }
    end;	{ of case 8 }
   9: 	{ found p1 in left and c2 in center }
    begin
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     p2c := c2c;							{ here is column for top pt }
     top[nextt.row, p2c] := ptd[2];	{ put second pt letter in top square in same col as c2 }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
			begin	{ added 9/23/08 }
				top[nextt.row, nextt.col] := ctt[3];	{ put third ct letter in top square in same row as p2 }
				nextt.col := nextt.col + 1;			{ increase column number for next letter }
			end;
		 nextt.row := nextt.row + 1;		{ get ready for next letter }
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
    end;	{ of case 9 }
   10: 	{ found p2 in top and c2 in center }
    begin
     p1r := c2r;							{ here is row for left pt }
     left[p1r, nextl.col] := ptd[1];		{ put first pt letter in left square in same row as c2 }
		 if ptd[1] <> ctt[1] then					{ if letters are not identical Added 8/18/08}
				begin
					left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square in same col as p1 }
					nextl.row := nextl.row + 1;			{ increase row number for next letter }
				end;
     nextl.col := nextl.col + 1;			{ get ready for next letter }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put third ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ increase column number for next letter but not row }
      end;
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 10 }
   11: 	{ found p1 in left, p2 in top, and c2 in center }
    begin
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put third ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;	{ increase column number for next letter but not row }
      end;
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 11 }
   12: 	{ found c1in left and c2 in center }
    begin
     if ptd[1] <> ctt[1] then			{ if letters are not identical }
      left[c2r, c1c] := ptd[1];			{ put first pt letter in left square in same column as c1, in c2r }
     top[nextt.row, c2c] := ptd[2];	{ put second pt letter in top square in c2c }
     if ptd[2] <> ctt[3] then			{ if letters are not identical }
      top[nextt.row, nextt.col] := ctt[3];	{ put third ct letter in top square in same row as p2 }
     nextt.row := nextt.row + 1;		{ increase row number for next letter }
     nextt.col := nextt.col + 1;			{ increase column number for next letter }
    end;	{ of case 12 }
   13: 	{ found p1and c1 in left, c2 in center }
    begin
     if c1c <> p1c then					{ columns must be identical }
      CombColsL(c1c, p1c);
     top[nextt.row, c2c] := ptd[2];	{ put second pt letter in top square in correct column }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[nextt.row, nextt.col] := ctt[3];	{ put this ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     nextt.row := nextt.row + 1;		{ get ready for next letter }
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
    end;	{ of case 13 }
   14: 	{ found c1 in left, p2  in top, c2 in center }
    begin	{ do least complicated first }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[c2r, c1c] := ptd[1];		{ put first pt letter in left square in same column as c1, in c2r }
      end;
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put this ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 14 }
   15: 	{ found p1 and c1in left, p2  in top, c2 in center }
    begin	{ do least complicated first }
     if p1c <> c1c then
      CombColsL(p1c, c1c);
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[p2r, nextt.col] := ctt[3];	{ put this ct letter in top square in same row as p2 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 15 }
   16: 	{ found c3 in top }
    begin
     left[nextl.row, nextl.col] := ptd[1];	{ put first pt letter in left square }
     centr := nextl.row;				{ here is  row number for intersection }
     nextl.row := nextl.row + 1;		{ increase row number for next letter }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     nextl.col := nextl.col + 1;			{ increase column number for next letter ADDED JULY12/06, CORRECT POSITION 1/07 }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, nextt.col] := ptd[2];	{ put second pt letter in top square in same row as c3 }
       centc := nextt.col;				{ save for next test }
       nextt.col := nextt.col + 1;	{ increase column number for next letter but not row }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;  { of case 16 }
   17: 	{ found p1in left and c3 in top: c1 in p1c, p2 in c3r }
    begin
     centr := p1r;
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     centc := nextt.col;					{ here is top column number }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, nextt.col] := ptd[2];	{ put second pt letter in top square in same row as c3 }
       nextt.col := nextt.col + 1;		{ get ready for next letter }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 17 }
   18: 	{ found p2 and c3 in top }
    begin
     left[nextl.row, nextl.col] := ptd[1];	{ put first pt letter in left square }
     centr := nextl.row;				{ here is  row number for intersection }
     nextl.row := nextl.row + 1;		{ increase row number for next letter }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     nextl.col := nextl.col + 1;			{ finished on left, increase column number for next letter }
     centc := p2c;						{ here is top column number }
     if c3r <> p2r then					{ if rows are not identical }
      CombRowsT(c3r, p2r);
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 18 }
   19: 	{ found p1 in left, p2 and c3 in top }
    begin
     centr := p1r;						{ here is  row number for intersection }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     centc := p2c;						{ here is top column number }
     if c3r <> p2r then					{ if rows are not identical }
      CombRowsT(c3r, p2r);
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 19 }
   20: 	{ found c1 in left, c3 in top }
    begin
     centr := nextl.row;				{ here is  row number for intersection }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, c1c] := ptd[1];	{ put first pt letter in left square in same column as c1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;

     centc := c3r;						{in case letters are identical }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, nextt.col] := ptd[2];	{ put second pt letter in top square in same row as c3 }
       centc := nextt.col;				{ save for next test }
       nextt.col := nextt.col + 1;	{ increase column number for next letter but not row }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 20 }
   21: 	{ found p1 and c1 in left, c3 in top }
    begin
     centr := p1r;						{ here is  row number for intersection }
     if p1c <> c1c then
      CombColsL(p1c, c1c);
     centc := c3r;						{in case letters are identical }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, nextt.col] := ptd[2];	{ put second pt letter in top square in same row as c3 }
       centc := nextt.col;				{ save for next test }
       nextt.col := nextt.col + 1;	{ increase column number for next letter but not row }
      end;
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 21 }
   22: 	{ found c1in left, p2 and c3 in top: p1 in c1c, p2r must = c3r }
    begin
     centr := nextl.row;				{ here is  row number for intersection }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, c1c] := ptd[1];	{ put first pt letter in left square in same column as c1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter }
      end;
     centc := p2c;						{ here is top column number }
     if c3r <> p2r then					{ if rows are not identical }
      CombRowsT(c3r, p2r);
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 22 }
   23: 	{ found p1 and c1in left, p2 and c3 in top: p1 in c1c, p2r must = c3r }
    begin
     centr := p1r;						{ here is  row number for intersection }
     if c1c <> p1c then					{ if columns are not identical }
      CombColsL(p1c, c1c);
     centc := p2c;						{ here is top column number }
     if c3r <> p2r then					{ if rows are not identical }
      CombRowsT(c3r, p2r);
     ctr[centr, centc] := ctt[2];		{ put second ct letter in center square }
    end;	{ of case 23 }
   24: 	{ found c3 in top and c2 in center }
    begin
     left[c2r, nextl.col] := ptd[1];		{ put first pt letter in left square in correct row }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square in next avail row }
       nextl.row := nextl.row + 1;	{ increase row number for next letter }
      end;
		 nextl.col := nextl.col + 1;		{ finished on left, increase column number for next letter }
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, c2c] := ptd[2];		{ put second pt letter in top square in same row as c3 and in c2c }
      end;
    end;	{ of case 24 }
   25: 	{ found p1in left, c3 in top and c2 in center }
    begin
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, c2c] := ptd[2];		{ put second pt letter in top square in same row as c3 and in c2c }
      end;
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
    end;	{ of case 25 }
   26: 	{ found  p2 and c3 in top, c2 in center}
    begin
     left[c2r, nextl.col] := ptd[1];		{ put first pt letter in left square in correct row }
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, nextl.col] := ctt[1];	{ put first ct letter in left square in next avail row }
       nextl.row := nextl.row + 1;	{ increase row number for next letter }
      end;
		 nextl.col := nextl.col + 1;		{ finished on left, increase column number for next letter }
     if c3r <> p2r then					{ if rows are not identical }
      CombRowsT(c3r, p2r);
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 26 }
   27: 	{ found p1 in left, p2 and c3 in top, c2 in center}
    begin
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[nextl.row, p1c] := ctt[1];	{ put first ct letter in left square in same column as p1 }
       nextl.row := nextl.row + 1;		{ increase row number for next letter, but not column }
      end;
     if c3r <> p2r then					{ if rows are not identical }
      CombRowsT(c3r, p2r);
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 27 }
   28: 	{ found c1 in left, c3 in top, c2 in center}
    begin
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      begin
       left[c2r, c1c] := ptd[1];		{ put first pt letter in left square in same column as c1, in c2r }
       nextl.row := nextl.row + 1;	{ increase row number for next letter, but not column }
      end;
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      begin
       top[c3r, c2c] := ptd[2];		{ put second pt letter in top square in same row as c3, in c2c }
      end;
    end;	{ of case 28 }
   29: 	{ found p1 and c1 in left, c3 in top, c2 in center}
    begin
     if ctt[3] <> ptd[2] then			{ if letters are not identical }
      top[c3r, c2c] := ptd[2];		{ put 2nd pt letter in top square in same row as c3 }
     if p1c <> c1c then
      CombColsL(p1c, c1c);
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
    end;	{ of case 29 }
   30: 	{ found c1in left, p2 and c3 in top, c2 in center: p1r must = c2r  }
    begin
     if ctt[1] <> ptd[1] then			{ if letters are not identical }
      left[c2r, c1c] := ptd[1];			{ put first pt letter in left square in same column as c1 }
     if p2r <> c3r then
      CombRowsT(p2r, c3r);
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{of case 30 }
   31: 	{ found p1 and c1in left, p2 and c3 in top, c2 in center: p1c must = c1c, p2r must = c3r,  }
    begin	{ do least complicated first }
     if p1c <> c1c then
      CombColsL(p1c, c1c);
     if p2r <> c3r then
      CombRowsT(p2r, c3r);
     if p1r <> c2r then
      CombRowsLC(p1r, c2r);
     if p2c <> c2c then
      CombColsTC(p2c, c2c);
    end;	{ of case 31 }
  end;	{ of case }
 end;		{ of procedure ProcTrig }
 
 procedure Push(x: stackentry; var S: stacktype);	{ push stackentry to stack }
 begin
		with S do
			if top = maxstack then
				begin
					writeln(' ERROR: Attempt to push an entry onto a full stack');
					pushflag := true;
				end
			else
				begin
					inc(top);
					entry[top] := x;		{ really means S.entry[S.top] := x }
				end;
 end;	{ of procedure Push }

 procedure Pop(var x: stackentry; var S: stacktype);	{ pop stackentry off stack }
 begin
		with S do
			begin
				if top = 0 then
					begin
						writeln(' ERROR: Attempt to pop an entry from an empty stack');
						popflag := true;
						exit
					end
				else
					begin
						x := entry[top];		{ really means x := S.entry[S.top] }
						dec(top);
					end;
			end;
 end;	{ of procedure Pop }

 procedure SaveSquares;
 var
	SE: stackentry;
 begin
		with SE do
			begin			{ load stackentry }
				ctrs := ctr;
				lefts := left;
				tops := top;
				nextls := nextl;
				nextts := nextt;
			end;
		Push(SE,S);					{ push this stackentry SE onto stack S }
		if pushflag then		{ pushflag raised in push if stack is full }
			begin
				writeln(' Exiting program because stack is full!');
				halt;
			end;
		popflag := false;
 end;		{ of procedure SaveSquares }

 procedure RecallSquares;
 var
	SE: stackentry;
 begin
		Pop(SE,S);
		if popflag then			{ popflag raised in pop if stack is empty }
			begin
				writeln(' No more undos possible');
				write(chr(7));		{ beep }
				exit;
			end;
		pushflag := false;
		with SE do
			begin			{ retrieve stackentry }
				ctr := ctrs;
				left := lefts;
				top := tops;
				nextl := nextls;
				nextt := nextts;
			end;
 end;		{ of procedure RecallSquares }

 procedure ProcTip(str1,str3:string);	{ str1 is Tip1 or Tip2, str3 is 'Tip1' or 'Tip2' }
  var
	 ds, ts: string[255];
   ii, i, j, imax, ltip: integer;
	 mflag: boolean;
 begin
		ltip := length(str1);
		imax := ltip div 2;						{ number of digrams in tip }
		mflag := true;								{ means didn't find match }
		for ii := 1 to np - imax + 1 do	{ number of unique starting positions for the tip to fit }
			begin
				kl := 3 * ii - 2;

{		Initialize sol and squares }

				for i := 1 to 2 * np do
					sol[i] := '.';
				for i := 1 to ns do					{ construct alphabet squares }
					for j := 1 to ns do
						begin
							ctr[i, j] := '.';
							left[i, j] := '.';
							top[i, j] := '.';
						end;
				nextl.row := 1;
				nextl.col := 1;
				nextt.row := 1;
				nextt.col := 1;

{		Process tip: get letters for left, top, and center squares.  First search to see if letter is already there. }

				for i := 1 to imax do
					begin
						ds := copy(str1, 2 * i - 1, 2);			{ get pt digram from tip }
						ts := '';
						for j := 1 to 3 do
							ts := concat(ts, str[j - 1 + kl + 3 * (i - 1)]);
							ProcTrig(ds, ts);
					end;	{ of i loop }
				GetSolution;
				if pos(str1, sol) > 0 then		{ tip survived loading all letters: Test #1 }
					if CheckLeft = false then		{ Didn't find more than 5 in Left: Test #2 }
						if CheckTop = false then	{ Didn't find more than 5 in Top: Test #3 }
							if CheckCtr = false then{ Didn't find more than 5 in Ctr: Test #4 }
								begin
									writeln(' Tip placement for ',str3,' at trigram #', (kl+2) div 3 : 3);
									inc(nm);							{ increment match count }
									match[nm].ct := copy(str,kl,3*imax);	{ store ciphertext string }
									match[nm].tip := str1;		{ store tip string }
									mflag := false;				{ found at least 1 match }
								end;
			end;	{ of ii loop }
		if mflag then
			writeln(' No match found for ',str3);
 end;	{of procecdure ProcTip }

 Procedure Swap;	{ 4 operations: columns in left, rows in top, rows }
 { in left and center, columns in top and center.  Check that next }
 { parameters move if their row or column is involved in the swap! }
 label
		12, 13;
 var
	i, k, r1, r2, c1, c2, S, RC: integer;
	C, D: char;
	temps: array[1..ns] of char;
	tempw: array[1..nw] of char;
 begin
 12:
		write(' ENTER SQUARE [L(LEFT), C(CENTER), T(TOP)], ("-1" to CANCEL): ');
		readln(C);
		if C = '-' then
			exit;							{ go back to main program }
		C := upCase(C);			{ uppercase }
		if not((C ='L') or (C = 'C') or (C = 'T')) then
			begin
				writeln(' BAD SQUARE ENTRY; TRY AGAIN');
				goto 12;
			end;
		S := ord(C) - 64;
 13:
		write(' ENTER R(ROWS) or C(COLUMNS) ("-1" to CANCEL): ');
		readln(D);
		if D = '-' then
			exit;							{ go back to main program }
		D := upCase(D);			{ uppercase }
		if not((D ='R') or (D = 'C')) then
			begin
				writeln(' BAD ROW/COLUMN ENTRY; TRY AGAIN');
				goto 13;
			end;
		RC := ord(D) - 64;
		k := S + RC;				{ index into combinations }
		if k = 23 then
			k := 6;						{ equivalent: top/center, columns }
		if k = 30 then
			k := 21;					{ equivalent: left/center, rows }
		case k of
			6: begin					{ TOP/CENTER, COLUMNS (check nextt.col) }
						write(' ENTER FIRST COLUMN # ("-1" to CANCEL) (count RIGHT from VERTICAL DIVIDER): ');
						readln(c1);		{ need to check for a number }
						if c1 = -1 then
							exit;
						write(' ENTER SECOND COLUMN # ("-1" to CANCEL) (count RIGHT from VERTICAL DIVIDER): ');
						readln(c2);
						if c2 = -1 then
							exit;
						if ((c1 = nextt.col) or (c2 = nextt.col)) then
							begin
								writeln(' Wait until column ',nextt.col,' is populated before swapping!');
								write(chr(7));
								exit;
							end;
						for i := 1 to nw do
							tempw[i] := top[i,c1];			{ buffer top column }
						for i := 1 to ns do
							temps[i] := ctr[i,c1];			{ buffer center column }
						for i := 1 to nw do						{ swap top columns }
							begin
								top[i,c1] := top[i,c2];
								top[i,c2] := tempw[i];
							end;
						for i := 1 to ns do						{ swap center columns }
							begin
								ctr[i,c1] := ctr[i,c2];
								ctr[i,c2] := temps[i];
							end;
				 end;	{ of case k=6 }
		 15: begin					{ LEFT, COLUMNS (check nextl.col) }
						write(' ENTER FIRST COLUMN # ("-1" to CANCEL) (count LEFT from VERTICAL DIVIDER): ');
						readln(c1);
						if c1 = -1 then
							exit;
						write(' ENTER SECOND COLUMN # ("-1" to CANCEL) (count LEFT from VERTICAL DIVIDER): ');
						readln(c2);
						if c2 = -1 then
							exit;
						if ((c1 = nextl.col) or (c2 = nextl.col)) then
							begin
								writeln(' Wait until column ',nextl.col,' is populated before swapping!');
								write(chr(7));
								exit;
							end;
						for i := 1 to ns do
							temps[i] := left[i,c1];			{ save first column in temp }
						for i := 1 to ns do
							begin
								left[i,c1] := left[i,c2];	{ load second }
								left[i,c2] := temps[i];		{ load first }
							end;
		     end;	{ of case k=15 }
		 21: begin					{ LEFT/CENTER, ROWS (check nextl.row) }
						write(' ENTER FIRST ROW # ("-1" to CANCEL) (count DOWN from HORIZONTAL DIVIDER): ');
						readln(r1);
						if r1 = -1 then
							exit;
						write(' ENTER SECOND ROW # ("-1" to CANCEL) (count DOWN from HORIZONTAL DIVIDER): ');
						readln(r2);
						if r2 = -1 then
							exit;
						if ((r1 = nextl.row) or (r2 = nextl.row)) then
							begin
								writeln(' Wait until row ',nextl.row,' is populated before swapping!');
								write(chr(7));
								exit;
							end;
						for i := 1 to nw do
							tempw[i] := left[r1,i];
						for i := 1 to ns do
							temps[i] := ctr[r1,i];
						for i := 1 to nw do						{ swap left rows }
							begin
								left[r1,i] := left[r2,i];
								left[r2,i] := tempw[i];
							end;
						for i := 1 to ns do						{ swap center rows }
							begin
								ctr[r1,i] := ctr[r2,i];
								ctr[r2,i] := temps[i];
							end;
				 end;	{ of case k=21 }
		 38: begin					{ TOP, ROWS (check nextt.row) }
						write(' ENTER FIRST ROW # ("-1" to CANCEL) (count UP from HORIZONTAL DIVIDER): ');
						readln(r1);
						if r1 = -1 then
							exit;
						write(' ENTER SECOND ROW # ("-1" to CANCEL) (count UP from HORIZONTAL DIVIDER): ');
						readln(r2);
						if r2 = -1 then
							exit;
						if ((r1 = nextt.row) or (r2 = nextt.row)) then
							begin
								writeln(' Wait until row ',nextt.row,' is populated before swapping!');
								write(chr(7));
								exit;
							end;
						for i := 1 to ns do
							temps[i] := top[r1,i];			{ save first row in temp }
						for i := 1 to ns do
							begin
								top[r1,i] := top[r2,i];		{ load second }
								top[r2,i] := temps[i];		{ load first }
							end;
				 end;	{ of case k=38 }
		end;	{ of case }
		GetSolution;
		writeln;
		DisplayCipher;
		DrawSquares;
 end;	{ of Procedure Swap }

 Procedure Stop;
 var
	i,j,k,nl: integer;
 begin
		nl := np div (2*nb);				{ number of full lines }
			for k := 1 to nl + 1 do		{ write out solution }
				begin
					write(Outfile,' ');		{ space }
					for j := 1 to 4*nb do
						if j + 4*nb*(k-1) <= 2*np then
							write(Outfile,sol[j + 4*nb*(k-1)]);
					writeln(Outfile);
				end;
		writeln(Outfile);
		writeln(Outfile,' ','LEFT:');
		for i := 1 to nextl.row -1 do
			begin
				write(Outfile,' ');			{ space }
				for j := nextl.col - 1 downto 1 do
					write(Outfile,left[i,j],' ');
				writeln(Outfile);
			end;
		writeln(Outfile);
		writeln(Outfile,' ','TOP:');
		for i := nextt.row - 1 downto 1 do
			begin
				write(Outfile,' ');			{ space }
				for j := 1 to nextt.col - 1 do
					write(Outfile,top[i,j],' ');
				writeln(Outfile);
			end;
		writeln(Outfile);
		writeln(Outfile,' ','CENTER:');
		for i := 1 to nextl.row -1 do
			begin
				write(Outfile,' ');			{ space }
				for j := 1 to nextt.col - 1 do
					write(Outfile,ctr[i,j],' ');
				writeln(Outfile);
			end;
		close(Outfile);
		writeln(' Solution written to text file: ',outstr);	
		write(' Press <Enter>: ');
		readln;
		halt;
 end;	{ of Procedure Stop }

begin
	title := '      TRISQUARE ASSISTANT';
	Writeln(title);
	write(' ENTER THE CON FILE NAME ("-1" to quit): ');
	readln(str1);								{ read in filename }
	if str1 = '-1' then
		halt;
	assign(Infile, str1);				{ open Infile with title str1 }
	{$I-}
	reset(Infile);
	{$I+}
	if IOResult <> 0 then
		begin
			writeln(' Error opening file ',str1);
			write(' Press <Enter>: ');
			readln;
			halt;
		end;
	insert('sol',str1,pos('.txt',str1));	{ insert 'sol' before '.txt' in str1 }
	outstr := str1;
	assign(Outfile, outstr);				
	rewrite(Outfile);						{ open output file }
	len := 0;
	readln(Infile,str);
	for i := 1 to 600 do
		if ord(str[i]) > 64 then
			inc(len);
	readln(Infile,tip);
	tip := upperc(tip);
	lt := length(tip);					{ length of tip }
	np := len div 3;						{ number of trigrams in con }
	nm := 0;										{ number of matches found }
	writeln(' Length=', len : 3, ' , Number of trigrams = ', np : 3);
	writeln(' Tip=', tip, ', Length of tip=', lt : 2);
	manflag := false;						{ tip will be entered by matching }
	pushflag := false;					{ error on push flag }
	popflag := false;						{ error on pop flag }
	S.top := 0;									{ initialize saving stack }
  
{		Process Tip }

	if lt mod 2 > 0 then
		begin
			tip1 := copy(tip, 1, lt - 1);		{ get even-numbered tip length starting with position 1 }
			tip2 := copy(tip, 2, lt - 1);		{ get even-numbered tip length starting with position 2 }
		end
	else
		begin
			tip1 := tip;										{ get even-numbered tip length starting with position 1 }
			tip2 := copy(tip, 2, lt - 2);		{ get even numbered tip - 2 length starting with position 2 }
		end;
	lt1 := length(tip1);
	lt2 := length(tip2);
	len1 := lt1 div 2;		{ half-length of tip1 and number of digrams }
	len2 := lt2 div 2;		{ half-length of tip2 }
	write(' Tip1= ');
	for i := 1 to len1 do
		write(tip1[2 * i - 1], tip1[2 * i], ' ');	{ write out tip1 as digrams }
	writeln('  Length=', lt1 : 2);
	write(' Tip2= ');
	for i := 1 to len2 do
		write(tip2[2 * i - 1], tip2[2 * i], ' ');	{ write out tip2 }
	writeln('  Length=', lt2 : 2);
	ProcTip(Tip1,'Tip1');	{ keeps track of nm, # of matches }
	ProcTip(Tip2,'Tip2');	{ keeps track of nm, # of matches }
	if nm > 1 then
		begin
			writeln(' ',nm:3,' matches found');	{ will have to enter tip manually }
			manflag := true;								{ tip point to be entered manually }
15:
			write(' ENTER FORM OF TIP; Tip1 or Tip2: ');
			readln(str3);
			str3 := upperc(str3);		{ get uppercase }
			if str3 = 'TIP1' then
				str1 := Tip1					{ tip letters }
			else if str3 = 'TIP2' then
				str1 := Tip2
			else
				begin
					writeln(' TIP TITLE ENTERED IN ERROR');
					goto 15;						{ try again }
				end;
			str2 := str1;						{ strings the same length }
			write(' ENTER TIP AT TRIGRAM #: ');
			readln(kl);
			str2 := copy(str,3*kl-2,3*length(str1) div 2);	{ grab ct }
			
{		Now have str1 and str2 needed to process tip letters }

		end;
	writeln;
	
{		Process tip at match point, populate squares }
	
	for i := 1 to 2 * np do			{	initialize sol for solution }
		sol[i] := '.';
	for i := 1 to ns do					{ construct alphabet squares }
		for j := 1 to ns do
			begin
				ctr[i, j] := '.';
				left[i, j] := '.';
				top[i, j] := '.';
			end;
	nextl.row := 1;
	nextl.col := 1;
	nextt.row := 1;
	nextt.col := 1;
	if not manflag then
		begin
			str1 := match[1].tip;				{ tip form from match }
			str2 := match[1].ct;				{ ciphertext from match }
		end;
	kmax := length(str1) div 2;			{ number of digrams }
	for i := 1 to kmax do
		begin
			dig := copy(str1,2*i-1,2);	{ get tip digram }
			trig := copy(str2,3*i-2,3);	{ get matching ct trigram }
			ProcTrig(dig,trig);
		end;
	GetSolution;

	repeat
		DisplayCipher;
		DrawSquares;
12:
		write(' ENTER PLAINTEXT DIGRAM ("-1" to QUIT,"0" to UNDO,"1" to SWAP ROWS/COLUMNS): ');
		readln(dig);
		if dig = '-1' then
				stop;								{ stop is procedure defined above }
		if dig = '0' then
			begin
				RecallSquares;
				goto 14;
			end;
		if dig = '1' then
			begin
				SaveSquares;
				Swap;
				goto 12;		{ after finishing swap }
			end;
		if (length(dig) <> 2) or (ord(dig[1]) < 65) or (ord(dig[2]) < 65) then
			begin
				write(chr(7));
				goto 12;		{ try again }
			end;
		dig := upperc(dig);
		SaveSquares;	{ if you get here, save current squares before modifying with new input }
13:
		write(' ENTER ASSOCIATED CIPHERTEXT TRIGRAM ("-1" to QUIT): ');
		readln(trig);
		if trig = '-1' then
			stop;									{ stop is procedure defined above }
		if length(trig) <> 3 then
			begin
				write(chr(7));
				goto 13;		{ try again }
			end;
		trig := upperc(trig);
		ProcTrig(dig, trig);
14:
		if((CheckLeft = false) and (CheckTop = false) and (CheckCtr = false)) then	{ Didn't find more than 5 in a column/row }
			GetSolution
		else
			begin
				writeln(' BAD ENTRY; TRY AGAIN');
				RecallSquares;
				write(chr(7));		{ beep }
				write(chr(7));		{ beep }
			end;
		writeln;
	until 2 = 25;						{ do forever }
end.