starting and stopping a subroutine

Hello,

I have a clearwin program that includes some animations using the simple library which I want to start and stop by pressing buttons. so that the animation will run until I press the stop button. Unfortunately I don't seem to be able to switch off what seems to be an infinit loop, and my animation runs until I crash the program

I wrote a small test code to show what I mean. Any help will be gratefully received, as I don't know what to try next!

best regards

Albert

winapp program test implicit none INCLUDE <windows.ins> external startit, stopit INTEGER :: ans, k character(len=1) :: info common info, k

ans=winio@('%ca[test]&') ans=winio@('%^bt[start]&',startit) ans=winio@('%^bt[stop]&',stopit) ans=winio@('%ob[depressed]%25st%cb',info)

end program !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine startit implicit none INCLUDE <windows.ins> character(len=1) :: info integer :: k common info, k info='I' k=1 do if (k0) exit
if (info'I') then ! doing something repetitively info='O' CALL window_update@(info) else info='I'
CALL window_update@(info) endif enddo

endsubroutine
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine stopit implicit none integer :: k common k

k=0

endsubroutine

I can supply you with my version of some bits of code I use in a %gr menu based graphics window. The parts are:

1. A menu option to set an interrupt.
2. the called interrupt routine which resets the stop routines
3. The routine which allows interupts to be tested
4. sample code using and testing for interrupts

Basically for my approach, there are 2 parts:

1. setting the interupt to be allowed
2. testing for and responding to the interupt.

the main running program loop must test for an interupt to have occurred ( at regular intervals, not too often and not to infrequent ) and then return to the menu after it occurs and is recognised.

The interupt can also be enabled from a mouse click, such as if (reason.eq.'MOUSE_LEFT_CLICK') then ! left click to stop run_flag = .false. call window_update@ (run_flag)

run_flag and quit_on are duplicate variables for testing ( legacy code! )

There are probably other ways to do this, but this works for me, no guarantees !!

Good luck

The code bits are: ! ! Part of the menu system to enable interrupt i = winio@ ('%ca@&', caption) i = winio@ ('%`^gr[grey, rgb_colours, full_mouse_input]&', & w_width, w_depth, w_handle, mouse_back_func) .. i = winio@ ('%mn[_{&Interupt]&', on_stop, detect_interupt_func) .. i = winio@ ('%mn[}&Help]', on_run, Help_func) ! ! end of menu routine

integer4 function detect_interupt_func() ! ! Called when user interupts the program in the menu ! run_flag & quiton are reset include <JDC_menu.ins> ! contains run_flag, on_run, on_stop etc include 'quitcm.ins' ! contains quit_on integer4 i ! i = winio@ ('%si? Interrupt has been selected&') i = winio@ ('%nl%cn%bt[OK]') ! if (i > 0) then run_flag = .false. quit_on = .true. call window_update@ (run_flag) call window_update@ (quiton) write (98,'(a)') 'Interrupt detected' end if ! detect_interupt_func = 1 end function detect_interupt_func

subroutine user_look ! ! Temporary suspension of program to enable update of interupt ! this should be equivalent to QUITEST ! it should be only called in wobble mode include <clearwin.ins> call temporary_yield@ return end subroutine user_look

! Part of the code in the part of the program which draws and tests for interupt ! ! Before drawing loop starts, enable interupt on_run = 0 ! turn off normal menu on_stop = 1 ! turn on interrupt menu run_flag = .true. ! program run is enabled quit_on = .false. ! quit interrupt enabled call window_update@ (on_run) call window_update@ (on_stop) call window_update@ (run_flag) call window_update@ (quiton) ! call permit_another_callback@ ! ! now cycle through each screen display ! num = cycles_per_minute ! run for 60 seconds DO k = 0, num CALL elapse_second (CPUS) ! start of display ! call user_look ! look for user interupt ! IF (QUITON) then call screen_report ('QUITON recognised') EXIT end if if (.not.run_flag) then call screen_report ('run_flag recognised') EXIT end if ! ! display this screen ...

Thank you John for supplying me with your code, this is most kind. I will try to adapt it to my needs tonight.

Best regards

Albert

Albert,

