BlitzClass

This code has been declared by its author to be Public Domain code.

BlitzClass by Yasha

2010

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\name = Lower(name)
	Return newBC
End Function

Function Extend.BlitzClass(newBC.BlitzClass, super.BlitzClass)
	Local i
	
	If newBC\super <> Null Then BlitzClass_Error("Class " + newBC\name + " already extends class " + newBC\super\name):Return
	newBC\super = super
	
	For i = 0 To super\noFields - 1
		newBC\fieldName[i] = super\fieldName[i]
		newBC\fieldType[i] = super\fieldType[i]
	Next
	newBC\noFields = super\noFields
	
	For i = 0 To super\noMethods - 1
		newBC\methodName[i] = super\methodName[i]
		newBC\methodUID[i] = super\methodUID[i]
	Next
	newBC\noMethods = super\noMethods
	
	Return newBC
End Function

Function AddField(class.BlitzClass, name$, fType = 0)
	Local i
	
	If class\final Then BlitzClass_Error "Class " + class\name + " has been instantiated and cannot be expanded further":Return
	
	name = Trim(Lower(name))
	For i=0 To class\noFields - 1
		If class\fieldName[i] = name
			BlitzClass_Error("Field " + name + " already exists in class " + class\name)
			Return
		EndIf
	Next
	
	class\fieldName[i] = name
	class\fieldType[i] = fType
	class\noFields = class\noFields + 1
End Function

Function AddMethod(class.BlitzClass, name$, uID = -1)		;Set the uID to zero to force an abstract method
	Local i
	
	If class\final Then BlitzClass_Error "Class " + class\name + " has been instantiated and cannot be expanded further":Return
	
	name = Trim(Lower(name))
	If uID = -1 Then uID = BlitzClass_MethodUID__()
	
	If name = "new"		;Constructor
		class\constructor = uID	
	Else				;Regular method
		For i = 0 To class\noMethods - 1
			If class\methodName[i] = name Then Exit
		Next
		
		class\noMethods = class\noMethods + (class\noMethods = i)
		class\methodName[i] = name
		class\methodUID[i] = uID
	EndIf
	
	Return uID
End Function

Function BlitzClass_GetMethodUID__(class.BlitzClass, mName$)
	Local i
	
	mName = Lower(mName)
	For i=0 To class\noMethods - 1
		If class\methodName[i] = mName Then Return class\methodUID[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 = obj\class
	
	While class <> cClass
		If class\super<>Null
			class = class\super
		Else
			Return False
		EndIf
	Wend
	
	Return True
End Function


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


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


Function delete_(obj.BCObject)
	Local i,s.BCString
	
	For i = 0 To BankSize(obj\objData) - 4 Step 4
		s = Object.BCString(PeekInt(obj\objData,i))
		If s <> Null Then Delete s
	Next
	
	FreeBank obj\objData
	Delete obj
End Function

Function get_(obj.BCObject, fName$)
	Local i, class.BlitzClass, s.BCString
	
	class = obj\class
	For i = 0 To class\noFields - 1
		If class\fieldName[i] = fName Then Exit
	Next
	If i = class\noFields
		BlitzClass_Error("Could not find field " + fName + " in class " + class\name)
		Return
	EndIf
	
	If class\fieldType[i] = BC_STRING
		s = Object.BCString(PeekInt(obj\objData, i * 4))
		Return bs_(s\value)		;Move it from its field box to an argument box
	Else
		Return PeekInt(obj\objData, i * 4)
	EndIf
End Function

Function set_(obj.BCObject, fName$, value)
	Local i, class.BlitzClass, s.BCString
	
	class = obj\class
	For i = 0 To class\noFields - 1
		If class\fieldName[i] = fName Then Exit
	Next
	If i = class\noFields
		BlitzClass_Error("Could not find field " + fName + " in class " + class\name)
		Return
	EndIf
	
	If class\fieldType[i] = 3	;String - move it from argument box to field box
		s = Object.BCString(PeekInt(obj\objData, i * 4))
		s\value = us_(value)
	Else
		PokeInt(obj\objData, 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__(obj\class, method)
	If uID = 0
		BlitzClass_Error("Class " + obj\class\name + " 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
	obj\class = oType
	obj\objData = CreateBank(4 * oType\noFields)
	oType\final = True		;oType has been instantiated - force an error if someone tries to add more fields after this
	
	For i = 0 To oType\noFields - 1
		If oType\fieldType[i] = 3	;Strings need boxes to be stored
			PokeInt obj\objData, i * 4, Handle(New BCString)
		EndIf
	Next
	
	BlitzClass_CallConstructor__(obj, obj\class, 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 class\super <> Null
		BlitzClass_CallConstructor__(obj, class\super, arg0, arg1, arg2, arg3);, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15)
	EndIf
	If class\constructor Then Return BlitzClass_CallMethod__(obj, class\constructor, 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


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

;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_

2010

Amazing!

Code Archives Forum