Simulation Core
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

103 lines
3.3 KiB

  1. module CIntegerArrayEventHandlerCollection
  2. use CIntegerArrayEventHandler
  3. implicit none
  4. public
  5. type, public :: IntegerArrayEventHandlerCollection
  6. type(IntegerArrayEventHandler), allocatable :: Delegates(:)
  7. contains
  8. procedure :: Length => Length
  9. procedure :: Add => Add
  10. procedure :: Remove => Remove
  11. procedure :: Empty => Empty
  12. procedure :: IsEmpty => IsEmpty
  13. procedure :: RunAll => RunAll_
  14. end type IntegerArrayEventHandlerCollection
  15. contains
  16. integer function Length(this)
  17. implicit none
  18. class(IntegerArrayEventHandlerCollection), intent(in) :: this
  19. if(allocated(this%Delegates)) then
  20. Length = size(this%Delegates)
  21. return
  22. end if
  23. Length = 0
  24. end function
  25. subroutine Add(this, proc)
  26. implicit none
  27. class(IntegerArrayEventHandlerCollection), intent(inout) :: this
  28. type(IntegerArrayEventHandler), allocatable :: tempArr(:)
  29. procedure (ActionIntegerArray), pointer, intent(in) :: proc
  30. integer :: i, isize
  31. if(allocated(this%Delegates)) then
  32. isize = size(this%Delegates)
  33. allocate(tempArr(isize+1))
  34. do i=1,isize
  35. tempArr(i) = this%Delegates(i)
  36. end do
  37. call tempArr(isize+1)%MakeNull()
  38. call tempArr(isize+1)%AssignTo(proc)
  39. deallocate(this%Delegates)
  40. call move_alloc(tempArr, this%Delegates)
  41. else
  42. allocate(this%Delegates(1))
  43. call this%Delegates(1)%MakeNull()
  44. call this%Delegates(1)%AssignTo(proc)
  45. end if
  46. end subroutine
  47. subroutine Remove(this, index)
  48. implicit none
  49. class(IntegerArrayEventHandlerCollection), intent(inout) :: this
  50. integer, intent(in) :: index
  51. type(IntegerArrayEventHandler), allocatable :: tempArr(:)
  52. integer :: i
  53. logical :: found
  54. if(index <= 0 .or. index > size(this%Delegates)) return
  55. if(.not.allocated(this%Delegates))return
  56. allocate(tempArr(size(this%Delegates)-1))
  57. found = .false.
  58. do i=1, size(this%Delegates)
  59. if(i==index) then
  60. found = .true.
  61. cycle
  62. end if
  63. if(found) then
  64. tempArr(i-1) = this%Delegates(i)
  65. else
  66. tempArr(i) = this%Delegates(i)
  67. endif
  68. end do
  69. deallocate(this%Delegates)
  70. call move_alloc(tempArr, this%Delegates)
  71. end subroutine
  72. subroutine Empty(this)
  73. implicit none
  74. class(IntegerArrayEventHandlerCollection), intent(inout) :: this
  75. if(allocated(this%Delegates)) deallocate(this%Delegates)
  76. end subroutine
  77. logical function IsEmpty(this)
  78. implicit none
  79. class(IntegerArrayEventHandlerCollection), intent(in) :: this
  80. IsEmpty = .not.allocated(this%Delegates)
  81. end function
  82. subroutine RunAll_(this, arg)
  83. implicit none
  84. class(IntegerArrayEventHandlerCollection), intent(inout) :: this
  85. integer, allocatable, intent (in) :: arg(:)
  86. integer :: i
  87. do i=1, size(this%Delegates)
  88. call this%Delegates(i)%Run(arg)
  89. end do
  90. end subroutine
  91. end module CIntegerArrayEventHandlerCollection