old/PAS/Dinamic/lists.pas

Unit LIsts;
Interface
{----------------=-=-=-=----------------}
{----------------=-=-=-=----------------}
{----------------=-=-=-=----------------}
type PList=^List;
     List=record
       val  : integer;
       next : Plist;
     end;
Procedure AddItem(var Li:PList; item:integer; num : word);
Procedure DeleteItem(var Li:PList;num:word);
Function  ListCount(Li:PList):word;
Procedure Sort(var Li:PList);
Function  GetItem(Li:PList;num:word):integer;
{----------------=-=-=-=----------------}
{----------------=-=-=-=----------------}
{----------------=-=-=-=----------------}
Implementation
{----------------=-=-=-=----------------}
Procedure AddItem(var Li:PList; item:integer; num : word);
var
 FF,La:PList;
 i:word;
begin
  La := Li;
  New(FF);
  FF^.val := item;
if num=1 then
  begin
    FF^.next := Li;
    Li := FF;
  end
else if ListCount(Li)<num then
  begin
    while La^.next<>nil do La:=La^.next;
    FF^.next := nil;
    La^.next := FF;
  end
else
 begin
  for i:= 3 to num do La := La^.next;
  FF^.next := La^.next;
  La^.next := FF;
 end;
end;
{----------------=-=-=-=----------------}
Procedure DeleteItem(var Li:PList;num:word);
var tm,tm2 : PList;i:word;
begin
 if num > ListCount(Li) then Exit;
 if num=1 then
  begin
    tm := Li^.next;
    dispose(Li);
    Li := tm;
  end
 else
  begin
    tm := Li;
    for i:=3 to num do tm:=tm^.next;
    tm2:=tm^.next;
    tm^.next := tm2^.next;
    dispose(tm2);
  end;
end;
{----------------=-=-=-=----------------}
Function  ListCount(Li:PList):word;
var TM:Plist;i,ret:word;
begin
  Tm := Li;
  if Li=nil then ret:=0
  else  begin ret:=1;
  while tm^.next<>nil do begin tm:=tm^.NEXT; inc(ret);end;
  end;
  ListCount:=ret;
end;
Function  GetItem(Li:PList;num:word):integer;
var i:word;  La  : PList;
begin
  La:=Li;
  if ListCount(Li)>=num then begin
  for i := 2 to num do La:=La^.next;
  GetItem := La^.val;
  end else
    GetItem:=-1;
end;
Procedure Sort(var Li:PLIST);
var 
 newli,k,ends2:plist;
begin
  New(newli);
  newli^.val := li^.val;
  newli^.next := nil;
  k := li^.next;
  Dispose(li);
  li := k;
  k := newli;

  repeat
     while (k^.val > li^.val) and (k^.next <> nil) do k := k^.next;
     if (k^.next = nil) and (k^.val > li^.val) then
       begin
        New(ends2);
        ends2^.next := nil;
        ends2^.val := li^.val;
        k^.next := ends2;
       end
     else
      begin
        New(ends2);
        ends2^.next := k^.next;
        k^.next := ends2;
        ends2^.val := k^.val;
        k^.val     := li^.val;
      end;
     k := li^.next;
     Dispose(li);
     li := k;
     k := newli;
  until li = nil;
  li := newli;
end;
end.