Написать процедуру присоединения стека S2 к стеку S1

program StackOne;//Написать процедуру присоединения стека S2 к стеку S1. 
 
uses crt;
 
type
  Tptr = ^Telem;{указательный тип данных на элемент Стека}
  Telem = record  {запись, состоящая из двух полей, описывающая элемент Стека}
    inf: integer;  {информационное поле - хранит символы}
    link: Tptr; {указательное поле - ссылка на следующий элемент Стека}
  end;
 
 
{Процедура: добавление элемента в вершину Стека}
procedure push(var topstek: Tptr; element: integer);
var
  p: Tptr;{вспомогательный указатель, ссылающийся на добавляемый элемент}
begin
  new(p); {выделение памяти под добавляемый элемент} 
  p^.inf := element;
  p^.link := topstek; {указатель на вершину Стека top поставили на только что добавленный элемент.
                       В итоге, Стек находится в согласованном состоянии после добавления элемента}
  topstek := p;
end;
 
{Процедура: печать элементов Стека от вершины в конец}
procedure PrintFromTop(topstek: Tptr);
var
  p: Tptr;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  if topstek = nil then WriteLn('Стек пуст')
  else begin
    p := topstek; {устанавливаем указатель р на первый элемент Стека}
    {выпечатываем на экран диалог}
    write('Элементы стека имеют вид: '); {устанавливаем указатель р на первый элемент Стека}
    {до тех пор, пока указатель р не выйдет за последний элемент Стека}
    while(p <> nil) do
    begin
      write(p^.inf, ' '); {печатаем на экран пользователя информационное поле текущего элемента Стека}
      p := p^.link; {переход на следующий элемент Стека}
    end;
  end;
  WriteLn
end;
 
 
procedure InputStack(var topstek: Tptr);
var
  n, elem: integer;
begin
  topstek := nil;
  WriteLn('Укажите, сколько элементов стека Вы хотите ввести:');
  ReadLn(n);
  for var i := 1 to n do 
  begin
    write('Введите значение добавляемого элемента: '); {ввод значения информационного поля элемента с клавиатуры} 
    ReadLn(elem);
    // if i mod 2 = 0 then если нужно, чтобы вставлялись только чётные - можно расскоментировать
    push( topstek, elem); {вставка элемента в вершину Стека} 
  end;
  writeln; {оповещение пользователя об успешном завершении операции}
  writeln('Добавление новых элементов успешно проведено!');
end;
 
{копировать чётные элементы в новый стек}  
procedure CopyEvenToOtherStack(const topstek1: Tptr; var topstek2: Tptr);
var
  p: Tptr;{вспомогательный указатель, ссылающийся на текущий элемент Стека}
begin
  topstek2 := nil;
  p := topstek1; {устанавливаем указатель р на первый элемент Стека}
  {до тех пор, пока указатель р не выйдет за последний элемент Стека}
  while(p <> nil) do
  begin
    if p^.inf mod 2 = 0 then 
      push( topstek2, p^.inf);
    p := p^.link; {переход на следующий элемент Стека}
  end;
end;
 
 
var
  top1, top2: Tptr;
 
begin
  InputStack( top1); {ввод с клавиатуры элементов стека}
  
  WriteLn('Содержимое первого стека.');
  PrintFromTop( top1); {печать элементов Стека от вершины вниз}
  
  CopyEvenToOtherStack( top1, top2);
  
  WriteLn('Содержимое второго стека.');
  PrintFromTop( top2); {печать элементов Стека от вершины вниз}
  
end.