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

MODULE FArrays;
(*
 * Provides a resizeable, flexible array type named FArray.
 *
 *)

IMPORT BT * := BasicTypes;

TYPE
  FArray * = POINTER TO FArrayDesc;

  ArrayOfAny = POINTER TO ARRAY OF BT.ANY;

  FArrayDesc * = RECORD (BT.COLLECTIONDesc)
    elements: ArrayOfAny;
    lower-,upper-: LONGINT;
  END;


PROCEDURE Create * (minindex,maxindex: LONGINT): FArray;
(*
 * require
 *   minindex <= maxindex
 *
 * ensure
 *   Result.lower=minindex;
 *   Result.upper=maxindex
 *
 *)

VAR
  a: FArray;
BEGIN
  NEW(a);
  a.lower := minindex;
  a.upper := maxindex;
  NEW(a.elements,maxindex-minindex+1);
  RETURN a;
END Create;


PROCEDURE (a: FArray) Put * (v: BT.ANY; at: LONGINT);
(*
 * require
 *   lower <= at;
 *   at <= upper;
 *   elements#NIL;
 * ensure
 *   Get(at)=v
 *)

BEGIN
  a.elements[at-a.lower] := v;
END Put;


PROCEDURE (a: FArray) Get * (at: LONGINT): BT.ANY;
(*
 * require
 *   lower <= at;
 *   at <= upper;
 *   elements#NIL;
 *)

BEGIN
  RETURN a.elements[at-a.lower];
END Get;


PROCEDURE (a: FArray) Resize * (minindex,maxindex: LONGINT);
(*
 * require
 *   a.elements#NIL
 *
 * ensure
 *   lower<=minindex;
 *   upper>=maxindex
 *
 *)

VAR
  new: ArrayOfAny;
  i: LONGINT;

BEGIN
  IF (minindex<a.lower) OR (maxindex>a.upper) THEN
    IF minindex>a.lower THEN minindex := a.lower END;
    IF maxindex<a.upper THEN maxindex := a.upper END;
    NEW(new,maxindex-minindex+1);
    FOR i:=0 TO a.upper-a.lower DO
      new[i+a.lower-minindex] := a.elements[i];
    END;

(* $IFNOT GarbageCollector *)

    DISPOSE(a.elements);

(* $END  *)

    a.elements := new;
    a.lower := minindex;
    a.upper := maxindex;
  END;
END Resize;


(*
 * redefinition of inherited routines:
 *
 *)


PROCEDURE (a: FArray) Add        * (x: BT.ANY);  
(*
 * Does nothing useful. DO NOT USE!
 *)
BEGIN
  HALT(20);
END Add;


PROCEDURE (a: FArray) Remove     * (x: BT.ANY);
(* removes x from c.
 *)
VAR
  i: LONGINT;
BEGIN
  FOR i := a.lower TO a.upper DO
    IF a.elements[i]=x THEN a.elements[i] := NIL END;
  END;
END Remove;


PROCEDURE (a: FArray) nbElements * (): LONGINT;
(* returns the number of elements within c.
 *)
BEGIN
  RETURN a.upper-a.lower+1;
END nbElements;


PROCEDURE (a: FArray) Do         * (p: BT.DoProc; par: BT.ANY);
(* calls p(x,par) for every element x stored within c.
 * par passes some additional information to p. par is not touched by Do.
 *)
VAR
  i: LONGINT;
BEGIN
  FOR i := a.lower TO a.upper DO
    p(a.elements[i],par);
  END;
END Do;


END FArrays.