C @(#)gd8r.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 GD8033(DISPLAY,CHAN,COLOUR,XA,YA,XB,YB,ROID,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  a) subroutine IIRINR		version 1.00	880614
C  b) subroutine IIRRRI		version 1.00	880121
C  c) subroutine IIRWRI		version 1.00	880614
C  d) subroutine IIRSRV		version 1.00	890119
C  all routines				1.20	880915
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  DeAnza, 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
C  a) IIRINR(DISPLAY,CHAN,COLOUR,XA,YA,XB,YB,ROID,IDST)
C  b) IIRRRI(DISPLAY,CHAN,ROID,XA,YA,XB,YB,MEMO,IDST)
C  c) IIRWRI(DISPLAY,CHAN,ROID,XA,YA,XB,YB,IDST)
C  d) IIRSRV(DISPLAY,ROID,VIS,IDST)
C
C  input par:
C  DISPLAY:	I*4		display id.
C  CHAN:	I*4		input memory id (we ignore that...)
C  COLOUR:	I*4		colour
C  XA:		I*4		min x
C  YA:		I*4		min y
C  XB:		I*4		max x
C  YB:		I*4		max y
C
C  VIS:		I*4		1 = visible, 0 = invisible
C
C  in/output par:
C  ROID:	I*4		ROI id  (output par for IIRINR, else input par)
C  IDST:	I*4		return status
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN,COLOUR,XA,YA,XB,YB,ROID,IDST
	INTEGER*4	XROID
C	
	INTEGER*2	UNIT
	INTEGER*2	CMASK,RESREG,FIX
	INTEGER*2	LCR,RCR,LR,RR,LPA
C	
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	LR,RR,LCR,RCR,LPA
C	
	DATA	CMASK 	/"001460/
	DATA	XROID   /0/
C
C  get unit
	UNIT = DISPLAY
C	
C  start with cursor control register = 0
C	
	IF (COLOUR.EQ.0) THEN
	   FIX = 15
	ELSE
	   FIX = 14
	ENDIF
C
	CURREG(5) = FIX				!insert fixed cursor shape
	CURREG(5) = IOR(CURREG(5),CMASK)	!insert X, Y components
C	
C  send cursor control register to the Deanza
	CALL IP8QW(LCR,UNIT,DZIOSB,,,CURREG(5),2,0,4)
C	
C  allright then...
	ROID = XROID
	XROID = XROID + 1
C 
	IF (XA.GE.0)
     +	   CALL GD8035(DISPLAY,CHAN,ROID,XA,YA,XB,YB,IDST)
C 
	IDST = 0
C	
	RETURN
	END

	SUBROUTINE GD8034(DISPLAY,CHAN,ROID,XA,YA,XB,YB,MEMO,IDST)
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN,ROID,XA,YA,XB,YB,MEMO,IDST
	INTEGER*4	N1,N,ISS
C		
	INTEGER*2	UNIT,CONTROL,FCREG
	INTEGER*2	RCR,RVR,LPR
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
	INCLUDE	'MID_INCLUDE:IDIDEV.INC'
C	
	EXTERNAL	RCR,RVR,LPR
C	
C  get unit
	UNIT = DISPLAY
C	
C  get cursor registers from the Deanza
	CALL IP8QW(RCR,UNIT,DZIOSB,,,CURREG(1),8,0,0)
C	
C  make sure cursor1 gets minimum
	IF (CURREG(1).GT.CURREG(3)) THEN
	   XA = CURREG(3)
	   XB = CURREG(1)
	ELSE
	   XA = CURREG(1)
	   XB = CURREG(3)
	ENDIF
	IF (CURREG(2).GT.CURREG(4)) THEN
	   YA = CURREG(4)
	   YB = CURREG(2)
	ELSE
	   YA = CURREG(2)
	   YB = CURREG(4)
	ENDIF
C	
C  get X-, Y- split registers + FCRs
1000	CALL IP8QW(RVR,UNIT,DZIOSB,,,VOCREG(1),4,0,0)
	CALL IP8QW(RVR,UNIT,DZIOSB,,,FCR(1),16,0,8)
C	
C  determine relevant FCR
	IF ( (VOCREG(1).EQ.0) .AND. (VOCREG(2).EQ.(QDSZY-1)) ) THEN
	   FCREG = FCR(4)			!no split screen
	ELSE
	   IF (XA.LT.VOCREG(1)) THEN
	      ISS = 1
	      IF (YA.LT.VOCREG(2)) ISS = 2
	   ELSE
	      ISS = 0
	      IF (YA.LT.VOCREG(2)) ISS = 3
	   ENDIF
	   FCREG = FCR(ISS+1)
	ENDIF
C	
C  pull out memory channel from FCR
	MEMO = IAND(FCREG,"17)
C	
C  alright then...
	IDST = 0
	RETURN
	END

	SUBROUTINE GD8035(DISPLAY,CHAN,ROID,XA,YA,XB,YB,IDST)
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN,ROID,XA,YA,XB,YB,IDST
C		
	INTEGER*2	UNIT
	INTEGER*2	AX,BX,AY,BY
	INTEGER*2	LCR
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	LCR
C
C  get unit
	UNIT = DISPLAY
C	
C  make sure, cursor1 get minimum coords
	IF (XA.GT.XB) THEN
	   AX = XB
	   BX = XA
	ELSE
	   AX = XA
	   BX = XB
	ENDIF
	IF (YA.GT.YB) THEN
	   AY = YB
	   BY = YA
	ELSE
	   AY = YA
	   BY = YB
	ENDIF
C	
	CURREG(1) = AX
	CURREG(2) = AY
	CURREG(3) = BX
	CURREG(4) = BY
C	
C  and send it to the Deanza
	CALL IP8QW(LCR,UNIT,DZIOSB,,,CURREG(1),8,0,0)
C	
C  alright then...
	IDST = 0
	RETURN
	END

	SUBROUTINE GD8036(DISPLAY,ROID,VIS,IDST)
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,ROID,VIS,IDST
C 
	INTEGER*2	UNIT,CMASK
	INTEGER*2	RCR,LCR
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
	INCLUDE	'MID_INCLUDE:IDIDEV.INC'
C	
	EXTERNAL	RCR,LCR
C	
C  get unit
	UNIT = DISPLAY
C
	CALL IP8QW(RCR,UNIT,DZIOSB,,,CURREG(5),2,0,4)
	IF (VIS.NE.0) THEN
           CMASK = "001460
           CURREG(5) = IOR(CURREG(5),CMASK)
        ELSE
           CURREG(5) = 0
	ENDIF
C	
C  send cursor control register to the Deanza
	CALL IP8QW(LCR,UNIT,DZIOSB,,,CURREG(5),2,0,4)
C	
	RETURN
	END