🚀 go-pugleaf

Hi:

  I am posting the following on behalf of Truszek Lajos,
who does not have a good connection to Usenet. Please forward
all comments to him, at 100263.105@compuserve.com

Wojtek

From: Truszek Lajos <100263.105@compuserve.com>
To: Wojtek Skulski <skulski@nsrl31.nsrl.rochester.edu>
Subject: RE: Collections in Oberon
Message-ID: <951221145312_100263.105_EHV141-1@CompuServe.COM>

Wojtek !
Thank you for your mail.Sorry i am using last time only Oberon/F,how can I
decode your file what you send me.
I send you an implementation of a collection ported from Borland Pascal .
I have no direct connection internet to Oberon/F newsgroup can you make
it avaiable for other Oberon friends.Thank you.

with best regards Attila Truszek

the source of collections  folows here ====>
(*********************************************************)
(*                                                      *)
(*       Collections Module   (with Oberon/F 1.1)        *)
(*                                                     *)
(*  The module defintions comes from Borland Pascal 7.0  *)      
(*    implemented in Oberon/F by Attila and Lajos Truszek *)  
(*    e-mail   : 100263.105@Compuserve.Com               *)    
(*   Phone     : 00+36 34383840                          *)
(*   Address   :  Hungary H-2890 TATA Szechenyi u 4.     *)
(*                                                       *) 
(*********************************************************)

MODULE Collections;

  IMPORT Stores;
  
  TYPE
    ItemList = POINTER TO ItemListDesc;
    ItemListDesc = ARRAY OF Stores.Store;
  

    Collection* = POINTER TO CollectionDesc;
    CollectionDesc* = RECORD(Stores.StoreDesc)
      Items : ItemList;
      Count-,
      Limit-: INTEGER
    END;

    SortedCollection* = POINTER TO SortedCollectionDesc;
    SortedCollectionDesc* = RECORD(CollectionDesc)
      Duplicates-: BOOLEAN
    END;

    String* = POINTER TO StringDesc;  
    StringDesc* = RECORD (Stores.StoreDesc)
      str : POINTER TO ARRAY OF CHAR      
    END;      
  
    StringCollection* = POINTER TO StringCollectionDesc;
    StringCollectionDesc* = RECORD(SortedCollectionDesc)
    END;
        
    EqualProc* = PROCEDURE (Item : Stores.Store) : BOOLEAN;
    EachProc*  = PROCEDURE (Item : Stores.Store);


