[bb] BlitzClass by Yasha [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:40

Previous topic - Next topic

BlitzBot

Title : BlitzClass
Author : Yasha
Posted : 1+ years ago

Description : Another utterly pointless example.... hehe.

At the end of the day there is no easy way to use polymorphism in a purely procedural language without function pointers, but depending on how masochistic you are, you can come pretty close (A C preprocessor with macros would be a big bonus though). This system is a simplified version of the one I used (as a compiler target) in Objective-B3D. It's fairly readable, but still requires far too much typing to really be useful (and also isn't type-checked). I post it in the hope that it'll help procedural-BB users in the understanding of polymorphism, more than anything else.

Usage:

There are two include files. you'll need to Include "BlitzClass.bb" at the top of your project (the first codebox). BlitzClass.bb itself includes BlitzClass_User.bb (the second codebox). The files are separate because, as you might guess from the name, thie functions in BlitzClass_User.bb are intended to be edited by the end user; those in BlitzClass.bb aren't.

Classes need to be declared above code where they're used, as they're created at runtime and thus the code needs to run through them before they exist. Start a new class with the NewClass() function (I would assign this to a global, unless you specifically want it in local scope). Add data fields to it with the AddField function. Specifying a type is only really important for string fields.

Methods are a little more complex. Define the function normally, with the first parameter (the "self" parameter) of type BCObject. I would recommend positioning and naming the function with the rest of the class. Then (or if you prefer the style, right before it) call AddMethod as shown in the examples. This needs to be done in sequence so that the right method ID will be generated. Alternatively if you want to reuse a method in another class, you can supply the optional ID parameter yourself. Finally, you need to add a call to the function to BlitzClass_CallMethod__() in BlitzClass_User.bb, as shown in the example. If the function returns a non-integer, wrap it in a cast-to-int function (explained below); if any of the parameters are non-integers, they need to be unwrapped with cast-from-int functions.
Any method added with the name "new" will automatically be called when the class is instantiated.

The next three functions in BlitzClass_User.bb only need to have their number of arguments changed to suit the maximum number of arguments accepted by your constructors and methods. By default it's four and eight respectively. The other function is an error handler; since type errors will be noticed at runtime rather than compile-time with such a system, how to handle them is best left up to the user.

You can extend a base class with the Extend() function. Extend() applies an old class to a new class; you may as well just call NewClass() for the first parameter. Each class can only have one super.

To instantiate a class, call new_() with the class variable and any constructor arguments required. In order to make the main functions generic, new_() and msg_() accept only integer arguments (and msg_() returns only integers too). To pass a B3D type object, use Handle(); to pass floats and strings, use bf_() and bs_() respectively to "box" the value into an integer. Non-integer parameters need to be "unboxed" with the appropriate function in BlitzClass_CallMethod__() (uf_(), us_(), or Object.myType() ).

Once your object is created, send messages to it with msg_(). The first argument is the BCObject, and the second is a string containing the name of the method to call. The remianing arguments are passed as integers, same as to new_(), and the same rules apply. Additionally, if msg_() needs to return a non-integer, it'll need to be "unboxed" with uf_(), us_() or Object.myType().

get_() and set_() work in the same way as msg_(), but the string parameter is a data field rather than a method. These are implemented in BlitzClass.bb.

When you're done with your object, remember to delete it with delete_() (not the regular Delete command), as there isn't any reference counting.

The boxing of values into integers is only one way to do this; a more restricted system might go for methods that only have a certain type signature; or all the arguments could be boxed into a single value by an argument-compound-constructor function; or one could try a more flexible value type like strings (that are much slower). Or you could be sensible and use a different language, but that's never the fun way....
BlitzClass.bb:


;-------------------------------------------------------------;
;                                                             ;
;   BlitzClass - a native dynamic object system for Blitz3D   ;
;   =======================================================   ;
;                                                             ;
;-------------------------------------------------------------;


;==============================================================
; Constants
;==============================================================


Const BC_INTEGER = 1 ;TypeIDs. Only String is actually used for anything currently
Const BC_FLOAT = 2
Const BC_STRING = 3
Const BC_BCOBJECT = 4

