C @(#)gd8l.for	19.1 (ES0-DMD) 02/25/03 13:55:08
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 GD8025(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST)
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IILWLT		version 1.00		880120
C	      IILRLT			1.00		880120
C  K. Banse			ESO - Garching
C
C.KEYWORDS
C  DeAnza display , LUT
C
C.PURPOSE
C  to load an LUT into the DeAnza,
C  to read an LUT from DeAnza,
C  according to the IDI document
C
C.ALGORITHM
C  use DeAnza level 0 software
C
C.INPUT/OUTPUT
C  call as IILWLT(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST)
C	   IILRLT(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST)
C
C  input par:
C  DISPLAY:	I*4		DISPLAY no.
C  NLUT:	I*4		LUT section no. (0 - 3)
C  				if = 4, it's for the overlay !!
C  ISTA:	I*4		start within LUT table in DeAnza
C  COUNT:	I*4		no. of entries in table to send/read
C	
C  input/output par:
C  RLUT:	R*4 array	LUT table with R,G,B entries
C  IDST:	I*4		return status
C
C-----------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,NLUT,ISTA,COUNT,IDST
	INTEGER*4	N,NN,ISW
C	
	REAL*4		RLUT(3,COUNT)
C	
	INTEGER*2 	UNIT,LUT(1024,2),RESREG
	INTEGER*2	RR,LR,LPA,LVR
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	RR,LR,LPA,LVR
C
	UNIT = DISPLAY
C
C  check, if we want to load an overlay table
	IF (NLUT.EQ.4) THEN
	   CALL KKOWLT(UNIT,ISTA,COUNT,RLUT,IDST)
	   RETURN
	ENDIF
C	
C  set resolution register for low byte transfer
	CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	RESREG = IAND(SYSREG(12),"177677)
	RESREG = IOR(RESREG,"100)
	CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11)
C	
C  set LUT address in the DeAnza
	N = IAND("377,ISTA)			!cut out low byte
	VOCREG(4) = IOR(N,ISHFT(NLUT,8))
C
C  main loop:
C  convert R, G, B real table to I*2 and send it to the DeAnza
C	
	ISW = 1
	DO NN=1,3
C	
	   DO N=1,COUNT
	      LUT(N,ISW) = NINT(RLUT(NN,N)*255.)
	   ENDDO
C	
	   CALL IP8W(UNIT)					!wait till ready ...
	   CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3)	
	   CALL IP8Q(LPA,UNIT,DZIOSB,,,LUT(1,ISW),COUNT*2,NN-1,1)
	   ISW = 3 - ISW					!switch buffer
	ENDDO
C
	CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	IDST = 0
	RETURN
	END	

	SUBROUTINE GD8026(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST)
C	
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,NLUT,ISTA,COUNT,IDST
	INTEGER*4	N,ISW,JSW
C	
	REAL*4		RLUT(3,COUNT)
	REAL*4		F
C	
	INTEGER*2 	UNIT,LUT(1024,2),RESREG
	INTEGER*2	RR,LR,RPA,LVR
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	RR,LR,RPA,LVR
C
	UNIT = DISPLAY
C	
C  set resolution register for low byte transfer
	CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	RESREG = IAND(SYSREG(12),"177677)
	RESREG = IOR(RESREG,"100)
	CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11)
C	
C  set LUT address in the DeAnza
	N = IAND("377,ISTA)			!cut out low byte
	VOCREG(4) = IOR(N,ISHFT(NLUT,8))
C
C  main loop:
C  get LUT from the DeAnza and convert I*2 table to R, G, B real table
C	
	ISW = 1
	JSW = 3 - ISW					!switch buffer
	F = 1./255.
C	
C  read red table with wait + greeen table without wait
	CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3)	
	CALL IP8QW(RPA,UNIT,DZIOSB,,,LUT(1,ISW),COUNT*2,0,1)
	CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3)	
	CALL IP8Q(RPA,UNIT,DZIOSB,,,LUT(1,JSW),COUNT*2,1,1)
C	
C  make sure high byte is 0 and convert red table to real
	DO N=1,COUNT						
	   RLUT(1,N) = F * FLOAT(IAND(LUT(N,ISW),"377))
	ENDDO
C	
C  fire up reading of blue as soon as green table is in
	CALL IP8W(UNIT)					!wait till ready ...
	CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3)	
	CALL IP8Q(RPA,UNIT,DZIOSB,,,LUT(1,ISW),COUNT*2,2,1)
C
C  convert green table
	DO N=1,COUNT
	   RLUT(2,N) = F * FLOAT(IAND(LUT(N,JSW),"377))
	ENDDO
C	
C  wait + convert blue table
	CALL IP8W(UNIT)	
	DO N=1,COUNT
	   RLUT(3,N) = F * FLOAT(IAND(LUT(N,ISW),"377))
	ENDDO
C
	CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	IDST = 0
	RETURN
	END	

	SUBROUTINE GD8023(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST)
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IILWIT		version 1.00	880120
C	      IILRIT			1.00	880120
C  K. Banse			ESO - Garching
C
C.KEYWORDS
C  DeAnza display , ITT
C
C.PURPOSE
C  to load an ITT into the DeAnza,
C  to read an ITT from DeAnza
C  according to the IDI document
C
C.ALGORITHM
C  use DeAnza level 0 software
C
C.INPUT/OUTPUT
C  call as IILWIT(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST)
C  	   IILRIT(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST)
C
C  input par:
C  DISPLAY:	I*4		display no.
C  CHAN:	I*4		memory board no.
C  NITT:	I*4		ITT section no. (0 - 3)
C  ISTA:	I*4		start in ITT table inside DeAnza
C  COUNT:	I*4		no. of bytes to send/read
C	
C  input/output par:
C  RITT:	R*4 array	ITT table
C  IDST:	I*4		return stat
C
C-----------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN,NITT,ISTA,COUNT,IDST
	INTEGER*4	N
C	
	REAL*4		RITT(1)
C	
	INTEGER*2 	UNIT,ITT(256),ILADR,RESREG
	INTEGER*2	RR,LR,LMC,LPA
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	RR,LR,LMC,LPA
C
	UNIT = DISPLAY
C	
C  set resolution register for low byte transfer
	CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	RESREG = IAND(SYSREG(12),"177677)
	RESREG = IOR(RESREG,"100)
	CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11)
C
C  convert real table to I*2
	DO N=1,COUNT
	   ITT(N) = NINT(RITT(N)*255.)
	ENDDO
C	
C  build ITT address
	N = IAND("377,ISTA)			!cut out start (usually = 0 anyway)
	N = IOR("10000,ISTA)			!add ITT enable bit (bit 12)
	ILADR = IOR(N,ISHFT(NITT,8))		!integrate also ITT section
	N = CHAN + 1
	MEMREG(4,N) = IAND(MEMREG(4,N),"176377)		!clear L9,L8 bit (9,8)
	MEMREG(4,N) = IOR(MEMREG(4,N),ILADR)
C	
C  send the table to the DeAnza
	CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(4,N),2,CHAN,3)	!set LUT address reg.
	CALL IP8QW(LPA,UNIT,DZIOSB,,,ITT,COUNT*2,CHAN,0)
C
	CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	IDST = 0
	RETURN
	END	

	SUBROUTINE GD8024(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST)
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN,NITT,ISTA,COUNT,IDST
	INTEGER*4	N
C	
	INTEGER*2	UNIT,ITT(256),ILADR,RESREG
	INTEGER*2	RR,LR,LMC,RPA
C	
	REAL*4		RITT(1)
	REAL*4		F
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C
	EXTERNAL	RR,LR,LMC,RPA
C
C  set resolution register for low byte transfer
	CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	RESREG = IAND(SYSREG(12),"177677)
	RESREG = IOR(RESREG,"100)
	CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11)
C	
C  build ITT address
	N = IAND("377,ISTA)			!cut out start (usually = 0 anyway)
	N = IOR("10000,ISTA)			!add ITT enable bit (bit 12)
	ILADR = IOR(N,ISHFT(NITT,8))		!integrate also ITT section
	N = CHAN + 1
	MEMREG(4,N) = IAND(MEMREG(4,N),"176377)		!clear L9,L8 bit (9,8)
	MEMREG(4,N) = IOR(MEMREG(4,N),ILADR)
C
C  read the table from the DeAnza
	CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(4,N),2,CHAN,3)	!set LUT address reg.
	CALL IP8QW(RPA,UNIT,DZIOSB,,,ITT,COUNT*2,CHAN,0)
C	
C  make sure high byte is 0 and convert to real
	F = 1./255.
	DO N=1,COUNT
	   RITT(N) = F * FLOAT(IAND(ITT(N),"377))
	ENDDO
C
	CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11)
	IDST = 0
	RETURN
	END	

	SUBROUTINE GD8049(DISPLAY,CHAN,VISI,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IILSBV		version 1.00	880125
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  DeAnza, LUT
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 IILSBV(DISPLAY,CHAN,VISI,IDST)
C
C  input par:
C  DISPLAY:	I*4		display id.
C  CHAN:	I*4		memory id
C  VISI:	I*4		LUT bar visibility, 0 = off, > 0 = on
C
C  output par:
C  IDST:	I*4		return status
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN,VISI,IDST
	INTEGER*4	N,STAT
C	
	INTEGER*2	UNIT,CLREF,SETREF
	INTEGER*2	LMC
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	DATA	CLREF	/"167777/, SETREF /"010000/
C	
	EXTERNAL	LMC
C
	N = CHAN + 1
	UNIT = DISPLAY
C	
C  clear + set RF bit (12) of memory register 0 of channel CHAN
C  depending upon VISI
C	
	MEMREG(1,N) = IAND(MEMREG(1,N),CLREF)
	IF (VISI.GT.0)
     +	   MEMREG(1,N) = IOR(MEMREG(1,N),SETREF)	
C	
	CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(1,N),2,CHAN,0)
C	
	IDST = 0
	RETURN
	END
