1C*PGQINF -- inquire PGPLOT general information 2C%void cpgqinf(const char *item, char *value, int *value_length); 3C+ 4 SUBROUTINE PGQINF (ITEM, VALUE, LENGTH) 5 CHARACTER*(*) ITEM, VALUE 6 INTEGER LENGTH 7C 8C This routine can be used to obtain miscellaneous information about 9C the PGPLOT environment. Input is a character string defining the 10C information required, and output is a character string containing the 11C requested information. 12C 13C The following item codes are accepted (note that the strings must 14C match exactly, except for case, but only the first 8 characters are 15C significant). For items marked *, PGPLOT must be in the OPEN state 16C for the inquiry to succeed. If the inquiry is unsuccessful, either 17C because the item code is not recognized or because the information 18C is not available, a question mark ('?') is returned. 19C 20C 'VERSION' - version of PGPLOT software in use. 21C 'STATE' - status of PGPLOT ('OPEN' if a graphics device 22C is open for output, 'CLOSED' otherwise). 23C 'USER' - the username associated with the calling program. 24C 'NOW' - current date and time (e.g., '17-FEB-1986 10:04'). 25C 'DEVICE' * - current PGPLOT device or file. 26C 'FILE' * - current PGPLOT device or file. 27C 'TYPE' * - device-type of the current PGPLOT device. 28C 'DEV/TYPE' * - current PGPLOT device and type, in a form which 29C is acceptable as an argument for PGBEG. 30C 'HARDCOPY' * - is the current device a hardcopy device? ('YES' or 31C 'NO'). 32C 'TERMINAL' * - is the current device the user's interactive 33C terminal? ('YES' or 'NO'). 34C 'CURSOR' * - does the current device have a graphics cursor? 35C ('YES' or 'NO'). 36C 'SCROLL' * - does current device have rectangle-scroll 37C capability ('YES' or 'NO'); see PGSCRL. 38C 39C Arguments: 40C ITEM (input) : character string defining the information to 41C be returned; see above for a list of possible 42C values. 43C VALUE (output) : returns a character-string containing the 44C requested information, truncated to the length 45C of the supplied string or padded on the right with 46C spaces if necessary. 47C LENGTH (output): the number of characters returned in VALUE 48C (excluding trailing blanks). 49C-- 50C 18-Feb-1988 - [TJP]. 51C 30-Aug-1988 - remove pseudo logical use of IER. 52C 12-Mar-1992 - change comments for clarity. 53C 17-Apr-1995 - clean up some zero-length string problems [TJP]. 54C 7-Jul-1995 - get cursor information directly from driver [TJP]. 55C 24-Feb-1997 - add SCROLL request. 56C----------------------------------------------------------------------- 57 INCLUDE 'pgplot.inc' 58 INTEGER IER, L1, GRTRIM 59 LOGICAL INTER, SAME 60 CHARACTER*8 TEST 61 CHARACTER*64 DEV1 62C 63C Initialize PGPLOT if necessary. 64C 65 CALL PGINIT 66C 67 CALL GRTOUP(TEST,ITEM) 68 IF (TEST.EQ.'USER') THEN 69 CALL GRUSER(VALUE, LENGTH) 70 IER = 1 71 ELSE IF (TEST.EQ.'NOW') THEN 72 CALL GRDATE(VALUE, LENGTH) 73 IER = 1 74 ELSE IF (TEST.EQ.'VERSION') THEN 75 VALUE = 'v5.2.2' 76 LENGTH = 6 77 IER = 1 78 ELSE IF (TEST.EQ.'STATE') THEN 79 IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN 80 VALUE = 'CLOSED' 81 LENGTH = 6 82 ELSE IF (PGDEVS(PGID).EQ.0) THEN 83 VALUE = 'CLOSED' 84 LENGTH = 6 85 ELSE 86 VALUE = 'OPEN' 87 LENGTH = 4 88 END IF 89 IER = 1 90 ELSE IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN 91 IER = 0 92 ELSE IF (PGDEVS(PGID).EQ.0) THEN 93 IER = 0 94 ELSE IF (TEST.EQ.'DEV/TYPE') THEN 95 CALL GRQDT(VALUE) 96 LENGTH = GRTRIM(VALUE) 97 IER = 0 98 IF (LENGTH.GT.0) IER = 1 99 ELSE IF (TEST.EQ.'DEVICE' .OR. TEST.EQ.'FILE') THEN 100 CALL GRQDEV(VALUE, LENGTH) 101 IER = 1 102 ELSE IF (TEST.EQ.'TERMINAL') THEN 103 CALL GRQDEV(DEV1, L1) 104 IF (L1.GE.1) THEN 105 CALL GRTTER(DEV1(1:L1), SAME) 106 ELSE 107 SAME = .FALSE. 108 END IF 109 IF (SAME) THEN 110 VALUE = 'YES' 111 LENGTH = 3 112 ELSE 113 VALUE = 'NO' 114 LENGTH = 2 115 END IF 116 IER = 1 117 ELSE IF (TEST.EQ.'TYPE') THEN 118 CALL GRQTYP(VALUE,INTER) 119 LENGTH = GRTRIM(VALUE) 120 IER = 0 121 IF (LENGTH.GT.0) IER = 1 122 ELSE IF (TEST.EQ.'HARDCOPY') THEN 123 CALL GRQTYP(VALUE,INTER) 124 IF (INTER) THEN 125 VALUE = 'NO' 126 LENGTH = 2 127 ELSE 128 VALUE = 'YES' 129 LENGTH = 3 130 END IF 131 IER = 1 132 ELSE IF (TEST.EQ.'CURSOR') THEN 133 CALL GRQCAP(DEV1) 134 IF (DEV1(2:2).EQ.'N') THEN 135 VALUE = 'NO' 136 LENGTH = 2 137 ELSE 138 VALUE = 'YES' 139 LENGTH = 3 140 END IF 141 IER = 1 142 ELSE IF (TEST.EQ.'SCROLL') THEN 143 CALL GRQCAP(DEV1) 144 IF (DEV1(11:11).NE.'S') THEN 145 VALUE = 'NO' 146 LENGTH = 2 147 ELSE 148 VALUE = 'YES' 149 LENGTH = 3 150 END IF 151 IER = 1 152 ELSE 153 IER = 0 154 END IF 155 IF (IER.NE.1) THEN 156 VALUE = '?' 157 LENGTH = 1 158 ELSE IF (LENGTH.LT.1) THEN 159 LENGTH = 1 160 VALUE = ' ' 161 END IF 162 END 163