PureBasic Forums - English

Code: Select all

;Generic structured Queues: Idle 1/4/12 
;updated 6.03 5/12/23
;A utility class for implementing queues Fifo or Lifo (Stacks) of structured data that may contain PB Objects 

;you need to provide callbacks for the queue to copy and clear the users data structure 

;Procedure UserCopyCallback(*src,*dst) 
;  CopyStructure(*src,*dst,UserDataStructure)
;EndProcedure 
;Procedure UsersClearClallback(*item) 
;  ClearStructure(*item,UserDataStructure)
;EndProcedure
 
EnableExplicit 
;Class creation helper macros 
Macro _ClassSetMethod(cls,method)
  PokeI(*this\vt+MethodOffset,method)
  MethodOffset+SizeOf(Integer)
EndMacro
 
Macro _ClassAlloc(ptr,Class,Interfaces)
  Protected MethodOffset
  ptr = AllocateMemory(SizeOf(class))
  ptr\vt = AllocateMemory(SizeOf(Interfaces))
  InitializeStructure(ptr,class)
EndMacro 

Macro _ClassFree(ptr)
  FreeMemory(ptr\vt)
  FreeMemory(ptr)
EndMacro

;-Queue type 
Enumeration 1 
  #Fifo
  #Lifo 
EndEnumeration 

;- prototype for user copy and clear function 
Prototype QueueCopy(*src,*dst) 
Prototype QueueClear(*item)

;-Class Def 
Structure Queue 
  *vt
  List Queue.i()  
  QueueType.i
  ElementSize.i
  Count.i
  Mutex.i
  Copy.QueueCopy
  Clear.QueueClear
EndStructure  

Procedure Queue_Push(*this.Queue,*item)
  LockMutex(*this\Mutex)
  LastElement(*this\Queue())
  AddElement(*this\Queue())
   *this\Queue() = AllocateMemory(*this\ElementSize)
   *this\Copy(*item,*this\Queue())
   *this\Count +1
   UnlockMutex(*this\Mutex)
 EndProcedure 

Procedure Queue_Pop(*this.Queue,*item) 
   LockMutex(*this\Mutex)
   If *this\Count 
     If *this\QueueType = #Fifo
       FirstElement(*this\Queue())
     Else 
       LastElement(*this\Queue())
     EndIf   
     *this\copy(*this\Queue(),*item)
     *this\clear(*this\Queue())
     FreeMemory(*this\Queue())
     *this\Count -1
     DeleteElement(*this\Queue())
     UnlockMutex(*this\Mutex)
     ProcedureReturn 1  
   EndIf   
   UnlockMutex(*this\Mutex)
 EndProcedure 
 
Procedure Queue_PushPop(*this.Queue,*item) 
  LockMutex(*this\Mutex)
  LastElement(*this\Queue())
  AddElement(*this\Queue())
  *this\Queue() = AllocateMemory(*this\ElementSize)
  *this\Copy(*item,*this\Queue())
  If *this\QueueType = #Fifo
    FirstElement(*this\Queue())
  Else 
    LastElement(*this\Queue())
  EndIf   
  *this\copy(*this\Queue(),*item)
  *this\clear(*this\Queue())
  FreeMemory(*this\Queue())
  DeleteElement(*this\Queue())
  UnlockMutex(*this\Mutex)
  ProcedureReturn 1  
EndProcedure  
 
Procedure Queue_Free(*this.Queue) 
  LockMutex(*this\Mutex)
  ForEach *this\Queue() 
   *this\clear(*this\Queue()) 
   FreeMemory(*this\Queue())
  Next   
  UnlockMutex(*this\Mutex)
  _ClassFree(*this)
EndProcedure   

;-Constructor 
Procedure New_Queue(typeSize,*copy.QueueCopy,*clear.QueueClear,QueueType=#Fifo)
  Protected *this.Queue
 
  Interface iQueue
    push(*item)
    pop(*item)
    pushpop(*item)
    Free()
  EndInterface
  
  If Not *copy Or Not *clear 
    MessageRequester("Queue :","You need to pass the address of a copy and free function") 
    End
  EndIf
  
  _ClassAlloc(*this,Queue,iQueue)
  _ClassSetMethod(*this,@Queue_Push())
  _ClassSetMethod(*this,@Queue_Pop())
  _ClassSetMethod(*this,@Queue_PushPop())
  _ClassSetMethod(*this,@Queue_Free())
  
  *this\QueueType = QueueType
  *this\Mutex = CreateMutex()
  *this\Copy = *copy 
  *this\clear = *clear
  *this\ElementSize = typeSize 
  ProcedureReturn *this
 
EndProcedure

DisableExplicit 

;-Test
;users structure can include PB objects     
Structure udata
  a.i
  st.s
  List alist.i()
EndStructure   

;Queue uses a callback to copy the user structure in and out of queue 
Procedure ucopy(*src.udata,*dst.udata) 
  ;InitializeStructure(*dst,udata) ;may be needed if nested 
  CopyStructure(*src,*dst,udata)
EndProcedure 

;Queue uses a callback so you can clear the user data structure 
Procedure uClear(*item.udata) 
  ClearStructure(*item,udata)
EndProcedure   

;define a new queue (size of type, address copy function, queue type) 
Global fifo.iQueue = New_Queue(SizeOf(udata),@ucopy(),@uclear(),#Fifo)

Global dat.udata 
;buffer items into fifo queue 
For a = 1 To 10 
  dat\a = a 
  dat\st = "Stack Element " + Str(a)
  ;populate the list 
  For b = a To 10 
    AddElement(dat\alist())
    dat\alist() = b 
  Next 
  fifo\push(@dat)
  ClearList(dat\alist())
Next 

;do a push and pop on fifo  
For a = 11 To 20 
  dat\a = a 
  dat\st = "Stack Element " + Str(a)
  ;populate the list 
  For b = a To 20 
    AddElement(dat\alist())
    dat\alist() = b 
  Next   
  ;push and pop 
  fifo\pushpop(@dat)
  Debug dat\a
  Debug dat\st 
  ;debug the list items 
  ForEach dat\alist() 
    Debug "list item " + Str(dat\alist()) 
  Next 
  ClearList(dat\alist())
  Debug "======"
Next   

;flush fifo 
While fifo\pop(@dat) 
  Debug dat\a
  Debug dat\st 
  ForEach dat\alist() 
    Debug "list item " + Str(dat\alist()) 
  Next  
   ClearList(dat\alist())
   Debug "======"
Wend   

fifo\Free()