InsertJSONStructure( ObjectValue,*vt,Interface)
Akzeptiert auch Interfaces. Man muss nur als "Variable" einen nummerierten (Integer) Speicherbereich übergeben (größe über SizeOf(Interface) ermitteln) und schon hat man alle "Member" als String und ihre Positionen in JSON, die man auf verschiedene Art und Weise auslesen kann.
Mit der Runtime-Bibliothek erhält man ein sehr mächtiges Werkzeug. So lassen sich zu den Interface-Member-Namen problemlos die passenden Proceduren finden - solange diese Proceduren ein Runtime davor stehen haben.
Es gibt leider nur zwei größere "Probleme". Zum einen bekommt man so die nicht die Parameter-Liste. Das wäre für den einen oder anderen Fall durchaus interessant. Zum anderen gibt es das problem, dass das "Interface/Structure" bei InsertJSONStructure nicht variable sein kann, da sich Structure/Interface-Namen nicht in Variablen speichern lassen und Strings hier nicht akzeptiert werden. Auch bekommt man leider nicht mit, ob das Interface ein "Extend" eines anderen Interface ist.
Für was man sowas alles braucht? Eine Klassen-Verwaltungs-Include-Datei bspw. Durch den Trick über das JSON spart man sich ein haufen "asMethod" und andere Tricks. Man muss nur vor jeder Methode-Procedure ein RUNTIME schreiben, damit es gefunden wird und fertig.
Ich hab mal wieder gebastelt. Nur ein paar Hinweise: Class::Declare() ist vollständig optional. Der Unterschied zwischen Class::New und Class::FastNew liegt daran, das New die Runtime-Bibliothek zwingend benötigt. FastNew greift direkt auf eine globale Variable zurück, die muss aber vorher mit Class::Declare/Define() definiert werden. Die VT-Table der Klassen werden überigens beim ersten Aufruf von NEW erzeugt oder wenn man sie mittels class::init() initialisiert.
Code: Alles auswählen
DeclareModule __Class;----Declare __Class
EnableExplicit
Prototype.i OnePara(one.i)
Prototype.i TwoPara(one.i,two.i)
Prototype.i NonePara()
Prototype.s output(*obj,jsonflag=0)
#isDLL=Bool(#PB_Compiler_ExecutableFormat=#PB_Compiler_DLL)
Structure MethodsList
name.s
pos.i
*method.onepara
EndStructure
Structure ClassInfo
*Class_VT;must be first!
Name.s
Array methods.MethodsList(0)
*vt
SizeOfVT.i
Constructor.OnePara
ConstructorEx.TwoPara
CopyConstructor.OnePara
Destructor.OnePara
Allocate.NonePara
CopyObj.OnePara
Output.Output
Array *Uplist.ClassInfo(0)
*Extends.ClassInfo
EndStructure
Macro _c34
"
EndMacro
Declare _new(class.s,modulename.s,*para=0)
Declare GetClassInfo(class.s,ModuleName.s="")
EndDeclareModule
;-
DeclareModule Class;----Declare Class
EnableExplicit
Interface class
new(*para=0)
free(*obj.integer)
copy(*obj.integer)
IsClass(*obj.integer)
IsAccessable(*obj.integer)
GetName.s(*obj.integer)
EndInterface
Global Class.Class
Macro Declare(classname,extendClass=/,AllowNull=0)
CompilerIf Not Defined(classname#__sizeof,#PB_Constant)
CompilerIf SizeOf(classname)
#classname#__sizeof=SizeOf(classname)
CompilerElse
#classname#__sizeof=SizeOf(integer)
CompilerEndIf
CompilerIf __class::_c34#extendClass#__class::_c34<>"/"
#classname#__extends=__class::_c34#extendClass#__class::_c34
CompilerElse
#classname#__extends=""
CompilerEndIf
#classname#__module=#PB_Compiler_Module
#classname#__AllowNull=AllowNull
Runtime #classname#__sizeof
Runtime #classname#__extends
Runtime #classname#__module
Runtime #classname#__AllowNull
Global classname#__ClassInfo
Runtime classname#__ClassInfo
Global classname.class::class
CompilerIf Not __class::#isDLL
classname=__class::GetClassInfo(__class::_c34#classname#__class::_c34,#PB_Compiler_Module)
CompilerEndIf
CompilerEndIf
EndMacro
Macro Define(classname,extendClass=/,AllowNull=0)
CompilerIf OffsetOf(s#classname\__vt)<>0
CompilerError "s"+__class::_c34#classname#__class::_c34+" Structure-Error. __VT is not first element!"
CompilerEndIf
CompilerIf Not Defined(classname#__sizeof,#PB_Constant)
CompilerIf SizeOf(classname)
#classname#__sizeof=SizeOf(classname)
CompilerElse
#classname#__sizeof=SizeOf(integer)
CompilerEndIf
CompilerIf __class::_c34#extendClass#__class::_c34<>"/"
#classname#__extends=__class::_c34#extendClass#__class::_c34
CompilerElse
#classname#__extends=""
CompilerEndIf
#classname#__module=#PB_Compiler_Module
#classname#__AllowNull=AllowNull
Runtime #classname#__sizeof
Runtime #classname#__extends
Runtime #classname#__module
Runtime #classname#__AllowNull
Global classname#__ClassInfo
Runtime classname#__ClassInfo
Global classname.class::class
CompilerEndIf
CompilerIf __class::#isDLL
Procedure classname#___Init()
classname=__class::GetClassInfo(__class::_c34#classname#__class::_c34,#PB_Compiler_Module)
EndProcedure
classname#___Init()
CompilerElse
classname=__class::GetClassInfo(__class::_c34#classname#__class::_c34,#PB_Compiler_Module)
CompilerEndIf
Runtime Procedure.i classname#___GetTable(Array functions.__class::MethodsList(1))
Protected js,i,ii,*vt,ObjectValue
CompilerIf SizeOf(classname)
Dim functions(SizeOf(classname)/SizeOf(integer)-1)
js=CreateJSON(#PB_Any)
If js
*vt=AllocateMemory(SizeOf(classname))
If *vt
For i=0 To SizeOf(classname)-SizeOf(integer) Step SizeOf(integer)
PokeI(*vt+i,i)
Next
ObjectValue=JSONValue(js)
InsertJSONStructure( ObjectValue,*vt,classname)
FreeMemory(*vt)
If ExamineJSONMembers(ObjectValue)
While NextJSONMember(ObjectValue)
i=GetJSONInteger(JSONMemberValue(ObjectValue))
ii=i/SizeOf(integer)
functions(ii)\name=JSONMemberKey(ObjectValue)
functions(ii)\pos=GetJSONInteger(JSONMemberValue(ObjectValue))
Wend
EndIf
;ExtractJSONMap(JSONValue(js),functions())
EndIf
EndIf
FreeJSON(js)
CompilerElse
;Dim functions(0)
CompilerEndIf
EndProcedure
Runtime Procedure.s classname#___Output(*obj,flag=0)
Protected ret.s,js
js=CreateJSON(#PB_Any)
If js
InsertJSONStructure( JSONValue(js), *obj, s#classname)
ret=ComposeJSON(js,flag)
FreeJSON(#PB_Any)
EndIf
ProcedureReturn ret
EndProcedure
Runtime Procedure.i classname#___Allocate()
ProcedureReturn AllocateStructure(s#classname)
EndProcedure
Runtime Procedure.i classname#___Copy(*obj)
Protected *new=AllocateStructure(s#ClassName)
If *new
CopyStructure(*obj,*new,s#ClassName)
EndIf
ProcedureReturn *new
EndProcedure
EndMacro
Macro New(classname,para=0)
(__class::_new(__class::_c34#classname#__class::_c34,#PB_Compiler_Module,para))
EndMacro
Macro FastNew(classname,para=0)
(classname\new(para))
EndMacro
Declare Copy(*obj.integer)
Declare Call(*obj,method.s)
Declare.s GetName(*obj.integer)
Declare Free(*obj)
Macro Delete(obj)
class::free(Obj)
EndMacro
Declare.s Output(*obj.integer)
Global CountObjects
;-Class::PBObject
Interface PBObject
GetPBHandle()
GetID()
Free()
EndInterface
Structure sPBObject
*__vt
handle.i
EndStructure
class::Declare(PBObject,/,#True)
Declare GetPBObject(*class,handle)
Declare.s XMAP(i)
EndDeclareModule
;-
Module __Class;----__Class
Prototype.i GetTable(Array functions.MethodsList(1))
Declare CreateTable(class.s)
Declare ClassNew(*ClassInfo.ClassInfo,*para=0)
Declare ClassFree(*ClassInfo.ClassInfo,*obj.integer)
Declare ClassCopy(*ClassInfo.ClassInfo,*obj.integer)
Declare ClassIsClass(*ClassInfo.ClassInfo,*obj.integer)
Declare ClassIsAccessable(*ClassInfo.ClassInfo,*obj.integer)
Declare.s ClassGetName(*ClassInfo.ClassInfo,*obj.integer)
DataSection
vt_new:
Data.i @ClassNew(),@ClassFree(),@ClassCopy(),@ClassIsClass(),@ClassIsAccessable()
class_vt:
Data.i ?vt_new
EndDataSection
CompilerIf #isDLL
Procedure __Class_Init()
class::class=?class_vt
EndProcedure
__Class_Init()
CompilerElse
class::class=?Class_vt
CompilerEndIf
Procedure ClassIsClass(*ClassInfo.ClassInfo,*obj.integer)
ProcedureReturn Bool(*ClassInfo\vt=*obj\i)
EndProcedure
Procedure ClassIsAccessable(*ClassInfo.ClassInfo,*obj.integer)
Protected *ObjectInfo.ClassInfo
Protected i
Protected ret=#False
*ObjectInfo=PeekI(*obj\i-SizeOf(integer))
For i=0 To ArraySize(*ObjectInfo\Uplist())
If *ObjectInfo\Uplist(i)\vt=*ClassInfo\vt
ret=#True
Break
EndIf
Next
ProcedureReturn ret
EndProcedure
Procedure.s ClassGetName(*ClassInfo.ClassInfo,*obj.integer)
ProcedureReturn class::GetName(*obj)
EndProcedure
Procedure ClassFree(*ClassInfo.ClassInfo,*obj.integer)
ProcedureReturn class::free(*obj)
EndProcedure
Procedure ClassCopy(*ClassInfo.ClassInfo,*obj.integer)
ProcedureReturn class::copy(*obj)
EndProcedure
Procedure GetClassInfo(class.s,ModuleName.s="")
Protected *ClassInfo.ClassInfo
If ModuleName<>"" And FindString(class,"::")=0
class=ModuleName+"::"+class
EndIf
*ClassInfo=GetRuntimeInteger(class+"__ClassInfo")
If *ClassInfo=0
;Debug "INTIALIZE CLASS:"+class
*classInfo=CreateTable(class)
SetRuntimeInteger(class+"__ClassInfo",*ClassInfo)
EndIf
ProcedureReturn *ClassInfo
EndProcedure
Procedure CreateTable(class.s)
Protected GetTable.GetTable
Protected *method
Protected constclass.s
Protected pos,i,count
Protected *buf.integer
Protected ExtendClass.s,*ExtendClassInfo.ClassInfo
Protected *ClassInfo.ClassInfo
Protected ModuleName.s
Protected OnlyClass.s
Protected AllowNull
*ClassInfo=AllocateStructure(*ClassInfo)
;NewMap functions.i()
pos=FindString(class,"::")
If pos
pos+1
constclass=Left(class,pos)+"#"+Mid(class,pos+1)
OnlyClass=Mid(class,pos+1)
Else
constclass="#"+class
OnlyClass=Class
EndIf
AllowNull=GetRuntimeInteger(constclass+"__AllowNull")
ExtendClass=GetRuntimeString(constclass+"__Extends")
If extendClass<>""
ModuleName=GetRuntimeString(constclass+"__Module")
If ModuleName<>"" And FindString(ExtendClass,"::")=0
ExtendClass=ModuleName+"::"+ExtendClass
EndIf
*ExtendClassInfo=GetClassInfo(ExtendClass)
CompilerIf #PB_Compiler_Debugger
;Debug "Check "+class+": extend "+ExtendClass
If *ExtendClassInfo=0
Debug class+": extend "+ExtendClass+" doesn't exist."
CallDebugger
End
EndIf
CompilerEndIf
EndIf
GetTable=GetRuntimeInteger(class+"___GetTable()")
If GetTable=0
FreeStructure(*ClassInfo)
ProcedureReturn 0
EndIf
*ClassInfo\SizeOfVT=GetRuntimeInteger(constclass+"__SizeOf")
If *ClassInfo\SizeOfVT
*buf=AllocateMemory(*ClassInfo\SizeOfVT+SizeOf(integer))
*buf\i=*ClassInfo
*ClassInfo\vt=*buf+SizeOf(integer)
If *ExtendClassInfo
CopyMemory(*ExtendClassInfo\vt,*ClassInfo\vt,*ExtendClassInfo\SizeOfVT)
count=ArraySize(*ExtendClassInfo\Uplist())
ReDim *ClassInfo\Uplist( count +1)
For i=0 To Count
*ClassInfo\Uplist(i)=*ExtendClassInfo\Uplist(i)
Next
*ClassInfo\Extends=*ExtendClassInfo
EndIf
GetTable(*ClassInfo\methods())
For i=0 To ArraySize( *ClassInfo\methods())
With *ClassInfo\methods(i)
If \name<>""
*method=GetRuntimeInteger(class+"_"+ \name +"()")
If *method
PokeI(*ClassInfo\vt + \pos,*method)
\method=*method
CompilerIf #PB_Compiler_Debugger
ElseIf AllowNull=#False And PeekI(*ClassInfo\vt + \pos)=0
Debug "Missing Method (or RUNTIME): "+class+"_"+ \name+"()"
CallDebugger
End
CompilerEndIf
EndIf
EndIf
EndWith
Next
;FreeMap(functions())
*ClassInfo\ConstructorEx =GetRuntimeInteger(class+"__ConstructorEx()")
If *ClassInfo\ConstructorEx=0
*ClassInfo\ConstructorEx =GetRuntimeInteger(class+"_"+OnlyClass+"Ex()")
If *ClassInfo\ConstructorEx=0
*ClassInfo\Constructor =GetRuntimeInteger(class+"__Constructor()")
If *ClassInfo\Constructor=0
*ClassInfo\Constructor =GetRuntimeInteger(class+"_"+OnlyClass+"()")
EndIf
EndIf
EndIf
*ClassInfo\Destructor =GetRuntimeInteger(class+"__Destructor()")
If *ClassInfo\Destructor=0
*ClassInfo\Destructor =GetRuntimeInteger(class+"_De"+OnlyClass+"()")
EndIf
*ClassInfo\CopyConstructor=GetRuntimeInteger(class+"__CopyConstructor()")
*ClassInfo\Allocate =GetRuntimeInteger(class+"___Allocate()")
*ClassInfo\CopyObj =GetRuntimeInteger(class+"___Copy()")
*ClassInfo\Output =GetRuntimeInteger(class+"___Output()")
*ClassInfo\Name = Class
*ClassInfo\Class_VT = ?vt_new
*ClassInfo\Uplist( ArraySize(*ClassInfo\Uplist()) )=*ClassInfo
EndIf
ProcedureReturn *ClassInfo
EndProcedure
Procedure _new(class.s,ModuleName.s,*para=0)
Protected *ClassInfo.ClassInfo
Protected *obj.integer
If FindString(class,"::")
ModuleName=""
ElseIf ModuleName<>""
ModuleName+"::"
EndIf
*ClassInfo=GetClassInfo(ModuleName+class)
If *ClassInfo
class=ModuleName+class
ElseIf FindString(class,"::")=0
class=class+"::"+class
*ClassInfo=GetClassInfo(class)
EndIf
If *ClassInfo=0
Debug "Class not found: "+ class
CallDebugger
End
EndIf
*Obj=classNew(*ClassInfo,*para)
ProcedureReturn *obj
EndProcedure
Procedure ClassNew(*ClassInfo.ClassInfo,*para=0)
Protected *obj.integer,i,do=#True
*Obj=*ClassInfo\Allocate()
If *obj=0
ProcedureReturn 0
EndIf
class::CountObjects+1
PokeI(*obj,*ClassInfo\vt)
;Call all constructors
For i=0 To ArraySize(*ClassInfo\Uplist())
If *ClassInfo\Uplist(i)\ConstructorEx
do=*ClassInfo\Uplist(i)\ConstructorEx(*obj,*para)
ElseIf *classinfo\Uplist(i)\Constructor
do=*classinfo\Uplist(i)\Constructor(*obj)
EndIf
If do=0
While i>0
i-1
If *ClassInfo\Uplist(i)\Destructor
*ClassInfo\Uplist(i)\Destructor(*obj)
EndIf
Wend
FreeStructure(*obj)
*obj=0
Break
EndIf
Next
ProcedureReturn *obj
EndProcedure
EndModule
;-
Module Class;----class
UseModule __class
Procedure Copy(*obj.integer)
Protected *ClassInfo.ClassInfo
Protected *new.integer
Protected i
If *obj
*ClassInfo=PeekI(*obj\i-SizeOf(integer))
*new=*ClassInfo\CopyObj(*obj)
If *new
For i=0 To ArraySize( *ClassInfo\Uplist() )
If *ClassInfo\Uplist(i)\CopyConstructor And *ClassInfo\Uplist(i)\CopyConstructor(*new)=0
While i>0
i-1
If *ClassInfo\Uplist(i)\Destructor
*ClassInfo\Uplist(i)\Destructor(*new)
EndIf
Wend
FreeStructure(*new)
*new=0
Break
EndIf
Next
EndIf
EndIf
If *new
class::CountObjects+1
EndIf
ProcedureReturn *new
EndProcedure
Procedure Call(*obj.integer,Method.s)
Protected *ClassInfo.ClassInfo
Protected *ret,i
If *obj
*ClassInfo=PeekI(*obj\i-SizeOf(integer))
method=UCase(Method)
For i=0 To ArraySize(*ClassInfo\methods())
With *ClassInfo\methods(i)
If UCase( \name )=method
*ret= \method
Break
EndIf
EndWith
Next
EndIf
ProcedureReturn *ret
EndProcedure
Procedure.s GetName(*obj.integer)
Protected *ClassInfo.ClassInfo
If *obj
*ClassInfo=PeekI(*obj\i-SizeOf(integer))
ProcedureReturn *ClassInfo\Name
EndIf
EndProcedure
Procedure Free(*obj.integer)
Protected *ClassInfo.ClassInfo
If *obj And *obj\i<>0
class::CountObjects-1
*ClassInfo=PeekI(*obj\i-SizeOf(integer))
While *ClassInfo
If *ClassInfo\Destructor
*ClassInfo\Destructor(*obj)
EndIf
*ClassInfo=*ClassInfo\Extends
Wend
*obj\i=0
FreeStructure(*obj)
EndIf
EndProcedure
Procedure.s Output(*obj.integer)
Protected *ClassInfo.ClassInfo
Protected ret.s
*ClassInfo=PeekI(*obj\i-SizeOf(integer))
ret=Hex(*obj)+" "+*ClassInfo\Name+" - "+*ClassInfo\Output(*obj,0)
ProcedureReturn ret
EndProcedure
;Klasse PBObject- handle sichern und wiederherstellen.
CompilerIf #PB_Compiler_Processor=#PB_Processor_x86
#_handlemask=$11111111
#_handleadd= $22222222
CompilerElse
#_handlemask=$1111111111111111
#_handleadd= $2222222222222222
CompilerEndIf
Threaded _handlestring.s
Threaded *_g1.integer,*_g2.integer
Procedure.s XMap(i)
If *_g1=0
_handlestring=Space(SizeOf(integer))
*_g1=@_handlestring
*_g2=@_handlestring+SizeOf(integer)
EndIf
*_g1\i= (i | #_handlemask)
*_g2\i= (i & #_handlemask) | #_handleadd
ProcedureReturn _handlestring
EndProcedure
Structure handle
Map *object.PBObject()
EndStructure
Global NewMap ClassObject.handle()
Procedure GetPBObject(*class.ClassInfo,handle)
If FindMapElement( ClassObject(*class\Name)\object(),xmap(handle))
ProcedureReturn ClassObject(*class\Name)\object()
EndIf
EndProcedure
class::Define(PBObject)
Runtime Procedure PBObject_PBObjectEx(*self.sPBObject,handle)
*self\handle = handle
ClassObject(GetName(*self))\object(xmap(handle))=*self
ProcedureReturn handle
EndProcedure
Runtime Procedure PBObject__CopyConstructor(*self.sPBObject)
;Debug "copyConstructor"
ProcedureReturn #False
EndProcedure
Runtime Procedure PBObject_DePBObject(*self.sPBObject)
If *self\handle
DeleteMapElement( ClassObject(GetName(*self))\object(),xmap(*self\handle))
*self\handle=0
EndIf
EndProcedure
Runtime Procedure PBObject_GetPBHandle(*self.sPBObject)
ProcedureReturn *self\handle
EndProcedure
Runtime Procedure PBObject_Free(*self.PBObject)
class::free(*self)
ProcedureReturn #Null
EndProcedure
EndModule
;-
;-
;-example
CompilerIf #PB_Compiler_IsMainFile
DeclareModule test
Interface Counter
Reset()
Add(value.i=1)
Set(value.i)
Get()
EndInterface
Structure SCounter
*__vt
value.i
EndStructure
Interface CounterPlus Extends Counter
Sub(value.i)
EndInterface
Structure sCounterPlus Extends sCounter
EndStructure
class::Declare(Counter)
class::Declare(CounterPlus,Counter)
EndDeclareModule
Module test
;class::Init(Counter)
;class::init(CounterPlus)
c2.CounterPlus=class::FastNew(CounterPlus)
c2\Set(20)
Debug c2\Get()
c2\sub(2)
Debug c2\get()
c2\Reset()
Debug c2\Get()
class::Free(c2)
c1.counter=class::new(Counter)
c1\Set(20)
Debug c1\Get()
c1\Add(2)
Debug c1\get()
c1\Reset()
Debug c1\Get()
c1\add(40)
c1b.counter=class::Copy(c1)
Debug c1b\Get()
c1b\Set(99)
Debug c1b\get()
Debug c1\get()
c1\set(10)
class::Free(c1)
Debug c1b\get()
Debug CallFunctionFast(class::Call(c1b,"get"),c1b)
class::free(c1b)
Runtime Procedure Counter_Reset(*self.SCounter)
*self\value=0
EndProcedure
Runtime Procedure Counter_Add(*self.sCounter, Value.i)
*self\value+value
ProcedureReturn *self\value
EndProcedure
Runtime Procedure Counter_Set(*self.sCounter, Value.i)
*self\value=value
ProcedureReturn *self\value
EndProcedure
Runtime Procedure Counter_Get(*self.SCounter)
ProcedureReturn *self\value
EndProcedure
Runtime Procedure Counter__Constructor(*self.sCounter)
Debug "New Counter:"+*self
ProcedureReturn #True
EndProcedure
Runtime Procedure Counter__Destructor(*self.sCounter)
Debug "Destroy Counter:"+*self
EndProcedure
Runtime Procedure Counter__CopyConstructor(*self.sCounter)
Debug "CopyConstructor:"+*self
ProcedureReturn #True
EndProcedure
Runtime Procedure CounterPlus_Sub(*self.sCounterPlus,value.i)
*self\value-Value
EndProcedure
Runtime Procedure CounterPlus__Constructor(*self.sCounterPlus)
Debug "New CounterPlus:"+*self
ProcedureReturn #True
EndProcedure
Runtime Procedure CounterPlus__Destructor(*self.sCounterPlus)
Debug "Destroy CounterPlus:"+ *self
EndProcedure
Runtime Procedure CounterPlus_Get(*self.sCounterPlus)
ProcedureReturn *self\value+10000
EndProcedure
class::Define(CounterPlus,Counter)
class::Define(Counter)
EndModule
Interface Counter Extends Test::Counter
mul(value.i)
OldGet()
EndInterface
Structure sCounter Extends Test::sCounter
oldvalue.i
EndStructure
Runtime Procedure Counter_Mul(*self.sCounter,value.i)
*self\oldvalue=*self\value
*self\value * value
EndProcedure
Runtime Procedure Counter_OldGet(*self.sCounter)
ProcedureReturn *self\oldvalue
EndProcedure
class::Define(Counter,Test::Counter)
c1.counter=class::new(counter)
c1\Set(20)
Debug ""+c1\Get()+" "+c1\OldGet()
c1\mul(4)
Debug ""+c1\Get()+" "+c1\OldGet()
class::Free(c1)
c2.test::CounterPlus = class::new(test::CounterPlus)
c2\set(23)
c2\Set(4)
Debug c2\Get()
class::free(c2)
Interface CounterOld Extends Counter
EndInterface
Structure sCounterOld Extends sCounter
EndStructure
class::Define(CounterOld,Counter)
Runtime Procedure CounterOld_Reset(*self.sCounterOld)
*self\oldvalue=*self\value
*self\value=0
EndProcedure
Runtime Procedure CounterOld_Add(*self.sCounterOld,value.i)
*self\oldvalue=*self\value
*self\value +value
EndProcedure
Runtime Procedure CounterOld_Set(*self.sCounterOld,value.i)
*self\oldvalue=*self\value
*self\value=value
EndProcedure
Runtime Procedure CounterOld__Constructor(*self.sCounterOld)
Debug "New CounterOld:"+*self
ProcedureReturn #True
EndProcedure
Runtime Procedure CounterOld__Destructor(*self.sCounterOld)
Debug "Free CounterOld:"+*self
ProcedureReturn #True
EndProcedure
Runtime Procedure CounterOld__CopyConstructor(*self.sCounterold)
Debug "CopyFail Counterold:"+*self
ProcedureReturn #False
EndProcedure
c3.CounterOld=CounterOld\new()
Debug c3
c3\Set(56)
Debug ""+c3\Get()+" "+c3\OldGet()
c3\add(56)
Debug ""+c3\Get()+" "+c3\OldGet()
c3\mul(56)
Debug ""+c3\Get()+" "+c3\OldGet()
c3\reset()
Debug ""+c3\Get()+" "+c3\OldGet()
Debug "Outputtest:"+class::Output(c3)
Debug class::copy(c3)
Debug "Accessabletest"
Debug "counterold: "+CounterOld\IsClass(C3)+" "+CounterOld\IsAccessable(c3)
Debug "counter: "+Counter\IsClass(C3)+" "+Counter\IsAccessable(c3)
Debug "test::counter: "+test::Counter\IsClass(C3)+" "+test::Counter\IsAccessable(c3)
Debug "test::counterplus: "+test::CounterPlus\IsClass(C3)+" "+test::CounterPlus\IsAccessable(c3)
class::class\free(c3)
Debug class::CountObjects
CompilerEndIf