(**************************************************************************

:Program.    EdLists.mod
:Contents.   Lists-module modified for AmokEd
:Author.     Fridtjof Siebert, Hartmut Goebel [hG]
:Language.   Oberon
:Translator. AmigaOberon V2.00
:History.    V1.0, 17-Jun-90 Fridtjof Siebert
:History.    V1.1, 10-Jan-91 H.Goebel: AddSection...,GoForw./Backw.
:History.    V1.2, 28-Mar-91   [hG] SetMark, ..Area..->..Mark..
:History.    V1.3, 30 Sep 1991 [hG] + GetPred, GetSucc, Swap
:History.    V1.4, 17 Oct 1991 [hG] + IsElement, GoForward/BackwardNil
:Date.       17 Oct 1991 20:48:37

:Remark.     only changes to the original Module are:
:Remark.       STRUCTs instead of RECORDs, STRUCT-elements exported

**************************************************************************)

MODULE EdLists;

TYPE
  NodePtr* = POINTER TO Node;
  Node* = STRUCT
            next*, prev*: NodePtr;
          END;
  List* = STRUCT
            head* : NodePtr;
            tail* : NodePtr;
            remallowed: INTEGER;
          END;
  Mark* = List;

  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;
END Init;

(*------ Add ------------------------------*)

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;
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;
END AddTail;


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;
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;
END AddBehind;

(*------ Remove ---------------------------*)

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;
  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;

(*------ Do Forward/Backward --------------*)

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;

(*------ Elements -------------------------*)

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 GetSucc*(n: NodePtr): NodePtr;
BEGIN
  RETURN n.next;
END GetSucc;


PROCEDURE GetPred*(n: NodePtr): NodePtr;
BEGIN
  RETURN n.prev;
END GetPred;


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


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

(*------ Go Forward/Backward --------------*)

PROCEDURE GoForward*(list: List; VAR n: NodePtr; num: LONGINT);
BEGIN
  WHILE (num>0) AND (n#NIL) DO
    n := n.next;
    DEC(num);
  END;
  IF n=NIL THEN n:=list.tail; END;
END GoForward;


PROCEDURE GoBackward*(list: List; VAR n: NodePtr; num: LONGINT);
BEGIN
  WHILE (num>0) AND (n#NIL) DO
    n := n.prev;
    DEC(num);
  END;
  IF n=NIL THEN n:=list.head; END;
END GoBackward;


PROCEDURE GoForwardNil*(VAR n: NodePtr; num: LONGINT);
BEGIN
  WHILE (num>0) AND (n#NIL) DO
    n := n.next;
    DEC(num);
  END;
END GoForwardNil;


PROCEDURE GoBackwardNil*(VAR n: NodePtr; num: LONGINT);
BEGIN
  WHILE (num>0) AND (n#NIL) DO
    n := n.prev;
    DEC(num);
  END;
END GoBackwardNil;

(*------ misc -----------------------------*)

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


PROCEDURE IsElement*(VAR list: List; e: NodePtr): BOOLEAN;
VAR
  n: NodePtr;
BEGIN
  n := list.head;
  WHILE n # NIL DO
    IF n = e THEN RETURN TRUE; END;
    n := n.next;
  END;
  RETURN FALSE;
END IsElement;


PROCEDURE CountElements*(VAR list: List): LONGINT;
VAR
  i: LONGINT;
  n: NodePtr;
BEGIN
  i := 0;
  n := list.head;
  WHILE n#NIL DO n := n.next; INC(i) END;
  RETURN i;
END CountElements;


PROCEDURE Swap*(VAR list: List; a,b: NodePtr);
VAR
  c: NodePtr;
BEGIN
  c := b.prev;
  Remove(list,b);
  AddBehind(list,b,a);
  Remove(list,a);
  IF c = NIL THEN AddHead(list,a);
             ELSE AddBehind(list,c,a); END;
END Swap;

(*------ marks and things around ----------*)

PROCEDURE AddMarkBefore*(VAR list: List; mark: Mark; x: NodePtr);
(* fügt mark vor x in die Liste ein *)

BEGIN
  mark.head.prev := x.prev;
  mark.tail.next := x;
  x.prev := mark.tail;
  IF mark.head.prev=NIL THEN list.head := mark.head
                ELSE mark.head.prev.next := mark.head END;
  INC(mark.remallowed);
END AddMarkBefore;


PROCEDURE AddMarkBehind*(VAR list: List; mark: Mark; x: NodePtr);
(* fügt mark hinter x in die Liste ein *)

BEGIN
  mark.tail.next := x.next;
  mark.head.prev := x;
  x.next := mark.head;
  IF mark.tail.next=NIL THEN list.tail := mark.tail
                     ELSE mark.tail.next.prev := mark.tail END;
  INC(mark.remallowed);
END AddMarkBehind;


PROCEDURE AddMarkHead*(VAR list: List; mark: Mark);
BEGIN
  mark.tail.next := list.head;
  mark.head.prev := NIL;
  IF mark.tail.next=NIL THEN list.tail   := mark.tail;
                ELSE mark.tail.next.prev := mark.tail END;
  list.head := mark.head;
  INC(mark.remallowed);
END AddMarkHead;


PROCEDURE AddMarkTail*(VAR list: List; mark: Mark);
BEGIN
  mark.head.prev := list.tail;
  mark.tail.next := NIL;
  IF mark.head.prev=NIL THEN list.head   := mark.head;
                ELSE mark.head.prev.next := mark.head END;
  list.tail := mark.tail;
  INC(mark.remallowed);
END AddMarkTail;


PROCEDURE RemoveMark*(VAR list: List; mark: Mark);
BEGIN
  IF (mark.head#NIL) AND (mark.tail#NIL)THEN
    IF list.remallowed # 0 THEN HALT(20) END;
    IF mark.tail.next#NIL THEN
      mark.tail.next.prev := mark.head.prev
    ELSE
      list.tail := mark.head.prev
    END;
    IF mark.head.prev#NIL THEN
      mark.head.prev.next := mark.tail.next
    ELSE
      list.head := mark.tail.next
    END;
  END;
  DEC(mark.remallowed);
END RemoveMark;


PROCEDURE SetMark*(VAR mark: Mark; h,t: NodePtr);
BEGIN
  IF (h=NIL) AND (t=NIL) THEN
    mark.head := NIL; mark.tail := NIL;
  ELSE
    IF h#NIL THEN mark.head := h; END;
    IF t#NIL THEN mark.tail := t; END;
  END;
  IF mark.remallowed=0 THEN mark.remallowed := 1; END;
END SetMark;

END EdLists.