нарисовать блок схему

Program fgyr;
uses crt;
var g,f:text;
isxs:string;
i,p,kolvopr,func:integer;
slova:array [1..100] of string;
znaki_prepin:set of char;
 
 
procedure rec_in_massiv(s:string);
var vr_slovo:string;
    i,p,iforsl:integer;
begin
iforsl:=0;
for i:=1 to length(s) do begin
p:=pos(' ',s);
if p>0 then begin vr_slovo:=copy(s,1,p-1);
inc(iforsl);
if vr_slovo[length(vr_slovo)] in znaki_prepin then
begin
slova[iforsl]:=copy(vr_slovo,1,length(vr_slovo)-1); inc(iforsl);
slova[iforsl]:=vr_slovo[length(vr_slovo)]+'*7*7*';   end
else slova[iforsl]:=vr_slovo;
delete(s,1,p);
end; end;
inc(iforsl);
if s[length(s)] in znaki_prepin then
begin
slova[iforsl]:=copy(s,1,length(s)-1);
inc(iforsl);  slova[iforsl]:=s[length(s)]+'*7*7*'; end
else slova[iforsl]:=s;
kolvopr:=iforsl;
end;
 
 
function pow(x,n:integer):integer;
var i,r:integer;
begin
r:=x;
for i:=1 to n-1 do r:=r*x;
pow:=r;
end;
{------------------------dvoicnaia---------------------------}
procedure dvoicnaia;
function dv(s:string):boolean;
var rez: boolean;  i:integer;
begin
rez:=true;
for i:=1 to length(s) do
if ((s[i]<>'0') and (s[i]<>'1')) then rez:=false;
dv:=rez;
end;
 
function dv_podscet(s:string):integer;
var i,r,code,n,sum,cislo:integer;
    vector:array[1..250] of integer;
begin
r:=1;
for i:=1 to length(s) do val(s[i],vector[i],code);
sum:=-r;
n:=length(s);
for i:=1 to n do
 
 sum:=sum+(vector[i]*pow(2,abs(i-n)));
dv_podscet:=sum;
end;
 
var i:integer;
begin
for i:=1 to kolvopr do
 if length(slova[i])>1 then
 if dv(slova[i]) then begin
 writeln(g,slova[i],' = ',dv_podscet(slova[i]));
 writeln(slova[i],' = ',dv_podscet(slova[i]));   end;
end;
 
{-----------------------delPROB------------------------}
procedure delPROB (var s:string);
var  i:integer;
begin
i:=1;
repeat
if copy(s,i,2)='  ' then delete(s,i,1) else inc(i);
until i>length(s);
end;
{-------------------------naoborot-------------------------}
procedure naoborot;
 
function ex(s:string):string;
var i:integer; x:string;
begin
x:='';
For i:=1 to length(s) do x:=s[i]+x;
ex:=x; end;   {***}
var  i,j:integer;
begin
for i:=1 to kolvopr do begin if pos('*7*7*',slova[i])>0 then delete(slova[i],2,5);
begin write(g,ex(slova[i])); write(ex(slova[i]));  end;
if pos('*7*7*',slova[i+1])=0 then begin write(' ');  write(g,' '); end; end;
end;
 
{------------------------exchange-------------------------}
procedure exchange(var a,b:string);
var c:string;
begin
c:=a; a:=b; b:=c; end;
 
procedure sorting;
var  i:integer;
     swop:boolean;
     vrs1,vrs2:string;
     n:integer;
 
begin
n:=kolvopr;
repeat
swop:=false;
for i:=1 to n-1 do begin
vrs1:=slova[i];
vrs2:=slova[i+1];
if ord(vrs1[1])>ord(vrs2[1]) then begin         {esli "<" togda po ubivaniiu }
exchange(slova[i],slova[i+1]); swop:=true; end;
                                  end;
n:=n-1;
until not swop;
 
for i:=1 to kolvopr do begin if pos('*7*7*',slova[i])>0 then delete(slova[i],2,5);
write(g,slova[i]);
if pos('*7*7*',slova[i+1])=0 then  write(g,' ');  end;
end;
 
{--------------------dublikator---------------------}
procedure dublikator;
var i, j,k,n: Integer;
s: Boolean;
vector_for_dubl:array [1..300] of string[20];
 
begin
k:=0;
n:= kolvopr;
for i:=1 to n do
begin  s := true;
for j:=1 to i-1 do
if slova[j]=slova[i] then s:=false;
if s then  begin
inc(k);
vector_for_dubl[k]:=slova[i];
end;
end;
for i:=1 to k do begin if pos('*7*7*',vector_for_dubl[i])>0 then delete(vector_for_dubl[i],2,5);
begin write(vector_for_dubl[i]);
write(g,vector_for_dubl[i]);
end;
if pos('*7*7*',vector_for_dubl[i+1])=0 then begin write(' '); write(g,' ');
end;    end;
end;
{-------------------------------}
 
 
{**************************menu**************************}
begin
clrscr;
writeln;
assign (f,'1.txt' ); reset (f);
assign (g,'222.txt' ); rewrite (g);
znaki_prepin:=['.','!',',','-'];
 
writeln('Menyu programmy:');
writeln('1. Perevodchik');
writeln('2. Trimmer');
writeln('3. Shifrator');
writeln('4. Sortirovschik');
writeln('5. Dublikator');
writeln;
write('Vvedite nuzhnuyu vam funktsiyu (ot 1 do 5):');
readln(func);
 
 
while not eof(f) do begin   
readln(f,isxs);
rec_in_massiv(isxs); 
 
if func = 1 then dvoicnaia; 
if func = 2 then begin delPROB(isxs); writeln(isxs); writeln(g,isxs); end;
if func = 3 then naoborot;{fail}
if func = 4 then sorting;
if func = 5 then dublikator;
end;                   
 
 
for i:=1 to kolvopr do begin if pos('*7*7*',slova[i])>0 then delete(slova[i],2,5);
write(g,slova[i]);
if pos('*7*7*',slova[i+1])=0 then  write(g,' ');  end;
 
writeln; writeln('Poluchennye dannye uspeshno zapisany v fail:');
close(f); close(g);
readln;
end.