!======================================================================
!
! Program PeekApp
! 
! Simimulates a compute loop with peekchar and getchar 
! to handle input as it comes in character by character.
! 
! Since QWIN has no concept of unsolicited input (i.e.
! you get beeps if no read or getchar has been done),
! it is necessary to do a getchar.  But this puts the
! program to sleep until a character has been typed.
!
! Peekchar does not work under QWIN since there is no
! console buffer to accept unsolicited input, and hence
! no buffer counter to check.
!
! One way around this is to use a multithread application.
! One thread does a getchar and is blocked until a character
! typed.  The other thread is in a loop doing useful work
! and checking in the loop to see if the other thread has
! received input.
!

module PeekAppModule

use dflib
use dfmt
use dfport

implicit none

integer*4 bufget, bufput
character*1 buffer(0:255)
integer ThreadHandle
character*1 stop_char
data stop_char /'Q'/
logical FLAG
data FLAG /.false./
save FLAG
type(RTL_CRITICAL_SECTION) DrawLock

integer*4, static :: saveunit

contains

subroutine PeekStart(unit)
integer unit
integer  j, m

if(FLAG) return

saveunit = unit

bufput = 0
bufget = 0

call InitializeCriticalSection( loc(DrawLock) )

ThreadHandle = CreateThread( 0, 0, GetCharProc, %loc(saveunit), &
			     CREATE_SUSPENDED, j )

!Priority is the same as QWIN control loop and 1 step above
!the QWIN application loop.  But this is no problem since
!the thread will be asleep most of the time waiting for 
!a character to be typed in.

m = SetThreadPriority(ThreadHandle, THREAD_PRIORITY_ABOVE_NORMAL )

m = ResumeThread(ThreadHandle)

call sleepqq(100) ! sleep 1/10 of a second
                  ! seems to be needed to avoid a
				  ! problem with opening a GRAPH1 window

FLAG = .true.     ! show initialized

return

end subroutine PeekStart


subroutine PeekStop()
!
! Note the use of the unit number to get the handle of the window
!  to which to send a message requesting the process to EXIT PROCESS.
!
use dfwin
integer i
LOGICAL K
if(.not.FLAG) return
i = SendMessage(GetHWndQQ(saveunit), WM_CHAR, ichar(stop_char), 0)
FLAG=.false.
return
end subroutine PeekStop


integer*4 function GetCharProc( unit )
use dflib
integer*4 j,k, unit
character*1 ch
   
GetCharProc = 1

do while(.true.)
   j = focusqq(unit)! avoid GRAPH1 window 
   ch = getcharqq() ! this will block until a character is typed

! When the "stop" message is passed here, ExitThread is called in order
!  to perform an orderly cleanup of resources, including stack, memory,
!  I/O objects, etc.
! The alternative, TerminateThread, should not be used as it does not
!  properly terminate a given thread, not releasing its resources, and 
!  affecting DLL's that it has included.

   if(ch .eq. stop_char) then 
     FLAG = .FALSE.
     call ExitThread(0)
   endif

   ! interlock buffer
   call EnterCriticalSection( loc(DrawLock) )
   !insert the character
   bufput = IAND(bufput + 1,16#000000FF)
   if(bufput .eq. bufget) then
      CALL BEEPQQ(4000,500)
      bufput = IAND(bufput - 1,16#000000FF)
   else
   buffer(bufput) = ch
   endif
   ! release the buffer
   call LeaveCriticalSection( loc(DrawLock) )
end do
end function GetCharProc

logical*4 function userpeekchar()
   ! interlock buffer
   call EnterCriticalSection( loc(DrawLock) )
   !check if any characters in buffer
   if(bufget .eq. bufput) then
      userpeekchar = .false.
   else
      userpeekchar = .true.
   endif
   ! release the buffer
   call LeaveCriticalSection( loc(DrawLock) )

end function userpeekchar

character*1 function usergetchar()
   ! interlock buffer
   call EnterCriticalSection( loc(DrawLock) )
   !get the character
   if(bufget .eq. bufput) then
      CALL BEEPQQ(4000,500)
      usergetchar = ' '
      else
      bufget = IAND(bufget + 1,16#000000FF)
      usergetchar = buffer(bufget)
   endif
   ! release the buffer
   call LeaveCriticalSection( loc(DrawLock) )

end function usergetchar

end module PeekAppModule




!-----------------------------------------------------------------------

Program PeekApp
use PeekAppModule
use dfport
use dfwin

integer*4 i, j, k, unitnum
logical*4 test
character*1 ch

unitnum = 10
open(unitnum, file='user')

1  k = 0
stop_char = 'q'
write(unitnum,*) 'Press q to stop'
call PeekStart(unitnum)
test=.true.

loop_a: do i=1,100000000
   if(mod(i,100).eq.0) then
      call sleepqq(0)
   endif
   !dummy computation
   if((i-k) .ge. 1000000) then
     k = i
     write(unitnum,*) "Working i = ",i
   endif
   !call peekcharqq substitute to see if any input yet
   if(userpeekchar()) then
     ch = usergetchar()  ! get the character
     j = fputc(unitnum, ch)        ! and echo it
   end if
   
   if(.not. FLAG) then ! was the other thread exited ?
     write(unitnum,*) 'Suspended'
     write(unitnum,*) 'Continue? [Enter y/n]'
     read(unitnum,*) ch
     if (ch.eq.'y'.or.ch.eq.'Y') then
      test=.true.
      call PeekStart(unitnum)
     else
	test = .false. ! leave the do loop
		exit loop_a
     end if
   end if

end do loop_a

if(FLAG) then
	write(unitnum,*) 'Calculation ended normally'
	! unblock char-getting thread and ask it to exit
	call PeekStop()
	write(unitnum,*) 'Re-start? [Enter y/n]'
	read(unitnum,*) ch
	if (ch.eq.'y'.or.ch.eq.'Y') goto 1
else
	write(unitnum,*) 'Calculation aborted'
end if

end 
