Sorry your browser is not supported!

`Use: Return_Value=Call Function Name("_OV_Get_Value",P1,P2$)
`Parameter 1: Object ID (DWord)
`Parameter 2: Value Name (String)
Function _OV_Get_Value()
   RetVal as DWord
   RetVal=0
   arglist=Open Arglist()
   ObjID=Arglist DWord(arglist)
   If ObjID<1 Then ExitFunction
   If Not _OV_Activate_Object(ObjID) then ExitFunction RetVal
   VName$=ArgList String$(arglist)
   NameMemLoc as Dword
   Flag=0
   For i = 8 to Get Memblock Size(Active_Object_MB(0))-12 Step 12
      NameMemLoc=MemBlock DWord(Active_Object_MB(0),i)
      If NameMemLoc>0
         If Not Compare(Peek String(NameMemLoc),VName$)
            Flag=1
            Exit
         EndIf
      EndIf
   Next i
   If Not Flag Then ExitFunction RetVal
   VType=MemBlock DWord(Active_Object_MB(0),i-4)
   Select VType
      Case 1,2,3
         RetVal=Peek DWord(MemBlock DWord(Active_Object_MB(0),i+4))
      EndCase
      Case 256,257
         RetVal=MemBlock DWord(Active_Object_MB(0),i+4)
      EndCase
   EndSelect
EndFunction RetVal

Sync On:Sync Rate 0

For i = 1 to 500
   Make Object Cube i,1
   Position Object i,Rnd(100)-50,.5,Rnd(100)
   `Write a String Variant to the Object (the Object's Name)
   Call Function Name "_OV_Write_Value",i,"ObjectName",OV_STRING,"Obj"+Str$(i),0
   `Write a Float Variant to the Object (the Object's turn rate)
   Call Function Name "_OV_Write_Value",i,"TurnRight",OV_FLOAT,Rnd(10.0)/10.0+.01,1
   `Write a Function Variant to the Object (Update_Object() turns the object at the previously stored turn rate)
   Call Function Name "_OV_Write_Value",i,"UpdateObj",OV_FUNCTION,"Update_Object;"+Str$(i),2
   `Write another Function Variant to the Object (Display_Object_Data() displays information about the object)
   Call Function Name "_OV_Write_Value",i,"DisplayData",OV_FUNCTION,"Display_Object_Data;"+Str$(i),3
   Place Object In Group i,99
Next i

Do
   Control Camera Using ArrowKeys 0,.3,1
   _Process_DFE_Objects()
   Set Cursor 0,0
   Print Screen FPS()
   Print System SMem Available()
   Sync
Loop

End


`Sample Test Functions

Function Update_Object(ObjID)
   `Rem out the following line and the leak slows down considerably.
   r#=Call Function Name("_OV_Get_Value",ObjID,"TurnRight")
   Turn Object Right ObjID,r#
EndFunction

Function Display_Object_Data(ObjID)
   If Object In Screen(ObjID)
      If Pick Object(MouseX(),MouseY(),ObjID,ObjID)
         n$=Call Function Name("_OV_Get_Value",ObjID,"ObjectName")
         r#=Call Function Name("_OV_Get_Value",ObjID,"TurnRight")
         Center Text Object Screen X(ObjID),Object Screen Y(ObjID)-30,n$
         Center Text Object Screen X(ObjID),Object Screen Y(ObjID)-20,Fast Left$("Turn Rate="+Str$(r#),13)
      EndIf
   EndIf
EndFunction



`======================================================
`Object Variants
`======================================================
`These functions require IanM's Matrix Utilities V7.1 (or later).


`OV_MEMSIZE is how many variables the Object Variants Lib will store per object.
#CONSTANT OV_MEMSIZE 100

#CONSTANT OV_INTEGER 1
#CONSTANT OV_DWORD 2
#CONSTANT OV_FLOAT 3
#CONSTANT OV_STRING 256
#CONSTANT OV_FUNCTION 257


`Use: Call Function Name "_OV_Write_Value",P1,P2$,P3,P4,P5
`Parameter 1: Object ID (DWord)
`Parameter 2: Value Name (String) : Note - the Name is case sensitive
`Parameter 3: Value Type (DWord)
`Parameter 4: Value (as declared by the Value Type)
`Parameter 5: Value_Position (DWord): Must be within the OV_MEMSIZE range.
`It is your responsibility to use this function correctly. Passing a numeric value
`when the Value Type is declared as _OV_String or _OV_Function will cause a crash.
Function _OV_Write_Value()
   arglist=Open Arglist()
   ObjID=Arglist DWord(arglist)
   If ObjID<1 Then ExitFunction
   If Not _OV_Activate_Object(ObjID) then ExitFunction
   VName$=ArgList String$(arglist)
   VType=ArgList DWord(arglist)
   Value as Dword
   MemLoc as DWord
   Select VType
      Case 1,2
         Value = ArgList DWord(arglist)
         MemLoc=Alloc(4)
         Poke Dword Memloc,Value
      EndCase
      Case 3
         Value#=ArgList Float(arglist)
         MemLoc=Alloc(4)
         Poke Float Memloc,Value#
      EndCase
      Case Default
         Value$ = ArgList String$(arglist)
         MemLoc=Alloc String(Value$)
      EndCase
   EndSelect
   VPos=ArgList Dword(arglist)
   If VPos>Get MemBlock Size(Active_Object_MB(0))-13 then ExitFunction
   D=MemBlock DWord(Active_Object_MB(0), (VPos*12)+8)
   If D Then _OV_Delete_Variant(D)
   D=MemBlock DWord(Active_Object_MB(0), (VPos*12)+12)
   If D Then _OV_Delete_Variant(D)
   NameMemLoc as Dword
   NameMemLoc=Alloc String(VName$)

   Write Memblock DWord Active_Object_MB(0), (VPos*12)+4, VType
   Write Memblock DWord Active_Object_MB(0), (VPos*12)+8, NameMemLoc
   Write Memblock DWord Active_Object_MB(0), (VPos*12)+12, MemLoc

EndFunction



`Use: Return_Value=Call Function Name("_OV_Get_Value",P1,P2$)
`Parameter 1: Object ID (DWord)
`Parameter 2: Value Name (String)
Function _OV_Get_Value()
   RetVal as DWord
   RetVal=0
   arglist=Open Arglist()
   ObjID=Arglist DWord(arglist)
   If ObjID<1 Then ExitFunction
   If Not _OV_Activate_Object(ObjID) then ExitFunction RetVal
   VName$=ArgList String$(arglist)
   NameMemLoc as Dword
   Flag=0
   For i = 8 to Get Memblock Size(Active_Object_MB(0))-12 Step 12
      NameMemLoc=MemBlock DWord(Active_Object_MB(0),i)
      If NameMemLoc>0
         If Not Compare(Peek String(NameMemLoc),VName$)
            Flag=1
            Exit
         EndIf
      EndIf
   Next i
   If Not Flag Then ExitFunction RetVal
   VType=MemBlock DWord(Active_Object_MB(0),i-4)
   Select VType
      Case 1,2,3
         RetVal=Peek DWord(MemBlock DWord(Active_Object_MB(0),i+4))
      EndCase
      Case 256,257
         RetVal=MemBlock DWord(Active_Object_MB(0),i+4)
      EndCase
   EndSelect
EndFunction RetVal

`Returns a 0 if the Object cannot be activated for any reason.
`Uses a temporary free memblock
Function _OV_Activate_Object(ObjID as DWord)
   If ObjID<1 Then ExitFunction 0
   If Not Object Exist(ObjID) then ExitFunction 0
   _OV_DeActivate_Object()
   Active_Object_MB(0)=1
   Get Memblock From Object Active_Object_MB(0),ObjID
   If Not Memblock Exist(Active_Object_MB(0))
      Make Memblock Active_Object_MB(0),(OV_MEMSIZE * 12) + 4
      Write Memblock DWord Active_Object_MB(0),0,ObjID
   EndIf
EndFunction 1

`Saves the current active object (if one is active) and clears the memblock
Function _OV_DeActivate_Object()
   Dim Active_Object_MB(0)
   If Active_Object_MB(0)>0
      If Memblock Exist(Active_Object_MB(0))
         OldObj=Memblock DWord(Active_Object_MB(0),0)
         Add Memblock To Object Active_Object_MB(0),OldObj
         Delete Memblock Active_Object_MB(0)
      EndIf
      Active_Object_MB(0)=0
   EndIf
EndFunction

Function _OV_Delete_Variant(MemLoc as DWord)
   Free Peek DWord(MemLoc)
   Free MemLoc
EndFunction

Remstart
`Safely copies a Memblock to another Memblock
Function _OV_Copy_Memblock(SourceMB as Byte,TargetMB as Byte)
   If SourceMB<1 or TargetMB<1 then ExitFunction
   If Not Memblock Exist(SourceMB) then ExitFunction
   Copy Memblock SourceMB,TargetMB,0,0,Get Memblock Size(SourceMB)
EndFunction
remend

Function _Process_DFE_Objects()
   For j = 1 To Group Count(99)
      ObjID=Group Object(99,j)
      _OV_Activate_Object(ObjID)
      For i = 4 to Get Memblock Size(Active_Object_MB(0))-12 Step 12
         VType=MemBlock Dword(Active_Object_MB(0),i)
         If VType=OV_FUNCTION
            Func$=Peek String(MemBlock Dword(Active_Object_MB(0),i+8))
            _Call_Function(Func$)
         EndIf
      Next i
   Next j
EndFunction


Function _Call_Function(Function$)
   Dim PL(8) as Dword
   Dim ReturnValue(0) As DWord
   Split String Function$,";"
   For i = 2 to Split Count()
      PL(i-2)=_Convert_Parameter_To_Dword(Get Split Word$(i))
   Next i
   Call Function Name Get Split Word$(1),PL(0),PL(1),PL(2),PL(3),PL(4),PL(5),PL(6),PL(7),PL(8)
   Clear Array PL()
EndFunction

Function _Convert_Parameter_To_Dword(Param$)
   t=Asc(Fast Left$(Param$,1))
   value$=Mid$(Param$,2,0)
   Dim DFEMem(0) as Dword
   `Clean up the previous string memory, if one was made, to avoid leakage.
   If DFEMem(0)
      Free Peek Dword(DFEMem(0))
      Free DFEMem(0)
      DFEMem(0)=0
   EndIf
   RV as DWord
   Select t
      Case 35
         RV=Cast Float To Dword(Val(value$))
      EndCase
      Case 36
         DFEMem(0)=Alloc String(value$)
         RV=DFEMem(0)
      EndCase
      Case Default
         RV=Val(Param$)
      EndCase
   EndSelect
EndFunction RV

function x()
  a = open arglist()
  b = open arglist() ` this will now 'collect' the 'a' arglist
endfunction