FTN,L 
C 
C 
C 
CC************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
CC************************************************************
C 
C 
C 
C      NAME: DEVICE STATUS (GDSTT)
C      SOURCE: 92840 - 18049
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
C SY2001 CHANGED &GDSTT TO IMPLEMENT GDSTT(9) FOR SOFTWARE TEXT.
C VARIABLE GD9 HOLDS THE FOUR REAL VALUES THAT GET RETURNED TO THE
C USER FOR GDSTT(9) WHEN SOFTWARE TEXT IS ON. 
C 
C 
      SUBROUTINE XDSTT(INN,IGCB,INDEX,INDIC,
     1IARRY),92840-16001 REV.2013 790904
      DIMENSION INDEX(2),IARRY(2) 
      DIMENSION ICAP(10)
C 
C***********************************************************************SY2013/ 
      LOGICAL GSOFT 
      REAL GD9(4) 
      INTEGER IGD9(8) 
      EQUIVALENCE (GD9,IGD9)
C**********************************************************END OF SY2013 MOD* 
      EQUIVALENCE (ICAP,ID),(ICAP(2),ICLR),(ICAP(3),NUMPN)
      EQUIVALENCE (ICAP(4),NCURS),(LORG,ICAP(5))
      EQUIVALENCE (ICAP(6),ISLNT),(ICLIP,ICAP(7)),(LDIR,ICAP(8))
      EQUIVALENCE (ICHR,ICAP(9))                                        EM1913
C 
C     THIS IS THE COMMAND PROCESSOR FOR THE AGL COMMAND 
C  GDSTT. THIS COMMAND INFORMS THE USER OF THE DEVICE 
C  CAPABILITIES.
C 
C     CALLING SEQUENCE PARAMETERS: IGCB -GCB
C       INDEX - ARRAY CONTAINING INTEGER VALUES WHICH INDICATE
C               WHICH CAPABILITY IS OF INTEREST.
C       INDIC - NUMBER OF ENTRIES IN INDEX. 
C       IARRY - RETURN BUFFER WHERE DATA IS TO GO.
C 
C  THE ARRAY ICAP CONTAINS THE GRAPHIC INTERPRETIVE CODES 
C  NECESSARY TO RETRIEVE THE DATA FROM THE DEVICE OR DEVICE 
C  SUBROUTINE.
C 
      DATA ID/ 3003B/ 
      DATA ICLR/27401B/ 
      DATA NUMPN/30001B/
      DATA NCURS/30401B/
      DATA LORG/31001B/ 
      DATA ISLNT/31404B/
      DATA ICLIP/32001B/
      DATA MAXCP/9/                                                     EM1913
      DATA LDIR/33403B/ 
      DATA ICHR/32410B/                                                 EM1913
      DATA GD9/.055555555,.944444445,0.0,.65625/                        SY2013
C 
CCCC
C     THIS CALL ESTABLISHES AN ADDRESS LINK BETWEEN THE GRAPGHICS 
C  PACKAGE AND THE CURRENT GCB AND ALSO CHECKS FOR A SUSPENDED GCB. 
C 
      ISUSP= 0
      CALL GCBIM(99,1,IGCB,ISUSP) 
      IF(ISUSP.NE.0)RETURN
      J = 1 
      IF(INDIC)800,800,5
C*******************************************************************
C DO LOOP STARTS HERE.
C 
5     DO 500 I=1,INDIC
      INST = INDEX(I) 
      IF(INST.LE.0.OR.INST.GT.MAXCP)GO TO 800 
C*****************************************************************
C TRAP OUT A CALL TO GDSTT(9) IF SOFTWARE TEXT IS ALSO ON               SY2013
C 
      IF ((INST .NE. 9) .OR. (.NOT. GSOFT(IGCB))) GO TO 10
      DO 8 L=1,8
8     IARRY(J+L-1)=IGD9(L)
      J=J+8 
      GO TO 500 
C 
C END OF SY2013 ADDITION                                                SY2013
C************************************************************************ 
C 
10    ITHNG = ICAP(INST)
C 
C     NUMBER OF ITEMS ASSOCIATED WITH GIC 
C 
      NUM = IAND(ITHNG,377B)
C 
C     CALL DEV. SUB. TO GET DATA
C 
      CALL OUTPT(1,ITHNG,1) 
      CALL GCBIM(16,1,IARRY(J),NUM,1) 
      J = J + NUM 
500   CONTINUE
C 
      RETURN
C 
800   CALL PLTER(27)
      RETURN
      END 
      END$
                                                                                                                                              