|
- module CHookVariables
- !**use CRealEventHandlerCollection
- ! use CHookActions
- implicit none
- Type :: HookType
- real :: HookHeight_S = 0.0
- real :: HookHeight
- !**type(RealEventHandlerCollection) :: OnHookHeightChange
- end type HookType
- Type(HookType)::Hook
-
- contains
-
- subroutine Set_HookHeight(v)
- use CDrillingConsoleVariables
- implicit none
- real , intent(in) :: v
-
- #ifdef ExcludeExtraChanges
- if(Hook%HookHeight == v) return
- #endif
- Hook%HookHeight = v
-
- ! if(associated(HookHeightPtr)) then
- ! call HookHeightPtr(Hook%HookHeight)
- ! end if
-
- #ifdef deb
- print*, 'HookHeight=', Hook%HookHeight
- #endif
-
- !**call Hook%OnHookHeightChange%RunAll(Hook%HookHeight)
- end subroutine
-
-
- subroutine Set_HookHeight_S(v)
- implicit none
- real , intent(in) :: v
-
- if(v == Hook%HookHeight) then
- return
- elseif (v > Hook%HookHeight) then
- loop1: do
- call Set_HookHeight(Hook%HookHeight + 0.2)
- if(abs(v - Hook%HookHeight) <= 0.1) then
- call Set_HookHeight(v)
- exit loop1
- endif
- call sleepqq(100)
- enddo loop1
- else ! v < HookHeight
- loop2: do
- call Set_HookHeight(Hook%HookHeight - 0.2)
- if(abs(Hook%HookHeight - v) <= 0.1) then
- call Set_HookHeight(v)
- exit loop2
- endif
- call sleepqq(100)
- enddo loop2
- endif
-
- end subroutine
-
-
- subroutine Set_HookHeight_WN(v)
- !DEC$ ATTRIBUTES DLLEXPORT :: Set_HookHeight_WN
- !DEC$ ATTRIBUTES ALIAS: 'Set_HookHeight_WN' :: Set_HookHeight_WN
- implicit none
- real , intent(in) :: v
- !call Set_HookHeight(v)
- Hook%HookHeight_S = v
- end subroutine
-
-
- subroutine Update_HookHeight_From_Snapshot()
- implicit none
- call Set_HookHeight_S(Hook%HookHeight_S)
- end subroutine
-
- end module CHookVariables
|