[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]

    { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
      Demonstration; sample unit with ADT implementation of the standard array

      This is an abstract data type engine for the Borland Pascal array list.
      The program requires EFLIB to compile. EFLIB is a FREE and POWERFUL
      object-oriented toolkit for Borland Pascal, to compile. It's available
      via Internet at http://www.ts.umu.se/~jola/EFLIB/. EFLIB features not
      only data structures, but also streams, user interface, and much more.

      If you have any question, write an e-mail to Johan Larsson at
      jola@ts.umu.se.

      THIS SOURCE CODE IS DONATED TO PUBLIC DOMAIN FOR DISTRIBUTION WITH THE
      SWAG PACKAGE. FEEL FREE TOO USE THE SOURCE CODE TO MAKE YOUR OWN,
      ADVANCED EFLIB COMPATIBLE DATA STRUCTURE. }

    unit STDARRAY;

    INTERFACE

    uses EFLIBDEF, EFLIBDAT;

    const NumberOfElements = 1000;

    type { Type of elements inside standard array object }
         ElementType                       = real;

         { Implementation of a standard Pascal array with a compile-time fixed
           size. Because this object is inherited from EFLIBs parent object for
           data types, it has features such as sorting, searching and stream
           storage (inherited methods). }
         StandardArrayObjectPointerTyp     = ^StandardArrayObjectType;
         StandardArrayObjectType           = object (DataObjectType)
                                                 public
                                                   { Fields }
                                                   BaseArray        : array [1 .. NumberOfElements] of ElementType;
                                                   LastUsed         : word;
                                                   { Miscellaneous methods }
                                                   procedure Clear; virtual;                           { Clears all elements }
                                                   { Methods for handling of elements }
                                                   procedure Add (var Data); virtual;                  { Adds an element }
                                                   procedure Insert (var Data; Index : word); virtual; { Inserts an element }
                                                   procedure Update (Index : word; var Data); virtual; { Updates an element }
                                                   procedure Element (Index : word; var Data);
                                                             virtual;                                  { Retrieves an element }
                                                   procedure Erase (Index : word); virtual;            { Erases an element }
                                                   function Compare (Index1, Index2 : word) :
                                                            shortint; virtual;                         { Compares two elements }
                                                   function CompareContent (Index : word; var Data) :
                                                            shortint; virtual;                         { Compares element content }
                                                   { Methods for stream storage }
                                                   constructor StreamLoad (Stream : pointer);          { Loads from a stream }
                                                   { Methods for direct element access }
                                                   function ElementSize (Index : word) :
                                                            word; virtual;                             { Size of element data }
                                                   function ElementPointer (Index : word) :
                                                            pointer; virtual;                          { Returns element pointer }
                                                   { Status methods }
                                                   function Elements : word; virtual;                  { Number of elements }
                                                   function Capacity : word; virtual;                  { Capacity of elements }
                                                   function NameOfType : string; virtual;              { Name of object type }
                                             end;

    IMPLEMENTATION

    {$B-} {$IFNDEF DEBUG} {$I-} {$S-} {$R-} {$Q-} {$ENDIF}

    uses EFLIBIO;

    { *** StandardArrayObjectType *** }

    { Clears data type (ie. erases all elements). }
    procedure StandardArrayObjectType.Clear;
    begin
         FillChar (BaseArray, SizeOf(BaseArray), 0);
         LastUsed := 0;
    end;

    { Adds data into data type in a new element. }
    procedure StandardArrayObjectType.Add (var Data);
    begin
         if LastUsed < Capacity then begin
            Inc (LastUsed); BaseArray[LastUsed] := ElementType(Data);
         end else { Error; array is full } ;
    end;

    { Inserts data to data type in a new element that follows specified indexed
      element in order. If index is zero, element is inserted first in the
      data type. }
    procedure StandardArrayObjectType.Insert (var Data; Index : word);
    var Count : word;
    begin
         if Capacity > Elements then begin
            { Pull elements inside array to make space for a new element }
            for Count := Elements downto Succ(Index) do
                BaseArray[Succ(Count)] := BaseArray[Count];
            Inc (LastUsed); BaseArray[Index] := ElementType (Data);
         end else { Error; array is full } ;
    end;

    { Updates an element in the data type. }
    procedure StandardArrayObjectType.Update (Index : word; var Data);
    begin
         if (Index >= 1) and (Index <= Elements) then
            BaseArray[Index] := ElementType(Data)
         else { Error; range check error; not a valid element index } ;
    end;

    { Returns the data in an indexed element in the data type. }
    procedure StandardArrayObjectType.Element (Index : word; var Data);
    begin
         if IsValid (Index) then
            Move (BaseArray[Index], Data, ElementSize(Index))
         else { Error; range check error; not a valid element index } ;
    end;

    { Erases an element from the data type. This is a method that must be
      overridden by all descendants. }
    procedure StandardArrayObjectType.Erase (Index : word);
    var Count : word;
    begin
         if IsValid(Index) then begin
            { Pull elements inside array to make space for a new element }
            for Count := Index to Pred(Elements) do
                BaseArray[Count] := BaseArray[Succ(Count)];
            Dec (LastUsed);
         end else { Error; range check error; not a valid element index } ;
    end;

    { Compares two indexed elements inside the data type and returns
      1, 0 or -1, depending on if the first element is bigger, equal
      or smaller than the second element. }
    function StandardArrayObjectType.Compare (Index1, Index2 : word) : shortint;
    begin
         if BaseArray[Index1] > BaseArray[Index2] then Compare := 1
            else if BaseArray[Index1] < BaseArray[Index2] then Compare := -1
                 else Compare := 0;
    end;

    { Compares the content of an elements with some data and returns
      1, 0 or -1, depending on if the element is bigger, equal or smaller
      than the data. }
    function StandardArrayObjectType.CompareContent (Index : word; var Data) : shortint;
    begin
         if BaseArray[Index] > ElementType(Data) then CompareContent := 1
            else if BaseArray[Index] < ElementType(Data) then CompareContent := -1
                 else CompareContent := 0;
    end;

    { Constructs and loads the object from a stream. This is an abstract
      constructor that must be overridden by all descendants that support
      stream storage. }
    constructor StandardArrayObjectType.StreamLoad (Stream : pointer);
    var Storage : StreamObjectPointerType absolute Stream;
    begin
         if Storage^.IsInitialized and Storage^.IsAllocated and
            not Storage^.IsWriteOnly then with Storage^ do begin

            { Load object data }
            if Initialize then Inherited StreamLoad (Storage);

         end else { Error; failed to load object } ;
    end;

    { Returns the size of elements inside the data type. }
    function StandardArrayObjectType.ElementSize (Index : word) : word;
    begin ElementSize := SizeOf(ElementType); end;

    { Returns a pointer to a specified elements data region. }
    function StandardArrayObjectType.ElementPointer (Index : word) : pointer;
    begin ElementPointer := @BaseArray[Index]; end;

    { Returns the number of elements inside the data type. }
    function StandardArrayObjectType.Elements : word;
    begin Elements := LastUsed; end;

    { Returns the number of elements that can be stored inside the data
      type. }
    function StandardArrayObjectType.Capacity : word;
    begin Capacity := SizeOf(BaseArray) div ElementSize (0); end;

    { Returns the full Borland Pascal name of the object type }
    function StandardArrayObjectType.NameOfType : string;
    begin NameOfType := 'StandardArrayObjectType'; end;

    end. { unit }

    { - - - - - - - - - - - Cut here - - - - - - - - - }

    { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
      Demonstration; example on ARRAYLST.PAS implementation

      EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
      MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL! THIS DEMONSTRAT-
      ION PROGRAM MAY FREELY BE USED AND DISTRIBUTED.                          }

    uses EFLIBDEF, STDARRAY;

    var MyArray : StandardArrayObjectType; Number : real;

    begin
         WriteLn ('* Standard Pascal array implemented as a polymorphic EFLIB data type *');

         with MyArray do begin
              Initialize;

              { Add some elements }
              Number := 1.1; Add (Number);
              Number := 2.2; Add (Number);
              Number := 4.4; Add (Number);

              with CreateIterator^ do begin
                   repeat
                         WriteLn (Real(Content^):0:2);
                         WalkForward;
                   until IsEnd;
                   Free;
              end;

              Intercept;
         end;
    end.

[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]