OO Support Library
From VistApedia
Jump to navigationJump to 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