awaitevent.f

Intro/: Directory containing introductory examples. HelloWorld.c A simple program that draws a bo

$alias fdopen='fdopen'(%val, %ref)
      include 'phigs.f1.h'			! get the HP-PHIGS aliases
      program AwaitEvent			! program "AwaitEvent.f"
      include 'phigs.f2.h'			! get the HP-PHIGS constants

      integer*4	WorkstnID			! workstation identifier
      parameter	(WorkstnID=1)			! value chosen by the user
      integer*4	ConnID				! connection identifier
      integer*4	WorkstnType			! workstation type
      parameter	(WorkstnType=POIDDX)		! out/in, direct, dbl bfr, X
      integer*4	Mouse, KeyBoard, Softkeys	! device numbers
      parameter (Mouse=1, KeyBoard=2, Softkeys=3)
      integer*4	ReturnDevice, ReturnClass	! returned device/class
      integer*4	Simultaneous			! more simultaneous events?
      real	TimeOut				! for "pwait"
      parameter	(TimeOut=60.)			! time out after one minute
      logical	Done 				! loop control variable
      integer*4	Error				! error-return variable
      integer*4 fdopen				! to get file descriptor

      call popph(fdopen(fnum(7), 'w'//char(0)), 0)	! open phigs
      call pue004('/dev/screen/phigs_window', ConnID)	! get connection ID
      call popwk(WorkstnID, ConnID, WorkstnType)	! open workstation
      call pschm(WorkstnID, Mouse,    PEVENT, PECHO)	! set choice mode
      call pslcm(WorkstnID, Mouse,    PEVENT, PECHO)	! set locator mode
      call pschm(WorkstnID, Softkeys, PEVENT, PECHO)	! set choice mode
      call pschm(WorkstnID, KeyBoard, PEVENT, PECHO)	! set choice mode
      print '(a40, a21)', "Ready.  (Type 'Q' or click in the lower",
     +	"-left corner to quit.)"
      Done=.false.
      do while (.not. Done)
	  call pwait(TimeOut, WorkstnID,	! await event
     +	    ReturnClass, ReturnDevice)
	  if (ReturnClass .eq. PNCLAS) then
	      print *, "One-minute timeout occurred.  Terminating."
	      Done=.true.
	  else 
	      call GetInfo(ReturnClass, ReturnDevice)
	  end if
	  call pqsim(Error, Simultaneous)	! inquire simultaneous events
	  if (Error .ne. 0) then
	      print *, "Error", Error, "returned from 'pqsim'."
	  end if
	  do while (Simultaneous .eq. PMORE)	! while more events...
	      print *, "Simultaneous event: "
	      call pwait(TimeOut, WorkstnID, ReturnClass, ReturnDevice)
	      call GetInfo(ReturnClass, ReturnDevice)
	      call pqsim(Error, Simultaneous)   ! inquire simultaneous events
	  end do
      end do
      call pclwk(WorkstnID)			! close workstation
      call pclph				! close phigs
      stop					! stop processing
      end					! end of program
!*****************************************************************************
      subroutine GetInfo(DevClass, DevNumber)
      integer*4 DevClass
      integer*4 DevNumber
      include '/usr/include/phigs.f2.h'

      integer*4	Status				! choice status
      integer*4	Choice				! choice number
      integer*4	ViewIndex			! view index of locator
      real	Lx, Ly, Lz			! XYZ location

      !--- get and print choice device input ---------------------------------
      if (DevClass .eq. PCHOIC) then
	  call pgtch(Status, Choice)		! get choice
	  if (Status .eq. POK) then
	      if (DevNumber .eq. 1) then
	         print *, "Mouse button:", Choice
	      endif
	      if (DevNumber .eq. 2) then
		  if (char(Choice).gt.' '.and.char(Choice).le.'~') then
		      print *, "Keyboard key: '", char(Choice),
     +			"' (", Choice, ")"
		  else
		      print *, "Keyboard key: ' ' (",Choice,")"
		  endif
		  if (char(Choice) .eq. 'Q') then
		      print *, "'Q' typed; quitting."
		      stop
		  end if
	      end if
	      if (DevNumber .eq. 3) then
	         print *, "Function key: ", Choice
	      endif
	  else
	      print *, "(No choice input)"
	  end if
      end if
      !--- get and print locator device input --------------------------------
      if (DevClass .eq. PLOCAT) then
	  call pgtlc3(ViewIndex, Lx, Ly, Lz)	! get locator
	  print '(a11, f4.2, a2, f4.2, a2, f4.2, a14, I1, ".")',
     +	    " Locator: (", Lx, ", ", Ly, ", ", Lz, "); View Index=",
     +	    ViewIndex
	  if (Lx .lt. .1 .and. Ly .lt. .1) then
	      print *, "Mouse clicked in lower-left corner; quitting."
	      stop
	  end if
      end if
      return
      end