Just to summarise what I sent yesterday, there are 4 basic phases of interrupt that you need to provide. The easiest way to manage the interrupt is via a clearwin+ menu system, as this allows for easier management of different program threads.

In the routine you are wanting to interrupt, there are two phases:

1. is to initially allow for the interrupt, by providing a variable which registers the interrupt for all routines. I use two variables, QUIT_ON and RUN_FLAG (only 1 is required but historical code use either ) 'call window_update@ (run_flag)' updates these variables for all threads. 'call permit_another_callback@' is important as it enables interrupt events to be seen by clearwin+. The interrupt event can be a menu option or a mouse click. Others may be possible ?

2. Periodically in this running program, you should test QUIT_ON or RUN_FLAG to see if their value has been changed by the other interrupting thread. 'call temporary_yield@' allows this part of the program to check for other threads updating these variables. Responding to this event is to exit this routine and return to the menu system.

The other important parts of the program are providing the interrupt routines and their response. This is done in the menu structure. 3) I provide the interrupt, via both a menu option and also a mouse event option. I use a graphics window with %gr and full_mouse_input, although other non-graphic menus may work. i = winio@ ('%`^gr[grey, rgb_colours, full_mouse_input]&', & w_width, w_depth, w_handle, mouse_back_func)

4. The final part is the code either the menu option 'i = winio@ ('%mn[~&Interupt]&', on_stop, detect_interupt_func)' or the mouse call-back routine 'mouse_back_func'. These routines simply reset the global variables.

The menu structure also provides for easy restart and resetting of run options.

The menu option %sc is also useful as it is a clean way of initialising the program, within the menu structure. eg, i = winio@ ('%sc&', plot_setup_func)

Once it's working, it is easy to use. The finessing is to get the frequency of temporary_yield@ right. Paul Laidler sent me a template of this years ago, and I've transferred this template to each program I've developed.

I'd be interested if others have developed alternative approaches to this solution ?

John Campbell

Hi John,

Thank you very much for the detailed instructions. The first thing I tried last night was to add two lines in subroutine startit.

do

call PERMIT_ANOTHER_CALLBACK@ call temporary_yield@

if (k==0) exit

this works, however, now I'm wondering if I might cause problems with this overly simple approach?

A couple of points : Permit_Another_Callback@ only needs to be called once per interrupt and so can be placed outside the loop. I think I have the right terminology, when I say that the interrupt response routine is another thread. The menu structure is the best way to manage multiple program threads. For your program example to work, you must have done more to your code, as you need an interrupt response routine to change the value of K.

Regards John

Another point: your startit and stopit routines must be functions with an empty argument list, not subroutines.

Sorry about the previous comment, I should have read your original code listing. I have modified your program for some examples of changes: replaced common, which must be consistent, with a module used %`rd to display value of K replaced subroutines with function and give example of 0 or 1 return. 1 to continue, 0 to exit. introduced sleep@ to control rate of do loop, and give example of changing parameters for program when running. You could also use system_clock to time the do loop and then sleep the balance of seconds, although that is for when the loop itteration takes a significant time. I hope the changes help

winapp 

module common_variables
INTEGER :: k 
character(len=1) :: info 
real*8 seconds
end module common_variables

program test 
use common_variables
implicit none 
INCLUDE <windows.ins> 
external startit, stopit, exitit
!
integer :: ans
!
info = 'A'
k = 99
seconds = 0.05
!
ans=winio@('%ca[test of interrupt]&') 
ans=winio@('%^bt[start]  &',startit) 
ans=winio@('%^bt[stop]   &',stopit) 
ans=winio@('%^bt[exit]   &',exitit) 
ans=winio@('%ff%nl %ob[depressed]  %25st %cb&', info) 
ans=winio@('%ff%nl value of k is  %`rd&', k)
ans=winio@('%ff update delay is %rf seconds', seconds)   ! real must be *8

end program 

integer function startit ()
use common_variables
implicit none 
INCLUDE <windows.ins> 

real*4 sec

