Кольцевой список - Turbo Pascal - Ответ 3222404

program qwe;
    uses crt;
    const
      k1 = 5;
      k2 = 3;
      k3 = k1 + k2;
    TYPE
      PTR = ^SP;
      SP = RECORD
        INF : integer;
        next : PTR;
      END;
     
     
    procedure create_ring(var root: ptr);
    var
      k, zn : integer;
      i, j: ptr;
    begin
      new(root);
      root^.next := NIL;
      for k := 1 to k1 do
        begin
        zn := k;
        if k = 1 then
          begin
          root^.inf := zn;
          new(i);
          root^.next := i;
     
          end
        else
          if k < k1 then
            begin
            i^.inf := zn;
            new(j);
            i^.next := j;
            i := j;
            end
          else
            begin
            i^.inf := zn;
            i^.next := root;
            end;
        end;
    end;
    procedure destroy_ring(var root: ptr);
    var i, j: ptr;
    begin
      if root <> nil then
        begin
        i := root;
        repeat
          j := i^.next;
          dispose(i);
          i := j;
        until i = root;
        root := nil;
        end;
    end;
     
    procedure print_ring(root: ptr; len: integer);
    var
      k : integer;
      p: ptr;
    begin
      writeln('----------');
      p := root;
      for k := 1 to len do begin
        writeln('VALUE: ', p^.inf); writeln('');
        p := p^.next;
      end;
      writeln('----------');
    end;
     
     
     
    function create_list: ptr;
    var
      i: integer;
      root, p, tail: ptr;
    begin
      root := nil; tail := nil;
     
      for i := 1 to k2 do begin
        new(p);
        p^.next := nil;
        p^.inf := 10 * i;
     
        if root = nil then root := p
        else tail^.next := p;
     
        tail := p;
      end;
      create_list := root;
    end;
     
    procedure destroy_list(var root: ptr);
    var
      p, T: ptr;
    begin
      p := root;
      while p <> nil do begin
        T := p;
        p := p^.next;
        dispose(T);
      end;
      root := nil;
    end;
     
    procedure print_list(root: ptr);
    var p: ptr;
    begin
      writeln('----------');
      p := root;
      while p <> nil do begin
        writeln('VALUE: ', p^.inf); writeln;
        p := p^.next;
      end;
      writeln('----------');
    end;
     
    procedure merge(ring, list: ptr; step: integer);
    var
      p1, p2, new_node: ptr;
      i: integer;
    begin
      p1 := ring; p2 := list;
      while p2 <> nil do begin
     
        for i := 1 to step - 1 do
          if p1 <> nil then p1 := p1^.next;
     
        new(new_node);
        new_node^.inf := p2^.inf;
        new_node^.next := p1^.next;
        p1^.next := new_node;
     
        p1 := p1^.next^.next;
        p2 := p2^.next;
      end;
    end;
     
    var
      ring_root, list_root: ptr;
      step: integer;
     
    BEGIN
      clrscr;
      randomize;
      create_ring(ring_root);
      writeln('Оригинальный список (кольцевой)');
      print_ring(ring_root, k1);
      writeln('+++++++++++');
      list_root := create_list;
      writeln('Добавляемый список');
      print_list(list_root);
      write('Введите шаг вставки:');
      Readln(step);
     
      merge(ring_root, list_root, step);
     
      writeln('+++++++++++');
      writeln('Переформированный спискок');
      print_ring(ring_root, k3);
     
      destroy_ring(ring_root);
      destroy_list(list_root);
      readkey;
    END.