program enigma (enigmawheels, infile, outfile, input, output);

{*******************************************************************************
  Enigma Encryption Variant Version 2.3:

    This program impliments the German Enigma encryption methods, with a slight
    variation. This program does _not_ perform a substitution on the text
    before or after the Enigma Wheels are implimented, as this may be done
    easily using the other substitution programs.
    
    The original Enigma provided 3 wheels which had the numbers 1..26 on them.
    Each time the first wheel completes a revolution, the next wheels moves
    round one place . . .
    
    This program allows the user to set up 4 wheels (the last one is only useful
    on _very_ long documents) where the numbers on the wheels are in any order
    and may be repeated.
    
    The file "enigmawheels" contains the 4 wheels. This file should contain
    104 integers.
    
    The file "infile" contains the text to be operated on, and the file
    "outfile" contains the translated text.
     
    The user may set HTML to be TRUE, in which case all text between < & > is
    not changed.
								      
    Written by Stuart Prescott      20/04/96                   
    Last modified                   14/05/96

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

{*******************************************************************************
    Required includes:                                             
	lowercase.i             (returns lowercase value of char)
	
	isletter.i              (returns TRUE if char is a letter)
	
	IgnoreHTML.i            (Asks whether to ignore HTML tags)
	
	HTMLSkip.i              (Skips over chars from < to >)

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

const
    MAXWheellength  = 25;
    NUMWheels       = 4;

    DEBUGDEcode         = FALSE;
    DEBUGRotateLetter   = FALSE;
    DEBUGGetWheels      = FALSE;
    DEBUGAdvanceWheels  = FALSE;
    DEBUGCalculateRotor = FALSE;


type 
    wheeltype           = array [ 1..NUMWheels, 0..MAXWheellength ]
			  of integer;
			  
    wheelpositiontype   = array [ 1..NUMWheels ] 
			  of 0..MAXWheellength;

    methodChoiceType    = -1..1;
		
var
    DorE                        {-1 or 1 according to Decode/ Encode}
		: methodChoiceType;

    html                        {ignore text between < & > if TRUE}
		: boolean;
    
    wheels                      {the numbers on each wheel}
		: wheeltype;

    pos                         {the positions of each wheel} 
		: wheelpositiontype;

    enigmawheels,               {file containg the wheels}
    infile,                     {file containing the text}
    outfile                     {file containing the output}
		: text;
	 
{******************************************************************************}

#include 'isletter.i'
#include 'lowercase.i'
#include 'IgnoreHTML.i'
#include 'HTMLSkip.i'

{******************************************************************************}
function DEcode : methodChoiceType;

    {***************         
    This function asks the user whether the text is to be encoded
    or decode. The function then returns the integer 1 if the choice was
    to encode and -1 if the choice was to decode. This returned parameter
    is later used as part of the coding algorithm to determine whether
    to add or subtract the rotor value
    ***************}
    
    var
	ch
		    : char;
		    
	choice
		    : methodChoiceType;
	
    { P: TRUE}      
    begin
	repeat
	    writeln (' (1) Encode');
	    writeln (' (2) Decode');
	    writeln;
	    write   ('Enter choice: ');
	    readln(ch);
	until (ch in ['1', '2']);

	if ch = '1' then begin
	    choice :=  1;
	end
	else begin
	    choice := -1;
	end;
	if DEBUGDEcode then
	    writeln('DorE =',choice :3);
	
	assert (
		((choice = -1) and (ch = '2')) or
		((choice =  1) and (ch = '1'))
	       );
	
	DEcode := choice;
    end;
    { R: returns 1 or -1 according to the encodeing/decoding wish}
    
{******************************************************************************}
procedure InitAll
    (
    var wheels      : wheeltype;
    var pos         : wheelpositiontype
    ); 

    var
	c,                      {dummy counter}
	d
		    : integer;
		   
    
    { P: TRUE}
    begin
	for c := 0 to MAXWheellength do begin
	    for d := 1 to NUMWheels do begin
		wheels[d, c]:=0;
	    end;
	end;

	for c:=1 to 4 do begin
	    pos[c] := 25;
	end;
	
	reset(enigmawheels);
	reset (infile);
	rewrite (outfile);
    end;                {procedure InitAll}
    { R: wheels [d,c]=0 and files appropriately set}

{******************************************************************************}
procedure GetWheel
    (
    var wheels      : wheeltype
    );
    
    var 
	count,                      {count of rotation values entered}
	c                           {dummy counter}
		    : integer;          

    { P: enigmawheels contains at least NUMWheels*(MAXWheellength+1) integers}
    begin
	count := -1;
	c     :=  0;

	while ((not eof(enigmawheels)) and
	  (count <= MAXWheellength) and (c <= NUMWheels)) do begin

	    if eoln( enigmawheels ) then begin
		readln( enigmawheels );
	    end
	    else begin
		count := (count + 1) mod (MAXWheellength + 1);
		if count = 0 then begin
		    c := c + 1;
		end;
		if c <= NUMWheels then begin
		    read( enigmawheels, wheels[c, count] );
		    if DEBUGGetWheels then begin
			write( wheels[c, count] :3 );
		    end;
		end;
	    end;       {if eoln}

	end;    {while} 

	if DEBUGGetWheels then begin
	    writeln;
	    for c := 1 to NUMWheels do begin
		for count := 1 to MAXWheellength do begin
		    write( wheels[c, count] :3 );
		end;
	    end;
	end;    {if DEBUG}

    end;                {procedure GetWheel}
    { R: wheels[c,d] contain the enigmawheels}

{******************************************************************************}
procedure AdvanceWheels
    (
    var pos         : wheelpositiontype
    );

    var
	c,                           {dummy counter}
	d
		    : integer;
	advance                      {advances a wheel when true}
		    : boolean;

    { P: wheels[c] are the enigma wheels and are in positions pos[c]}
    begin
	for c := NUMWheels downto 1 do begin
	    advance := TRUE;
	    for d := (c-1) downto 1 do begin
		if not(advance and (pos[d] = MAXWheellength)) then begin
		    if DEBUGAdvanceWheels then                    
			write( not(advance and (pos[d] = MAXWheellength)) );
		    advance := FALSE;
		end;
	    end;
	    if advance then begin
		pos[c] := (pos[c] + 1) mod (MAXWheellength + 1)
	    end;
	end;
	if DEBUGAdvanceWheels then begin
	    for c := 1 to NUMWheels do begin
		write( pos[1]:3 );
	    end;
	    writeln;
	end;

    end;        {procedure AdvanceWheels}
    { R: the positions of the wheels have been advanced}

{******************************************************************************}
function CalculateRotor
    (
    wheels          : wheeltype;
    pos             : wheelpositiontype
    )
    : integer;

    var
	c,                          {dummy counter}
	rotor                       {temp storage for rotor value}
		    : integer;

    { P: wheels[c] contain the encryption wheels at positions pos[c]}
    begin
	rotor := 0;

	for c := 1 to NUMWheels do begin
	    rotor := rotor + wheels[ c,pos[c] ];
	    if DEBUGCalculateRotor then begin
		writeln(pos[c], wheels[ c,pos[c] ], rotor);
	    end;
	end;

	CalculateRotor := rotor;

    end;        {function CalculateRotor}
    { R: the next rotation is returned}

{******************************************************************************}
function RotateLetter 
    (
    letter          : char;
    rotor           : integer;
    DorE            : methodChoiceType
    )
    : char;

    var
	cti                         {CipherText Integer ie ASCII value}
		    : integer;
		    
	ch                          {temp character storage}
		    : char;

    { P: letter is the letter to be encrypted}
    begin
	letter:= lowercase(letter);

	cti:= ord(letter) + ((rotor) mod 26) * DorE;
	if cti < (ord ('a')) then cti := cti + 26;
	if cti > (ord ('z')) then cti := cti - 26;

	ch := chr(cti);

	assert(ch in ['a'..'z']);

	if DEBUGRotateLetter then begin
	    writeln( letter, (rotor*DorE) :3, ch :2 );
	end;

	RotateLetter := ch;

    end;        {function RotateLetter}
    { R: returns the encoded letter}


{******************************************************************************}
procedure EncodeFile
    (
    wheels          : wheeltype;
    pos             : wheelpositiontype;
    html            : boolean;
    DorE            : methodChoiceType
    );

    var 
	rotation                    {total rotation}
		    :integer;

	pt,                         {plaintext character}
	ct                          {ciphertext character}
		    : char; 

    begin
	rotation:=0;    

	while not eof(infile) do begin
	    if eoln(infile) then begin
		readln(infile);
		writeln(outfile);
	    end
	    else begin

		read(infile, pt);
		if isletter(pt) then begin

		    AdvanceWheels(pos);
		    rotation := CalculateRotor(wheels, pos);

		    ct := RotateLetter(pt, rotation, DorE);
		    write( outfile, ct );

		    assert ( ct in ['a'..'z'] );

		end
		else begin
		    write(outfile, pt);

		    if ((pt = '<') and html) then begin
			HTMLSkip;
		    end;
		end; {if isletter}

	    end; {if eoln}
       end; {while not eof(infile)}
    end;                {procedure EncodeFile}
    { R: the entire file has been translated}

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

    DorE := DEcode;
    html := IgnoreHTML;
    
    InitAll    (wheels, pos);

    GetWheel   (wheels);

    EncodeFile (wheels, pos, html, DorE)

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