!======================================================================
!
! Program PeekApp
! 
! This multi-threaded program simulates a compute loop with peekchar 
! and getchar to handle input as it comes in character by character.  
! 
! Because QuickWin 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.  However, getchar puts the
! program to sleep until a character has been typed.
!
! Peekchar cannot be used under QuickWin as 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.
!
! The second thread of this sample simply counts from 1-100000,
! and displays the current total at the end of each loop.
!
! 

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(unit)

integer unit

integer  j, m

integer*4, static :: saveunit

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)

return

end subroutine PeekStart

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

   ! 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, unit
character*1 ch
i = 0
k = 0

unit = 5
open(unit, file='user')
j = setbkcolorrgb(#00ff0000)
j = settextcolorrgb(#0000ff)

call PeekStart(unit)

do while(.true.)
   call sleepqq(0)
   !dummy computation
   if(((i-k) .ge. 1000000) .or. (i .eq. 0) ) then
     k = i
     write (unit,*) "Working i = ",i
   endif
   i = i + 1
   !call peekcharqq substitute to see if any input yet
   if(userpeekchar()) then
     ch = usergetchar()  ! get the character
     j = fputc(unit,ch)        ! and echo it
     if(ichar(ch) .eq. 3) stop  ! stop for control C
   endif
end do

end 
