
Code: Select all
;- BASE class
Interface iBASE
SetS(s.s)
GetS.s()
SetL(l.l)
GetL.l()
SetF(f.f)
GetF.f()
EndInterface
Structure cBASEVT
SetS.l
GetS.l
SetL.l
GetL.l
SetF.l
GetF.l
EndStructure
Structure cBASE
*VTable.cBASEVT
;Data
s.s
l.l
f.f
EndStructure
;- OBJ class
Interface iOBJ Extends iBASE
SetW(w.w)
GetW.w()
SetB(b.b)
GetB.b()
EndInterface
Structure cOBJVT Extends cBASEVT
SetW.l
GetW.l
SetB.l
GetB.l
EndStructure
Structure cOBJ Extends cBASE
w.w
b.b
EndStructure
;- BASE functions
Procedure base_SetS(*this.cBASE, s.s)
*this\s = s
EndProcedure
Procedure.s base_GetS(*this.cBASE)
ProcedureReturn *this\s
EndProcedure
Procedure base_SetL(*this.cBASE, l.l)
*this\l = l
EndProcedure
Procedure.l base_GetL(*this.cBASE)
ProcedureReturn *this\l
EndProcedure
Procedure base_SetF(*this.cBASE, f.f)
*this\f = f
EndProcedure
Procedure.f base_GetF(*this.cBASE)
ProcedureReturn *this\f
EndProcedure
;- BASE constructor
Procedure.l new_base()
Protected *p.cBASE
Static *VTable.cBASEVT
If *VTable = 0
*VTable = AllocateMemory(SizeOf(cBASEVT))
*VTable\SetS = @base_SetS()
*VTable\GetS = @base_GetS()
*VTable\SetL = @base_SetL()
*VTable\GetL = @base_GetL()
*VTable\SetF = @base_SetF()
*VTable\GetF = @base_GetF()
EndIf
*p = AllocateMemory(SizeOf(cBASE))
*p\VTable = *VTable
ProcedureReturn *p
EndProcedure
;- OBJ functions
Procedure obj_SetW(*this.cOBJ, w.w)
*this\w = w
EndProcedure
Procedure.w obj_GetW(*this.cOBJ)
ProcedureReturn *this\w
EndProcedure
Procedure obj_SetB(*this.cOBJ, b.b)
*this\b = b
EndProcedure
Procedure.b obj_GetB(*this.cOBJ)
ProcedureReturn *this\b
EndProcedure
;- OBJ constructor
Procedure.l new_obj()
Protected *p.cOBJ, *vt.cOBJVT
*p = ReAllocateMemory(new_base(), SizeOf(cOBJ))
*p\VTable = ReAllocateMemory(*p\VTable, SizeOf(cOBJVT))
If *p\VTable <> 0
*vt = *p\VTable
*vt\SetW = @obj_SetW()
*vt\GetW = @obj_GetW()
*vt\SetB = @obj_SetB()
*vt\GetB = @obj_GetB()
EndIf
ProcedureReturn *p
EndProcedure
Debug "### Die BASE-Klasse ###"
DefType.iBASE b
b = new_base()
b\SetS("hallo")
b\SetL(20)
b\SetF(21.023)
Debug b\GetS()
Debug b\GetL()
Debug b\GetF()
Debug "### Nun das Objekt ###"
DefType.iOBJ o
o = new_obj()
o\SetS("obj")
o\SetL(666)
o\SetF(616)
o\SetB(11)
o\SetW(12)
CallDebugger
Debug o\GetS()
Debug o\GetL()
Debug o\GetF()
Debug o\GetB()
Debug o\GetW()
is only a pointer to the interface, so now, when calldebugger is reached,
i want to add "o" to the watch-list. Doesn't work cause the name for the
debugger is "*o" cause it's a pointer.
I don't really know what I want to request here, but it's inconsistent.
Perhaps I could request, that we have to declare it as a pointer explicitly
like with structures...
And I would wish to see more advanced pointer handling in PB, like
*(p + 2)\b = 3
it's just annoying to write
*p + 1
*p\b = 3
*p - 1
or
PokeB(*p + 1, 3)
(Yes, I know that not everyone is loving this syntax, but I do

greetz
Remi