Лабораторные работы_2 / LAB6 / LAB6

program Lab6_Zaharov;
uses crt;
type
item = record
key : integer;
end;
tape = file of item;
var
c,a,b : tape;
eor,fl : boolean;
num : char;
l : integer;
x : item;
f : text;

{Џа®жҐ¤га  ўлў®¤   ­®¬ «ЁЁ ­  нЄа ­}
procedure Anomaliya (text1, text2 : string; var p_repeat : boolean);
var p_key : char;
y : integer;
i,k : byte;
begin
clrscr;
if p_repeat=true then k:=4 else k:=2;
textcolor(k);
y:=(82 - 4 - length (text1)) div 2;
gotoxy (y,10); write ('Й'); for i:=1 to length (text1)+2 do write ('Н'); write ('»');
gotoxy (y,11); write ('є '); textcolor (k+240); write (text1); textcolor (k); write (' є');
gotoxy (y,12); write ('И'); for i:=1 to length (text1)+2 do write ('Н'); write ('ј');
if length(text2)<>0
then
begin
textcolor (8);
y:=(82 - 8 - length (text2)) div 2;
gotoxy (y,13); write ('Ъ'); for i:=1 to length (text2)+6 do write ('Д'); write ('ї');
gotoxy (y,14); write ('і ',text2,' і');
gotoxy (y,15); write ('А'); for i:=1 to length (text2)+6 do write ('Д'); write ('Щ');
end;
gotoxy(1,1);
if p_repeat=true then
repeat
sound (800); delay (40000);
nosound; delay (50000);
until keypressed
else repeat until keypressed;
k:=1; p_repeat:=true;
gotoxy (60,20); textcolor (blue); write ('ЪДДДДДДДДДДДї');
gotoxy (60,23); textcolor (blue); write ('АДДДДДДДДДДДЩ');
repeat gotoxy (60,21); clreol;
textcolor (15);
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
if k=1 then textbackground(blue) else textbackground(0);
write (' ЏЋ‚’Ћђ€’њ ');
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);

gotoxy (60,22); clreol;
textcolor (15);
textbackground (0);
textcolor (blue); write ('і');
textcolor(15);
if k=2 then textbackground(blue) else textbackground(0);
write (' ‡Ђ‚…ђ€’њ ');
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
repeat
p_key:=readkey;
until (p_key=chr(72)) or (p_key=chr(80)) or (p_key=chr(13));
if ((p_key=chr(72)) or (p_key=chr(80))) and (k=1)
then begin k:=2; p_repeat:=false; end
else if ((p_key=chr(72)) or (p_key=chr(80))) and (k=2)
then begin k:=1; p_repeat:=true; end
else
if p_key=chr(13)
then k:=3;
until (k=3);
clrscr;
end;

{ЏҐаҐбл«Є  н«Ґ¬Ґ­в  Ё§ е ў г}
procedure Copy (var x,y : tape);
var buf,buf1 : item;
begin
read (x,buf);
write (y,buf);
if not eof(x) then
begin
{‡ Ј«п¤лў ­ЁҐ ўЇҐаҐ¤}
read (x,buf1);
eor:=buf.key>buf1.key;
seek(x,filepos(x)-1);
end
else eor:=true;
end;

{ЏҐаҐЇЁбм ®¤­®© бҐаЁЁ Ё§ е ў г}
procedure CopyRun (var x,y : tape);
begin
repeat
Copy (x,y);
until eor;
end;

{‘«Ёп­ЁҐ бҐаЁ© Ё§   Ё b ў б}
procedure MergeRun;
var bufA, bufB : item;
begin
repeat
read (a,bufA);
read (b,bufB);
if bufA.key<bufB.key then
begin
seek (a,filepos(a)-1);
seek (b,filepos(b)-1);
Copy (a,c);
if eor then
CopyRun (b,c);
end
else
begin
seek (a,filepos(a)-1);
seek (b,filepos(b)-1);
Copy (b,c);
if eor then
CopyRun (a,c);
end;
until eor;
end;

{Ё§ a Ё b ў c}
procedure Merge;
begin
repeat
MergeRun;
l:=l+1;
until (eof (b) or eof (a));
while not eof (a) do
begin
CopyRun (a,c);
l:=l+1;
end;
while not eof (b) do
begin
CopyRun (b,c);
l:=l+1;
end;
end;

{Ё§ б ў a Ё b}
procedure Distribute;
begin
repeat
CopyRun (c,a);
if not eof (c) then
CopyRun (c,b);
until eof (c);
end;

{‘®авЁа®ўЄ  ҐбвҐб⢥­­л¬ б«Ёп­ЁҐ¬}
procedure NaturalMerge;
begin
repeat
rewrite (a);
rewrite (b);
reset (c);
Distribute;
l:=0;
reset (a);
reset (b);
rewrite (c);
Merge;
until l=1;
end;

{ѓ« ў­ п Їа®Ја ¬¬ }
begin
repeat
clrscr;
writeln;
writeln (' ‹ Ў®а в®а­ п а Ў®в  # 7');
writeln (' ‚­Ґи­пп б®авЁа®ўЄ .');
writeln;
write ('‚ўҐ¤ЁвҐ ­®¬Ґа д ©«  (1 Ё«Ё 2) >>> ');
readln (num);
if (num<>'1') and (num<>'2') then
begin
fl:=true;
Anomaliya ('‚­Ё¬ ­ЁҐ! ЋиЁЎЄ !','€бЄ®¬л© д ©« ­Ґ бгйҐбвўгҐв',fl);
end
else
begin
assign (a,'H:\LAB6\a'+num+'.dat');
assign (b,'H:\LAB6\b'+num+'.dat');
assign (c,'H:\LAB6\c'+num+'.dat');
assign (f,'H:\LAB6\f'+num+'.txt');
reset (f);
rewrite (c);
writeln ('„® б®авЁа®ўЄЁ:');
while not eof (f) do
begin
read (f,x.key);
write (c,x);
write (x.key,' ');
end;
writeln;
NaturalMerge;
writeln ('Џ®б«Ґ б®авЁа®ўЄЁ:');
reset (c);
while not eof (c) do
begin
read (c,x);
write (x.key,' ');
end;
fl:=false;
readln;
Anomaliya ('Џа®Ја ¬¬  ўлЇ®«­Ґ­  гбЇҐи­®.','',fl);
close (a);
close (b);
close (c);
close (f);
end;
until fl=false;
end.