C @(#)gd8z.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 GD8012(DISPLAY,CHAN,NOCHAN,SCX,SCY,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IIWSC	version 1.00	880125
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  DeAnza, memory, scroll
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  IIZWSC(DISPLAY,CHAN,NOCHAN,SCX,SCY,IDST)
C
C  input par:
C  DISPLAY:	I*4		display id.
C  CHAN:	I*4 array	memory ids
C  NOCHAN:	I*4 		no. of memory ids
C  SCX:		I*4		x-scroll value
C  SCY:		I*4		y-scroll value
C
C  output par:
C  IDST:	I*4		return status
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN(1),NOCHAN,SCX,SCY,IDST
	INTEGER*4	SCRTOP,N,NN
C	
	INTEGER*2	UNIT,SC,C1,NSCX,NSCY
	INTEGER*2	LMC
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
	INCLUDE	'MID_INCLUDE:IDIDEV.INC'
	INCLUDE	'MID_INCLUDE:IDIMEM.INC'
C	
	EXTERNAL	LMC
C	
	DATA	C1 /"176000/
C	
	SCRTOP = QDSZY - 1			!top line on screen
C	
	UNIT = DISPLAY
	NSCX = - SCX				!offsets from 0,0 are
	NSCY = SCRTOP - SCY			!to DeAnza 0,511 business...
C	
C  set up scroll value in DeAnza memory
C  bits X9 - X0 in reg.0 and bits Y9 - Y0 in reg. 1
C	
	DO NN=1,NOCHAN
	   N = CHAN(NN) + 1
C
	   MEMREG(1,N) = IAND(MEMREG(1,N),C1)	!clear scroll
	   SC = IAND(NSCX,"001777)			!cut out last 10 bits
	   MEMREG(1,N) = IOR(MEMREG(1,N),SC)
C
	   MEMREG(2,N) = IAND(MEMREG(2,N),C1)	!clear scroll
	   SC = IAND(NSCY,"001777)			!cut out last 10 bits
	   MEMREG(2,N) = IOR(MEMREG(2,N),SC)
C	
C  and send it to the DeAnza
	   CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(1,N),4,CHAN(NN),0)
	ENDDO
C	
C  alright then...
	IDST = 0
	RETURN
	END

	SUBROUTINE GD8013(DISPLAY,CHAN,NOCHAN,ZOOM,IDST)
C	
C++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C  subroutine IIZWZM	version 1.00	880118
C  K. Banse                  	ESO - Garching
C
C.KEYWORDS
C  DeAnza, memory, scroll
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  IIDZWZM(DISPLAY,CHAN,NOCHAN,ZOOM,IDST)
C
C  input par:
C  DISPLAY:	I*4		display id.
C  CHAN:	I*4 array 	memory ids
C  NOCHAN:	I*4 		no. of memory ids
C  ZOOM:	I*4		zoom factor
C
C  output par:
C  IDST:	I*4		return status
C	
C--------------------------------------------------
C
	IMPLICIT NONE
C	
	INTEGER*4	DISPLAY,CHAN(1),NOCHAN,ZOOM,IDST
	INTEGER*4	N,NN
C	
	INTEGER*2	UNIT,IZ,IZO
	INTEGER*2	LMC
C
	INCLUDE	'MID_INCLUDE:DEANZAH.INC'
	INCLUDE	'MID_INCLUDE:DEANZAS.INC'
C	
	EXTERNAL	LMC
C	
	UNIT = DISPLAY
C	
C  set up zoom value in DeAnza memory
C  bits Z3 - Z0 (15 - 13) in reg.0 and bits Z3 - Z0 (15 - 13) in reg. 1
C	
	DO NN=1,NOCHAN
	   N = CHAN(NN) + 1
	   IZ = IAND((ZOOM-1),"000007)		!cut out last 3 bits of ZOOM - 1
	   IZO = ISHFT(IZ,13)
	   MEMREG(1,N) = IAND(MEMREG(1,N),"017777)	!clear zoom
	   MEMREG(1,N) = IOR(MEMREG(1,N),IZO)
	   MEMREG(2,N) = IAND(MEMREG(2,N),"017777)	
	   MEMREG(2,N) = IOR(MEMREG(2,N),IZO)
C	
C  and send it to the DeAnza
	   CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(1,N),4,CHAN(NN),0)
	ENDDO
C	
C  alright then...
	IDST = 0
	RETURN
	END