Ч2 ИПР2 В5 / ИПР2

{Создать однонаправленную очередь с числами в диапазоне от –50 до +50. 
После  создания  очереди  выполнить  индивидуальное  задание.  В  конце  работы 
все очереди должны быть удалены.
5. Удалить из очереди каждый второй элемент.}
{Написана в PascalABC.NET
GetMem = new
FreeMem = dispose}

Program IPW_2;
uses crt; 
type
  Tinf=integer; // тип данных, который будет храниться в элементе очереди
  List=^TList;  // Указатель на элемент типа TList
  TList=record // Наименование нашего типа "запись"
    data:TInf;  // Данные, хранимые в элементе
    next:List;   // Указатель на следующий элемент списка
  end;
  
procedure AddElem(var spis1:List;znach1:TInf); // Процедура добавления нового элемента в очередь
var
  tmp:List;
begin
  if spis1=nil then // Проверяем не пуст ли список
  begin
    new(spis1);
    tmp:=spis1;
  end
  else 
  begin
    tmp:=spis1;
    while tmp^.next<>nil do
      tmp:=tmp^.next; // Ставим tmp на последний элемент списка
    new(tmp^.next);
    tmp:=tmp^.next;   // Переносим tmp на новый элемент
  end;
  tmp^.next:=nil; // Зануляем указатель
  tmp^.data:=znach1; // Заносим значение
end;

procedure Print(spis1:List); // Процедура печати очереди
begin
  if spis1=nil then // Проверка наличия элементов
  begin
    writeln('Очередь пуста.');
    exit;
  end;
  while spis1<>nil do // Пока указатель stek1 не станет указывать в пустоту
  begin  
    Write(spis1^.data, ' '); //Вывод элементов
    spis1:=spis1^.next // Перенос указателя вглубь
  end;
end;

Procedure FreeStek(spis1:List); // Процедура удаления очереди, очистка памяти
var
  tmp:List;
begin
  while spis1<>nil do
  begin
    tmp:=spis1; // Указатель tmp на вершину стека
    spis1:=spis1^.next;  // Вершину стека перенесём на следующий за данной вершиной элемент
    dispose(tmp); // Освобождаем память занятую под старую вершину
  end;
end;

Procedure DelElem(var spis1:List;tmp:List); // Процедура удаления элемента по позиции
var
  tmpi:List;   
  begin // Удаляемый элемент на на вершине стека!
    tmpi:=spis1; // Ставим указатель на вершину стека
    while tmpi^.next<>tmp do // Доходим до элемента стоящего "перед" тем, который нам следует удалить
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next; // Указатель элемента переносим на следующий элемент за удаляемым
    dispose(tmp);// Удаляем элемент
  end;

Procedure DelElemPos(var spis1:List;posi:integer); // Поиск порядкового номера
var
  i:integer;
  tmp:List;
begin
  i:=1; // Счетчик позиции
  tmp:=spis1;
  while (tmp<>nil) and (i<>posi) do // Пока tmp не укажет в "пустоту" или мы не найдём искомый элемент
  begin
    tmp:=tmp^.next; // Переходим на следующий элемент
    inc(i) // Увеличиваем значение счётчика
  end;
  DelElem(spis1,tmp); // Переход к процедуре удаления элемента
  
end;


var
  Spis,spis1,tmpl:List;
  znach,i,j,t,N:integer;
  ch:char;
begin
  Spis:=nil;
  repeat
    clrscr;
    Writeln('Выберите желаемое действие:');
    Writeln('1. Добавить в очередь число от -50 до +50.');
    Writeln('2. Добавить N рандомных чисел в очередь от -50 до +50.');
    Writeln('3. Удалить из очереди каждый второй элемент.');
    Writeln('4. Просмотреть очередь.');
    Writeln('5. Выход (очистка очереди).');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin // Добавление 1 числа
            write('Введите значение добавляемого элемента(от -50 до +50): ');
            readln(znach);
            if (znach<(-50)) or (znach>+50) then
              repeat
              writeln ('Введенно неправильное значение!');
              writeln ('Введите значение от -50 до +50:');
              readln(znach);
              until (znach>=(-50)) and (znach<=+50);
            AddElem(Spis,znach);
          end;
      '2':begin // Добавление нескольких рандомных числе
        randomize;
        Writeln ('Введите колличество добавляемых числе N:');
        readln(N);
        for i:=1 to N do
          begin
          znach:=random(100)-50;
            AddElem(Spis,znach);
            end;
            write('Значания введены!');
            readkey;
          end; 
      '3': begin // Удаление каждого второго элемента
        spis1:=spis;
           while spis1<>nil do
         begin
         inc(j); // Счетчик числа элементов в очереди
         spis1:=spis1^.next
         end;
         if j=0 then begin // Проверка наличия элементов
           writeln('Очередь пустa.');
           readkey;
           end;
         if j=1 then begin // Если нет 2 элемента
           writeln ('Очередь содержит всего 1 элемент');
           j:=0;
           readkey;
           end;
         if j>1 then
           begin
         t:= (j div 2); // Порядковые номера удаляемых элементов
         znach:=2;
         for i:=1 to t do
           begin
         DelElemPos(Spis,znach);
         inc(znach);
         end;
         Writeln ('Элемент(ы) удалены!');
         readkey;
         j:=0;
         end;
         end;
       '4':begin // Просмотр очереди
          clrscr;
          Print(Spis);
          readkey;
        end;
            
      end;
  until ch='5';
  FreeStek(Spis); // Очистка памяти
end.