uses CRT;

const  Parts: array [1..6] of string = ('Австралия и Океания', 'Азия', 'Америка', 'Антарктида', 'Африка', 'Европа');

Type Data = Record
               Country:string;
               Part:integer;
               Capital:string;
             End;
NodePtr = ^Node;    {указатель на элемент списка}
Node = record   {элемент списка}
    D: Data;    {данные}
    Prev,Next: NodePtr; {указатели на предыдущий и следующий элементы списка (двусвязный список)}
    end;

Predicate = function(var D:Data):boolean;

var
  Mode:byte;
  First, Current, Last:NodePtr; {указатели на первый, текущий и последний элементы списка}
  F:file of Data;
  i:Data;
  Mode1Part: integer;
  Mode2Country: string;

{----------------------------------------------------------------------------}
procedure PushBack(var D:Data);  {Занесение данных в конец списка}
begin
  if SizeOf(Node) <= MaxAvail then {Проверка на размер доступной памяти. SizeOf(X) - размер переменных типа X в байтах, MaxAvail - размер наибольшего непрерывного участка памяти}
    begin
       if First = Nil then {Если создается 1-й элемент списка}
       begin
         New(First);  {выделяем память}
         First^.D := D; {присваиваем данные}
         First^.Next:=Nil; {в списке 1 элемент => связей нет}
         First^.Prev:=Nil;
         Last := First; {указатель на 1-й элемент = указателю на последний}
       end
       else
       begin {Добавление данных в конец списка (1-й элемент уже создан)}
         new(Last^.Next); {выделяем память (тут же происходит связывание последнего элемента с создаваемым)}
         Last^.Next^.Prev := Last; {связываем только что созданный элемент с предыдущим}
         Last := Last^.Next; {передвигаем указатель на созданный элемент}
         Last^.D := D; {присваиваем данные}
         Last^.Next := Nil; {Следующего элемента нет}
       end;
  end
  else {если недостаточно памяти, то}
  begin
    Writeln('Недостаточно памяти'); {выведем сообщение}
    readkey;
    halt; {и завершим программу}
  end;