Const BC_DEBUGMODE = True ;Integer constants can be used for conditional compilation (ie. type checks)
Const BC_MAXSTRINGS = 1024
Const BC_MAXMETHODS = 256
Const BC_MAXFIELDS  = 256


;==============================================================


;==============================================================
; Box classes
;==============================================================


;Float
Global BlitzClass_FloatBox__

Function bf_%(fVal__#)
    PokeFloat BlitzClass_FloatBox__,0,fVal__
    Return PeekInt(BlitzClass_FloatBox__,0)
End Function

Function uf_#(fBoxH__)
    PokeInt BlitzClass_FloatBox__,0,fBoxH__
    Return PeekFloat(BlitzClass_FloatBox__,0)
End Function

;String
Type BlitzClass_BoxStr__
    Field sVal$
End Type

Function bs_%(sVal__$)
    Local sBox__.BlitzClass_BoxStr__
    sBox__=Last BlitzClass_BoxStr__
    sBox__sVal=sVal__
    Insert sBox__ Before First BlitzClass_BoxStr__
    Return Handle(sBox__)
End Function

Function us_$(sBoxH__)
    Local sBox__.BlitzClass_BoxStr__,sVal__$
    sBox__=Object.BlitzClass_BoxStr__(sBoxH__)
    sVal__=sBox__sVal
    sBox__sVal=""
    Return sVal__
End Function

;Setup
Function BlitzClass_Setup_Box_Classes__()
    Local i,sBox.BlitzClass_BoxStr__

    BlitzClass_FloatBox__=CreateBank(4)
    Delete Each BlitzClass_BoxStr__
    For i=1 To BC_MAXSTRINGS        ;If this isn't enough, change BC_MAXSTRINGS above
        sBox=New BlitzClass_BoxStr__
    Next
End Function

BlitzClass_Setup_Box_Classes__


;==============================================================


;==============================================================
; Class Definitions
;==============================================================


Type BlitzClass
Field name$
Field super.BlitzClass
Field constructor
Field final
Field noFields
Field fieldName$[BC_MAXFIELDS]
Field fieldType[BC_MAXFIELDS]
Field noMethods
Field methodName$[BC_MAXMETHODS]
Field methodUID[BC_MAXMETHODS]
End Type

Type BCObject
Field class.BlitzClass
Field objData
End Type

Type BCString
Field value$
End Type


Global BlitzClass_PrivateMethodUIDCounter__


Function NewClass.BlitzClass(name$ = "")
Local newBC.BlitzClass
newBC = New BlitzClass
newBC
ame = Lower(name)
Return newBC
End Function

Function Extend.BlitzClass(newBC.BlitzClass, super.BlitzClass)
Local i

If newBCsuper <> Null Then BlitzClass_Error("Class " + newBC
ame + " already extends class " + newBCsuper
ame):Return
newBCsuper = super

For i = 0 To super
oFields - 1
newBCfieldName[i] = superfieldName[i]
newBCfieldType[i] = superfieldType[i]
Next
newBC
oFields = super
oFields

For i = 0 To super
oMethods - 1
newBCmethodName[i] = supermethodName[i]
newBCmethodUID[i] = supermethodUID[i]
Next
newBC
oMethods = super
oMethods

Return newBC
End Function

Function AddField(class.BlitzClass, name$, fType = 0)
Local i

If classfinal Then BlitzClass_Error "Class " + class
ame + " has been instantiated and cannot be expanded further":Return

name = Trim(Lower(name))
For i=0 To class
oFields - 1
If classfieldName[i] = name
BlitzClass_Error("Field " + name + " already exists in class " + class
ame)
Return
EndIf
Next

classfieldName[i] = name
classfieldType[i] = fType
class
oFields = class
oFields + 1
End Function

Function AddMethod(class.BlitzClass, name$, uID = -1) ;Set the uID to zero to force an abstract method
Local i

If classfinal Then BlitzClass_Error "Class " + class
ame + " has been instantiated and cannot be expanded further":Return

name = Trim(Lower(name))
If uID = -1 Then uID = BlitzClass_MethodUID__()

If name = "new" ;Constructor
classconstructor = uID
Else ;Regular method
For i = 0 To class
oMethods - 1
If classmethodName[i] = name Then Exit
Next

class
oMethods = class
oMethods + (class
oMethods = i)
classmethodName[i] = name
classmethodUID[i] = uID
EndIf

Return uID
End Function

Function BlitzClass_GetMethodUID__(class.BlitzClass, mName$)
Local i

mName = Lower(mName)
For i=0 To class
oMethods - 1
If classmethodName[i] = mName Then Return classmethodUID[i]
Next

Return 0
End Function

Function BlitzClass_MethodUID__()
BlitzClass_PrivateMethodUIDCounter__ = BlitzClass_PrivateMethodUIDCounter__ + 1
Return BlitzClass_PrivateMethodUIDCounter__
End Function

Function BC_CheckType(obj.BCObject, cClass.BlitzClass) ;(Shorter names for more commonly-called public functions)
Local class.BlitzClass

class = objclass

While class <> cClass
If classsuper<>Null
class = classsuper
Else
Return False
EndIf
Wend

Return True
End Function


;==============================================================


;==============================================================
; Object Access
;==============================================================


Function delete_(obj.BCObject)
Local i,s.BCString

For i = 0 To BankSize(objobjData) - 4 Step 4
s = Object.BCString(PeekInt(objobjData,i))
If s <> Null Then Delete s
Next

FreeBank objobjData
Delete obj
End Function

Function get_(obj.BCObject, fName$)
Local i, class.BlitzClass, s.BCString

class = objclass
For i = 0 To class
oFields - 1
If classfieldName[i] = fName Then Exit
Next
If i = class
oFields
BlitzClass_Error("Could not find field " + fName + " in class " + class
ame)
Return
EndIf

If classfieldType[i] = BC_STRING
s = Object.BCString(PeekInt(objobjData, i * 4))
Return bs_(svalue) ;Move it from its field box to an argument box
Else
Return PeekInt(objobjData, i * 4)
EndIf
End Function

Function set_(obj.BCObject, fName$, value)
Local i, class.BlitzClass, s.BCString

class = objclass
For i = 0 To class
oFields - 1
If classfieldName[i] = fName Then Exit
Next
If i = class
oFields
BlitzClass_Error("Could not find field " + fName + " in class " + class
ame)
Return
EndIf

If classfieldType[i] = 3 ;String - move it from argument box to field box
s = Object.BCString(PeekInt(objobjData, i * 4))
svalue = us_(value)
Else
PokeInt(objobjData, i * 4, value)
EndIf

Return value
End Function


;==============================================================


;==============================================================
; User-defined functions
;==============================================================

Include "BlitzClass_User.bb"

;==============================================================



BlitzClass_User.bb:


;BlitzClass - user-defined implementation details
;================================================


;==============================================================
; Message passing (ie. methods - the core)
;==============================================================


; If your methods need more parameters, add more to this
Function BlitzClass_CallMethod__(obj.BCObject, uID, arg0=0, arg1=0, arg2=0, arg3=0, arg4=0, arg5=0, arg6=0, arg7=0);, arg8=0, arg9=0, arg10=0, arg11=0, arg12=0, arg13=0, arg14=0, arg15=0)

