OO Support Library

From VistApedia
Jump to: navigation, search

TMGOOL.m

;"------------------------------------------
;" new and delete functions below
;"------------------------------------------

new(objectType,Constructor)                
        ;"Purpose -- A constructor for object Widget
        ;"Input: objectType -- the NAME of the type of the object to be defined.
        ;"              This should be a variable (global or otherwise) that will hold the
        ;"              defined objects.  All the instances of a object of a particular type
        ;"              will be held in this one variable.  If this variable already holds
        ;"              other instances of the object, it will be added in.
        ;"        Constructor -- the name of an entry point to call for constructing the instance of the object.
        ;"Result: returns the name of the particular instance --which is really @objectType@(ID)  
        
        ;"Notes: thoughts for enhancements.  I could specify a parent object type and establish
        ;"          method overridding etc.
        ;"         Currently this setup below doesn't allow for inheritance of parent variables.

        new ID,constFn,objectName
        set @objectType@("LAST ID")=$get(@objectType@("LAST ID"))+1
        set ID=@objectType@("LAST ID")
        set @objectType@("INSTANCES",ID)=""
        set @objectType@("DESTRUCTOR")="destWidget^TMGOOWG"
        set @objectType@(ID,"TYPE")="WIDGET"
        set @objectType@(ID,"ID")=ID
        set @objectType@(ID,"TYPEDEF")=objectType
        set objectName=$name(@objectType@(ID))
        
        set constFn="do "_Constructor_"("""_objectName_""")"
        xecute constFn
        
        quit objectName
        
delete(objectName)        
        ;"Purpose:  A destructor for object Widget
        ;"              any needed clean up code would go here first.
        ;"Input: objectName -- the name of the object instance to be deleted.
        ;"              This should be the value returned from defWidget
        
        new destr,ID,typeDef
        
        set destr=$get(@objectName@("DESTRUCTOR"))
        if destr'="" do
        . set destr="do "_destr
        . xecute destr
        
        set ID=$get(@objectName@("ID"))
        set typeDef=$get(@objectName@("TYPEDEF"))
        kill @typeDef@("INSTANCES",ID)
        kill @typeDef@(ID)
        quit
        

fn(objectName,objectFn,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16)
        ;"Purpose: to execute a function stored in a object
        ;"Input: ObjectName -- the name of the object containing the member function
        ;"         objectFn -- the name of the function to be executed in the member function
        ;"         v1...v16 -- OPTIONAL input variables.  Only the number of variables called for by
        ;"              the specified function will be used.  
        ;"Result -- returns the output value of the specified function, or "" if there is not output.
        
        new outVar set outVar=""
        new TMGthis set TMGthis=objectName  ;"setup global-scope 'this' var pointer for member function to use (if wanted)
        new typeDef set typeDef=$get(@objectName@("TYPEDEF")) if typeDef="" goto fnDone

        ;"example of fn: wgtMultiply^TMGOOWG(x,y)
        new fn set fn=$get(@typeDef@(objectFn)) if fn="" goto fnDone
        
        new Params set Params=$piece($piece(fn,"(",2),")",1)
        new TMGOOI set TMGOOI=1
        new TMGParam
loop1        
        set TMGParam=$piece(Params,",",TMGOOI)
        if $extract(TMGParam,1)="." set TMGParam=$extract(TMGParam,2,999)
        if TMGParam="" goto PastLoop
        new @TMGParam merge @TMGParam=@("v"_TMGOOI) ;"NEW parameters for fn to be called, and stuff with v1...v16
        set TMGOOI=TMGOOI+1
        if TMGOOI'>16 goto loop1
        
PastLoop        
        set fn="set outVar=$$"_fn     ;"e.g. 'set outVar=$$wgtMultiply^TMGOOWG(x,y)'
        xecute fn  ;"<--- call actual function.  PERHAPS LET OBJECTS DEFINE CUSTOM ERROR TRAP FUNCTIONS??
        
fnDone
        quit outVar