generic utility class to implement queues fifos,stacks

[idle]

Generic utility class to implement queues that may contain PB Objects
note it utilises callbacks to copy and clear the userdata in and out of the queue
uses fifo's lifo's (stacks)

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()