C @(#)gd8g.for 17.1.1.1 (ES0-DMD) 01/25/02 17:34:38 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 + GD8021(DISPLAY,CHAN,XFIG,YFIG,NDIM,INTENS,STYLE,IDST) C C++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine IIGPLY version 1.00 880627 C K. Banse ESO - Garching C 1.20 890215 C C.KEYWORDS C DeAnza, overlay graphics C C.PURPOSE C draw a graph in graphics memory according to IDI decoument (Feb. 86) C.ALGORITHM C use 'write+update instruction' to draw (via IP8QW call with WV) C C.INPUT/OUTPUT C call as IDI_PL(DISPLAY,CHAN,XFIG,YFIG,NDIM,INTENS,STYLE,IDST) C C input par: C DISPLAY: I*4 unit no. C CHAN: I*4 no. of memory board used as overlay channel C if = -1, no overlay channel existing C XFIG: I*4 array contains the x-coordinates C YFIG: I*4 array contains the y-coordinates C NDIM: I*4 dimension of XFIG and YFIG C INTENS: I*4 intensity for drawing (0 - 255) C STYLE: I*4 line style, currently ignored (always straight line) C C output par: C IDST: I*4 return status C C.VERSIONS C 1.20 make it work for "unlimited" polygon length C C-------------------------------------------------- C IMPLICIT NONE C INTEGER*4 DISPLAY,CHAN,XFIG(1),YFIG(1),NDIM,IDST INTEGER*4 INTENS,STYLE,IPI INTEGER*4 N,NN,REM C INTEGER*2 FIGURE(2,1000) INTEGER*2 UNIT,INTNS INTEGER*2 RI,LR,RR,WV C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' INCLUDE 'MID_INCLUDE:IDIDEV.INC' C EXTERNAL RI,LR,RR,WV C UNIT = DISPLAY C C set RESOLUTION register (reg 11) to 2 bytes transfer CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) SYSREG(12) = IAND(SYSREG(12),"177677) CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) C SYSREG(33) = 2**CHAN CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(33),4,1,32) C C at the moment the colours red, green, blue, ... are not supported IF ( (INTENS.GT.1) .AND. (INTENS.LE.8) ) THEN INTNS = 255 !map all to white ELSE INTNS = INTENS ENDIF C C copy figure REM = 0 C 1000 NN = NDIM - REM IF (NN.GT.1000) NN = 1000 C DO N=1,NN IPI = XFIG(N+REM) IF (IPI.GE.QMSZX) THEN IPI = QMSZX - 1 ELSE IF (IPI.LT.0) IPI = 0 ENDIF FIGURE(1,N) = IPI IPI = YFIG(N+REM) IF (IPI.GE.QMSZY) THEN IPI = QMSZY - 1 ELSE IF (IPI.LT.0) IPI = 0 ENDIF FIGURE(2,N) = IPI ENDDO C C now draw the vector DO N=1,NN-1 CALL IP8QW(WV,UNIT,DZIOSB,,,FIGURE(1,N),8,0,INTNS) ENDDO C C test, if we are finished IF ((REM+NN).LT.NDIM) THEN REM = REM + NN GOTO 1000 ENDIF C IDST = 0 RETURN END SUBROUTINE GD8022(DISPLAY,CHAN,STRING,XPOS,YPOS,PATH, + ORIENT,INTENS,HT,IDST) C C++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine IIGTXT version 1.00 880513 C K. Banse ESO - Garching C C.KEYWORDS C DeAnza, overlay channel, alphabet C C.PURPOSE C fulfill the requirements as defined in the IDI document C C.ALGORITHM C characters are built in a 7*8 matrix (x:0-6, y:0-7) C use IDI_PL to plot the stuff in the overlay plane C C.INPUT/OUTPUT C call as IIGTXT(DISPLAY,CHAN,STRING,XPOS,YPOS,PATH,ORIENT,INTENS,HT,IDST) C C input par: C DISPLAY: I*4 unit no. C CHAN: I*4 memory id C STRING: char. expr. character string to be displayed C XPOS: I*4 x-position C YPOS: I*4 y-position C PATH: I*4 text path: C INTENS: I*4 intensity C HT: I*4 text height, currently not supported C characters are built in a 7*8 matrix C or fixed in the alphanumerics memory C C output par: C IDST: I*4 return status C C-------------------------------------------------- C IMPLICIT NONE C INTEGER*4 DISPLAY,CHAN,ORIENT INTEGER*4 INTENS,XPOS,YPOS,PATH,HT,IDST INTEGER*4 LSTR C CHARACTER*(*) STRING C LSTR = LEN(STRING) C IF (CHAN.LT.90) THEN CALL KKGRA(DISPLAY,CHAN,STRING,LSTR,XPOS,YPOS,PATH, + ORIENT,INTENS,HT,IDST) ELSE CALL KKALP(DISPLAY,STRING,LSTR,XPOS,YPOS,INTENS,IDST) ENDIF C RETURN END