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

  win = record
    info: infotype;
    Next,pred: Wind;
  end;

var
  first, tek, endlist: Wind;
  nn: integer;
  klav: char;

procedure NewListRec;   {Sozd New List}

  procedure CreateRec(var R: infotype;
            i: word; s: string);
  begin
    with R do begin
      X1 := 1 + random(70);
      X2 := 10 + random(80 - X1 - 10);
      Y2 := round(X2 * 25 / 80) - 1;
      Y1 := 1 + random(24 - Y2);
      FoneC := random(6) + 1;
      TextC := random(15);
      if TextC = FoneC Then TextC := TextC + 1;
      k := i;
      text := s;
    end;
  end;

  procedure Append(var first, last: Wind; const R: InfoType);
  var p: Wind;
  begin
    new(p);
    p^.info := R;
    p^.next := nil;
    p^.pred := last;

    if first = nil then first := p
    else last^.next := p;

    last := p;
  end;

var
  R: infotype;
  s: string;
  i: integer;

begin
  clrscr;
  gotoxy(10,10);

  first := nil; endlist := nil;
  nn:=24+random(10);
  for i := 1 to nn do begin

    if i = 1 then s := '1' else s := 'ab';
    CreateRec(R, i, s);
    Append(first, endlist, R);

  end;

  clrscr;
  gotoxy(20,20);
  write('Список создан. Элементов: ',nn,'.');
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}

  function f(const R: infotype): real;
  begin
    f := sqrt(abs(
           sqr(round(R.X2 / 2) + R.X1) +
           sqr(round(R.Y2 / 2) + R.Y1)
         ));
  end;
  procedure SortList(var first: wind);
  var
    i, j: wind;
    X: infotype;
  begin
    i := first;
    while i <> nil do begin
      X := i^.info;
      j := i^.pred;
      while (j <> nil) and (f(i^.info) > f(j^.info)) do begin
        j^.next^.info := j^.info;
        j := j^.pred;
      end;

      if j = nil then first^.info := X
      else j^.next^.info := X;

      i := i^.next;
    end;
  end;

begin
  SortList(first);
  klav:=readkey;if klav=#0 then klav:=readkey;
end;


procedure Show(const R: infotype; dblFrame: Boolean);
begin
  Window(R.X1, R.Y1, R.X1 + R.X2 - 1, R.Y1 + R.Y2 - 1);
  TextColor(R.TextC);
  TextBackGround(R.FoneC);
  ClrScr;
  if dblFrame then DobleFrame(R.X1, R.X2, R.Y1, R.Y2)
  else OnceFrame(R.X1, R.X2, R.Y1, R.Y2);

  GotoXY(2, 2); Write(R.k);
  GotoXY((R.X2 div 2) - 2, ((R.Y2 - 1) div 2) + 1);
  WriteLn(R.text);
end;


procedure vivod;
var p: wind;
begin
  Window(1, 1, 80, 25);
  TextBackground(Black); ClrScr;

  p := first;
  while p <> nil do begin
    Show(p^.info, p^.next = nil);
    p := p^.next;
  end;
  tek := endlist;
end;

procedure DisposeRec;
var T: wind;
begin
  tek := first;
  while tek <> nil do begin
    T := tek;
    tek := t^.next;
    Dispose(T);
  end;
end;

procedure sled_wind; { Perehod na sled wind po '>' }
var p: wind;
begin
  if tek = endlist then tek := first
  else tek := tek^.next;

  p := first;
  while p <> nil do begin
    Show(p^.info, false);
    p := p^.next;
  end;
  Show(tek^.info, true);
end;

procedure pred_wind; { perehod na pred wind}
var p: wind;
begin
  if tek = first then tek := endlist
  else tek := tek^.pred;

  p := first;
  while p <> nil do begin
    Show(p^.info, false);
    p := p^.next;
  end;
  Show(tek^.info, true);
end;



procedure posledovatelno;           {vivod okon posledovatelno po enter}
var p: wind;
begin
  window(1, 1, 80, 25);
  TextBackground(black);
  clrscr;

  tek := first;
  p := first;
  while p <> nil do begin
    Show(p^.info, p^.next = nil);
    repeat
      klav := readkey;
    until klav = #13;
    p := p^.next;
  end;
  Show(tek^.info, true);

  window(7,7,50,20); TextBackground(0); clrscr;textcolor(11);
  DobleFrame(7,44,7,14); gotoxy(13,7); writeln('Окон выведено:',nn);
  repeat
    klav:=readkey;
  until klav = #13;

  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;
  until klav = #13;

  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;


begin
  clrscr;
  newlistrec;
  (*
    posledovatelno;
  *)
  showall;
end.