program programa;
uses crt;
type
	Wind = ^win;
	win = record
	x1,x2,y1,y2,j,textc,fonec,k:word;
	text:string;
	Next,pred: Wind;
	end;

var first, tek,endlist,tmp: Wind;
    nn,n,k,i,j,s:integer;
    klav,c:char;

procedure NewListRec;   {Sozd New List}
var a:string;
ans:char;
f:text;
 begin
   clrscr;
   gotoxy(10,10);
  { assign(f,'strings.txt');
   reset(f); }
   nn:=24+random(10);
   New(first); {выделить память для первой записи }
   first^.x1:=1+random(70); {заполнить информационные поля}
   first^.x2:=10+random(80-first^.x1-10);
   first^.y2:=round((first^.x2)*25/80)-1;
   first^.y1:=1+random(24-first^.y2);
   first^.fonec:=random(6)+1;
   first^.textc:=random(15);
   if first^.textc=first^.fonec then first^.textc:=first^.textc+1;
   first^.k:=1;
   first^.text:='1';
   first^.pred:=nil;
   tek:=first; {сделать первую запись текущей }
   for i:=2 to nn do
    begin
        New(tek^.Next);{ выделить память для следующей записи }
        tek^.Next^.x1:=1+random(70); {заполнить информационные поля}
        tek^.Next^.x2:=10+random(80-tek^.Next^.x1-10);
        tek^.Next^.y2:=round((tek^.Next^.x2)*25/80)-1;
        tek^.Next^.y1:=1+random(24-tek^.Next^.y2);
        tek^.next^.fonec:=random(6)+1;
        tek^.next^.textc:=random(15);
        if tek^.next^.textc=tek^.next^.fonec then tek^.next^.textc:=tek^.next^.textc+1;
        tek^.next^.k:=i;
        tek^.next^.text:='ab';
        tek^.next^.pred:=tek;
        tek:=tek^.Next; { сделать следующую запись текущей }
    end;
    tek^.Next := nil;
    endlist:=tek;
    clrscr;
    gotoxy(20,20);
    write('Список создан. Элементов: ',nn,'.');
   { close(f); }
end;