end;
{----------------------------------------------------------------------------}
procedure ListDelete(N:NodePtr); {удаление из списка элемента, на который указывает N}
begin
    if N = First then {если удаляется 1-й элемент}
    begin
      if First^.Next <> Nil then {в списке больше 1 элемента}
      begin
         First := First^.Next; {передвинем указатель First на следующий элемент}
         First^.Prev := Nil;   {Предыдущей элемент удален}
      end
      else {если в списке всего 1 элемент}
      begin
         First := Nil; {Нет элементов - нет указателей,}
         Last  := Nil; {такие дела}
      end;
      Current := First; {Текущий элемент - первый}
      Dispose(N); {Освобождаем память из под удаленного элемента}
      exit;     {Выход из процедуры}
    end;
    if N = Last then {Удаление последнего элемента}
    begin
      Last := Last^.Prev; {переместим указатель Last на предыдущий элемент}
      Last^.Next := Nil;  {Следующий элемент удален}
      Current := Last;    {Текущий элемент - последний}
      Dispose(N);   {Освобождаем память из под удаленного элемента}
      exit;     {Выход из процедуры}
    end;
        {Удаление элементов, которые не являются ни первым, ни последним}
      N^.Prev^.Next := N^.Next; {Связываем элемент, предшествующий элементу N, со следущим за N элементом}
      N^.Next^.Prev := N^.Prev; {{Связываем элемент, следущий за N, с предшествующим N элементом}
      Current := N^.Prev; {Текущий элемент - элемент, предшествующий элементу N}
      Dispose(N);   {Освобождаем память из под удаленного элемента}

end;
{----------------------------------------------------------------------------}
function Menu:integer; {см. Lab5}
procedure Select(SM,N:integer);
begin
  if N in [1..3] then
  begin
    GotoXY(2, SM + 1);
    write(' ');
    GotoXY(2, N + 1);
    write('*');
  end
end;

var
  mode: integer;
  c: char;
  ext:boolean;
begin
  clrscr;
  repeat
    writeln('Выберите Режим');
    writeln('[*] Ввод данных');
    writeln('[ ] Просмотр и редактирование');
    writeln('[ ] Выход');

    mode := 1;
    repeat
      c := readkey;
      if c in ['1'..'3'] then
      begin
         Select(mode, ord(c) - ord('0'));
         mode := ord(C) - ord('0');
      end;
      if c = #0 then ext := true;
      if (c in [#72,#80]) and ext then
      begin
        if (c = #72) and (mode > 1) then
        begin
           Select(mode, mode - 1);
           dec(mode);
        end;
        if (c = #80) and (mode < 3) then
        begin
           Select(mode, mode + 1 );
           inc(mode);
        end;
        ext := false;
      end;
    until c = #13;
  until c = #13;
  menu := mode;
end;

{-----------------------------------------------------------------------------}
procedure ClrLine(Y,X:integer);{см. Lab5}
var
  i:integer;
begin
  GotoXY(X,Y);
  ClrEOL;
end;
{---------------------------------------------------------------------------}
procedure Message(Y:word; s:string);{см. Lab5}
var
X_,Y_:integer;
begin
  X_ := WhereX;
  Y_ := WhereY;
  ClrLine(Y,1);
  write(s);
  GotoXY(X_,Y_);
end;
{-----------------------------------------------------------------------------}
function ReadStr(Y:integer; var S:string; var Quit:boolean):char;{см. Lab5}
var
  c:char;
  i:integer;
  ext:boolean;
begin
  ClrLine(Y, 14);
  i := Length(S);

  write(S);
  ext := false;
  Quit := false;
  repeat
    c := readkey;
    if c = #27 then
    begin
      Quit := true;
      exit;
    end;
    if (c = #8) and (i > 0) then
    begin
      GotoXY(WhereX-1, WhereY);
      write(' ');
      GotoXY(WhereX-1, WhereY);
      delete(S, i, 1);
      dec(i);
    end;
    if c = #0 then ext := true;
    if (c in ['a'..'z', 'A'..'Z', 'а'..'я', 'А'..'Я','-']) and (i<80-14) and not ext then
    begin
      write(c);
      s := s+c;
      inc(i);
    end;

  until (c = #13) or ((c in [#72, #80]) and ext);
  ReadStr := c;
end;
{-----------------------------------------------------------------------------}
function ReadPart(Y:integer; var P:integer; var Quit:boolean):char;{см. Lab5}
var
    c:char;
    ext: boolean;
    i:integer;
begin
  ClrLine(Y,14);
  if P <> 0 then
  begin
    write(Parts[P]);
    i:=1;
  end;
  Quit:=false;

  Message(9,'Выберите часть света, в которой расположена страна');
  GotoXY(1, 10);
  for i:=1 to 6 do
    Writeln(i,' - ', Parts[i]);
  i:= 0;
  GotoXY(14, Y);
  repeat
    c := readkey;
    if c = #27 then
    begin
      Quit := true;
      exit;
    end;
    if c = #0 then ext := true;
    if c in ['1'..'6'] then
    begin
       ClrLine(Y,14);
        Write(Parts[ord(c)-ord('0')]);
       GotoXY(WhereX-1, WhereY);
       P := ord(c)-ord('0');
    end;

  until (c=#13) or ((c in [#72, #80]) and ext);

  for i:=0 to 6 do
    Message(9+i, '');
  ReadPart := c;
end;
{-----------------------------------------------------------}
procedure EnterData;
var
 { F: file of Data;}  {файл не используется}
  G: Data;
  c: char;
  f, quit:boolean;
  i, day: word;
begin
  clrscr;
  repeat
    clrscr;
    i := 1;
    G.Country := '';
    G.Part := 0;
    G.Capital := '';
    Writeln('Страна     : ');
    Writeln('Часть света: ');
    Writeln('Столица    : ');

    Message(9, 'ESC - возврат в меню');
    repeat
    repeat
      GotoXY(14, i);
      case i of
        1: c := ReadStr(1, G.Country, quit);
        2: c := ReadPart(2, G.Part, quit);
        3: c := ReadStr(3, G.Capital, quit);
      end;
      if quit then
         exit;

      if (c in [#72, #80]) then
      begin
        if (c = #72) and (i > 1) then
           dec(i);
        if (c = #80) and (i < 3) then
           inc(i);
       end;
      if (c = #13) and (i < 3) then
      begin
        inc(i);
        c := #0;
      end;
    until (c = #13) and (i = 3);

      if G.Country = '' then
      begin
        i := 1;
        f := false;
        end
      else f:= true;

      if g.Part = 0 then
        begin
        i:=2;
        f := false;
        end;
      if G.Capital = '' then
        begin
        i:=3;
        f := false;
        end;

       if not f then
         Message(9, 'Нужно заполнить все поля');

    until f;

    PushBack(G); {Сохраняем введенные данные в список}
   until  c = #27;

end;

Procedure WriteItem(var D:Data); {см. Lab5}
Var
  X,Y, i:integer;
  s:string;
begin
  Y := WhereY;
  GotoXY(2, Y);
  s := D.Country;
  if Length(D.Country)<24 then
     write('│',D.Country)
  else
  begin
    Delete(S, 22 , Length(s) - 21);
    write('│', s+'...');
  end;

  GotoXY(27, Y);
  Write('│', Parts[D.Part]);
  GotoXY(52, Y);
  s := D.Capital;
  if Length(D.Capital)<26 then
     write('│',D.Capital)
  else
  begin
    Delete(S, 25 , Length(s) - 25);
    write('│', s+'...');
  end;

end;

procedure Edit(N:NodePtr); {редактирование элемента, на который указывает указатель N}
var
  t: Data;
  c: char;
  f, quit:boolean;
  i: word;
begin

    clrscr;
    t:=N^.D; {Копируем данные из элемента N во временную переменную}
    i := 1;

    Writeln('Страна     : ', t.Country);
    Writeln('Часть света: ', Parts[t.Part]);
    Writeln('Столица    : ', t.Capital);

    Message(9, 'ESC - возврат в меню');
    repeat
    repeat
      GotoXY(14, i);
      case i of
        1: c := ReadStr(1, t.Country, quit);
        2: c := ReadPart(2, t.Part, quit);
        3: c := ReadStr(3, t.Capital, quit);
      end;
      if quit then
         exit;

      if (c in [#72, #80]) then
      begin
        if (c = #72) and (i > 1) then
           dec(i);
        if (c = #80) and (i < 3) then
           inc(i);
       end;
      if (c = #13) and (i < 3) then
      begin
        inc(i);
        c := #0;
      end;
    until (c = #13) and (i = 3);

      if t.Country = '' then
      begin
        i := 1;
        f := false;
        end
      else f:= true;

      if t.Part = 0 then
        begin
        i:=2;
        f := false;
        end;
      if t.Capital = '' then
        begin
        i:=3;
        f := false;
        end;

       if not f then
         Message(9, 'Нужно заполнить все поля');
    until f;
    N^.D := t; {заменяем данные в элементе списка N отредактированными данными}
end;
{---------------------------------------------------------------------------}
Function ShowAll(var I:Data):boolean;far; {см. Lab5}
begin
  ShowAll := True;
end;
{----------------------------------------------------------------------------}
Function Mode1(var I:Data):boolean;far; {см. Lab5}
begin
    if I.Part = Mode1Part then
        Mode1:=true
    else Mode1:=false;
end;
{----------------------------------------------------------------------------}
Function Mode2(var I:Data):boolean;far; {см. Lab5}
begin
    if I.Country = Mode2Country then
        Mode2:=true
    else Mode2:=false;
end;
{----------------------------------------------------------------------------}
Procedure SelectMode(var S:Predicate); {см. Lab5}
var
  c:char;
  i:integer;
  ext, quit:boolean;
begin
  ClrScr;
  writeln('[*] Показывать все записи');
  writeln('[ ] Вывод списка стран, расположенных в заданной части света');
  writeln('[ ] Вывод информации о заданной стране');
  ext := false;
  i := 1;
  repeat
    GotoXY(2, i);
    write('*');

    c := readkey;
    if c = #0 then ext := true;
    if (c = #72) and ext and (i > 1) then
    begin
      dec(i);
      GotoXY(2, i+1);
      write(' ');
    end;
    if (c = #80) and ext and (i<3) then
    begin
      inc(i);
      GotoXY(2, i-1);
      write(' ');
    end;
  until c = #13;
  case i of
    1: S := ShowAll;
    2: begin
        S := Mode1;
        ClrScr;
        Write('Часть света:');
        Mode1Part := 0;
        repeat
            c := ReadPart(1, Mode1Part, quit);
        until (c = #13) and (Mode1Part <> 0);
        end;
    3: begin
        S := Mode2;
        ClrScr;
        Write('Страна     : ');
        Mode2Country := '';
        repeat
            c := ReadStr(1, Mode2Country, quit);
        until (c = #13) and (Mode2Country <> '');
        end;
    end;

end;
{---------------------------------------------------------------------------}
Procedure Show;
var
  t: Data;
  ip:NodePtr; {указатель на выбранный элемент (на экране) в списке}
  Select:Predicate;
  N, i, j, k, offset, Y:integer;
  c:char;
  ext,scroll, refresh:boolean;
begin
  ClrScr;
  ip := First; {выбран 1-й элемент}
  Current := First; {текущий - 1-й элемент}
  offset := 0;
  if First = nil then {если нет элементов}
  begin
     ClrScr;
     Writeln('Нет записей');
     Writeln('Нажмите любую клавишу чтобы вернуться в меню');
     readkey;
     exit;
  end;

  GotoXY(1,2);
  write('*');
  Y := 2;
  j := 1;
  scroll := false;
  refresh := true;
  N := 0;
  offset := 0;
  Select := ShowAll;
  repeat

  if (N = 0) or scroll or refresh then
  begin
  if refresh then
  begin
  Message(1,' │        Страна          │       Часть света      │         Столица       ');
  TextBackground(LightGray);
  TextColor(Black);
  Message(25,'Up/Down - навигация  Del - удаление F3 - режим F4 - редактирование  ESC - выход');

  TextColor(LightGray);
  TextBackground(Black);
  end;
  for i:=2 to 24 do ClrLine(i,1);
  i := offset*22 + 1;
  ip := First;
  for i:=1 to Offset*22 do {переместимся в списке к блоку из 22 элементов}
      if ip^.Next <> Nil then {если следующий элемент существует, то}
      ip := ip^.Next; {перейти к нему}
  if Offset > 0 then ip := ip^.Next;
  k:=1;
  GotoXY(3, 2);

  while (ip<>nil) and (k<=23) do
  begin
    if Select(ip^.D) then
       begin
       WriteItem(ip^.D);
       inc(k);
       GotoXY(3, 1+k);
       end;
       ip := ip^.next;
  end;
    N := k - 1;
  if N = 0 then
  begin
     ClrScr;
     Writeln('Нет записей');
     Writeln('ESC - вернуться в меню');
     Writeln('F3  - выбрать режим');
     c := readkey;
     if c = #0 then c:=readkey;
     if c = #61 then
     begin
       SelectMode(Select);
       Refresh := true;
       offset := 0;
       Y:=2;
       Close(F);
       Continue;
     end;
     if c = #27 then
        exit;
  end;
  GotoXY(1,Y);
  write('*');
  Scroll := false;
  refresh := false;
  end;

  repeat
    c := readkey;
    if c = #0 then ext := true;
    if (c = #83) and ext then
    begin
       clrscr;
       writeln('Удалить? y/n');
       repeat
         c := readkey;
         if UpCase(c) = 'Y' then
         begin
            if not Select(Current^.D) then
            begin
            Current := ip;
            repeat
            Current := Current^.Next;
            until (Current = Nil) or Select(Current^.D);
            end;

            ListDelete(Current);

            if N = 1 then
            begin
                Y := 25;
                j := 23;
                dec(Offset);
            end;
            break;
         end;
       until UpCase(c) = 'N';

       if j > 1 then dec(j);
       if Y > 2 then dec(Y);
       refresh := true;
       break;
    end;
    if (c = #61) and ext then
    begin
      SelectMode(Select);
      j := 1;
      Y := 2;
      offset := 0;
      Current := First;
      Refresh := true;
      break;
    end;
    if (c = #62) and ext then
    begin
      Edit(Current);
      refresh := true;
      break;
    end;
    if (c = #72) and ext and (Y >= 2) then
    begin
       if (Y = 2) and (j >= 1) then
       begin
         if offset > 0 then
         begin
              dec(offset);
              if Current^.Prev <> Nil then
                repeat
                    Current := Current^.Prev;
                until (Select(Current^.D) or (Current^.Prev = Nil));
              Scroll := true;
              Y:=24;
              j:=23;
              break;
         end
       end;

       if j > 1 then dec(j);
       if Y > 2 then dec(Y);
       if Current <> First then
       repeat
             Current := Current^.prev;
       until Select(Current^.D) or (Current^.Prev = Nil);
       GotoXY(1, Y+1);
       write(' ');
       GotoXY(1, Y);
       write('*');
    end;

    if (c = #80) and ext and (Y <= N+1) then
    begin
      if (Y = 24) and (Current^.Next <> Nil) then
      begin
        inc(offset);
        repeat
              Current := Current^.Next;
        until Select(Current^.D) or (Current^.Next = Nil);
        scroll := true;
        Y := 2;
        j := 1;
        break;
      end;

      If (Y <= N) and (Current^.Next <> Nil) then
      begin
        inc(j);
        inc(Y);
        repeat
              Current:=Current^.next;
        until Select(Current^.D) or (Current^.Next = Nil);
        GotoXY(1, Y-1);
        write(' ');
        GotoXY(1, Y);
        write('*');
      end;
    end;
  until (c in [#72, #80]) and ext or (c = #27);
  until c = #27;
end;


begin
  clrscr;
  assign(F, 'base.dat');
  {$I-}
  reset(F);
  {$I+}
  if IOResult <> 0 then
    rewrite(F);
  while not EOF(F) do {Считывание данных из файла}
  begin
    read(F, i);
    PushBack(i); {Занесем данные в список}
  end;
  close(F);
 { Current := First;
  while Current <> nil do
    Current := Current^.Next;
  }
  repeat
    Mode := Menu;
    case Mode of
      1: EnterData;
      2: Show;
      end;
  until mode = 3;
  Current := First;
  Rewrite(F); {Сотрем файл и запишем в него данные}
  while Current <> Nil do
  begin
    Write(F, Current^.D); {Запись данных }
    Current := Current^.Next; {переход к следующему элементу}
  end;
  close(F);
end.