C @(#)gd8i1.for	17.1.1.1 (ES0-DMD) 01/25/02 17:34:39
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
	SUBROUTINE 
     +  GD8037(DISPLAY,INTATY,INTAID,OBJTY,OBJID,INTAOP,EXTRIG,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IIIENI		version 1.20	880929
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  Image Display, cursor boards
C
C.PURPOSE
C  fulfill the requirements as described in the IDI document
C
C.ALGORITHM
C  use DeAnza level-0 software
C
C.INPUT/OUTPUT
C  call as IIIENI(DISPLAY,INTATY,INTAID,OBJTY,OBJID,INTAOP,EXTRIG,IDST)
C
C  input par:
C  DISPLAY:	I*4		Display Unit
C  INTATY:	I*4	        Interactor type 
C  INTAID:	I*4	        Interactor identifier
C  OBJTY:	I*4		Object type
C  OBJID:	I*4		Object identifier
C  INTAOP:	I*4		interactive operation
C  EXTRIG:	I*4		exit trigger number
C
C  output par:
C  IDST:	I*4		return status
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,INTATY,INTAID,OBJTY,OBJID
	INTEGER*4	INTAOP,EXTRIG,IDST
	INTEGER*4	ITY,N,TRGLIM
C		
	INTEGER*2	UNIT,ENTER,CONTROL
	INTEGER*2	LPR
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	LPR
C	
        DATA   TRGLIM  /10/
C 
C  get unit
	UNIT = DISPLAY
	IDST = 0
C 
        IF (INTAOP.GT.1) RETURN
C	
C  test input for interaction (we do not support everything yet...)
C  and determine internal number ITY
C	
	IF (INTATY.EQ.5) THEN			!Trigger handling
	   IF (OBJTY.EQ.0) THEN			!no visible effect
	      ITY = 5 + INTAID                  !EXIT or ENTER button/trigger
	   ELSE
	      IDST = 403
	      RETURN
	   ENDIF
C 
	ELSE IF (INTATY.EQ.0) THEN		!Locator handling
	   IF (OBJTY.EQ.1) THEN			!Cursor
	      ITY = 1 + OBJID			!curor #0 or cursor #1
	   ELSE IF (OBJTY.EQ.0) THEN		!no visible effect
	      ITY = 4                           !just use locator (joystick/trackball)
	   ELSE IF (OBJTY.EQ.4) THEN		!ROI (= 2 cursors)
	      ITY = 3
	   ELSE
	      IDST = 403			!wrong object type
	      RETURN
	   ENDIF
C 
	ELSE
	   IDST = 401				!wrong interaction type
	   RETURN
	ENDIF
C 
C  we do not use interrupts...
	CALL IP8QW(LPR,UNIT,DZIOSB,,,1,2,0,1)		!set CL bit (bit 0)
C 
        DO N=1,TRGLIM
           IF (DZTRIG(1,N).LE.0) THEN
              DZTRIG(1,N) = ITY
	      DZTRIG(2,N) = INTAOP		
              RETURN
	   ENDIF
        ENDDO
C	
C  let's get the hell out of here...
	RETURN
	END

	SUBROUTINE GD8038(DISPLAY,TRIGSTAT,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IIIEIW		version 1.20	880915
C  K. Banse                  	ESO - Garching
C  1.30	    890104		1.40     900327
C
C.KEYWORDS
C  Image Display, event flags, cursor boards
C
C.PURPOSE
C  fulfill the requirements as described in the IDI document 
C
C.ALGORITHM
C  use DeAnza level-0 software
C
C.INPUT/OUTPUT
C  call as IIIEIW(DISPLAY,TRIGSTAT,IDST)
C
C  input par:
C  DISPLAY:	I*4		Display Unit
C
C  output par:
C  TRIGSTAT:	I*4 array	trigger status array, each element = 0 or 1
C  IDST:	I*4		return status
C	
C.VERSIONS
C  1.30		provide also for trigger status for EXECUTE button,
C		even though only used in X Windows
C  1.40		increase size of DZTRIG and TRIGSTAT to 10
C 
C--------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,TRIGSTAT(1),IDST
	INTEGER*4	ISS,KK(10),PUSH,N,TRGLIM
C
	INTEGER*2	UNIT
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
	INCLUDE	'MID_INCLUDE:IDIDEV.INC'
C	
        DATA   TRGLIM  /10/                 !KK needs same dimension...
C	
	UNIT = DISPLAY
	IDST = 0
	DO N=1,TRGLIM
           TRIGSTAT(N) = 0
        ENDDO
C 
500	N = -1
	CALL DAZWAI(N)		  !force synchro loop (delay from DAZHOLD(12)
C 
C  main loop over all TRGLIM (currently = 10) slots
C 
	DO 1000 N=1,TRGLIM
	   KK(N) = 0
	   IF (DZTRIG(1,N).LE.0) GOTO 1000
C 
C  get cursor status + info about ENTER button
C 
	   IF (QJOYFL.EQ.0) THEN			!we have a joystick
	      IF (DZTRIG(1,1).EQ.1) THEN
	         ISS = "000400				!cursor no. 0
	      ELSE IF (DZTRIG(1,1).EQ.2) THEN
	         ISS = "001000				!cursor no. 1
	      ELSE
	         ISS = "001400				!cursor no. 0 or 1
	      ENDIF
	      CALL JOYPSH(UNIT,PUSH,ISS)
C 
	   ELSE						!we have a trackball
	      IF (DZTRIG(1,1).EQ.1) THEN
	         ISS = 0				!cursor no. 0
	      ELSE IF (DZTRIG(1,1).EQ.2) THEN
	         ISS = 1				!cursor no. 1
	      ELSE
	         ISS = 2				!cursor no. 0 or 1
	      ENDIF
	      CALL TRKPSH(UNIT,PUSH,ISS)
	   ENDIF
C	
C  find out, if ENTER pressed
C	
	IF (PUSH.EQ.1) THEN
	   IF (ISS.EQ.0) THEN			!cursor(s) off => this means EXIT
	      TRIGSTAT(1) = 1
	   ELSE
	      TRIGSTAT(2) = 1	
	   ENDIF
	   KK(N) = 1				!idicate reason to leave loop...
	ELSE
           IF (DZTRIG(2,N).EQ.0) KK(N) = 1	!for inter. op. = 0, we leave anyway
	ENDIF
C 
1000	ENDDO					!end of main loop
C 
C	
C  check, if something came in, so we can leave ...
C	
	DO N=1,TRGLIM
	   IF (KK(N).NE.0) RETURN
	ENDDO
C 
	GOTO 500				!loop more
C 
	END

	SUBROUTINE GD8039(DISPLAY,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IIISTI		version 1.20	880915
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  Image Display
C
C.PURPOSE
C  fulfill the requirements as described in the IDI document 
C
C.ALGORITHM
C  use DeAnza level-0 software
C
C.INPUT/OUTPUT
C  call as IIISTI(DISPLAY,IDST)
C
C  input par:
C  DISPLAY:	I*4		Display Unit
C
C  output par:
C  IDST:	I*4		return status
C	
C.VERSIONS
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C 
	INTEGER*4	DISPLAY,IDST
	INTEGER*4	N,TRGLIM
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C 
        DATA  TRGLIM  /10/
C 
	IDST = 0
C	
	DO N=1,TRGLIM
	   DZTRIG(1,N) = 0
	ENDDO
C	
	RETURN
	END

	SUBROUTINE GD8040(DISPLAY,INTATY,INTAID,DEVDSC,LL,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IIIQID		version 1.00	880205
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  Image Display
C
C.PURPOSE
C  fulfill the requirements as described in the IDI document 
C
C.ALGORITHM
C  use DeAnza level-0 software
C
C.INPUT/OUTPUT
C  call as IIIQID(DISPLAY,INTATY,INTAID,DEVDSC,LL,IDST)
C
C  input par:
C  DISPLAY:	I*4		Display Unit
C
C  output par:
C  IDST:	I*4		return status
C	
C.VERSIONS
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C 
	INTEGER*4	DISPLAY,INTATY,INTAID,LL,IDST
	INTEGER*4	KK
C	
	CHARACTER*(*)	DEVDSC
C 
	INCLUDE	'MID_INCLUDE:IDIDEV.INC'
C	
	IF (INTATY.EQ.0) GOTO 1000
	IF (INTATY.EQ.5) GOTO 2000
C 
	IDST = 404
	RETURN
C 
C  we return info about the locator
1000	IF (QJOYFL.EQ.0) THEN
	   DEVDSC(1:) = 'Joystick '
	   LL = 8
	ELSE
	   DEVDSC(1:) = 'Trackball '
	   LL = 9
	ENDIF
	GOTO 9000
C 
C  we return info about the ENTER button at the locator
2000	IF (QJOYFL.EQ.0) THEN
	   DEVDSC(1:) = 'ENTER button (= lowest b.) '
	   LL = 26
	ELSE
	   DEVDSC(1:) = 'ENTER button (= rightmost b.) '
	   LL = 29
	ENDIF
	GOTO 9000
C 
9000	KK = LEN(DEVDSC)
	IF (KK.LT.LL) LL = KK
	IDST = 0
C 
	RETURN
	END