Code: Alles auswählen
;-
DeclareModule __Class
EnableExplicit
Macro MacroColon
:
EndMacro
Macro MacroQuote
"
EndMacro
Macro MacroSingleQuote
'
EndMacro
Macro JoinMacroParts (P1, P2=, P3=, P4=, P5=, P6=, P7=, P8=) : P1#P2#P3#P4#P5#P6#P7#P8 : EndMacro
Macro CreateMacro (name,macroBody=)
__Class::JoinMacroParts (Macro name, __Class::MacroColon, macroBody, __Class::MacroColon, EndMacro) :
EndMacro
Macro CreateQuote (name)
__Class::JoinMacroParts (__Class::MacroQuote,name,__Class::MacroQuote)
EndMacro
Macro CreateSingleQuote (name)
__Class::JoinMacroParts (__Class::MacroSingleQuote,name,__Class::MacroSingleQuote)
EndMacro
CompilerIf #PB_Compiler_Debugger
Declare CheckvTable(*vTable,size)
CompilerEndIf
EndDeclareModule
Module __Class
CompilerIf #PB_Compiler_Debugger
Procedure CheckvTable(*vTable.integer,size)
Protected ok=#True
While size
If *vTable\i=0
ok=#False
Break
EndIf
size-SizeOf(integer)
*vTable+SizeOf(integer)
Wend
ProcedureReturn ok
EndProcedure
CompilerEndIf
EndModule
;-
DeclareModule __class_
Macro This
*self.Properties
EndMacro
Macro SetMethod(name,Proc=__none)
CompilerIf __class::CreateQuote(proc)="__none"
PokeI(*__vTable+OffsetOf(Class\name()),@name())
CompilerElse
PokeI(*__vTable+OffsetOf(Class\name()),@Proc())
CompilerEndIf
EndMacro
Macro AliasMethod(name,alias)
PokeI(*__vTable+OffsetOf(Class\name()),PeekI(*__vTable+OffsetOf(Class\alias())))
EndMacro
Macro SuperNew
__super New
EndMacro
Macro AllocateObject()
If This=0
This=__Allocate()
EndIf
EndMacro
Macro Method(Ret,name,para) ;EndIndent
Declare.Ret name para
SetMethod(name)
Procedure.ret name para
ProtectedSelf
;EndIndent
EndMacro
Macro EndMethod
;Indent ;Indent
EndProcedure
EndMacro
Macro ProtectedSelf
Protected Self.Class=This
EndMacro
Macro MethodReturn
ProcedureReturn
EndMacro
EndDeclareModule
Module __class_
EndModule
;-
DeclareModule Class
EnableExplicit
Structure Properties;-properties
*__vTable
EndStructure
Interface Class;-class
EndInterface
Structure SubTable;-SubTable
free.i
clone.i
EndStructure
Declare Free(*self)
Declare Clone(*self)
;- Class handling
Macro Begin( ExtendsClass = Class )
EnableExplicit
CompilerIf Not Defined(__DeclaredEnableClass,#PB_Constant)
;DeclareModule
#__DeclaredEnableClass=#True
Global *__vTable
Declare __Allocate()
Declare __Free(*self,recursive=0)
Declare __Clone(*self,recursive=0)
;space bevor and after : is important!
__Class::CreateMacro(__Super, ExtendsClass#__Class::MacroColon#__Class::MacroColon) :
UseModule __class_
CompilerElse
;Module
Goto __ModuleEnd
__ModuleStart:
*__vTable=AllocateMemory(SizeOf(Class)+SizeOf(Class::SubTable)) +SizeOf(Class::SubTable)
CompilerIf __Class::CreateQuote(__super)<>"Class::"
CopyMemory(__Super *__vTable,*__vTable,SizeOf( __super Class))
CompilerEndIf
;-Class::Allocate()
Procedure __Allocate()
Protected *self.Properties
*self=AllocateStructure(Properties)
If *self
*self\__vTable=*__vTable
EndIf
ProcedureReturn *self
EndProcedure
CompilerEndIf
EndMacro
Macro End()
CompilerIf Not Defined(__DeclaredEndClass,#PB_Constant)
;DeclareModule
#__DeclaredEndClass=#True
CompilerIf Not Defined(New,#PB_Procedure)
#__DefineNew=#True
Declare New(This=0)
CompilerEndIf
Gosub __ModuleStart
CompilerElse
;Module
CompilerIf Defined(__DefineNew,#PB_Constant)
;-Class::New()
Procedure New(This=0)
AllocateObject()
CompilerIf __Class::CreateQuote(__super)<>"Class::"
SuperNew(This)
CompilerEndIf
ProcedureReturn This
EndProcedure
CompilerEndIf
;-Class::Free()
Procedure __Free(*self.Properties,recursive=0)
CompilerIf Defined(Free,#PB_Procedure)
Free(*self)
CompilerEndIf
CompilerIf __Class::CreateQuote(__super)<>"Class::"
__super __Free(*self,#True)
CompilerEndIf
If recursive=0
FreeStructure(*self)
EndIf
ProcedureReturn 0
EndProcedure
;SetMethod(Free)
PokeI(*__vTable-SizeOf(Class::SubTable)+OffsetOf(Class::SubTable\Free),@__Free())
;PokeI(*__vTable+OffsetOf(Class\Free()),@Free())
;-Class::Clone()
Procedure __Clone(*self.Properties,recursive=0)
Protected *oldself.Properties
If recursive=0
*oldself=*self
*self=AllocateStructure(Properties)
CopyStructure(*oldself,*self,Properties)
EndIf
CompilerIf __Class::CreateQuote(__super)<>"Class::"
__super __Clone(*self,#True)
CompilerEndIf
CompilerIf Defined(Clone,#PB_Procedure)
Clone(*self)
CompilerEndIf
ProcedureReturn *self
EndProcedure
;SetMethod(Free)
PokeI(*__vTable-SizeOf(Class::SubTable)+OffsetOf(Class::SubTable\clone),@__Clone())
CompilerIf #PB_Compiler_Debugger
If Not __Class::CheckVTable(*__vTable,SizeOf(Class))
Debug "ERROR: Missing SetMethod"
CallDebugger
End
EndIf
CompilerEndIf
Return
__ModuleEnd:
CompilerEndIf
EndMacro
EndDeclareModule
Module Class
Procedure Free(*self.Properties)
Protected *proc.integer=*self\__vTable-SizeOf(SubTable)+OffsetOf(SubTable\Free)
CallFunctionFast(*proc\i,*self,0)
EndProcedure
Procedure Clone(*self.Properties)
Protected *proc.integer=*self\__vTable-SizeOf(SubTable)+OffsetOf(SubTable\clone)
ProcedureReturn CallFunctionFast(*proc\i,*self,0)
EndProcedure
EndModule
;-
;- Example
CompilerIf #PB_Compiler_IsMainFile
;-
;- Test - normal Class
DeclareModule Test
Class::Begin()
Structure Properties Extends Class::Properties
value.i
EndStructure
Interface Class Extends Class::Class
Set(value.i)
Get()
EndInterface
Declare Get(This)
Declare New(This,value)
Class::End()
EndDeclareModule
Module Test
Class::Begin()
Procedure Set(This,value)
This\value=value
ProcedureReturn value
EndProcedure
SetMethod(Set)
Procedure Get(*self.Properties)
ProcedureReturn *self\value
EndProcedure
SetMethod(Get)
Procedure Free(This)
Debug "Free:"+Hex(This)
EndProcedure
Procedure New(This,value)
AllocateObject()
This\value=value
ProcedureReturn This
EndProcedure
Class::End()
EndModule
;-
;- Test2 - Child Class
DeclareModule Test2
Class::Begin(Test)
Structure Properties Extends Test::Properties
EndStructure
Interface Class Extends test::Class
_oldSet(value)
EndInterface
Declare New(This,value)
Class::End()
EndDeclareModule
Module Test2
Class::Begin()
AliasMethod(_oldSet,Set)
Procedure Set(This,value)
ProtectedSelf
self\_oldSet(value)
EndProcedure
SetMethod(Set)
Procedure Free(This)
Debug "Free2:"+Hex(This)
EndProcedure
Procedure New(This,value)
AllocateObject()
This=SuperNew(This,value*2)
ProcedureReturn This
EndProcedure
Class::End()
EndModule
;-
;- Test3 Obj in Obj
DeclareModule Test3
Class::Begin()
Structure Properties Extends Class::Properties
object.test::Class
EndStructure
Interface Class Extends Class::Class
Get()
Set(Value)
EndInterface
Declare New(This=0)
Class::End()
EndDeclareModule
Module Test3
Class::Begin()
Procedure Get(This)
ProcedureReturn This\Object\Get()
EndProcedure
SetMethod(Get)
Procedure SetTestDummi(This,Value)
This\Object\Set(Value)
EndProcedure
SetMethod(Set,SetTestDummi)
Procedure New(This=0)
AllocateObject()
This\Object=test::New(0,0)
ProcedureReturn This
EndProcedure
Procedure Clone(This)
This\Object=Class::Clone(This\Object)
EndProcedure
Procedure Free(This)
Class::Free(This\Object)
EndProcedure
Class::End()
EndModule
;-
;- Test4 strings
DeclareModule Test4
Class::Begin()
Interface Class Extends Class::Class
Get.s()
Set(value.s)
Quote(value.s)
BadQuote(value.s)
EndInterface
Structure Properties Extends Class::Properties
Value.s
EndStructure
Class::End()
EndDeclareModule
Module Test4
Class::Begin()
Method(s,Get,(This));-Test4:Get
ProcedureReturn This\Value
EndMethod
Method(i,Set,(This,Value.s) ) ;-Test4:Set
This\Value=Value
EndMethod
Method(i,Quote,(This,Value.s)) ;-Test4:Quote
self\Set(Chr(34)+value+Chr(34))
EndMethod
Method(i,BadQuote,(This,Value.s));-Test4:BadQuote
Set(This,Chr(34)+value+Chr(34)); not Recommand!
EndMethod
Class::End()
EndModule
;-
;- Test5 StringChild
DeclareModule Test5
Class::Begin(Test4)
Interface Class Extends Test4::Class
EndInterface
Structure Properties Extends Test4::Properties
EndStructure
Class::End()
EndDeclareModule
Module Test5
Class::Begin()
Class::End()
EndModule
object.test::Class= Test::New(0,99);THIS must be zero!
object2.test2::Class = Test2::New(0,9);THIS must be zero!
object3.test3::Class = Test3::New()
object4.test4::Class = Test4::New()
Debug "--"
object5.test5::Class = Test5::New()
Debug object\get()
object\Set(20)
Debug object\Get()
Class::Free(object)
Debug object2\Get()
Class::Free(object2)
Debug object3\Get()
object3\set(20)
Debug object3\Get()
Class::Free(object3)
Debug object4\Get()
object4\Set("Testi")
Debug object4\Get()
object4\Quote("Ei")
Debug object4\Get()
object4\BadQuote("Eis")
Debug object4\Get()
Class::Free(object4)
object5\set("Muhahaha")
Debug object5\Get()
Class::Free(object5)
Debug "---"
object=Test::New(0,99)
object6.test::Class = Class::Clone(object)
Debug object\get()
Debug object6\Get()
Debug "---"
object\set(2)
object6\set(3)
Debug "---"
Debug object\get()
Debug object6\Get()
Class::Free(object6)
Debug object\get()
Class::Free(object)
Debug "---"
object3=test3::New()
object3\set(12)
object7.test3::Class = Class::Clone(object3)
Debug object3\get()
Debug object7\Get()
object3\set(34)
object7\set(56)
Debug object3\get()
Debug object7\Get()
Class::free(object3)
Debug object7\Get()
Class::Free(Object7)
CompilerEndIf
Sowohl bei DeclareModule und Module muss man mit Class::Begin([<parentclass>]) einleiten und Class::End() beenden. Die Datenstruktur muss immer Properties und das Interface immer Class heißen und entweder mit einer Parent-Klasse oder Class:: "extended" werden.
Methoden kann man einfach mit Proceduren realisiert werden, die als ersten Parameter zwangsweise *self.properties - oder kürzer und ohne Autovervollständigung This (Macro) sein. Die Procedure kann man anschließend mit "AsMethod(Methode [,Procedurenname])" bekannt machen. Falls der Procedurennamen mit den Methodennamen übereinstimmt, kann man den zweiten Parameter weglassen.
Wenn man in der Methode eine andere Methode aufrufen will, macht man das am besten mit " Protected Self.Class=This " oder als Macro " ProtectedSelf ". Anschließend kann man self\Methode() verwenden.
Child-Klassen können Methoden einfach überschreiben, indem man sie neu definiert. Wenn man eine alte Methode retten will, kann man mit AliasMethod() ein Alias erstellen.
Wer kürzer schreiben will, kann auch die Macros Method, EndMethod und MethodReturn benutzen.
Alles wird mindestens einmal in den Beispielen gemacht
Wenn in DeclareModule keine New, Free, Clone - Methoden declared werden (nicht in Interface!), wird eine Default-Variante erzeugt. AsMethod darf nicht bei Free, New und Clone angewendet werden!
New-Methode:
Das ist der Konstruktor und leider ein bischen umständlicher. Dafür kann man hier schon eine beliebige Anzahl von Parameter genommen werden - der erste muss aber This sein! Der erste Aufruf innerhalb des Konstruktors sollte unbedingt " AllocateObject() " sein. Standardmäßig wird nicht der Konstruktor des Parent aufgerufen! Das muss man selber machen, am besten mit " SuperNew (this,parameter) " (sollte als erstes passieren, aber nur wenn es einen Parent gibt!). Als Rückgabeparameter muss man "this" zurückgeben.
Das ganze sieht dann bspw. so aus:
Code: Alles auswählen
Procedure New(This,value)
AllocateObject()
This=SuperNew(This,value*2)
ProcedureReturn This
EndProcedure
Das hier ist deutlich einfacher. Es werden von Child nach Parent die jeweilige Free-Methode automatisch aufgerufen. Man sollte alles freigeben, was man innerhalb des Objects reservert hat. Bspw. Speicher, andere Objecte, Handles etc.
Clone-Methode:
Wenn man ein Objekt duplizieren will, wird diese Methode aufgerufen. Es wird automatisch eine 1:1-Kopie des Objects erstellt und man erhält diese neue Adresse als Parameter. Ähnlich wie bei Free wird automatisch von Parent nach Child aufgerufen und jedes Klassen-Segment sollte sich nur um seine eigene Properties kümmern. Clone darf nicht fehlschlagen! Wenn man ein Handle etc. nicht duplizieren kann, muss man hier einen Neutralen/ungültigen Wert einsetzen (bspw. 0).
Kann man bei Test3 bei den Beispielen schön ansehen.
Wie gesagt, es wurde bereist eine Kopier erstellt. Wenn aber ein pointer zu einen Speicherbereich in den Properties ist - der pointer wird kopiert und verzweigt auf den gleichen Speicherbereich wie das Original. Das muss man zwingend mit Clone entflechten.
Ein Object-Link kann man einfach mit .<modulname>::Class erstellen. Ein Objekt bekommt man mit <modulname>::New(0,parameterliste) - Den ersten Parameter muss man leider hier mit angeben - this muss hier 0 sein, also eine 0.
Freigegeben wird das Objekt mit Class::Free(Object) . Falls man einen Clone braucht, Class::Clone(Object) .
p.s.: In den Beispielen mische die verschiedenen Stiele etwas. *self.Properties ist identisch mit This. Ersteres hat halt den Vorteil, das der Editor Vorschläge machen kann, was bei THIS nicht geht.