;Add each method to this structure as follows:
; Case myMethod_Ptr:Return myMethod( obj, arg0, uf_(arg1), Object.myType(arg2), arg3, us_(arg4) )

Select uID

Case Animal_New_Ptr:Return Animal_New(obj, us_(arg0))
Case Animal_PrintName_Ptr: Return Animal_PrintName(obj)
Case Cat_Talk_Ptr:Return Cat_Talk(obj)
Case Dog_Talk_Ptr:Return Dog_Talk(obj)

Default ;Should never reach this
BlitzClass_Error "Unknown error: invalid method uID"
End Select
End Function

; Same here
Function msg_(obj.BCObject, method$, arg0=0, arg1=0, arg2=0, arg3=0, arg4=0, arg5=0, arg6=0, arg7=0);, arg8=0, arg9=0, arg10=0, arg11=0, arg12=0, arg13=0, arg14=0, arg15=0)
Local uID

uID = BlitzClass_GetMethodUID__(objclass, method)
If uID = 0
BlitzClass_Error("Class " + objclass
ame + " does not implement method " + method)
Return 0
EndIf

; and here...
Return BlitzClass_CallMethod__(obj, uID, arg0, arg1, arg2, arg3, arg4, arg5, arg6, arg7);, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)
End Function

; Add more arguments as required by constructors
Function new_.BCObject(oType.BlitzClass, arg0=0, arg1=0, arg2=0, arg3=0);, arg4=0, arg5=0, arg6=0, arg7=0, arg8=0, arg9=0, arg10=0, arg11=0, arg12=0, arg13=0, arg14=0, arg15=0)
Local obj.BCObject, i

