PureBasic Forums - English

Posted: **Sat Jul 27, 2024 1:52 pm**

I was bored again ...

In the SDK of PureBasic there is the example for the Object Management Ticket.
Here as an example as DataSet, also for the use with threads.

Code: Select all

;-TOP by mk-soft, v1.01, 27.07.2024

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Use Compiler Option ThreadSafe!"
CompilerEndIf

DeclareModule pbObjectCommon
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
      PB_Object_GetOrAllocateID(*Objects, ID)
      PB_Object_GetObject(*Objects, DynamicOrArrayID)
      PB_Object_IsObject(*Objects, DynamicOrArrayID)
      PB_Object_IsHandle(*Objects, *NativeHandle)
      PB_Object_EnumerateAll(*Objects, *ObjectEnumerateAllCallback, *pData)
      PB_Object_EnumerateStart(*Objects)
      PB_Object_EnumerateStartRecursive(*Objects)
      PB_Object_EnumerateNext(*Objects, *ID)
      PB_Object_EnumerateNextRecursive(*Objects, *ID)
      PB_Object_EnumerateAbort(*Objects)
      PB_Object_FreeID(*Objects, DynamicOrArrayID)
      PB_Object_CleanAll(*Objects)
      PB_Object_Init(StructureSize, IncrementStep, *ObjectFreeFunction)
      PB_Object_Count(*Objects)
    EndImport
  CompilerElse
    ImportC ""
      PB_Object_GetOrAllocateID(*Objects, ID)
      PB_Object_GetObject(*Objects, DynamicOrArrayID)
      PB_Object_IsObject(*Objects, DynamicOrArrayID)
      PB_Object_IsHandle(*Objects, *NativeHandle)
      PB_Object_EnumerateAll(*Objects, *ObjectEnumerateAllCallback, *pData)
      PB_Object_EnumerateStart(*Objects)
      PB_Object_EnumerateStartRecursive(*Objects)
      PB_Object_EnumerateNext(*Objects, *ID)
      PB_Object_EnumerateNextRecursive(*Objects, *ID)
      PB_Object_EnumerateAbort(*Objects)
      PB_Object_FreeID(*Objects, DynamicOrArrayID)
      PB_Object_CleanAll(*Objects)
      PB_Object_Init(StructureSize, IncrementStep, *ObjectFreeFunction)
      PB_Object_Count(*Objects)
    EndImport
  CompilerEndIf  
EndDeclareModule

Module pbObjectCommon
  ;
EndModule

; ********

DeclareModule DataSet
  Declare NewDataSet(ID, Value = 0, Text.s = "")
  Declare FreeDataSet(ID)
  Declare IsDataSet(ID)
  Declare GetDataSetValue(ID)
  Declare.s GetDataSetText(ID)
  Declare SetDataSetValue(ID, Value)
  Declare AddDataSetValue(ID, Value)
  Declare SetDataSetText(ID, Text.s)
EndDeclareModule

Module DataSet
  
  EnableExplicit
  
  UseModule pbObjectCommon
  
  Structure udtDataSet
    ; Object Header
    RESERVED_OR_OS_HANDLE.i
    ; Object Data
    Mutex.i
    iValue.i
    sText.s
  EndStructure
  
  Global *ObjectDataSet
  
  ; ----
  
  Procedure FreeDataSet(ID)
    Protected *Object.udtDataSet
    *Object = PB_Object_IsObject(*ObjectDataSet, ID)
    If *Object
      FreeMutex(*Object\Mutex)
      ClearStructure(*Object, udtDataSet)
      PB_Object_FreeID(*ObjectDataSet, ID)
    EndIf
  EndProcedure
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure ObjectFreeFunctionCB(ID)
      FreeDataSet(ID)
    EndProcedure
  CompilerElse
    ProcedureC ObjectFreeFunctionCB(ID)
      FreeDataSet(ID)
    EndProcedure
  CompilerEndIf
  
  ; ----
  
  Procedure InitObject()
    *ObjectDataSet = PB_Object_Init(SizeOf(udtDataSet), 16, @ObjectFreeFunctionCB())
  EndProcedure : InitObject()
  
  ; ----
  
  Procedure NewDataSet(ID, Value = 0, Text.s = "")
    Protected *object.udtDataSet
    CompilerIf #PB_Compiler_Debugger
      If id >= 0 And id > 10000
        Debug "Warning NewDataSet over 10000 Array Elements!"
      EndIf
    CompilerEndIf
    *object = PB_Object_GetOrAllocateID(*ObjectDataSet, ID)
    If *object
      InitializeStructure(*object, udtDataSet)
      *object\RESERVED_OR_OS_HANDLE = #True ; Must be set
      *object\Mutex = CreateMutex()
      *object\iValue = Value
      *object\sText = Text
    EndIf
    ProcedureReturn *object
  EndProcedure
  
  ; ----
  
  Procedure IsDataSet(ID)
    Protected r1, *object.udtDataSet
    *object = PB_Object_IsObject(*ObjectDataSet, ID)
    ProcedureReturn *object
  EndProcedure
  
  ; ----
  
  Procedure GetDataSetValue(ID)
    Protected r1, *object.udtDataSet
    *object = PB_Object_IsObject(*ObjectDataSet, ID)
    If *object
      LockMutex(*object\Mutex)
      r1 = *object\iValue
      UnlockMutex(*object\Mutex)
    EndIf
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure.s GetDataSetText(ID)
    Protected r1.s, *object.udtDataSet
    *object = PB_Object_IsObject(*ObjectDataSet, ID)
    If *object
      LockMutex(*object\Mutex)
      r1 = *object\sText
      UnlockMutex(*object\Mutex)
    EndIf
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure SetDataSetValue(ID, Value)
    Protected *object.udtDataSet
    *object = PB_Object_IsObject(*ObjectDataSet, ID)
    If *object
      LockMutex(*object\Mutex)
      *object\iValue = Value
      UnlockMutex(*object\Mutex)
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure AddDataSetValue(ID, Value)
    Protected *object.udtDataSet
    *object = PB_Object_IsObject(*ObjectDataSet, ID)
    If *object
      LockMutex(*object\Mutex)
      *object\iValue + Value
      UnlockMutex(*object\Mutex)
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure SetDataSetText(ID, Text.s)
    Protected *object.udtDataSet
    *object = PB_Object_IsObject(*ObjectDataSet, ID)
    If *object
      LockMutex(*object\Mutex)
      *object\sText = Text
      UnlockMutex(*object\Mutex)
    EndIf
  EndProcedure
  