info='I' 
k=1 
sec = seconds
call PERMIT_ANOTHER_CALLBACK@ 
do 
   call temporary_yield@ 
   CALL window_update@(k)  
   if (k==0) exit 
   if (info=='Z') then ! doing something repetitively 
      info='A' 
      CALL window_update@(info) 
   else 
      info=char (ichar(info)+1) 
      CALL window_update@(info) 
   endif
   call sleep@ (sec)  ! expects real*4 argument
end do 
startit = 1
end function startit

integer function stopit ()
use common_variables
implicit none 

k=0 
stopit = 1
end function stopit

integer function exitit ()
use common_variables
implicit none 

k=0
exitit = 0    ! return zero to stop
end function exitit

Yet again I should apologise, as I did not fully check the previous example I sent.

The correct use of window_update@ is important and should be called after a variable is modified, otherwise if the different threads are delayed, they may not pick up the updated value immedately. This is more obvious if some of the threads involve a significant amount of computation. The revised use of window_update@ and some changes to the string display are included.

Also, when the loop itteration becomes more compute intensive and variable in it's run time, the checking of elapsed time via system_clock can be very effective in timing the loop itteration to ensure a uniform display rate. There are better timing routines than SYSTEM_CLOCK but thats an old topic.

Enough said, I hope this latest effort is more consistent !

winapp 

module common_variables
INTEGER :: k, nc
character(len=20) :: info 
real*8 step_seconds, loop_step
end module common_variables

program test 
use common_variables
implicit none 
INCLUDE <windows.ins> 
external startit, stopit, exitit
!
integer :: ans
!
info = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
k = 99
nc = 0
step_seconds = 0.05
loop_step    = 0
!
ans=winio@('%ca[test of interrupt]&') 
ans=winio@('%^bt[start]  &',startit) 
ans=winio@('%^bt[stop]   &',stopit) 
ans=winio@('%^bt[exit]   &',exitit) 
ans=winio@('%ff%nl %ob[depressed]  %25st %cb&', info) 
ans=winio@('%ff%nl ichar value of last character is  %`rd&', nc)
ans=winio@('%ff value of k is  %`rd&', k)
ans=winio@('%ff update delay is %rf seconds&', step_seconds)   ! real must be *8
ans=winio@('%ff loop itteration is %`rf seconds', loop_step) 

end program 

integer function startit ()
use common_variables
implicit none 
INCLUDE <windows.ins> 

real*8 start, step
real*4 sec
integer n

n = len(info)
k=1 
CALL window_update@ (k)  
call PERMIT_ANOTHER_CALLBACK@ 
do 
   call elapse_seconds (start)
   call temporary_yield@ 
   if (k==0) exit 
!
   info(1:n-1) = info(2:n)
   if (info(n:n)=='~') then ! doing something repetitively 
      nc = 32
      info(n:n)=char(nc)
      CALL window_update@ (info) 
   else 
      nc = ichar (info(n:n))+1
      info(n:n)=char (nc)
      CALL window_update@ (info) 
   end if
   CALL window_update@ (nc)
   CALL window_update@ (loop_step)  ! include in timing
!
   call elapse_seconds (step)
   loop_step = step - start
   sec = step_seconds - loop_step
   call sleep@ (sec)  ! expects real*4 argument
end do 
startit = 1
end function startit

integer function stopit ()
use common_variables
implicit none 

k=0 
CALL window_update@(k)  
stopit = 1
end function stopit

integer function exitit ()
use common_variables
implicit none 

k=0
CALL window_update@(k)  
exitit = 0    ! return zero to stop
end function exitit

subroutine elapse_seconds (seconds)

real*8 seconds

integer*8 :: count_step, count_max
integer*8 :: count_start = 0
integer*8 :: count_rate  = 1
logical   :: first = .true.

if (first) then
   call SYSTEM_CLOCK (count_start, count_rate, count_max)
!zz   write (*,*) count_start, count_rate, count_max
   first = .false.
end if
!
call SYSTEM_CLOCK (count_step)
!
seconds = dble(count_step-count_start) / dble(count_rate)
if (seconds < 0) seconds = abs(seconds)   ! counter reduces in 3ghz P4 
end subroutine elapse_seconds

Thank you very much John. I really appreciate your help on this. I understand what your code is doing now. Thanks once again.

Best regards

Albert