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