program substitution (substtable, infile, outfile, input, output);

{*******************************************************************************
    Monoalphabetic Subsitution Version 2.3

    This program replaces every letter in a given file "infile"  with a
    character listed as the equivalent in the file "substtable".
    This is refered to as applying a substitution table.
    
    Both encryption and decryption may be performed using the one 
    substitution table by selecting the relevant menu option. (eg if a
    file was encrypted using wheel1, it may be decrypted using the same
    substitution table and the wheel2 option.

    This Program reads in a file "infile", applies a letter               
    substitution table (read in from file "substtable") to that  
    text, and then directs the translated output to a file       
    "outfile".
							 
    Comments may be put in "substtable" by enclosing them in     
    braces. Comments may not be nested.                  

    If the substitution for a particular letter is not known a ? may be
    placed in the "substtable" file. The program will then allocate a letter
    as a substitution. This letter will be displayed and substituted 
    in UPPER CASE.
								      
    The user may instruct the program to not apply the substitution table 
    to all text between < & >. This is used for the encryption of HTML
    documents where the HTML tags are enclosed in < & >. The use of this
    option with non-HTML documents may lead to large sections of text
    not being encrypted.

    Written by Stuart Prescott      06/04/96
    Last Modified:                  20/05/96

    Copyright (c) MCMXCVI, Stuart Prescott                  
*******************************************************************************}

{*******************************************************************************
    Required includes:                                             
	lowercase.i             (returns lowercase value of char)  
	
	uppercase.i             (returns uppercase value of char)  
   
	isletter.i              (returns TRUE if char is a letter)
	
	GetSubsttable.i         (reads in the Table from "substtable")

	IgnoreHTML.i            (Asks whether to ignore HTML tags)

	HTMLSkip.i              (Skips over chars up to next >)

*******************************************************************************}

const
    DEBUGgetcommand    = FALSE;
    DEBUGWorkOutWheels = FALSE;
    DEBUGSubstitute    = FALSE;
    DEBUGmain          = FALSE;


type
    alphabet    = array [ 'a'..'z' ]
		  of char;		{for holding the substitution alphabets}

    charType    = 'a'..'z';
    charSetType = set of charType;

var
    wheel1,				{used to hold the the substtable }
    wheel2				{used to hold the inverse function}
		: alphabet;

    command				{holds user's command}
		: char;

    html,				{TRUE if HTML tags are to be left}
    goodtable				{TRUE if substtable if error-free}
		: boolean;

    substtable, 
    infile, 
    outfile
		: text;

{*******************************************************************************
    Choice of Data Structures:
    
    The alphabet type stores the entire substitution table in an array that
    allows the substitution to be directly addressed. eg: the substitution for
    the letter ch1 is:
	    codewheel[ch1]

    The sets of lowercase letters (a..z) allow the checking of the  contents of
    each of the substitution arrays for their correctness.
*******************************************************************************}

{******************************************************************************}
#include 'lowercase.i'
#include 'uppercase.i'
#include 'isletter.i'

#include 'GetSubsttable.i'
#include 'IgnoreHTML.i'
#include 'HTMLSkip.i'
{******************************************************************************}

function getcommand 
    : char;
    
    {************
    finds out the user's wish as to which substtable to use
    ************}

    var 
	command					{holds the user's command}
	        : char;
    
    { P: TRUE}
    begin
	repeat
	    writeln;
	    writeln ('Enter command: Wheel(1), Wheel(2), or (q)uit.> ');
	    readln (command);
	    command := lowercase(command);
	    if DEBUGgetcommand then begin
		writeln ( 'command= ', command);
	    end;
	    if not (command in [ '1', '2', 'q' ]) then begin
		writeln ('Correct reponses are: 1 2 q ')
	    end;
	until (command in [ '1', '2', 'q' ]);

	getcommand :=command;

    end;        {func getcommand}
    { R: returns 1, 2, or q, according to the user's wish}

{******************************************************************************}
procedure WorkOutWheels
    (
    encode              : alphabet;
    var decode          : alphabet
    );

    {**************
    Calculates the inverse function for the given substtable
    **************}

    var
	ch
			: char;

    { P: encode contains the substitution table}
    begin
	for ch := 'a' to 'z' do begin
	    {writeln (encode[ch], uppercase(encode[ch]));}
	    if (encode[ch] = uppercase(encode[ch])) then begin
		decode[lowercase(encode[ch])] := uppercase(ch);
	    end
	    else begin
		decode[encode[ch]] := ch;
	    end;
	    if DEBUGWorkOutWheels then begin
		writeln (ch, encode[ch]);
	    end;
	    assert ( isletter(encode[ch]) );
	    assert ( isletter(decode[lowercase(encode[ch])]) );
	end;
    end;    {procedure WorkOutWheels}
    { R: decode contains the mirror image of the substitution table}
    
{******************************************************************************}
procedure printsubsttable
    (
    encode,
    decode              : alphabet
    );

    {**************
    writes out substtable for the user to choose from
    **************}

    var
	ch
			: char;
    
    { P: encode and decode contain the en- & de- coding substitution tables}
    begin
	writeln;
	
	{write out the input text}
	write ('input text: ');
	for ch:='a' to 'z' do
	    write (ch, ' ');
	writeln;
	
	write ('wheel1:     ');
	for ch:='a' to 'z' do
	    write (encode[ch], ' ');
	writeln;
	
	write ('wheel2:     ');
	for ch:= 'a' to 'z' do
	    write (decode[ch], ' ');
	writeln;
    
    end;        {proc printsubsttable}
    { R: the substitution tables are written to the std output}

{******************************************************************************}
function code 
    (
    ch                  : char; 
    cipher              : alphabet
    )
    : char;

    { P: ch is a letter to be translated}
    begin
	ch := cipher[ lowercase(ch) ];		    {find the equivalent letter}
	
	assert ( isletter(ch) );

	code := ch;
    end;        {func code}
    { R: returns the substitution of ch}

{******************************************************************************}
procedure Substitute
    (
    codewheel           : alphabet;
    SkipHTML            : boolean
    );

    var
	ch
			: char;

    { P: codewheel contains the substitution table to be applied }
    begin
	
	{make sure the user has sufficient info about process}
	writeln ( 'Creating output file: "outfile" . . .' );
	rewrite (outfile);
	writeln ( 'Preparing input file: "infile" . . .' );
	reset (infile);

	writeln;
	write ( 'Performing Translation . . .' );

	while not eof(infile) do begin
	    if eoln(infile) then begin
		readln (infile );		    {handle eoln correctly}
		writeln(outfile);
		if DEBUGSubstitute then begin
		    writeln;
		end;
	    end
	    else begin
		read (infile, ch);
		if isletter(ch) then begin  
		    ch := code(ch, codewheel);	    {encrypt letters}
		    write (outfile, ch);
		    if DEBUGSubstitute then begin
			write (ch);
		    end;
		end
		else begin
		    write (outfile, ch);	    {pass non-letters}
		    if ((ch = '<') and SkipHTML) then begin
			if DEBUGSubstitute then begin
			    writeln ('HTML=START');
			end;
			HTMLSkip;		    {HTML skipping . . .}
			if DEBUGSubstitute then begin
			    writeln ('HTML=END');
			end;
		    end;
		end;  {if isletter}
	    end;    {if eoln}
	end;    {while}

	writeln (' Translation complete!');

    end;	{procedure Substitute}
    { R: outfile contains the translated text}

{******************************************************************************}
{******************************************************************************}
begin   {main}

    goodtable := TRUE;
    GetSubsttable(wheel1, goodtable);           	{wheel1 variable}

    if DEBUGmain then begin
	writeln ('goodtable = ', goodtable);
    end;

    if goodtable then begin

	WorkOutWheels(wheel1, wheel2);          	{wheel2 variable}
	printsubsttable(wheel1, wheel2);

	command := getcommand;
    
	if command = '1' then begin
	    html := IgnoreHTML;
	    Substitute (wheel1, html);
	end
	else if command = '2' then begin
	    html := IgnoreHTML;
	    Substitute (wheel2, html);
	end;

    end;


end.    {main}
{******************************************************************************}
{******************************************************************************}