(*
This code was written by Dimitri Vulis and placed into public domain.
There is no copyright associated with this code. Use it as you wish.
*)
{$C-} {$K-} {$B-} {Options}
const
         CYR_A=176;          {0}
         CYR_ya=239;         {o}
         uppertot=182;
         BUFFERSIZE=16767;
type
         bufferptr=0..BUFFERSIZE;
var
         upper:array[0..222] of byte; { values }
         uppers:array[0..64] of byte; { start }
         upperm:array[0..63] of boolean; {multi-letter}
         upperu:byte; { used pointer }
         infile,outfile:file;
         inbuf,outbuf:array[0..BUFFERSIZE] of byte;
         inbufptr,outbufptr,inbuflen:integer;
         c,i,xbyte:byte;

{We buffer I/O because otherwise it's agonizingly slow}
function getbyte:boolean; {true if read xbyte, false if end of file}
begin
getbyte:=true;
if inbufptr>=inbuflen then begin
         blockread(infile, inbuf, BUFFERSIZE+1, inbuflen);
         if inbuflen=0 then
                   getbyte:=false;
         inbufptr:=0;
         end;
xbyte:=inbuf[inbufptr];
inbufptr:=inbufptr+1;
end;

procedure putbyte;
begin
outbuf[outbufptr]:=xbyte;
if outbufptr=BUFFERSIZE then begin
         blockwrite(outfile, outbuf, BUFFERSIZE+1);
         outbufptr:=0;
         end
else
         outbufptr:=outbufptr+1;
end;

procedure closefiles;
begin
close(infile);
if outbufptr>0 then
         blockwrite(outfile, outbuf, outbufptr);
close(outfile);
end;

{Standard PASCAL does not allow statically initialized arrays}
procedure add1(u1:char);
begin
upperm[c]:=false;
uppers[c]:=upperu;
upper[upperu]:=ord(u1);
upperu:=upperu+1;
c:=c+1;
end;

procedure add5(u1,u2,u3,u4,u5:char);
begin
upperm[c]:=true;
uppers[c]:=upperu;
upper[upperu]:=ord(u1);
upper[upperu+1]:=ord(u2);
upper[upperu+2]:=ord(u3);
upper[upperu+3]:=ord(u4);
upper[upperu+4]:=ord(u5);
upperu:=upperu+5;
c:=c+1;
end;

procedure add7(u1,u2,u3,u4,u5,u6,u7:char);
begin
upperm[c]:=true;
uppers[c]:=upperu;
upper[upperu]:=ord(u1);
upper[upperu+1]:=ord(u2);
upper[upperu+2]:=ord(u3);
upper[upperu+3]:=ord(u4);
upper[upperu+4]:=ord(u5);
upper[upperu+5]:=ord(u6);
upper[upperu+6]:=ord(u7);
upperu:=upperu+7;
c:=c+1;
end;

procedure add9(u1,u2,u3,u4,u5,u6,u7,u8,u9:char);
begin
upperm[c]:=true;
uppers[c]:=upperu;
upper[upperu]:=ord(u1);
upper[upperu+1]:=ord(u2);
upper[upperu+2]:=ord(u3);
upper[upperu+3]:=ord(u4);
upper[upperu+4]:=ord(u5);
upper[upperu+5]:=ord(u6);
upper[upperu+6]:=ord(u7);
upper[upperu+7]:=ord(u8);
upper[upperu+8]:=ord(u9);
upperu:=upperu+9;
c:=c+1;
end;

procedure add10(u1,u2,u3,u4,u5,u6,u7,u8,u9,u10:char);
begin
upperm[c]:=true;
uppers[c]:=upperu;
upper[upperu]:=ord(u1);
upper[upperu+1]:=ord(u2);
upper[upperu+2]:=ord(u3);
upper[upperu+3]:=ord(u4);
upper[upperu+4]:=ord(u5);
upper[upperu+5]:=ord(u6);
upper[upperu+6]:=ord(u7);
upper[upperu+7]:=ord(u8);
upper[upperu+8]:=ord(u9);
upper[upperu+9]:=ord(u10);
upperu:=upperu+10;
c:=c+1;
end;

procedure initialize;
begin
{We add the being/end group characters to suppress all ligatures. }
{We could get rid of most of these if we delete the ligtable }
upperu:=0;
c:=0;
add1('A');                   {0}
add1('B');                   {1}
add1('V');                   {2}
add1('G');                   {3}
add1('D');                   {4}
add1('E');                   {5}
add5('{','\','Z','h','}');   {6}
add1('Z');                   {7}
add1('I');                   {8}
add5('{','\','U','i','}');   {9}
add1('K');                   {:}
add1('L');                   {;}
add1('M');                   {<}
add1('N');                   {=}
add1('O');                   {>}
add1('P');                   {?}
add1('R');                   {@}
add1('S');                   {A}
add1('T');                   {B}
add1('U');                   {C}
add1('F');                   {D}
add5('{','\','K','h','}');   {E}
add5('{','\','T','s','}');   {F}
add5('{','\','C','h','}');   {G}
add5('{','\','S','h','}');   {H}
add7('{','\','S','h','c','h','}');     {I}
add10('{','\','c','D','p','r','i','m','e','}');  {J}
add1('Y');                   {K}
add9('{','\','c','P','r','i','m','e','}');       {L}
add5('{','\','E','e','}');   {M}
add5('{','\','Y','u','}');   {N}
add5('{','\','Y','a','}');   {O}
add1('a');                   {P}
add1('b');                   {Q}
add1('v');                   {R}
add1('g');                   {S}
add1('d');                   {T}
add1('e');                   {U}
add5('{','\','z','h','}');   {V}
add1('z');                   {W}
add1('i');                   {X}
add5('{','\','u','i','}');   {Y}
add1('k');                   {Z}
add1('l');                   {[}
add1('m');                   {\}
add1('n');                   {]}
add1('o');                   {^}
add1('p');                   {_}
add1('r');                   {`}
add1('s');                   {a}
add1('t');                   {b}
add1('u');                   {c}
add1('f');                   {d}
add5('{','\','k','h','}');   {e}
add5('{','\','t','s','}');   {f}
add5('{','\','c','h','}');   {g}
add5('{','\','s','h','}');   {h}
add7('{','\','s','h','c','h','}');     {i}
add10('{','\','c','d','p','r','i','m','e','}');  {j}
add1('y');                   {k}
add9('{','\','c','p','r','i','m','e','}');       {l}
add5('{','\','e','e','}');   {m}
add5('{','\','y','u','}');   {n}
add5('{','\','y','a','}');   {o}
uppers[c]:=upperu;

if upperu<>uppertot then
         writeln('Warning: upperu=',upperu:1,' uppertot=',uppertot:1);
end {initialize};

procedure openfiles;
var
         filename: packed array[0..60] of char;
begin
repeat
         write('Input file: ');
         readln(filename);
         assign(infile,filename);
         {$I-} reset(infile,1); {$I+}
until ioresult=0;
repeat
         write('Output file: ');
         readln(filename);
         assign(outfile,filename);
         {$I-} rewrite(outfile,1); {$I+}
until ioresult=0;

inbufptr:=1;
inbuflen:=0;
outbufptr:=0;
end {openfiles};

begin {main}

initialize;
{
for c:=0 to 63 do begin
 if upperm[c] then
 for i:=uppers[c] to uppers[c+1]-1 do write(chr(upper[i]))
 else write(upper[uppers[c]]);
 writeln;
end;
}
openfiles;

while getbyte do begin
if (xbyte>=CYR_A) and (xbyte<=CYR_ya) then begin
         c:=xbyte-CYR_A;
         if upperm[c] then begin
            for i:=uppers[c] to uppers[c+1]-1 do
                      begin
                      xbyte:=upper[i];
                      putbyte;
                      end
             end
         else begin
             xbyte:=upper[uppers[c]];
             putbyte;
             end
         end
else
         putbyte;
end;
closefiles;
end.