Simulation Core
Nie możesz wybrać więcej, niż 25 tematów Tematy muszą się zaczynać od litery lub cyfry, mogą zawierać myślniki ('-') i mogą mieć do 35 znaków.

CElevatorEnumVariables.f90 6.6 KiB

1 rok temu
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220
  1. module CElevatorEnumVariables
  2. use CVoidEventHandlerCollection
  3. implicit none
  4. integer :: Elevator = 0
  5. public
  6. type(VoidEventHandlerCollection) :: OnElevatorChange
  7. enum, bind(c)
  8. enumerator ELEVATOR_NEUTRAL
  9. enumerator ELEVATOR_LATCH_STRING_BEGIN
  10. enumerator ELEVATOR_LATCH_STRING_END
  11. enumerator ELEVATOR_UNLATCH_STRING_BEGIN
  12. enumerator ELEVATOR_UNLATCH_STRING_END
  13. enumerator ELEVATOR_LATCH_STAND_BEGIN
  14. enumerator ELEVATOR_LATCH_STAND_END
  15. enumerator ELEVATOR_UNLATCH_STAND_BEGIN
  16. enumerator ELEVATOR_UNLATCH_STAND_END
  17. enumerator ELEVATOR_LATCH_SINGLE_BEGIN
  18. enumerator ELEVATOR_LATCH_SINGLE_END
  19. enumerator ELEVATOR_UNLATCH_SINGLE_BEGIN
  20. enumerator ELEVATOR_UNLATCH_SINGLE_END
  21. end enum
  22. private :: Elevator
  23. contains
  24. subroutine Set_Elevator(v)
  25. implicit none
  26. integer , intent(in) :: v
  27. #ifdef ExcludeExtraChanges
  28. if(Elevator == v) return
  29. #endif
  30. Elevator = v
  31. #ifdef deb
  32. print*, 'Elevator=', Elevator
  33. #endif
  34. call OnElevatorChange%RunAll()
  35. end subroutine
  36. integer function Get_Elevator()
  37. implicit none
  38. Get_Elevator = Elevator
  39. end function
  40. subroutine Set_Elevator_WN(v)
  41. !DEC$ ATTRIBUTES DLLEXPORT :: Set_Elevator_WN
  42. !DEC$ ATTRIBUTES ALIAS: 'Set_Elevator_WN' :: Set_Elevator_WN
  43. implicit none
  44. integer , intent(in) :: v
  45. call Set_Elevator(v)
  46. end subroutine
  47. integer function Get_Elevator_WN()
  48. !DEC$ ATTRIBUTES DLLEXPORT :: Get_Elevator_WN
  49. !DEC$ ATTRIBUTES ALIAS: 'Get_Elevator_WN' :: Get_Elevator_WN
  50. implicit none
  51. Get_Elevator_WN = Elevator
  52. end function
  53. subroutine ElevatorLatchStringEnd()
  54. !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorLatchStringEnd
  55. !DEC$ ATTRIBUTES ALIAS: 'ElevatorLatchStringEnd' :: ElevatorLatchStringEnd
  56. implicit none
  57. #ifdef deb
  58. print*, 'ElevatorLatchStringEnd'
  59. #endif
  60. !if(Elevator /= ELEVATOR_LATCH_STRING_END) Elevator = ELEVATOR_LATCH_STRING_END
  61. call Set_Elevator(ELEVATOR_LATCH_STRING_END)
  62. end subroutine
  63. subroutine ElevatorUnLatchStringEnd()
  64. !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorUnLatchStringEnd
  65. !DEC$ ATTRIBUTES ALIAS: 'ElevatorUnLatchStringEnd' :: ElevatorUnLatchStringEnd
  66. implicit none
  67. #ifdef deb
  68. print*, 'ElevatorUnLatchStringEnd'
  69. #endif
  70. !if(Elevator /= ELEVATOR_UNLATCH_STRING_END) Elevator = ELEVATOR_UNLATCH_STRING_END
  71. call Set_Elevator(ELEVATOR_UNLATCH_STRING_END)
  72. end subroutine
  73. subroutine ElevatorLatchStandEnd()
  74. !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorLatchStandEnd
  75. !DEC$ ATTRIBUTES ALIAS: 'ElevatorLatchStandEnd' :: ElevatorLatchStandEnd
  76. !use CCommon, only: SetStandRack
  77. !use CStandRack
  78. implicit none
  79. #ifdef deb
  80. print*, 'ElevatorLatchStandEnd'
  81. #endif
  82. !if(Elevator /= ELEVATOR_LATCH_STAND_END) then
  83. ! Elevator = ELEVATOR_LATCH_STAND_END
  84. ! !call SetStandRack(Get_StandRack() - 1)
  85. !endif
  86. call Set_Elevator(ELEVATOR_LATCH_STAND_END)
  87. end subroutine
  88. subroutine ElevatorUnLatchStandEnd()
  89. !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorUnLatchStandEnd
  90. !DEC$ ATTRIBUTES ALIAS: 'ElevatorUnLatchStandEnd' :: ElevatorUnLatchStandEnd
  91. !use CCommon, only: SetStandRack
  92. !use CStandRack
  93. implicit none
  94. #ifdef deb
  95. print*, 'ElevatorUnLatchStandEnd'
  96. #endif
  97. !if(Elevator /= ELEVATOR_UNLATCH_STAND_END) then
  98. ! Elevator = ELEVATOR_UNLATCH_STAND_END
  99. ! !call SetStandRack(Get_StandRack() + 1)
  100. !endif
  101. call Set_Elevator(ELEVATOR_UNLATCH_STAND_END)
  102. end subroutine
  103. subroutine ElevatorLatchSingleEnd()
  104. !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorLatchSingleEnd
  105. !DEC$ ATTRIBUTES ALIAS: 'ElevatorLatchSingleEnd' :: ElevatorLatchSingleEnd
  106. implicit none
  107. #ifdef deb
  108. print*, 'ElevatorLatchSingleEnd'
  109. #endif
  110. !if(Elevator /= ELEVATOR_LATCH_SINGLE_END) Elevator = ELEVATOR_LATCH_SINGLE_END
  111. call Set_Elevator(ELEVATOR_LATCH_SINGLE_END)
  112. end subroutine
  113. subroutine ElevatorUnLatchSingleEnd()
  114. !DEC$ ATTRIBUTES DLLEXPORT :: ElevatorUnLatchSingleEnd
  115. !DEC$ ATTRIBUTES ALIAS: 'ElevatorUnLatchSingleEnd' :: ElevatorUnLatchSingleEnd
  116. implicit none
  117. #ifdef deb
  118. print*, 'ElevatorUnLatchSingleEnd'
  119. #endif
  120. !if(Elevator /= ELEVATOR_UNLATCH_SINGLE_END) Elevator = ELEVATOR_UNLATCH_SINGLE_END
  121. call Set_Elevator(ELEVATOR_UNLATCH_SINGLE_END)
  122. end subroutine
  123. logical function Get_EvelatorLatchString()
  124. !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorLatchString
  125. !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorLatchString' :: Get_EvelatorLatchString
  126. implicit none
  127. Get_EvelatorLatchString = .false. ! Elevator == ELEVATOR_LATCH_STRING
  128. end function
  129. logical function Get_EvelatorLatchStand()
  130. !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorLatchStand
  131. !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorLatchStand' :: Get_EvelatorLatchStand
  132. implicit none
  133. Get_EvelatorLatchStand = .false. ! Elevator == ELEVATOR_LATCH_STAND
  134. end function
  135. logical function Get_EvelatorLatchSingle()
  136. !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorLatchSingle
  137. !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorLatchSingle' :: Get_EvelatorLatchSingle
  138. implicit none
  139. Get_EvelatorLatchSingle = .false. ! Elevator == ELEVATOR_LATCH_SINGLE
  140. end function
  141. logical function Get_EvelatorUnlatchString()
  142. !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorUnlatchString
  143. !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorUnlatchString' :: Get_EvelatorUnlatchString
  144. implicit none
  145. Get_EvelatorUnlatchString = .false. ! Elevator == ELEVATOR_UNLATCH_STRING
  146. end function
  147. logical function Get_EvelatorUnlatchStand()
  148. !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorUnlatchStand
  149. !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorUnlatchStand' :: Get_EvelatorUnlatchStand
  150. implicit none
  151. Get_EvelatorUnlatchStand = .false. ! Elevator == ELEVATOR_UNLATCH_STAND
  152. end function
  153. logical function Get_EvelatorUnlatchSingle()
  154. !DEC$ ATTRIBUTES DLLEXPORT :: Get_EvelatorUnlatchSingle
  155. !DEC$ ATTRIBUTES ALIAS: 'Get_EvelatorUnlatchSingle' :: Get_EvelatorUnlatchSingle
  156. implicit none
  157. Get_EvelatorUnlatchSingle = .false. ! Elevator == ELEVATOR_UNLATCH_SINGLE
  158. end function
  159. end module CElevatorEnumVariables