old/PAS/ShowList/ShowList.pas

uses Graph, CRT;
Type
    ps  = ^el;
    el  = record
        data : integer;
        prev : ps;
    end;

var
  taba : array [1..50] of ps;
  tabb : array [1..50] of ps;
  A,B,tm,t1,t2  : ps;

Procedure PUSH(i:integer;var head:ps);
var ne : ps;
begin
  New(ne);
  ne^.data := i;
  ne^.prev := head;
  head := ne;
end;
Function POP(var head:ps):integer;
var ret:integer;newhead:ps;
begin
  if (head=nil) then
  begin
    POP:=0;
    exit;
  end;
  ret := head^.data;
  newhead := head^.prev;
  Dispose(head);
  head := newhead;
  POP := ret;
end;

Procedure Init;
var
  grDriver, grMode : integer;
  Errcode          : Integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,' ');
{  SetWriteMode(XORPut);}
  ErrCode := GraphResult;
  if ErrCode <> grOk then begin writeln('Нет графики!!!');Halt(2);end;
  SetFillStyle(XHatchFill,Green);
  SetColor(Blue);
  Bar(0,0,639,479);
  SetfillStyle(SolidFill,Black);
  Setcolor(black);
  Bar(20,20,620,460);
end;{Init}
{-----------}
Procedure ShowOne(num : word;it:string;color:byte);
var
 x, y, offs : integer;
begin
 x:=0;y:=0;
 offs:=0;
 if (num>50) then begin y:=200; dec(num,50);offs:=-10;end;
 inc(y,100);
 x := 30+num*40;
 SetColor(color);
 rectangle(x,y,x+30,y+30);
 line(x,y+20+offs,x+30,y+20+offs);
 line(x+15,y+20+offs,x+15,y+30+(offs*3));
 SetTextJustify(CenterText,CenterText);
 outtextxy(x+15,y-offs+10,it);
end;{ShowOne}
{-------------------}
Function GetNum(elem:ps):integer;
var i:word;
begin
 i:=1;
 while (taba[i+1]<>nil) and (taba[i]<>elem) do inc(i);
 if taba[i]<>elem then
  begin
   i:=1;
   while (tabb[i+1]<>nil) and (tabb[i]<>elem) do inc(i);
   if tabb[i]<>elem then
     GetNum:=0
   else
      GetNum:=i+50;
  end
 else
  GetNum:=i;
end; {GetNum}
{------------------}
Procedure Link(n1,n2:word;color:byte);
var
 offs1,offs2,x1,x2,y1,y2:integer;
begin
 x1:=0;y1:=0;x2:=0;y2:=0;offs1:=0;offs2:=0;
 if (n1>50) then begin y1:=200; dec(n1,50);offs1:=-10;end;
 if (n2>50) then begin y2:=200; dec(n2,50);offs2:=-10;end;
 inc(y1,100);
 inc(y2,100);
 x1 := 30+n1*40;
 x2 := 30+n2*40;
 SetColor(color);
 line(x1,y1+30+2*offs1,x1+15,y1+20+2*offs1);
 line(x1+8,y1+25+2*offs1,x2+22,y2+25+2*offs2);
end; {Link}
{---------------------}
Procedure ShowLists;
var
  i : integer;
  itt : string;
begin
  i:=1;
  while (taba[i]<>nil) do
   begin
     str(taba[i]^.data,itt);
     ShowOne(i,itt,Blue);
     inc(i);
   end;

  i :=1;
  while (tabb[i]<>nil) do
   begin
     str(tabb[i]^.data,itt);
     ShowOne(i+50,itt,Red);
     inc(i);
   end;
end; {ShowList}
{-----------}
Var
  fA,fB,fO      : text;
  item,i        : integer;
Begin
  Init;
  Assign(fA,'a.txt');
  Assign(fB,'b.txt');
  Assign(fO,'res.txt');
  Reset(fa);Reset(fB);Rewrite(fO);
  A:=nil;B:=nil;
  i:=1; fillchar(taba,50,0);
  while not eof(FA) do begin read(fA,item); PUSH(item,A);taba[i]:=A;inc(i)end;
  i:=1; fillchar(tabb,50,0);
  while not eof(FB) do begin read(fB,item); PUSH(item,B);tabb[i]:=B;inc(i)end;
  close(fA);close(fB);
  ShowLists;
  if (A^.data<B^.data) then
   begin tm:=A;A:=B;B:=tm;end;
  t1:=A;t2:=B;
  while (t1^.prev<>nil) do
   begin
     if (t1^.prev^.data<t2^.data) then
      begin
        tm := t1^.prev;
        t1^.prev:=t2;
        t2 := tm;
      end;
      Link(GetNum(t1),GetNum(T1^.prev),GetNum(t1));
      ReadKey;
      t1:=t1^.prev;
   end;
   t1^.prev := t2;
   Link(GetNum(t1),GetNum(T1^.prev),1);
   B:=nil;
   repeat
     item:=POP(A);
     if (item<>0) then PUSH(item,B);
   until item=0;
   repeat
     item:=POP(B);
     if (item<>0) then WriteLn(fO,item);
   until item=0;
   Close(fO);
   ReadKey;
End.