Xref: utzoo comp.lang.c:17462 comp.sys.amiga.tech:4520 comp.lang.modula2:1403 comp.lang.pascal:1676 rec.humor:20467
Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!sharkey!shadooby!accuvax.nwu.edu!tank!ncar!unmvax!tut.cis.ohio-state.edu!bloom-beacon!mit-eddie!uw-beaver!blake!ogccse!littlei!reed!reeder
From: reeder@reed.UUCP (Doug Reeder)
Newsgroups: comp.lang.c,comp.sys.amiga.tech,comp.lang.modula2,comp.lang.pascal,rec.humor
Subject: Re: Another Silly programming puzzle....
Keywords: contest silly
Message-ID: <12320@reed.UUCP>
Date: 6 Apr 89 09:59:37 GMT
References: <1210@microsoft.UUCP>
Reply-To: reeder@reed.UUCP (Doug Reeder)
Organization: Reed College, Portland OR
Lines: 105

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@reed.BITNET
Jinx                             from ARPA: tektronix!reed!reeder@berkeley.EDU
reeder@knowledge.JINX               Box 971 Reed College,Portland,OR 97202