C @(#)gd8i2.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 GD8041(DISPLAY,LOCNO,JX,JY,IDST) C C++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine IIIGLD version 1.00 880505 C K. Banse ESO - Garching C C.KEYWORDS C IDI Locator = joystick, trackball C C.PURPOSE C fulfill the requirements as described in the IDI document C C.ALGORITHM C distinguish between joystick + trackball, C and use DeAnza level-0 software C C.INPUT/OUTPUT C call as IIIGLD(DISPLAY,LOCNO,JX,JY,IDST) C C input par: C DISPLAY: I*4 display id. C LOCNO: I*4 locator number C JX: I*4 x-displacement C JY: I*4 y-displacement C C output par: C IDST: I*4 return status C C.VERSIONS C C-------------------------------------------------- C IMPLICIT NONE C INTEGER*4 DISPLAY,LOCNO,JX,JY,IDST INTEGER*4 N1,N C INTEGER*2 UNIT,CONTROL INTEGER*2 RPR C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' INCLUDE 'MID_INCLUDE:IDIDEV.INC' C EXTERNAL RPR C C get unit UNIT = DISPLAY C C for trackball we do the stuff in a separate subroutine IF (QJOYFL.EQ.1) THEN CALL TRKRD(UNIT,JX,JY) ELSE C C get joystick displacement register (reg. 3) from the Deanza CALL IP8QW(RPR,UNIT,DZIOSB,,,CONTROL,2,0,3) JX = IAND(CONTROL,"377) - 128 JY = ISHFT(CONTROL,-8) - 128 ENDIF C C allright then... IDST = 0 RETURN END SUBROUTINE GD8044(DISPLAY,EVAL,JJ,IDST) C IMPLICIT NONE C INTEGER*4 DISPLAY,EVAL,JJ,IDST C JJ = 1 IDST = 0 C RETURN END SUBROUTINE GD8045(DISPLAY,EVAL,OUTSTR,JJ,IDST) C IMPLICIT NONE C INTEGER*4 DISPLAY,EVAL,JJ,IDST C CHARACTER*(*) OUTSTR C JJ = LEN(OUTSTR) OUTSTR(1:) = ' ' READ(*,10000) OUTSTR IDST = 0 RETURN C 10000 FORMAT(A) END