EndModule

; ********

CompilerIf #PB_Compiler_IsMainFile
  
  ;-Test
  
  UseModule DataSet
  
  Debug "Create Numbered DataSet"
  NewDataSet(0, 1, "Number 1")
  NewDataSet(1, 2, "Number 2")
  
  Debug GetDataSetValue(0)
  Debug GetDataSetText(0)
  Debug GetDataSetValue(1)
  Debug GetDataSetText(1)
  
  Debug "Overwrite DataSet"
  NewDataSet(0, 10, "Number 10")
  Debug GetDataSetValue(0)
  Debug GetDataSetText(0)
  
  Debug "Change DataSet"
  SetDataSetValue(0, 1000)
  SetDataSetText(0, "Number 1000")
  Debug GetDataSetValue(0)
  Debug GetDataSetText(0)
  
  Debug "Create Any DataSet"
  id = NewDataSet(#PB_Any, 100, "Hello world!")
  Debug GetDataSetValue(id)
  Debug GetDataSetText(id)
  
  Debug "FreeDataSet"
  FreeDataSet(0)
  Debug IsDataSet(0)
  FreeDataSet(1)
  Debug IsDataSet(1)
  FreeDataSet(id)
  Debug IsDataSet(id)
  
  Debug "Threads - Wait 25s"
  Procedure thWorkAdd(ID)
    Protected c
    
    Debug "Add start ID " +id 
    Delay(100)
    For c = 1 To 1000
      AddDataSetValue(id, 1)
      Delay(20)
    Next
    Debug "Add Done ID " +id 
  EndProcedure
  
  Procedure thWorkSub(ID)
    Protected c
    
    Debug "Sub Start ID " +id 
    Delay(100)
    For c = 1 To 1000
      AddDataSetValue(id, -1)
      Delay(10)
    Next
    Debug "Sub Done ID " +id 
  EndProcedure
  
  NewDataSet(0, 100)
  NewDataSet(1, 200)
  NewDataSet(2, 300)
  id = NewDataSet(#PB_Any, 400)
  
  CreateThread(@thWorkAdd(), 0)
  CreateThread(@thWorkAdd(), 1)
  CreateThread(@thWorkAdd(), 2)
  CreateThread(@thWorkAdd(), id)
  
  CreateThread(@thWorkSub(), 0)
  CreateThread(@thWorkSub(), 1)
  CreateThread(@thWorkSub(), 2)
  CreateThread(@thWorkSub(), id)
  
  Delay(25000)
  Debug "Result"
  Debug GetDataSetValue(0)
  Debug GetDataSetValue(1)
  Debug GetDataSetValue(2)
  Debug GetDataSetValue(id)
  
CompilerEndIf

Posted: **Fri Aug 09, 2024 7:15 pm**

Continue to bore you for our greatest pleasure

Thanks for sharing

Posted: **Sat Aug 10, 2024 10:40 am**

I don't understand what is the purpose of this module

Any case of use example?

Posted: **Sat Aug 10, 2024 11:24 am**

Caronte3D wrote: Sat Aug 10, 2024 10:40 am I don't understand what is the purpose of this module
Any case of use example?

This is an example of how PureBasis handles objects internally. Like LoadFont, LoadImages, etc. See PureBasic folder SDK.
You can customise and use this example as a base for your own purposes.

PureBasic Forums - English

PB-SDK Object Management

PB-SDK Object Management

Re: PB-SDK Object Management

Re: PB-SDK Object Management

Re: PB-SDK Object Management