!======================================================================
!
! Program PeekApp
! 
! Simulates 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.
!
! To use this example, you must have DVF 5.0 Update 1 or later
! installed.
!

module PeekAppModule

use dflib
use dfmt
use dfport

implicit none

integer*4 bufget, bufput

character*1 buffer(0:255)

integer ThreadHandle

type(RTL_CRITICAL_SECTION) DrawLock

contains

subroutine PeekStart()

integer i, j, m

i = 0

bufput = 0
bufget = 0

call InitializeCriticalSection( loc(DrawLock) )

ThreadHandle = CreateThread( 0, 0, GetCharProc, %val(i), &
			     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_NORMAL )

m = ResumeThread(ThreadHandle)

return

end subroutine PeekStart


integer*4 function GetCharProc( i )
integer*4 i
character*1 ch
   
GetCharProc = 1

do while(.true.)
   ch = getcharqq() ! this will block until a character is typed

   ! 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

integer*4 i, j, k
character*1 ch
i = 0
k = 0
call PeekStart()

do while(.true.)
   !dummy computation
   i = i + 1
   if((i-k) .ge. 1000000) then
     k = i
     print *,"Working i = ",i
   endif
   !call peekcharqq substitute to see if any input yet
   if(userpeekchar()) then
     ch = usergetchar()  ! get the character
     j = putc(ch)        ! and echo it
   endif
end do

end