program Linked_list_routines;

uses crt;

type
  pointer = ^node;
  node = record
    val:integer;
    next:pointer;
  end;

  procedure write_list(list:pointer);
  var i:integer;
  begin
    i := 0;
    while (list <> nil) and (i<30) do
    begin
      write(list^.val,'-');
      list := list^.next;
      i := i+1;
    end;
    writeln;
  end;

  function find_end(start:pointer):pointer;
  begin
    if start^.next = nil then find_end:=start
    else find_end := find_end(start^.next);
  end;

  procedure append_node_end(var list,node1:pointer);
  var
    temp:pointer;
  begin
    temp := find_end(list);
    temp^.next := node1;
    node1^.next := nil;
  end;

  procedure append_lists(var list1,list2:pointer);
  var
    temp:pointer;
  begin
    temp := find_end(list1);
    temp^.next := list2;
  end;

  procedure kil_list(var list:pointer);
  begin
    if list<>nil then
    begin
      kil_list(list^.next);
      dispose(list);
    end;
  end;

  function find_2_end(start:pointer):pointer;
  begin
    if start^.next^.next = nil then find_2_end := start
    else find_2_end := find_2_end(start^.next);
  end;

  procedure behead(var list:pointer);
  var temp:pointer;
  begin
    if list^.next = nil then list := nil
    else begin
      temp := list;
      list := list^.next;
      dispose(temp);
    end;
  end;

  procedure kil_last(var list:pointer);
  var
    temp:pointer;
  begin
    if list^.next=nil then list := nil
    else begin
      temp := find_2_end(list);
      kil_list(temp^.next);
      temp^.next := nil;
    end;
  end;

  function sizeof_list(list:pointer):integer;
  begin
    if list=nil then sizeof_list := 0
    else sizeof_list := sizeof_list(list^.next)+1;
  end;

  procedure kil_nth(n:integer;var list:pointer);
  var
    i:integer;
    temp1,temp2:pointer;
  begin
    if (sizeof_list(list)=0) or (n>=sizeof_list(list)) then
      writeln('invalid input to kil_nth') else
    if n=0 then behead(list)
    else begin
      temp1 := list;
      for i := 1 to n-1 do temp1 := temp1^.next;
      temp2 := temp1^.next^.next;
      dispose(temp1^.next);
      temp1^.next := temp2;
    end;
  end;

  function sumof_list(list:pointer):integer;
  begin
    if list^.next=nil then sumof_list := list^.val
    else sumof_list := sumof_list(list^.next)+list^.val;
  end;

  function find_node(n:integer;list:pointer):pointer;
  begin
    if n=0 then find_node := list
    else find_node := find_node(n-1,list^.next);
  end;

  procedure add_head(var list,nod:pointer);
  begin
    nod^.next := list;
    list := nod;
  end;

  procedure insert_node(n:integer;var list,node1:pointer);
  var
    temp1,temp2:pointer;
  begin
    n := n - 1;
    if n=0 then add_head(list,node1)
    else begin
      temp1 := find_node(n,list);
      temp2 := temp1^.next;
      temp1^.next := node1;
      node1^.next := temp2;
    end;
  end;

  procedure mov_node(a,n:integer;var list:pointer);
  var
    temp:pointer;
  begin
    temp := find_node(a,list);
    kil_nth(a,list);
    insert_node(a+n,list,temp);
  end;

  procedure copy_list(var list1,list2:pointer);
  begin
    if list2=nil then list1 := nil
    else begin
      new(list1);
      list1^.val := list2^.val;
      copy_list(list1^.next,list2^.next);
    end;
  end;

  function find_node_val(c,n:integer;list:pointer):integer;
  begin
    if (n>list^.next^.val) or (list^.next=nil) then find_node_val := c
    else find_node_val := find_node_val(c+1,n,list^.next);
  end;

  procedure add_node(var list:pointer;nod:pointer);
  var
    temp,temp2:pointer;
    done:boolean;
  begin
    nod^.next := nil;
    if list=nil then
    begin
      list := nod;
    end else if nod^.val < list^.val then
    begin
      nod^.next := list;
      list := nod;
    end else begin
      temp := list;
      temp2 := list;
      done := false;
      while (temp <> nil) and (not done) do
      begin
        temp := temp^.next;
        if temp^.val > nod^.val then
        begin
          nod^.next := temp;
          temp2^.next := nod;
          done := true;
        end else temp2 := temp;
      end;
      if (temp^.next = nil) and (temp^.val < nod^.val) then temp^.next := nod;
    end;
  end;

  procedure make_list(var list:pointer);
  var
    i:integer;
    temp:pointer;
  begin
    new(list);
    list := nil;
    while i<>-1 do
    begin
      write('Enter next value (-1 to end):');
      readln(i);
      if i<>-1 then
      begin
        temp := nil;
        new(temp);
        temp^.val := i;
        add_node(list,temp);
        write_list(list);
      end;
    end;
  end;

  procedure sort_list(var list:pointer;list2:pointer);
  var temp:pointer;
  begin
    while list2<>nil do
    begin
      temp := list2^.next;
      add_node(list,list2);
      list2 := temp;
    end;
  end;

  procedure write_union(list,list2:pointer);
  var i:integer;
  begin
    sort_list(list,list2);
    i := 0;
    while (list <> nil) and (i<30) do
    begin
      if list^.val<>list^.next^.val then write(list^.val,'-');
      list := list^.next;
      i := i+1;
    end;
    writeln;
  end;

  procedure write_intersection(list,list2:pointer);
  var i:integer;
  begin
    sort_list(list,list2);
    i := 0;
    while (list <> nil) and (i<30) do
    begin
      if list^.val=list^.next^.val then write(list^.val,'-');
      list := list^.next;
      i := i+1;
    end;
    writeln;
  end;

  procedure kil_all_2nd(list:pointer);
  begin
    if (list=nil) or (list^.next=nil) then
    else begin
      kil_nth(1,list);
      kil_all_2nd(list^.next);
    end;
  end;

  procedure add_node_back(var list:pointer;nod:pointer);
  var
    temp,temp2:pointer;
    done:boolean;
  begin
    nod^.next := nil;
    if list=nil then
    begin
      list := nod;
    end else if nod^.val > list^.val then
    begin
      nod^.next := list;
      list := nod;
    end else begin
      temp := list;
      temp2 := list;
      done := false;
      while (temp <> nil) and (not done) do
      begin
        temp := temp^.next;
        if temp^.val < nod^.val then
        begin
          nod^.next := temp;
          temp2^.next := nod;
          done := true;
        end else temp2 := temp;
      end;
      if (temp^.next = nil) and (temp^.val > nod^.val) then temp^.next := nod;
    end;
  end;

  procedure reverse_list(var list:pointer);
  var temp,temp2:pointer;
  begin
    temp2 := nil;
    while list<>nil do
    begin
      temp := list^.next;
      add_node_back(temp2,list);
      list := temp;
    end;
    list := temp2;
  end;

  procedure main;
  var list,blah:pointer;
  begin
    writeln('Enter List1');
    make_list(list);
    write_list(list);
    writeln;
    writeln('list1 is:');
    write_list(list);
    writeln;
    writeln('list2 is:');
    write_list(blah);
    writeln;
    writeln('Enter List2');
    make_list(blah);
    writeln;
    add_node_end(list,blah);
    writeln('add node to end:');
    write_list(list);
    writeln;
    append_lists(list,blah);
    writeln('appended lists');
    write_list(list);
    writeln;
    writeln('Kill list');
    kil_list(list);
    write_list(list);
    writeln;
    writeln('Reverse list');
    reverse_list(list);
    write_list(list);
    writeln;
    writeln('Kill last node');
    kil_last(list);
    write_list(list);
    writeln;
    writeln('Kil nth (3rd) element');
    kil_nth(2,list);
    write_list(list);
    writeln;
    writeln('append and sort lists');
    sort_list(list,blah);
    write_list(list);
    writeln;
    writeln('The union is:');
    write_union(list,blah);
    writeln;
    writeln('The intersection is:');
    write_intersection(list,blah);
    writeln;
    writeln('Insert after nth(3rd)');
    insert_node(2,list,blah);
    write_list(list);
    writeln;
    writeln('Delete all 2nd');
    kil_all_2nd(list);
    write_list(list);}
    writeln;
    writeln('Sum of list:');
    writeln(sumof_list(list));
    writeln;
    writeln('Number of elements:');
    writeln(sizeof_list(list));
    writeln;
    writeln('Move node forward (2nd three fourward)');
    mov_node(2,3,list);
    write_list(list);
    writeln;
    writeln('Copy list');
    copy_list(blah,list);
    write('list1:');
    write_list(list);
    write('list2:');
    write_list(blah);
    writeln;
  end;

begin
  clrscr;
  main;
  repeat until keypressed;
end.