ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TJOOP11.ZIP/ELEMENTS.PAS

Pascal/Delphi Source File | 1991-05-20 | 9.4 KB | 369 lines

UNIT Elements ;





{**********************************************************************
 *                                                                    *
 *  PROGRAM :  Elements                PC FILE NAME :  Elements.PAS   *
 *  ----------------------------------------------------------------  *
 *  LIBRARY MODULES USED :  DOS CRT                                   *
 *  BaseType :  TP6.0 TPU SOURCE: BASETYPE.PAS  BINARY:  BASETYPE.TPU *
 *  ----------------------------------------------------------------  *
 *  PURPOSE :  The purpose of this UNIT is to provide a set of        *
 *             object elements for various data structures.           *
 *  ----------------------------------------------------------------  *
 *  AUTHOR   :  Thomas E. Jenkins, Jr.                                *
 *              PROGRAMMER, UNIVERSITY OF SOUTH CAROLINA, USA         *
 *  BITNET   :  [e-mail]                                 *
 *  INTERNET :  [e-mail]                      *
 *              [e-mail]                     *
 *  ----------------------------------------------------------------  *
 *  DISCAIMER :  This program has been tested to the best of my       *
 *               abilities.  The author claims no responsibility      *
 *               for the performance or side effects this program     *
 *               may yield.                                           *
 *  ----------------------------------------------------------------  *
 *  DISTIBUTION :  This program is given freely to the PD realms.     *
 *                 It may freely be copied and distributed.  Any      *
 *                 one wishing to use some or whole parts of this     *
 *                 program for commercial use please contact the      *
 *                 author first.                                      *
 *                                                                    *
 **********************************************************************}




                                 INTERFACE





USES
       BaseTypes;




CONST
       STR_OBJ                         = 00001 ;
       INT_OBJ                         = 00002 ;
       REAL_OBJ                        = 00003 ;





TYPE



             {


                 Here is a basic view of the Element object tree:

                 TObject                    [ to allow use with streams   ]
                    |
                    |
                    \___ TBaseOBJ           [ basic functions of stack &  ]
                             |              [ elements                    ]
                             |
                             \___ TElementOBJ    [ basic functionality of ]
                                       |         [ any element            ]
                                       |
                                       \___ TStrOBJ [ string specific     ]
                                       /            [ functions & storage ]
                                       |
                                       |
                                       \___ TIntOBJ [ integer specific    ]
                                       /            [ functions & storage ]
                                       |
                                       |
                                       \___ TRealOBJ [ real specific       ]
                                                     [ functions & storage ]

             }




       PString                         = ^STRING ;
       PINTEGER                        = ^INTEGER ;
       PREAL                           = ^REAL ;

       PStrOBJ                         = ^TStrOBJ ;
       TStrOBJ                         = OBJECT ( TElementOBJ )

         data                          : PString ;

         CONSTRUCTOR Init (     s      : STRING ) ;

         FUNCTION    TheType           : WORD ;
           VIRTUAL ;

         FUNCTION    GetData           : POINTER ;
           VIRTUAL ;

         PROCEDURE   SetData (     s   : POINTER ) ;
           VIRTUAL ;

         PROCEDURE   Display ;
           VIRTUAL ;

         DESTRUCTOR  Done ;
           VIRTUAL ;

         END ;  {  TStrOBJ  }

       PIntOBJ                         = ^TIntOBJ ;
       TIntOBJ                         = OBJECT ( TElementOBJ )

         data                          : INTEGER ;

         CONSTRUCTOR Init (     i      : INTEGER ) ;

         FUNCTION    TheType           : WORD ;
           VIRTUAL ;

         FUNCTION    GetData           : POINTER ;
           VIRTUAL ;

         PROCEDURE   SetData (     i   : POINTER ) ;
           VIRTUAL ;

         PROCEDURE   Display ;
           VIRTUAL ;

         DESTRUCTOR  Done ;
           VIRTUAL ;

         END ;  {  TIntOBJ  }

       PRealOBJ                        = ^TRealOBJ ;
       TRealOBJ                        = OBJECT ( TElementOBJ )

         data                          : REAL ;

         CONSTRUCTOR Init (     r      : REAL ) ;

         FUNCTION    TheType           : WORD ;
           VIRTUAL ;

         FUNCTION    GetData           : POINTER ;
           VIRTUAL ;

         PROCEDURE   SetData (     r   : POINTER ) ;
           VIRTUAL ;

         PROCEDURE   Display ;
           VIRTUAL ;

         DESTRUCTOR  Done ;
           VIRTUAL ;

         END ;  {  TIntOBJ  }





                               IMPLEMENTATION






