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