procedure DobleFrame(x11,x22,y11,y22:integer);
var j:integer;
begin
  gotoxy(2,1); write(#201);
  for j:=3 to x22-2 do write(#205);
  write(#187);
  for j:=2 to y22-1 do
  begin
    gotoxy(2,j); write(#186);
    gotoxy(x22-1,j); write(#186);
  end;
  gotoxy(2,y22); write(#200);
  for j:=3 to x22-2 do  write(#205);
  write(#188);
end;

procedure OnceFrame(x11,x22,y11,y22:integer);
var j:integer;
begin
  gotoxy(2,1); write(#218);
  for j:=3 to x22-2 do write(#196);
  write(#191);
  for j:=2 to y22-1 do
  begin
    gotoxy(2,j); write(#179);
    gotoxy(x22-1,j); write(#179);
  end;
  gotoxy(2,y22); write(#192);
  for j:=3 to x22-2 do write(#196);
  write(#217);
end;

procedure sortirovka;   {f7}
var ccc:wind;
k1,k2,k1t,k2t:integer;
   begin
     j:=1;i:=1;
     window(1,1,80,25); TextBackground(0); clrscr;
     tek:=first;
     while (i>nn) do
      begin
        tmp:=tek^.next;
        while (tek<>endlist) or (tek^.next<>nil) do
        begin
         k1:=sqr(round(tek^.x2/2)+tek^.x1);
         k2:=sqr(round(tek^.y2/2)+tek^.y1);
         k1t:=sqr(round(tmp^.x2/2)+tmp^.x1);
         k2t:=sqr(round(tmp^.y2/2)+tmp^.y1);
         if sqrt(abs(k1+k2)) > sqrt(abs(k1t+k2t)) then
           begin
           new(ccc);
              ccc^.x1:=tmp^.x1; ccc^.x2:=tmp^.x2; ccc^.y2:=tmp^.y2; ccc^.y1:=tmp^.y1; ccc^.fonec:=tmp^.fonec;
              ccc^.k:=tmp^.k; ccc^.textc:=tmp^.textc; ccc^.text:=tmp^.text;
              tmp^.x1:=tek^.x1; tmp^.x2:=tek^.x2;tmp^.y2:=tek^.y2;tmp^.y1:=tek^.y1;
              tmp^.fonec:=tek^.fonec; tmp^.textc:=tek^.textc; tmp^.k:=tek^.k;tmp^.text:=tek^.text;
              tek^.x1:=ccc^.x1; tek^.x2:=ccc^.x2;tek^.y2:=ccc^.y2;tek^.y1:=ccc^.y1;
              tek^.fonec:=ccc^.fonec;tek^.textc:=ccc^.textc; tek^.k:=ccc^.k;tek^.text:=ccc^.text;
              tek:=tek^.next;
              tmp:=tmp^.next;
              k1t:=0;k2t:=0;k1:=0;k2:=0;i:=i+1;
           dispose(ccc);
           end
         else
          begin
            k1t:=0;k2t:=0;k1:=0;k2:=0;i:=i+1;
            tek:=tek^.next;
            tmp:=tmp^.next;
          end;
        end;
     end;
         tek:=first;
         while tek<> nil do
         begin
           if ((2+j)+(tek^.x2+2+j-1))>79 then tek^.x2:=80-(2+j);
           if (2+(tek^.y2+2-1))>23 then tek^.y2:=25-2;
           window((2+j),2,tek^.x2+2+j-1,tek^.y2+2-1);
           textcolor(tek^.textc);
           TextBackground(tek^.fonec); clrscr;
           gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1);
           writeln(tek^.text);
           OnceFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
           if tek=endlist then DobleFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
           gotoxy(2,2); write(tek^.k);
           gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1); writeln(tek^.text);
           tek:=tek^.next;
           j:=j+2;
         end;
         tek:=first; i:=1;
         while tek<> nil do
         begin tek^.k:=i; i:=i+1; tek:=tek^.next; end;
         tek:=endlist;
         klav:=readkey;if klav=#0 then klav:=readkey;
      {   if klav<>#0 then vivod;   }
end;


procedure vivod;            {Prorisovka vseh okon}
  begin
    window(1,1,80,25); TextBackground(black); clrscr;
    tek:=first;
    while tek<> nil do
     begin
        window(tek^.x1,tek^.y1,tek^.x2+tek^.x1-1,tek^.y2+tek^.y1-1);
        textcolor(tek^.textc);
        TextBackground(tek^.fonec);clrscr;
        OnceFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
        if tek=endlist then DobleFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
        gotoxy(2,2); write(tek^.k);
        gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1);
        writeln(tek^.text);
        tek:=tek^.next;
     end;
    tek:=endlist;
  end;

procedure DisposeRec;
var Temp: wind;
begin
    tek := first;
    while tek <> nil do    begin
       Temp := tek^.Next;
       Dispose(tek);
       tek:= Temp;
    end;
end;
procedure sled_wind;                      {Perehod na sled wind po '>' }
 begin
   if tek=endlist then tmp:=first
   else tmp:=tek^.next;
   tek:=first;
   while tek<> nil do
     begin
       window(tek^.x1,tek^.y1,tek^.x2+tek^.x1-1,tek^.y2+tek^.y1-1);
       textcolor(tek^.textc);
       TextBackground(tek^.fonec);  clrscr;
       OnceFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
       gotoxy(2,2); write(tek^.k);
       gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1); writeln(tek^.text);
       tek:=tek^.next;
     end;
     tek:=tmp;
     window(tek^.x1,tek^.y1,tek^.x2+tek^.x1-1,tek^.y2+tek^.y1-1);
     textcolor(tek^.textc);
     TextBackground(tek^.fonec);  clrscr;
     DobleFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
     gotoxy(2,2); write(tek^.k);
     gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1); writeln(tek^.text);
  end;

procedure pred_wind;                          { perehod na pred wind}
  begin
     if tek=first then tmp:=endlist
     else tmp:=tek^.pred;
     tek:=first;
     while tek<> nil do
      begin
        window(tek^.x1,tek^.y1,tek^.x2+tek^.x1-1,tek^.y2+tek^.y1-1);
        textcolor(tek^.textc);
        TextBackground(tek^.fonec);  clrscr;
        OnceFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);        ;
        gotoxy(2,2); write(tek^.k);
        gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1); writeln(tek^.text);
        tek:=tek^.next;
      end;
     tek:=tmp;
     window(tek^.x1,tek^.y1,tek^.x2+tek^.x1-1,tek^.y2+tek^.y1-1);
     textcolor(tek^.textc);
     TextBackground(tek^.fonec);  clrscr;
     DobleFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);        ;
     gotoxy(2,2); write(tek^.k);
     gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1); writeln(tek^.text);
  end;



procedure posledovatelno;           {vivod okon posledovatelno po enter}
var j:integer;
  begin
    window(1,1,80,25); TextBackground(black); clrscr;
    tek:=first;
    while tek<> nil do
     begin
         window(tek^.x1,tek^.y1,tek^.x2+tek^.x1-1,tek^.y2+tek^.y1-1);
         textcolor(tek^.textc);
         TextBackground(tek^.fonec);  clrscr;
         OnceFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
         if tek=endlist then DobleFrame(tek^.x1,tek^.x2,tek^.y1,tek^.y2);
         gotoxy(2,2); write(tek^.k);
         gotoxy((tek^.x2 div 2)-2,(tek^.y2-1) div 2+1); writeln(tek^.text);
         if tek=endlist then
           begin
             window(7,7,50,20); TextBackground(0); clrscr;textcolor(11);
             DobleFrame(7,44,7,14); gotoxy(13,7); writeln('Окон выведено:',nn);
           end;
        klav:=readkey; if klav=#0 then klav:=readkey;
        if klav=#13 then tek:=tek^.next;
     end;
        window(1,1,80,25); TextBackground(0);
         vivod;
        repeat
        klav:=readkey; if klav=#0 then klav:=readkey;
        case klav of
         #44:{<} pred_wind;
         #46:{>} sled_wind;
         #65: {F7:} sortirovka;
        end;
      until klav=#27;
      window(1,1,80,25);TextBackground(7);  clrscr;
end;

procedure showall;    {vivod srazy vseh okon}
begin
  TextBackground(black);clrscr;
  tek:=first;
  vivod;

  window(7,7,50,20); TextBackground(0); clrscr;textcolor(11);
  DobleFrame(7,44,7,14); gotoxy(13,7); writeln('Окон выведенно:',nn);
  repeat
    klav:=readkey;
    if klav=#0 then klav:=readkey;
    if klav<> #0 then vivod;
    case klav of
         #44:{<} pred_wind;
         #46:{>} sled_wind;
         #65: {F7:} sortirovka ;
   end;

  until klav=#27;
  window(1,1,80,25);
  TextBackground(7);
  clrscr;
end;


begin
clrscr;
newlistrec;
readln;
{posledovatelno; }     {esli ety str uncomment, to vivod budet posledovat}
{TYT vivodim srazy vse okna, i perehod mejdy oknami no korretno rabotaet
 v posledovatelnom rejime vse horosho}
showall;
end.