{ The Computer Language Benchmarks Game

https://salsa.debian.org/benchmarksgame-team/benchmarksgame/

contributed by Marco van de Voort

}

program reverse_complement;

var lookupComplement : array[#0..#255] of char;

Const FASTAXLAT : array[0..11] of array[0..1] of char = (

( 'A', 'T' ), ( 'C', 'G' ),

( 'B', 'V' ), ( 'D', 'H' ),

( 'K', 'M' ), ( 'R', 'Y' ),

( 'a', 't' ), ( 'c', 'g' ),

( 'b', 'v' ), ( 'd', 'h' ),

( 'k', 'm' ), ( 'r', 'y' ));

BufferIncrement = 1024;

procedure flushbuffer(buffer:pchar;inbuf:longint);

var p,p2 : pchar;

c : char;

begin

if inbuf>0 then

begin

p:=buffer;

p2:=@buffer[inbuf-1];

while p<p2 do

begin

c:=lookupcomplement[p^];

p^:=lookupcomplement[p2^];

p2^:=c;

inc(p);

dec(p2);

end;

if p2=p then

p^:=lookupcomplement[p^];

p:=buffer;

p[inbuf]:=#0;

while (inbuf > 60) do

begin

c := p[60];

p[60]:=#0;

writeln(p);

p[60]:=c;

inc(p,60);

dec(inbuf,60);

end;

p[inbuf]:=#0;

writeln(p);

end;

end;

const initialincrement=1024;

procedure run;

var s : string;

c : char;

buffersize,

bufferptr,

len : longint;

p :pchar;

line : integer;

bufin,bufout : array[0..8191] of char;

begin

settextbuf(input,bufin);

settextbuf(output,bufout);

for c:=#0 to #255 do

lookupcomplement[c]:=c;

for len:=0 to high(FASTAXLAT) do

begin

lookupcomplement[FASTAXLAT[len][0]]:=upcase(FASTAXLAT[len][1]);

lookupcomplement[FASTAXLAT[len][1]]:=upcase(FASTAXLAT[len][0]);

end;

buffersize:=initialincrement;

bufferptr :=0;

getmem(p,buffersize);

line:=0;

while not eof do

begin

readln(s);

inc(line);

len:=length(s);

if (len>0) and (s[1]='>') then

begin

flushbuffer(p,bufferptr);

writeln(s);

bufferptr:=0;

end

else

begin

if (bufferptr+len+1)>buffersize then

begin

inc(buffersize,buffersize);

// inc(buffersize,initialincrement);

reallocmem(p,buffersize);

end;

move (s[1],p[bufferptr],len);

inc(bufferptr,len);

end;

end;

flushbuffer(p,bufferptr);

end;

begin

run;