PROCEDURE (t : Collection) SetLimit*(ALimit : INTEGER);
VAR AItems : ItemList; i : INTEGER;
BEGIN (* SetLimit *)
  IF ALimit < t.Count THEN 
    ALimit := t.Count 
  END;
  IF ALimit # t.Limit THEN
    IF ALimit = 0 THEN AItems := NIL 
    ELSE
      NEW(AItems,ALimit); (* GetMem *)
      FOR i := 0 TO ALimit - 1 DO AItems[i] := NIL END;
      IF (t.Count # 0) & (t.Items # NIL) THEN
        FOR i := 0 TO t.Count DO 
          AItems[i] := t.Items[i]
        END
      END  
    END;
    IF t.Limit # 0 THEN t.Items := NIL (* FreeMem *) END;
    t.Items := AItems;
    t.Limit := ALimit
  END
END SetLimit;
PROCEDURE (t : Collection) Init*(ALimit : INTEGER);
BEGIN (* Init *)
  t.Items := NIL;
  t.Count := 0;
  t.Limit := 0;
  t.SetLimit(ALimit)
END Init;

PROCEDURE (t : Collection) Internalize*(VAR rd : Stores.Reader);
VAR
  c, i: INTEGER;
  s : Stores.Store;
  
BEGIN (* Internalize *)
  t.Internalize^(rd);
  rd.ReadInt(t.Count);
  rd.ReadInt(t.Limit);
  t.Items := NIL;
  c := t.Count;
  i := t.Limit;
  t.Count := 0;
  t.Limit := 0;
  t.SetLimit(i);
  t.Count := c;
  FOR i := 0 TO c - 1 DO
    rd.ReadStore(s); 
    t.Items[i] := s
  END
END Internalize;

PROCEDURE (t : Collection) ForEach*(Action : EachProc);
VAR i : INTEGER; 
BEGIN (* ForEach *)
  FOR i := 0 TO t.Count - 1 DO 
    Action(t.Items[i]) 
  END
END ForEach;

PROCEDURE (t : Collection) Externalize*(VAR wr : Stores.Writer);
VAR i : INTEGER;
BEGIN (* Externalize *)
  t.Externalize^(wr);
  wr.WriteInt(t.Count);
  wr.WriteInt(t.Limit);
  FOR i := 0 TO t.Count - 1 DO
    wr.WriteStore(t.Items[i])
 END
END Externalize;

PROCEDURE (t : Collection) At*(Index : INTEGER) : Stores.Store;
BEGIN (* At *)
  RETURN t.Items[Index]
END At;

PROCEDURE (t : Collection) DeleteAll*;
BEGIN (* DeleteAll *)
   t.Count := 0;
   t.Items :=NIL; 
END DeleteAll;

PROCEDURE (t : Collection) AtDelete*(Index : INTEGER); 
VAR i : INTEGER;
BEGIN (* AtDelete *)
  FOR i := Index TO t.Count - 1 DO
    t.Items[i] := t.Items[i+1]
  END;
  DEC(t.Count)
END AtDelete;

PROCEDURE (t : Collection) AtInsert*(Index : INTEGER;Item : Stores.Store);
VAR i : INTEGER;
BEGIN (* AtInsert *)
  ASSERT((Index < t.Limit) & (Index >= 0));
  FOR i := t.Count -1 TO Index BY -1 DO
    t.Items[i+1] := t.Items[i] 
  END;
  t.Items[Index] := Item;
  INC(t.Count)  
END AtInsert;

PROCEDURE (t : Collection) IndexOf*(Item : Stores.Store) : INTEGER; 
VAR i : INTEGER;
BEGIN (* IndexOf *)
  i := 0;
  WHILE (i < t.Count) & (t.Items[i] # Item) DO 
    INC(i) 
  END;
  IF i > t.Count THEN 
    i := -1; 
  END;
  RETURN i
END IndexOf;


PROCEDURE (t : Collection) Delete*(Item : Stores.Store);
BEGIN  (* Delete *) t.AtDelete(t.IndexOf(Item))
END Delete;

PROCEDURE (t : Collection) FirstThat*(Test : EqualProc) : Stores.Store; 
VAR i : INTEGER; s : Stores.Store;
BEGIN (* FirstThat *)
  s := NIL;
  i := 0;
  WHILE (i < t.Count) & ~ Test(t.Items[i]) DO INC(i) END;
  IF i <= t.Count THEN s := t.Items[i] END;
  RETURN s
END FirstThat;

PROCEDURE (t : Collection) LastThat*(Test : EqualProc) : Stores.Store; 
VAR i : INTEGER; s : Stores.Store;
BEGIN (* LastThat *)
  s := NIL;
  i := t.Count - 1;
  WHILE (i >= 0) & ~ Test(t.Items[i]) DO DEC(i) END;
  IF i >= 0 THEN s := t.Items[i] END;
  RETURN s
END LastThat;

PROCEDURE (t : Collection) Insert*(Item : Stores.Store);
BEGIN  (* Insert *) t.AtInsert(t.Count, Item)
END Insert;


(********* SortedCollection *********)

PROCEDURE (t : SortedCollection) Init*(ALimit : INTEGER);
BEGIN  (* Init *)
  t.Init^(ALimit);
  t.Duplicates := FALSE
END Init;

PROCEDURE (t : SortedCollection) Compare*(Key1,Key2 : Stores.Store) : INTEGER;
BEGIN (* Compare *) RETURN 0
END Compare;


PROCEDURE (t : SortedCollection) Search*(Key : Stores.Store;
                                      VAR Index : INTEGER) : BOOLEAN;
VAR
  L,H,I,C : LONGINT;
  found : BOOLEAN;

BEGIN (* Search *)
  found := FALSE;
  L := 0;
  H := t.Count - 1;
  WHILE L <= H DO
    I := (L + H) DIV 2;
    C := t.Compare(t.Items[I],Key);
    IF C < 0 THEN
      L := I + 1
    ELSE
      H := L - 1;
      IF C = 0 THEN
        found := TRUE;
        IF ~ t.Duplicates THEN
          L := I
        END
      END
    END
  END;
  Index := SHORT(L);
  RETURN found
END Search;

PROCEDURE (t : SortedCollection) IndexOf*(Item : Stores.Store) : INTEGER;
VAR i,j : INTEGER;
BEGIN (* IndexOf *)
  j := -1;
  IF t.Search(Item,i) THEN
    IF t.Duplicates THEN
      WHILE (i < t.Count) & (Item # t.Items[i]) DO INC(i) END;
      IF i < t.Count THEN j := i END
    END
  END;
  RETURN j
END IndexOf;                

PROCEDURE (t : SortedCollection) Insert*(Item : Stores.Store);
VAR i : INTEGER;
BEGIN (* Insert *)
  IF ~ t.Search(Item,i) OR t.Duplicates THEN
    t.AtInsert(i,Item)
  END
END Insert;

PROCEDURE Length(s : ARRAY OF CHAR) : INTEGER;
VAR i : INTEGER;

BEGIN (* Length *)
  i := 0;
  WHILE (i <= LEN(s)) & (s[i] # 0X) DO INC(i) END;  
  IF i > LEN(s) THEN i := SHORT(LEN(s)) END;
  RETURN i
END Length;

PROCEDURE (t : String) Init*(s : ARRAY OF CHAR);
BEGIN (* Init *)
  NEW(t.str,Length(s));
  COPY(s,t.str^)
END Init;

PROCEDURE (t : String) Get*(VAR s : ARRAY OF CHAR);
BEGIN (* Get *) COPY(t.str^,s)
END Get;

END Collections.



MODULE Example;

(* A simple demostrations program for using Collenctions *)

  IMPORT Collections,Out,Stores,Files;
  
  TYPE
    obj = POINTER TO objdesc; 
    objdesc = RECORD (Stores.StoreDesc)
      data : ARRAY 32 OF CHAR
    END;
      
    MyColl = POINTER TO MyCollDesc;
    MyCollDesc = RECORD(Collections.SortedCollectionDesc)
    END;
  
  PROCEDURE (t : obj) Externalize*(VAR w : Stores.Writer);
  BEGIN
    t.Externalize^(w);
    w.WriteString(t.data);  
  END Externalize;
  
  PROCEDURE (t : obj) Internalize*(VAR rd : Stores.Reader);
  BEGIN
    t.Internalize^(rd);
    rd.ReadString(t.data);  
  END Internalize;
  
  PROCEDURE (m : MyColl) Compare*(e1,e2 : Stores.Store) : INTEGER;
  VAR i : INTEGER;
  BEGIN
    IF e1(obj).data = e2(obj).data THEN i := 0
    ELSIF e1(obj).data < e2(obj).data THEN i := -1
    ELSIF e1(obj).data > e2(obj).data THEN i := 1
    END;
    RETURN i
  END Compare;
  
  PROCEDURE  Show (e : Stores.Store); 
  BEGIN
    Out.String("data=");
    Out.String(e(obj).data); Out.Ln
  END Kiir;
    
  PROCEDURE P1*;
  VAR 
    p : MyColl;
    obj1,obj2,obj3 : obj;
    w : Stores.Writer;
    r  : Stores.Reader;  
    loc : Files.Locator;
    i,res : LONGINT;
    f : Files.File; 
    s : ARRAY 2 OF CHAR;
    
  BEGIN
    
    NEW(p);
    p.Init(3);
    NEW(obj1); obj1.data := "s3";
    p.Insert(obj1);
    NEW(obj1); obj1.data := "s1";
    p.Insert(obj1);
    NEW(obj1); obj1.data := "s2";
    p.Insert(obj1);
    loc := Files.dir.This("Prob");
    f := Files.dir.New(loc);
    w.ConnectTo(f);
    p.Externalize(w);
    f.Register("TEST.DAT","",res); 
    ASSERT(res = 0);
    f := Files.dir.Old(loc,"TEST.DAT",TRUE);
    ASSERT(f # NIL); 

    r.ConnectTo(f);
    p.Internalize(r);
    p.ForEach(Show);
    
  END P1;
  
BEGIN

END Example.