obj = New BCObject
objclass = oType
objobjData = CreateBank(4 * oType
oFields)
oTypefinal = True ;oType has been instantiated - force an error if someone tries to add more fields after this

For i = 0 To oType
oFields - 1
If oTypefieldType[i] = 3 ;Strings need boxes to be stored
PokeInt objobjData, i * 4, Handle(New BCString)
EndIf
Next

BlitzClass_CallConstructor__(obj, objclass, arg0, arg1, arg2, arg3);, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)
Return obj
End Function

; Same here
Function BlitzClass_CallConstructor__(obj.BCObject, class.BlitzClass, arg0=0, arg1=0, arg2=0, arg3=0);, arg4=0, arg5=0, arg6=0, arg7=0, arg8=0, arg9=0, arg10=0, arg11=0, arg12=0, arg13=0, arg14=0, arg15=0)
If classsuper <> Null
BlitzClass_CallConstructor__(obj, classsuper, arg0, arg1, arg2, arg3);, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)
EndIf
If classconstructor Then Return BlitzClass_CallMethod__(obj, classconstructor, arg0, arg1, arg2, arg3);, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)
End Function


;==============================================================


;==============================================================
; Type error handler (change this to suit requirements)
;==============================================================


Global BC_ErrorState

Function BlitzClass_Error(err$)
; RuntimeError err ;A static solution

Print err ;A dynamic solution
BC_ErrorState = True
End Function


;==============================================================



Code :
Code (blitzbasic) Select
;BlitzClass example

Include "BlitzClass.bb" ;Needs to appear before first use of the classes


;Because classes are defined at runtime they also need to be defined before first use


;Let's copy Wikipedia's polymorphism example


; Class Animal:

Global Animal.BlitzClass = NewClass("Animal") ;You don't actually have to name them but it helps error messages

AddField Animal, "name", BC_STRING ;Strings absolutely need type declarations - other types don't really

Function Animal_New(self.BCObject, name$)
set_ self, "name", bs_(name)
End Function ; Naming a method "new" will set it as a constructor, and it will be called
Global Animal_New_Ptr = AddMethod(Animal, "New") ; automatically at instantiation (after the super's constructor)

Function Animal_PrintName(self.BCObject) ;Name the actual functions as you like, so long as it's unique (obviously)
Print "Name: " + us_(get_(self, "name"))
End Function
Global Animal_PrintName_Ptr = AddMethod(Animal, "PrintName") ; It is ++ABSOLUTELY ESSENTIAL++ that the function declarations
; and method declarations are in the same order! Best to keep them
; side by side like this.


; Class Cat extends Animal

Global Cat.BlitzClass = Extend(NewClass("Cat"), Animal)

Function Cat_Talk(self.BCObject)
Print "Meowww!"
End Function
Global Cat_Talk_Ptr = AddMethod(Cat, "Talk")


; Class Dog extends Animal

Global Dog.BlitzClass = Extend(NewClass("Dog"), Animal)

Function Dog_Talk(self.BCObject)
Print "Arf! Arf!"
End Function
Global Dog_Talk_Ptr = AddMethod(Dog, "Talk")


; Let's test it

Local myAnimal.BCObject[3], i

myAnimal[1] = new_(Cat, bs_("Missie"))
myAnimal[2] = new_(Cat, bs_("Mr. Mistoffelees"))
myAnimal[3] = new_(Dog, bs_("Lassie"))


For i = 1 To 3
If BC_CheckType(myAnimal[i], Animal) ;Manually check type (totally unnecessary, shouldn't bother but this proves it works)

msg_(myAnimal[i], "PrintName")
msg_(myAnimal[i], "talk")

EndIf
Next

Print "":Print "Press a key to end..."
WaitKey
End


Comments :


_PJ_(Posted 1+ years ago)

 Amazing!