{===========================================================================}
{==                      M  E  T  H  O  D  S                              ==}
{===========================================================================}

          {------------------------------------------------}
          {--        C O N S T R U C T O R S             --}
          {------------------------------------------------}

 CONSTRUCTOR TStrOBJ.Init (    s       : STRING ) ;

  VAR
       sLength                         : BYTE ABSOLUTE s ;
                            {  Length always available.  No  }
                            {  function call needed this way }

   BEGIN  {  TStrOBJ.Init  }

     TElementOBJ.Init ;

     GetMem ( data , Length ( s ) + 1 ) ;     {  Assign data to new node   }

     END ;  {  TStrOBJ.Init  }

 CONSTRUCTOR TIntOBJ.Init (    i       : INTEGER ) ;

   BEGIN  {  TIntOBJ.Init  }

     TElementOBJ.Init ;

     data := i ;

     END ;  {  TIntOBJ.Init  }

 CONSTRUCTOR TRealOBJ.Init (    r      : REAL ) ;

   BEGIN  {  TRealOBJ.Init  }

     TElementOBJ.Init ;

     data := r ;

     END ;  {  TRealOBJ.Init  }


          {------------------------------------------------}
          {--          D E S T R U C T O R S             --}
          {------------------------------------------------}



 DESTRUCTOR  TStrOBJ.Done ;

   BEGIN  {  TStrOBJ.Done  }

     FreeMem ( data , Length ( data^ ) + 1 ) ;        {  Release reservered memory  }

     END ;  {  TStrOBJ.Done  }

 DESTRUCTOR  TIntOBJ.Done ;

   BEGIN  {  TIntOBJ.Done  }
     END ;  {  TIntOBJ.Done  }

 DESTRUCTOR  TRealOBJ.Done ;

   BEGIN  {  TRealOBJ.Done  }
     END ;  {  TRealOBJ.Done  }



          {------------------------------------------------}
          {--              M E T H O D S                 --}
          {------------------------------------------------}


 FUNCTION    TStrOBJ.GetData           : POINTER ;

   BEGIN  {  TStrOBJ.GetData  }

     GetData := data ;

     END ;  {  TStrOBJ.GetData  }

 FUNCTION    TStrOBJ.TheType           : WORD ;

   BEGIN  {  TStrOBJ.TheType  }

     TheType := STR_OBJ ;

     END ;  {  TStrOBJ.TheType  }

 PROCEDURE   TStrOBJ.SetData (     s   : POINTER ) ;

   BEGIN  {  TStrOBJ.SetData  }

     FreeMem ( data , Length ( data^ ) + 1 ) ;

     GetMem ( data , Length ( PString ( s )^ ) + 1 ) ;

     data^ := PString ( s )^ ;

     END ;  {  TStrOBJ.SetData  }

 PROCEDURE   TStrOBJ.Display ;

   BEGIN  {  TStrOBJ.Display  }

     Write ( data^ ) ;

     END ;  {  TStrOBJ.Display  }




 FUNCTION    TIntOBJ.GetData           : POINTER ;

   BEGIN  {  TIntOBJ.GetData  }

     GetData := @data ;

     END ;  {  TIntOBJ.GetData  }

 FUNCTION    TIntOBJ.TheType           : WORD ;

   BEGIN  {  TIntOBJ.TheType  }

     TheType := INT_OBJ ;

     END ;  {  TIntOBJ.TheType  }

 PROCEDURE   TIntOBJ.SetData (     i   : POINTER ) ;

   BEGIN  {  TIntOBJ.SetData  }

     data := PINTEGER ( i )^ ;

     END ;  {  TIntOBJ.SetData  }

 PROCEDURE   TIntOBJ.Display ;

   BEGIN  {  TIntOBJ.Display  }

     Write ( data ) ;

     END ;  {  TIntOBJ.Display  }






 FUNCTION    TRealOBJ.GetData          : POINTER ;

   BEGIN  {  TRealOBJ.GetData  }

     GetData := @data ;

     END ;  {  TRealOBJ.GetData  }

 FUNCTION    TRealOBJ.TheType          : WORD ;

   BEGIN  {  TRealOBJ.TheType  }

     TheType := REAL_OBJ ;

     END ;  {  TRealOBJ.TheType  }

 PROCEDURE   TRealOBJ.SetData (     r  : POINTER ) ;

   BEGIN  {  TRealOBJ.SetData  }

     data := PREAL ( r )^ ;

     END ;  {  TRealOBJ.SetData  }

 PROCEDURE   TRealOBJ.Display ;

   BEGIN  {  TRealOBJ.Display  }

     Write ( data :0:1 ) ;

     END ;  {  TRealOBJ.Display  }


{---------------------------------------------------------------------------}



END .