SimulationCore2/CSharp/Common/EventHandlers/CDoubleEventHandlerCollection.f90

module CDoubleEventHandlerCollection
    use CDoubleEventHandler
    implicit none   
    public  
    type, public :: DoubleEventHandlerCollection
        type(DoubleEventHandler), allocatable :: Delegates(:)
    contains
        procedure :: Length => Length
        procedure :: Add => Add
        procedure :: Remove => Remove
        procedure :: Empty => Empty
        procedure :: IsEmpty => IsEmpty
        procedure :: RunAll => RunAll
    end type DoubleEventHandlerCollection
    
    contains
    
    integer function Length(this)
        implicit none
        class(DoubleEventHandlerCollection), intent(in) :: this
        if(allocated(this%Delegates)) then 
            Length = size(this%Delegates)
            return
        end if
        Length = 0
    end function
    
    subroutine Add(this, proc)
        implicit none
        class(DoubleEventHandlerCollection), intent(inout) :: this
        type(DoubleEventHandler), allocatable :: tempArr(:)
        procedure (ActionDouble), pointer, intent(in) :: proc
        integer :: i, isize
        
        if(allocated(this%Delegates)) then
            isize = size(this%Delegates)
            allocate(tempArr(isize+1))
            do i=1,isize          
                tempArr(i) = this%Delegates(i)
            end do
            call tempArr(isize+1)%MakeNull()
            call tempArr(isize+1)%AssignTo(proc)
            deallocate(this%Delegates)
            call move_alloc(tempArr, this%Delegates)
        else
            allocate(this%Delegates(1))
            call this%Delegates(1)%MakeNull()
            call this%Delegates(1)%AssignTo(proc)
        end if
            
    end subroutine
    
    subroutine Remove(this, index)
        implicit none
        class(DoubleEventHandlerCollection), intent(inout) :: this
        integer, intent(in) :: index
        type(DoubleEventHandler), allocatable :: tempArr(:)
        integer :: i
        logical :: found
        
        if(index <= 0 .or. index > size(this%Delegates)) return
        if(.not.allocated(this%Delegates))return
        allocate(tempArr(size(this%Delegates)-1))
        found = .false.
        do i=1, size(this%Delegates)
            if(i==index) then
                found = .true.
                cycle
            end if
            if(found) then
                tempArr(i-1) = this%Delegates(i)
            else 
                tempArr(i) = this%Delegates(i)
            endif
        end do
        deallocate(this%Delegates)
        call move_alloc(tempArr, this%Delegates)
    end subroutine
    
    
    subroutine Empty(this)
        implicit none
        class(DoubleEventHandlerCollection), intent(inout) :: this
        if(allocated(this%Delegates)) deallocate(this%Delegates)
    end subroutine  
    
    logical function IsEmpty(this)
        implicit none
        class(DoubleEventHandlerCollection), intent(in) :: this
        IsEmpty = .not.allocated(this%Delegates)
    end function
    
    subroutine RunAll(this, arg)
        implicit none
        class(DoubleEventHandlerCollection), intent(inout) :: this
        real(8), intent(in) :: arg
        integer :: i
        do i=1, size(this%Delegates)
            call this%Delegates(i)%Run(arg)
        end do
    end subroutine
    
end module CDoubleEventHandlerCollection