Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Misc/OB3.2D2.DMS/in.adf/Module/Lists.mod

Text File | 1994-08-05 | 4.6 KB | 239 lines

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: Lists                Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE Lists;

IMPORT BT * := BasicTypes;

TYPE
  NodePtr* = POINTER TO Node;
  Node* = RECORD (BT.ANYDesc)
    next-: NodePtr;
    prev-: NodePtr;
  END;

  ListPtr * = POINTER TO List;
  List* = RECORD (BT.COLLECTIONDesc)
    head-: NodePtr;
    tail-: NodePtr;
    remallowed: INTEGER;
    numElements: LONGINT;
  END;

  DoProc * = PROCEDURE(n: NodePtr);

(* Die DoProc darf Remove(), RemHead() und RemTail() nicht benutzen. *)


PROCEDURE Init*(VAR list: List);
BEGIN
  list.head := NIL;
  list.tail := NIL;
  list.remallowed := 0;
  list.numElements := 0;
END Init;


PROCEDURE AddHead*(VAR list: List; n: NodePtr);
BEGIN
  n.next := list.head;
  n.prev := NIL;
  IF n.next=NIL THEN list.tail   := n;
                ELSE n.next.prev := n END;
  list.head := n;
  INC(list.numElements);
END AddHead;


PROCEDURE AddTail*(VAR list: List; n: NodePtr);
BEGIN
  n.prev := list.tail;
  n.next := NIL;
  IF n.prev=NIL THEN list.head   := n;
                ELSE n.prev.next := n END;
  list.tail := n;
  INC(list.numElements);
END AddTail;


PROCEDURE Remove*(VAR list: List; n: NodePtr);
BEGIN
  IF n#NIL THEN
    IF list.remallowed # 0 THEN HALT(20) END;
    IF n.next#NIL THEN n.next.prev := n.prev ELSE list.tail := n.prev END;
    IF n.prev#NIL THEN n.prev.next := n.next ELSE list.head := n.next END;
    DEC(list.numElements);
  END;
END Remove;


PROCEDURE RemHead*(VAR list: List): NodePtr;
VAR n: NodePtr;
BEGIN
  n := list.head; Remove(list,n); RETURN n;
END RemHead;


PROCEDURE RemTail*(VAR list: List): NodePtr;
VAR n: NodePtr;
BEGIN
  n := list.tail; Remove(list,n); RETURN n;
END RemTail;


PROCEDURE AddBefore*(VAR list: List;
                         n,x: NodePtr);
(* fügt n vor x in die Liste ein *)

BEGIN
  n.prev := x.prev;
  n.next := x;
  x .prev := n;
  IF n.prev=NIL THEN list.head   := n
                ELSE n.prev.next := n END;
  INC(list.numElements);
END AddBefore;


PROCEDURE AddBehind*(VAR list: List;
                         n,x: NodePtr);
(* fügt n hinter x in die Liste ein *)

BEGIN
  n.next := x.next;
  n.prev := x;
  x .next := n;
  IF n.next=NIL THEN list.tail   := n
                ELSE n.next.prev := n END;
  INC(list.numElements);
END AddBehind;


PROCEDURE Empty*(VAR list: List): BOOLEAN;
BEGIN
  RETURN list.numElements=0
END Empty;


PROCEDURE CountElements*(VAR list: List): LONGINT;
BEGIN
  RETURN list.numElements;
END CountElements;


PROCEDURE DoForward*(VAR list: List; proc: DoProc);
VAR n: NodePtr;
BEGIN
  INC(list.remallowed);
  n := list.head; WHILE n#NIL DO proc(n); n := n.next END;
  DEC(list.remallowed);
END DoForward;


PROCEDURE DoBackward*(VAR list: List; proc: DoProc);
VAR n: NodePtr;
BEGIN
  INC(list.remallowed);
  n := list.tail; WHILE n#NIL DO proc(n); n := n.prev END;
  DEC(list.remallowed);
END DoBackward;


PROCEDURE Next*(VAR n: NodePtr): BOOLEAN;
BEGIN
  n := n.next;
  RETURN n#NIL;
END Next;


PROCEDURE Previous*(VAR n: NodePtr): BOOLEAN;
BEGIN
  n := n.prev;
  RETURN n#NIL;
END Previous;


PROCEDURE Succ*(VAR n: NodePtr);
BEGIN
  n := n.next;
END Succ;


PROCEDURE Pred*(VAR n: NodePtr);
BEGIN
  n := n.prev;
END Pred;


PROCEDURE Head*(VAR list: List): NodePtr;
BEGIN
  RETURN list.head;
END Head;


PROCEDURE Tail*(VAR list: List): NodePtr;
BEGIN
  RETURN list.tail;
END Tail;


PROCEDURE (list: ListPtr) Add        * (x: BT.ANY);
(*
 * Adds x to the tail of list.
 *)
BEGIN
  AddTail(list^,x(Node));
END Add;


PROCEDURE (list: ListPtr) Remove     * (x: BT.ANY);
(*
 * removes x from list.
 *)
BEGIN
  Remove(list^,x(Node));
END Remove;


PROCEDURE (list: ListPtr) nbElements * (): LONGINT;
(* returns the number of elements within list.
 *)
BEGIN
  RETURN list.numElements
END nbElements;


PROCEDURE (list: ListPtr) isEmpty * (): BOOLEAN;
(* is list empty?
 *)
BEGIN
  RETURN list.numElements=0
END isEmpty;


PROCEDURE (list: ListPtr) Do         * (p: BT.DoProc; par: BT.ANY);
(* calls p(x,par) for every element x stored within list.
 * par passes some additional information to p. par is not touched by Do.
 *)
VAR
  n: NodePtr;
BEGIN
  INC(list.remallowed);
  n := list.head; WHILE n#NIL DO p(n,par); n := n.next END;
  DEC(list.remallowed);
END Do;


END Lists.