Another Silly programming puzzle....

Doug Reeder reeder at reed.UUCP
Thu Apr 6 19:59:37 AEST 1989


program decode(input, output, code, plain);
{decode cypher}

const
  NumTestLines = 10;

type
  lowercase = 'a' ..'z';

var
  coding : array[lowercase] of lowercase;
  LetterSet, LowerCaseSet : set of char;
  code, plain : text;
  print : boolean;

function lookup(c : char) : char;
begin
  if c in LetterSet then begin
    if c in LowerCaseSet then
      lookup := coding[c]
    else
      lookup := coding[chr(ord(c)+32)];
  end
  else
    lookup := c;
end;

procedure WriteCoding(var tf : text);
var ch : char;
begin
  writeln(tf);
  for ch := 'a' to 'z' do write(tf,ch);
  writeln(tf);
  for ch := 'a' to 'z' do write(tf,coding[ch]);
  writeln(tf);
end;

procedure TryRotations(var print : boolean);
var
  ch,response : char;
  rotation,lines : integer;
  continue : boolean;
begin
  rotation := 1;
  print := false;
  continue := true;
  repeat
    for ch := 'a' to 'z' do 
      coding[ch] := chr(((ord(ch)-ord('a') + rotation) mod 26) + ord('a'));
    lines :=0;
    reset(code);
    page(output);
    repeat
      if eoln(code) then begin
        writeln;
        lines := lines + 1;
      end
      else
        write(lookup(code^));
      get(code);
    until (lines = NumTestLines)or eof(code);
    write('Okay?  [y,n,q] '); readln(response);
    if response = 'y' then begin
      continue := false;
      print := true;
      WriteCoding(output);
    end;
    if response = 'q' then begin continue := false; print := false; end;
    rotation := rotation +1;
  until (continue = false) or (rotation = 26);
end;

procedure PrintOut;
begin
    reset(code);
    rewrite(plain);
    repeat
      if eoln(code) then 
        writeln(plain)
      else
        write(plain,lookup(code^));
      get(code);
    until eof(code);
end;


procedure setup;
begin
  LetterSet := ['a'..'z','A'..'Z'];
  LowerCaseSet := ['a'..'z'];
end;

begin {decode}
  setup;
  TryRotations(print);
  if print then PrintOut;
end.


    
-- 
Doug Reeder                         USENET: ...!tektronix!reed!reeder
Institute of Knowledge              BITNET: reeder at reed.BITNET
Jinx                             from ARPA: tektronix!reed!reeder at berkeley.EDU
reeder at knowledge.JINX               Box 971 Reed College,Portland,OR 97202



More information about the Comp.lang.c mailing list