Advantages:
- dynamic properties and messages (could be achieved with DLLs, too)
- no fixed class structure (that's the point for prototypes)
Disadvantages:
- slower than native PB
- no type checking (tests needed)
As Douglas Crockford said: "The best part of JavaScript is, that it's not typed and the worst part is, that it's not typed!"
The string handling is still puzzling me a little even knowing it's one pointer more;-)
The code uses one structure argument only; so the signature is always the same.
As in JavaScript:
Code: Select all
function abc(P){
}
abc({Value:'Test', P1:2, P3:4}); // dynamic, literal object
The source:
Code: Select all
enableExplicit
enumeration
#Property_Unknown = 0
#Property_String
#Property_Float
#Property_Double
#Property_Integer
#Property_Quad
endEnumeration
structure Property
Type .b
structureUnion
*String
Float .f
Double .d
Integer .i
Quad .q
endStructureUnion
endStructure
Procedure pString(P.s="")
Protected *R .Property = AllocateStructure(Property)
Protected *P
*R\Type = #Property_String
*R\String = AllocateMemory(len(P) * 2, #PB_Memory_NoClear) ; unicode
*P = *R\String
CopyMemoryString(P, @*P)
ProcedureReturn *R
EndProcedure
Procedure pInt(P.i)
Protected *R.Property = AllocateStructure(Property)
*R\Type = #Property_Integer
*R\Integer = P
ProcedureReturn *R
EndProcedure
Procedure pQuad(P.q)
Protected *R.Property = AllocateStructure(Property)
*R\Type = #Property_Quad
*R\Quad = P
ProcedureReturn *R
EndProcedure
procedure.s gString(*P.Property)
ProcedureReturn PeekS(*P\String)
endProcedure
interface IAny ; holds all possible messages of all objects
; messages for each prototype the same
get (Name.s)
set (Name.s, *A.Property=0)
del (Name.s)
msg (Name.s, Proc)
new ()
; free messages to be changed for each prototype
alert (*A=0)
copy (*A=0)
endInterface
structure Any_Procedures
*get
*set
*del
*msg
*new
*alert
*copy
EndStructure
prototype MessagePrototype(*P, *A=0)
structure Any
*Procedures ; interface access
list *Prototypes.Any() ; prototypes
map Messages.i() ; stored messages
map *Properties.Property() ; stored properties
Quit .b ; to jump out of outer scope
HasResult .b ; to check if result was given
EndStructure
global Any_Procedures.Any_Procedures
macro DQ
"
endMacro
macro newMessage(P)
procedure P#_Message(*P.Any, *A.Any=0): procedureReturn __call_Message(DQ#P#DQ, *P, *A): endProcedure
Any_Procedures\P = @P#_Message()
endMacro
declare __call_Message (Msg.s, *P.Any, *A.Any=0)
procedure __call_Message(Msg.s, *P.Any, *A.Any=0)
; this is the core of this implementation; the rest is simple PureBasic
protected Call .MessagePrototype
protected *R .Any
Call = *P\Messages(Msg)
if Call
*R = Call(*P, *A)
else
foreach *P\Prototypes()
*R = __call_Message(Msg, *P\Prototypes(), *A)
if *R\HasResult
ProcedureReturn *R
endif
next
endif
ProcedureReturn *R
endProcedure
newMessage(alert)
newMessage(copy)
declare add_Message (*P.Any, Name.s, Proc)
declare new_Prototype (*P.Any)
Procedure add_Message(*P.Any, Name.s, Proc)
*P\Messages(Name) = Proc
EndProcedure
Any_Procedures\msg = @add_Message()
Procedure new_Prototype(*P.Any)
protected *R.Any = AllocateStructure(Any)
*R\Procedures = Any_Procedures
ProcedureReturn *R
EndProcedure
Any_Procedures\new = @new_Prototype()
declare del_Property (*P.Any, Name.s)
declare get_Property (*P.Any, Name.s)
declare set_Property (*P.Any, Name.s, *A.Property=0)
procedure del_Property(*P.Any, Name.s)
protected *Pro.Property = DeleteMapElement(*P\Properties(), Name)
if *Pro
FreeStructure(*Pro)
ProcedureReturn #True
endif
ProcedureReturn #False
EndProcedure
Any_Procedures\del = @del_Property()
procedure get_Property(*P.Any, Name.s)
procedureReturn *P\Properties(Name)
EndProcedure
Any_Procedures\get = @get_Property()
procedure set_Property(*P.Any, Name.s, *A.Property=0)
*P\Properties(Name) = *A
ProcedureReturn *A
EndProcedure
Any_Procedures\set = @set_Property()
declare alert_Any (*P.Any, *A.Any=0)
declare copy_Any (*P.Any, *A.Any=0)
global *Any.Any = AllocateStructure(Any)
global Any.IAny = *Any
*Any\Procedures=Any_Procedures
*Any\Messages("alert") = @alert_Any()
*Any\Messages("copy") = @copy_Any()
Any\alert()
declare alert_Str(*P.Any, *A.Any)
declare alert_Text(*P.Any, *A.Any)
global *Text.Any = Any\new() : global Text.IAny = *Text
Text\msg("alert", @alert_Text())
Text\set("Value", pString("Hello, world!"))
Text\alert()
Text\del("Value")
define Str.IAny = Any\new()
define *Str.Any = Str
*Str\Messages("alert") = @alert_Str()
Str\set("Value", pString("Hello, world!"))
Str\alert()
Str\del("Value")
Str\set("Value", pInt(123))
Str\alert()
Str\del("Value")
Str\set("Value", pQuad(123456))
Str\alert()
Str\del("Value")
Procedure alert_Any(*P.Any, *A.Any=0)
debug "alert_Any: *P=" + Str(*P) + "; *A=" + Str(*A)
ProcedureReturn *P
EndProcedure
Procedure copy_Any(*P.Any, *A.Any=0)
protected *R.Any = AllocateStructure(Any)
CopyStructure(*P, *R, Any)
ProcedureReturn *R
EndProcedure
Procedure alert_Str(*P.Any, *A.Any)
protected P.IAny = *P
protected *Pr.Property = P\get("Value")
if *Pr
select *Pr\Type
case #Property_String
debug gString(*Pr)
case #Property_Integer
debug *Pr\Integer
case #Property_Quad
debug *Pr\Quad
default
endSelect
endif
EndProcedure
Procedure alert_Text(*P.Any, *A.Any)
protected P.IAny = *P
protected *Pr.Property = P\get("Value")
if *Pr
select *Pr\Type
case #Property_String
debug gString(*Pr)
case #Property_Integer
debug *Pr\Integer
case #Property_Quad
debug *Pr\Quad
default
endSelect
endif
EndProcedure