GDDM-GKS V1R1 Programming Guide and Reference
GDDM-GKS V1R1 Programming Guide and Reference
Previous topic |
Next topic |
Contents |
Index |
Contact z/OS |
Library |
PDF |
BOOK
Appendix E. Example programs GDDM-GKS V1R1 Programming Guide and Reference SC33-0334-00 |
|
This appendix contains two example programs:
C********************************************************************** 01200000
C* 5666-802 * 01800000
C* (C) COPYRIGHT IBM CORP. 1979,1987 * 02400000
C* LICENSED MATERIALS - PROPERTY OF IBM * 03000000
C* * 03600000
C* METOUT * 04200000
C* * 04800000
C* Program to display a metafile created by GDDM-GKS * 05400000
C* and/or save the picture as a GDF file. * 06000000
C* * 06600000
C* The program requests the number of the metafile * 07200000
C* to be input and then whether the picture is to be displayed * 07800000
C* or saved as GDF * 08400000
C* If the picture is to be saved the GDF file number is * 09000000
C* requested * 09600000
C* * 10200000
C* If the file cannot be found, or another error * 10800000
C* is detected, the error message is displayed. * 11400000
C* * 12000000
C* The program terminates when the picture has been * 12600000
C* displayed and the ENTER key has been pressed, or when * 13200000
C* the picture has been saved. * 13800000
C* * 14400000
C* * 15000000
C********************************************************************** 15600000
C 16200000
C 16800000
C Connection identifier for input metafile 17400000
INTEGER METAN 18000000
C Returned choice data 18600000
INTEGER STAT,CHNR 19200000
C Metafile item data 19800000
C - This program assumes that any item data record will fit in to 20400000
C a data record of 100 * 80 characters. 21000000
INTEGER MITYP,MILEN 21600000
PARAMETER (MAXREC=10) 21900000
PARAMETER (MAXLEN=MAXREC*80) 22200000
CHARACTER*80 DATREC(MAXREC) 22500000
C 22800000
C Response to prompt for Display or Save action 23400000
CHARACTER ACTION /'D'/ 24000000
C 24600000
C Workstation connection identifier and type 25200000
INTEGER CONNID /1/, WKTYPE /1/ 25800000
C 26400000
C GKS Operating state 27000000
INTEGER OPSTAT /0/ 27600000
C 28200000
C ERROR HANDLING 28800000
C 29400000
INTEGER*4 ERRIND /0/ 30000000
C 30600000
C********************************************************************** 31200000
C** ** 31800000
C** MAIN PROGRAM ** 32400000
C** ** 33000000
C********************************************************************** 33600000
C* Output header 34200000
C 34800000
WRITE (*,*) ' ' 35400000
WRITE (*,*) 'METOUT sample program ' 36000000
WRITE (*,*) ' ' 36600000
C 37200000
C Initialize the input metafile number 37800000
C the output workstation connection identifier is 1 by default 38400000
C 39000000
METAN = -1 39600000
C 40200000
C Request the metafile number from the operator 40800000
C 41400000
WRITE (*,*) 'type the input metafile identifier (0 to 9999)' 42000000
READ (*,*,END=50) METAN 42600000
50 CONTINUE 43200000
C 43800000
C Check the returned metafile number 44400000
C 45000000
IF ((METAN.LT.0).OR.(METAN.GT.9999)) THEN 45600000
WRITE(*,*) 'Metafile identifier is invalid' 46200000
GOTO 9999 46800000
ENDIF 47400000
C 48000000
C Request the action to be performed 48600000
C 49200000
WRITE (*,*) 'Type D to display or S to save the picture as GDF' 49800000
ACTION='D' 50000000
READ(*,'(A)',END=100) ACTION 51000000
100 CONTINUE 51600000
C 52200000
C Request the GDF file connection id if Save was requested 52800000
C 53400000
IF (ACTION.EQ.'S') THEN 54000000
WRITE (*,*) 'Type output GDF file identifier (0 to 9999)' 54600000
READ (*,*,END=150) CONNID 55200000
150 CONTINUE 55800000
C 56400000
C Check the returned GDF file connection id 57000000
C 57600000
IF ((CONNID.LT.0).OR.(CONNID.GT.9999)) THEN 58200000
WRITE(*,*) 'GDF file identifier is invalid' 58800000
GOTO 9999 59400000
ENDIF 60000000
C And set the rquested workstation type: GDF file output 60600000
WKTYPE = 5 61200000
ENDIF 61800000
C********************************************************************** 62400000
C** ** 63000000
C** OPEN GKS AND THE REQUIRED WORKSTATIONS ** 63600000
C********************************************************************** 64200000
C** This program uses error file ADMJ0000 64800000
CALL GOPKS(0,0) 65400000
C** Open the workstation required for output 66000000
CALL GOPWK(1,CONNID,WKTYPE) 66600000
C** and activate it 67200000
CALL GACWK(1) 67800000
C** Open the metafile input workstation 68500000
CALL GOPWK(2,METAN,4) 69200000
C 69900000
C Now perform a loop retrieving the item type, item length and the 70600000
C data record for each item and then interpreting the item 71300000
C 72000000
5000 CONTINUE 72700000
C- Get the item type and length 73400000
CALL GGTITM(2,MITYP,MILEN) 74100000
C- If the item is the END item we must leave the loop 74800000
IF (MITYP.EQ.0) GOTO 5999 75500000
C- else - skip the item if the data record will not fit in datrec 75700000
C or it is a user item 76000000
IF ((MILEN.GT.MAXLEN).OR.(MITYP.GT.100)) THEN 76200000
CALL GRDITM(2,0,MAXREC,DATREC) 76600000
ELSE 76900000
C- - read and the item data record 77200000
CALL GRDITM(2,MILEN,MAXREC,DATREC) 77500000
C- and interpret the item 77600000
CALL GIITM(MITYP,MILEN,MAXREC,DATREC) 78100000
ENDIF 78300000
C- continue with the next item 78700000
GOTO 5000 79000000
5999 CONTINUE 79700000
C- update the workstation to ensure display is correct 80400000
CALL GUWK(1,1) 81100000
C- If the output workstation is the console request enter key from 81800000
C the operator 82500000
IF (WKTYPE.EQ.1) CALL GRQCH(1,1,STAT,CHNR) 83200000
C- Deactivate the output workstation 83900000
CALL GDAWK(1) 84600000
C- and close it 85300000
CALL GCLWK(1) 86000000
C- close the metafile input workstation 86700000
CALL GCLWK(2) 87400000
C- close GKS 88100000
CALL GCLKS 88800000
9999 CONTINUE 89500000
C**** Termination 90200000
STOP 90900000
END 91600000
C 92300000
C 93000000
SUBROUTINE GERHND (ERRNR,FCTID,ERRFIL) 93700000
C********************************************************************** 94400000
C GERHND - This subroutine replaces GKS default error handling * 95100000
C********************************************************************** 95800000
INTEGER ERRNR,FCTID,ERRFIL 96500000
C- Call GERLOG to perform error logging 97200000
CALL GERLOG (ERRNR,FCTID,ERRFIL) 97900000
RETURN 98600000
END 99300000
C ******************************************************************00100000
C ** P R O G R A M M E T C N V **00200000
C ******************************************************************00300000
C ** **00400000
C ** 5666-802 **00600000
C ** (C) COPYRIGHT IBM CORP. 1987 **00800000
C ** LICENSED MATERIALS - PROPERTY OF IBM **01000000
C ** **01200000
C ** This program converts data between a GKS metafile and a **01400000
C ** character equivalent of that data. The conversion can be **01600000
C ** done in either direction (metafile to character or char- **01800000
C ** acter to metafile). **02000000
C ** **02200000
C ** Three I/O units (datasets) are used: **02400000
C ** - input options are read from unit "IIN" **02600000
C ** - output messages are written to unit "IOUT" **02800000
C ** - the character form of the metafile is read from or **03000000
C ** written to unit "ICHR". **03200000
C ** **03400000
C ******************************************************************03600000
C 03800000
PROGRAM METCNV 04000000
C 04200000
C**** DATA RECORD ARRAY 04400000
PARAMETER (MAXREC=10) 04600000
PARAMETER (MAXLEN=MAXREC*80) 04800000
CHARACTER*80 DATREC(MAXREC) 05000000
C 05200000
C**** CHAR/INTEGER/REAL EQUIVALENTS OF "DATREC" 05400000
PARAMETER (MXCDAT=MAXREC*80) 05600000
PARAMETER (MXIDAT=MXCDAT/4) 05800000
PARAMETER (MXRDAT=MXCDAT/4) 06000000
CHARACTER*1 CDAT(MXCDAT) 06200000
DIMENSION IDAT(MXIDAT) 06400000
DIMENSION RDAT(MXRDAT) 06600000
EQUIVALENCE (DATREC(1),CDAT(1),IDAT(1),RDAT(1)) 06800000
C 07000000
C**** CONVERSION TYPE 07200000
PARAMETER (ICNVMC=1) 07400000
PARAMETER (ICNVCM=2) 07600000
C**** MAXIMUM (NON-USER) METAFILE ITEM TYPE 07800000
PARAMETER (MAXTYP=100) 08000000
C 08200000
C 08400000
C ******************************************************************08600000
C ** I N I T I A L I S A T I O N **08800000
C ******************************************************************09000000
C 09200000
C**** INITIALISE INPUT/OUTPUT UNIT NUMBERS 09400000
IIN=5 09600000
IOUT=6 09800000
ICHR=7 10000000
C**** INITIALISE GKS WORKSTATION IDENTIFIER 10200000
IWKID=1 10400000
C 10600000
C**** GET TYPE OF CONVERSION REQUIRED 10800000
WRITE(IOUT,100)ICNVMC,ICNVCM 11000000
100 FORMAT(/1X,'ENTER TYPE OF CONVERSION REQUIRED:'/ 11200000
& 3X,I1,' = METAFILE TO CHARACTER'/ 11400000
& 3X,I1,' = CHARACTER TO METAFILE') 11600000
READ(IIN,110)ICNV 11800000
110 FORMAT(I1) 12000000
C**** CHECK VALUE ENTERED 12200000
IF (ICNV.EQ.ICNVCM.OR.ICNV.EQ.ICNVMC) THEN 12400000
WRITE(IOUT,120)ICNV 12600000
120 FORMAT(/1X,'CONVERSION TYPE SPECIFIED = ',I1) 12800000
ELSE 13000000
WRITE(IOUT,130)ICNV 13200000
130 FORMAT(/1X,'CONVERSION TYPE ',I1,' IS NOT VALID.'/ 13400000
& 3X,'EXECUTION IS TERMINATED.') 13600000
GOTO 3300 13800000
ENDIF 14000000
C 14200000
C**** GET NUMBER OF METAFILE TO BE USED 14400000
WRITE(IOUT,150) 14600000
150 FORMAT(/1X,'ENTER NUMBER OF METAFILE TO BE USED (1-4 DIGITS):') 14800000
READ(IIN,160)IFILE 15000000
160 FORMAT(BN,I4) 15200000
C**** CHECK VALUE ENTERED 15400000
IF (IFILE.GE.0) THEN 15600000
WRITE(IOUT,170)IFILE 15800000
170 FORMAT(/1X,'METAFILE NUMBER SPECIFIED = ',I4) 16000000
ELSE 16200000
WRITE(IOUT,180)IFILE 16400000
180 FORMAT(/BN,1X,'METAFILE NUMBER ',I4,' IS NOT VALID.'/ 16600000
& 3X,'EXECUTION IS TERMINATED.') 16800000
GOTO 3300 17000000
ENDIF 17200000
C 17400000
C**** OPEN GKS 17600000
CALL GOPKS (0,0) 17800000
C**** OPEN APPROPRIATE METAFILE WORKSTATION (INPUT OR OUTPUT) 18000000
IF (ICNV.EQ.ICNVCM) THEN 18200000
CALL GOPWK (IWKID,IFILE,3) 18400000
CALL GACWK (IWKID) 18600000
ELSE 18800000
CALL GOPWK (IWKID,IFILE,4) 19000000
ENDIF 19200000
C**** INITIALIZE METAFILE ITEM COUNTER 19400000
INUM=0 19600000
C 19800000
C 20000000
C ******************************************************************20200000
C ** M E T A F I L E I T E M L O O P **20400000
C ******************************************************************20600000
C 20800000
C**** PROCESS METAFILE ITEMS 21000000
200 INUM=INUM+1 21200000
C 21400000
C**** READ/GET ITEM TYPE AND LENGTH 21600000
IF (ICNV.EQ.ICNVCM) THEN 21800000
READ (ICHR,900)ITYP,ILEN 22000000
ELSE 22200000
CALL GGTITM (IWKID,ITYP,ILEN) 22400000
ENDIF 22600000
C 22800000
C**** CHECK THAT "DATREC" CAN CONTAIN ALL THE DATA 23000000
IF (ILEN.GT.MAXLEN) THEN 23200000
WRITE(IOUT,220)INUM,ITYP,ILEN,MAXLEN 23400000
220 FORMAT(/1X,'METAFILE ITEM ',I6,' WITH TYPE = ',I6, 23600000
& ' AND LENGTH = ',I6,' IS TOO LONG.'/ 23800000
& 3X,'EXECUTION IS TERMINATED. (MAX LENGTH SUPPORTED = ',I6,')')24000000
GOTO 3200 24200000
ENDIF 24400000
C 24600000
C**** GET ITEM DATA, AND WRITE ITEM TYPE AND LENGTH 24800000
IF (ICNV.EQ.ICNVMC) THEN 25000000
CALL GRDITM (IWKID,MAXLEN,MAXREC,DATREC) 25200000
WRITE(ICHR,900)ITYP,ILEN 25400000
ENDIF 25600000
C 25800000
C**** READ/WRITE ITEM DATA ACCORDING TO ITEM TYPE 26000000
IF (ITYP.EQ. 0) GOTO 1000 26200000
IF (ITYP.EQ. 1) GOTO 1001 26400000
IF (ITYP.EQ. 2) GOTO 1002 26600000
IF (ITYP.EQ. 3) GOTO 1003 26800000
IF (ITYP.EQ. 4) GOTO 1004 27000000
IF (ITYP.EQ. 5) GOTO 1005 27200000
IF (ITYP.EQ.11) GOTO 1011 27400000
IF (ITYP.EQ.12) GOTO 1012 27600000
IF (ITYP.EQ.13) GOTO 1013 27800000
IF (ITYP.EQ.14) GOTO 1014 28000000
IF (ITYP.EQ.15) GOTO 1015 28200000
IF (ITYP.EQ.21) GOTO 1021 28400000
IF (ITYP.EQ.22) GOTO 1022 28600000
IF (ITYP.EQ.23) GOTO 1023 28800000
IF (ITYP.EQ.24) GOTO 1024 29000000
IF (ITYP.EQ.25) GOTO 1025 29200000
IF (ITYP.EQ.26) GOTO 1026 29400000
IF (ITYP.EQ.27) GOTO 1027 29600000
IF (ITYP.EQ.28) GOTO 1028 29800000
IF (ITYP.EQ.29) GOTO 1029 30000000
IF (ITYP.EQ.30) GOTO 1030 30200000
IF (ITYP.EQ.31) GOTO 1031 30400000
IF (ITYP.EQ.32) GOTO 1032 30600000
IF (ITYP.EQ.33) GOTO 1033 30800000
IF (ITYP.EQ.34) GOTO 1034 31000000
IF (ITYP.EQ.35) GOTO 1035 31200000
IF (ITYP.EQ.36) GOTO 1036 31400000
IF (ITYP.EQ.37) GOTO 1037 31600000
IF (ITYP.EQ.38) GOTO 1038 31800000
IF (ITYP.EQ.39) GOTO 1039 32000000
IF (ITYP.EQ.40) GOTO 1040 32200000
IF (ITYP.EQ.41) GOTO 1041 32400000
IF (ITYP.EQ.42) GOTO 1042 32600000
IF (ITYP.EQ.43) GOTO 1043 32800000
IF (ITYP.EQ.44) GOTO 1044 33000000
IF (ITYP.EQ.51) GOTO 1051 33200000
IF (ITYP.EQ.52) GOTO 1052 33400000
IF (ITYP.EQ.53) GOTO 1053 33600000
IF (ITYP.EQ.54) GOTO 1054 33800000
IF (ITYP.EQ.55) GOTO 1055 34000000
IF (ITYP.EQ.56) GOTO 1056 34200000
IF (ITYP.EQ.61) GOTO 1061 34400000
IF (ITYP.EQ.71) GOTO 1071 34600000
IF (ITYP.EQ.72) GOTO 1072 34800000
IF (ITYP.EQ.81) GOTO 1081 35000000
IF (ITYP.EQ.82) GOTO 1082 35200000
IF (ITYP.EQ.83) GOTO 1083 35400000
IF (ITYP.EQ.84) GOTO 1084 35600000
IF (ITYP.EQ.91) GOTO 1091 35800000
IF (ITYP.EQ.92) GOTO 1092 36000000
IF (ITYP.EQ.93) GOTO 1093 36200000
IF (ITYP.EQ.94) GOTO 1094 36400000
IF (ITYP.EQ.95) GOTO 1095 36600000
IF (ITYP.GT.100) GOTO 1100 36800000
C 37000000
C**** UNSUPPORTED ITEM TYPE 37200000
WRITE(IOUT,250)INUM,ITYP 37400000
250 FORMAT(/1X,'METAFILE ITEM ',I6,' WITH TYPE = ',I6, 37600000
& ' IS NOT SUPPORTED.'/3X,'EXECUTION IS TERMINATED.') 37800000
GOTO 3200 38000000
C 38200000
C**** METAFILE-ITEM HEADER 38400000
900 FORMAT(2I15) 38600000
C**** METAFILE-ITEM DATA (CHARACTER) 38800000
901 FORMAT(80A1) 39000000
C**** METAFILE-ITEM DATA (INTEGER) 39200000
902 FORMAT(5I15) 39400000
C**** METAFILE-ITEM DATA (REAL) 39600000
903 FORMAT(1P5E15.6) 39800000
C 40000000
C**** END ITEM 40200000
1000 CONTINUE 40400000
C**** REDRAW ALL SEGMENTS 40600000
1002 CONTINUE 40800000
C**** CLOSE SEGMENT 41000000
1082 CONTINUE 41200000
C**** READ/WRITE ITEM DATA 41400000
GOTO 2000 41600000
C 41800000
C**** CLEAR WORKSTATION 42000000
1001 CONTINUE 42200000
C**** UPDATE WORKSTATION 42400000
1003 CONTINUE 42600000
C**** POLYLINE INDEX 42800000
1021 CONTINUE 43000000
C**** LINETYPE 43200000
1022 CONTINUE 43400000
C**** POLYLINE COLOR INDEX 43600000
1024 CONTINUE 43800000
C**** POLYMARKER INDEX 44000000
1025 CONTINUE 44200000
C**** MARKER TYPE 44400000
1026 CONTINUE 44600000
C**** POLYMARKER COLOR INDEX 44800000
1028 CONTINUE 45000000
C**** TEXT INDEX 45200000
1029 CONTINUE 45400000
C**** TEXT COLOR INDEX 45600000
1033 CONTINUE 45800000
C**** TEXT PATH 46000000
1035 CONTINUE 46200000
C**** FILL AREA INDEX 46400000
1037 CONTINUE 46600000
C**** FILL AREA INTERIOR STYLE 46800000
1038 CONTINUE 47000000
C**** FILL AREA STYLE INDEX 47200000
1039 CONTINUE 47400000
C**** FILL AREA COLOR INDEX 47600000
1040 CONTINUE 47800000
C**** PICK IDENTIFIER 48000000
1044 CONTINUE 48200000
C**** CREATE SEGMENT 48400000
1081 CONTINUE 48600000
C**** DELETE SEGMENT 48800000
1084 CONTINUE 49000000
C**** READ/WRITE ITEM DATA 49200000
IF (ICNV.EQ.ICNVCM) THEN 49400000
READ (ICHR,902)IDAT(1) 49600000
ELSE 49800000
WRITE(ICHR,902)IDAT(1) 50000000
ENDIF 50200000
GOTO 2000 50400000
C 50600000
C**** DEFERRAL STATE 50800000
1004 CONTINUE 51000000
C**** TEXT FONT AND PRECISION 51200000
1030 CONTINUE 51400000
C**** TEXT ALIGNMENT 51600000
1036 CONTINUE 51800000
C**** RENAME SEGMENT 52000000
1083 CONTINUE 52200000
C**** SET VISIBILITY 52400000
1092 CONTINUE 52600000
C**** SET HIGHLIGHTING 52800000
1093 CONTINUE 53000000
C**** SET DETECTABILITY 53200000
1095 CONTINUE 53400000
C**** READ/WRITE ITEM DATA 53600000
IF (ICNV.EQ.ICNVCM) THEN 53800000
READ (ICHR,902)IDAT(1),IDAT(2) 54000000
ELSE 54200000
WRITE(ICHR,902)IDAT(1),IDAT(2) 54400000
ENDIF 54600000
GOTO 2000 54800000
C 55000000
C**** MESSAGE 55200000
1005 IF (ICNV.EQ.ICNVCM) THEN 55400000
READ (ICHR,902)IDAT(1) 55600000
IMAX=4+IDAT(1) 55800000
READ (ICHR,901)(CDAT(I),I=5,IMAX) 56000000
ELSE 56200000
WRITE(ICHR,902)IDAT(1) 56400000
IMAX=4+IDAT(1) 56600000
WRITE(ICHR,901)(CDAT(I),I=5,IMAX) 56800000
ENDIF 57000000
GOTO 2000 57200000
C 57400000
C**** POLYLINE 57600000
1011 CONTINUE 57800000
C**** POLYMARKER 58000000
1012 CONTINUE 58200000
C**** FILL AREA 58400000
1014 CONTINUE 58600000
C**** READ/WRITE ITEM DATA 58800000
IF (ICNV.EQ.ICNVCM) THEN 59000000
READ (ICHR,902)IDAT(1) 59200000
IMAX=1+IDAT(1)*2 59400000
READ (ICHR,903)(RDAT(I),I=2,IMAX) 59600000
ELSE 59800000
WRITE(ICHR,902)IDAT(1) 60000000
IMAX=1+IDAT(1)*2 60200000
WRITE(ICHR,903)(RDAT(I),I=2,IMAX) 60400000
ENDIF 60600000
GOTO 2000 60800000
C 61000000
C**** TEXT 61200000
1013 IF (ICNV.EQ.ICNVCM) THEN 61400000
READ (ICHR,903)RDAT(1),RDAT(2) 61600000
READ (ICHR,902)IDAT(3) 61800000
IMAX=12+IDAT(3) 62000000
READ (ICHR,901)(CDAT(I),I=13,IMAX) 62200000
ELSE 62400000
WRITE(ICHR,903)RDAT(1),RDAT(2) 62600000
WRITE(ICHR,902)IDAT(3) 62800000
IMAX=12+IDAT(3) 63000000
WRITE(ICHR,901)(CDAT(I),I=13,IMAX) 63200000
ENDIF 63400000
GOTO 2000 63600000
C 63800000
C**** CELL ARRAY 64000000
1015 IF (ICNV.EQ.ICNVCM) THEN 64200000
READ (ICHR,903)(RDAT(I),I=1,6) 64400000
READ (ICHR,902)IDAT(7),IDAT(8) 64600000
IMAX=8+IDAT(7)*IDAT(8) 64800000
READ (ICHR,902)(IDAT(I),I=9,IMAX) 65000000
ELSE 65200000
WRITE(ICHR,903)(RDAT(I),I=1,6) 65400000
WRITE(ICHR,902)IDAT(7),IDAT(8) 65600000
IMAX=8+IDAT(7)*IDAT(8) 65800000
WRITE(ICHR,902)(IDAT(I),I=9,IMAX) 66000000
ENDIF 66200000
GOTO 2000 66400000
C 66600000
C**** LINEWIDTH SCALE FACTOR 66800000
1023 CONTINUE 67000000
C**** MARKER SIZE SCALE FACTOR 67200000
1027 CONTINUE 67400000
C**** CHARACTER EXPANSION FACTOR 67600000
1031 CONTINUE 67800000
C**** CHARACTER SPACING 68000000
1032 CONTINUE 68200000
C**** READ/WRITE ITEM DATA 68400000
IF (ICNV.EQ.ICNVCM) THEN 68600000
READ (ICHR,903)RDAT(1) 68800000
ELSE 69000000
WRITE(ICHR,903)RDAT(1) 69200000
ENDIF 69400000
GOTO 2000 69600000
C 69800000
C**** CHARACTER VECTORS 70000000
1034 CONTINUE 70200000
C**** PATTERN VECTORS 70400000
1041 CONTINUE 70600000
C**** CLIPPING RECTANGLE 70800000
1061 CONTINUE 71000000
C**** WORKSTATION WINDOW 71200000
1071 CONTINUE 71400000
C**** WORKSTATION VIEWPORT 71600000
1072 CONTINUE 71800000
C**** READ/WRITE ITEM DATA 72000000
IF (ICNV.EQ.ICNVCM) THEN 72200000
READ (ICHR,903)RDAT(1),RDAT(2),RDAT(3),RDAT(4) 72400000
ELSE 72600000
WRITE(ICHR,903)RDAT(1),RDAT(2),RDAT(3),RDAT(4) 72800000
ENDIF 73000000
GOTO 2000 73200000
C 73400000
C**** PATTERN REFERENCE POINT 73600000
1042 IF (ICNV.EQ.ICNVCM) THEN 73800000
READ (ICHR,903)RDAT(1),RDAT(2) 74000000
ELSE 74200000
WRITE(ICHR,903)RDAT(1),RDAT(2) 74400000
ENDIF 74600000
GOTO 2000 74800000
C 75000000
C**** ASPECT SOURCE FLAGS 75200000
1043 IF (ICNV.EQ.ICNVCM) THEN 75400000
READ (ICHR,902)(IDAT(I),I=1,13) 75600000
ELSE 75800000
WRITE(ICHR,902)(IDAT(I),I=1,13) 76000000
ENDIF 76200000
GOTO 2000 76400000
C 76600000
C**** POLYLINE REPRESENTATION 76800000
1051 CONTINUE 77000000
C**** POLYMARKER REPRESENTATION 77200000
1052 CONTINUE 77400000
C**** READ/WRITE ITEM DATA 77600000
IF (ICNV.EQ.ICNVCM) THEN 77800000
READ (ICHR,902)IDAT(1),IDAT(2) 78000000
READ (ICHR,903)RDAT(3) 78200000
READ (ICHR,902)IDAT(4) 78400000
ELSE 78600000
WRITE(ICHR,902)IDAT(1),IDAT(2) 78800000
WRITE(ICHR,903)RDAT(3) 79000000
WRITE(ICHR,902)IDAT(4) 79200000
ENDIF 79400000
GOTO 2000 79600000
C 79800000
C**** TEXT REPRESENTATION 80000000
1053 IF (ICNV.EQ.ICNVCM) THEN 80200000
READ (ICHR,902)IDAT(1),IDAT(2),IDAT(3) 80400000
READ (ICHR,903)RDAT(4),RDAT(5) 80600000
READ (ICHR,902)IDAT(6) 80800000
ELSE 81000000
WRITE(ICHR,902)IDAT(1),IDAT(2),IDAT(3) 81200000
WRITE(ICHR,903)RDAT(4),RDAT(5) 81400000
WRITE(ICHR,902)IDAT(6) 81600000
ENDIF 81800000
GOTO 2000 82000000
C 82200000
C**** FILL AREA REPRESENTATION 82400000
1054 IF (ICNV.EQ.ICNVCM) THEN 82600000
READ (ICHR,902)IDAT(1),IDAT(2),IDAT(3),IDAT(4) 82800000
ELSE 83000000
WRITE(ICHR,902)IDAT(1),IDAT(2),IDAT(3),IDAT(4) 83200000
ENDIF 83400000
GOTO 2000 83600000
C 83800000
C**** FILL AREA REPRESENTATION 84000000
1055 IF (ICNV.EQ.ICNVCM) THEN 84200000
READ (ICHR,902)IDAT(1),IDAT(2),IDAT(3) 84400000
IMAX=3+IDAT(2)*IDAT(3) 84600000
READ (ICHR,902)(IDAT(I),I=4,IMAX) 84800000
ELSE 85000000
WRITE(ICHR,902)IDAT(1),IDAT(2),IDAT(3) 85200000
IMAX=3+IDAT(2)*IDAT(3) 85400000
WRITE(ICHR,902)(IDAT(I),I=4,IMAX) 85600000
ENDIF 85800000
GOTO 2000 86000000
C 86200000
C**** COLOR REPRESENTATION 86400000
1056 IF (ICNV.EQ.ICNVCM) THEN 86600000
READ (ICHR,902)IDAT(1) 86800000
READ (ICHR,903)RDAT(2),RDAT(3),RDAT(4) 87000000
ELSE 87200000
WRITE(ICHR,902)IDAT(1) 87400000
WRITE(ICHR,903)RDAT(2),RDAT(3),RDAT(4) 87600000
ENDIF 87800000
GOTO 2000 88000000
C 88200000
C**** SEGMENT TRANSFORMATION 88400000
1091 IF (ICNV.EQ.ICNVCM) THEN 88600000
READ (ICHR,902)IDAT(1) 88800000
READ (ICHR,903)(RDAT(I),I=2,7) 89000000
ELSE 89200000
WRITE(ICHR,902)IDAT(1) 89400000
WRITE(ICHR,903)(RDAT(I),I=2,7) 89600000
ENDIF 89800000
GOTO 2000 90000000
C 90200000
C**** SET SEGMENT PRIORITY 90400000
1094 IF (ICNV.EQ.ICNVCM) THEN 90600000
READ (ICHR,902)IDAT(1) 90800000
READ (ICHR,903)RDAT(2) 91000000
ELSE 91200000
WRITE(ICHR,902)IDAT(1) 91400000
WRITE(ICHR,903)RDAT(2) 91600000
ENDIF 91800000
GOTO 2000 92000000
C 92200000
C**** USER ITEMS 92400000
1100 IF (ICNV.EQ.ICNVCM) THEN 92600000
READ (ICHR,901)(CDAT(I),I=1,ILEN) 92800000
ELSE 93000000
WRITE(ICHR,901)(CDAT(I),I=1,ILEN) 93200000
ENDIF 93400000
GOTO 2000 93600000
C 93800000
C 94000000
C**** WRITE ITEM DATA TO METAFILE (IF APPROPRIATE) 94200000
2000 IF (ICNV.EQ.ICNVCM) THEN 94400000
IF (ITYP.LE.MAXTYP) THEN 94600000
CALL GIITM (ITYP,ILEN,MAXREC,DATREC) 94800000
ELSE 95000000
CALL GWITM (IWKID,ITYP,ILEN,MAXREC,DATREC) 95200000
ENDIF 95400000
ENDIF 95600000
C 95800000
C**** CHECK FOR LAST METAFILE ITEM 96000000
IF (ITYP.NE.0) GOTO 200 96200000
C 96400000
C 96600000
C ******************************************************************96800000
C ** T E R M I N A T I O N **97000000
C ******************************************************************97200000
C 97400000
C**** SUCCESSFUL COMPLETION 97600000
WRITE(6,3100)INUM 97800000
3100 FORMAT(1X,'EXECUTION COMPLETED SUCCESSFULLY, ',I6, 98000000
& ' METAFILE ITEMS PROCESSED.') 98200000
C 98400000
C**** TERMINATE GKS 98600000
3200 IF (ICNV.EQ.ICNVCM) CALL GDAWK (IWKID) 98800000
CALL GCLWK (IWKID) 99000000
CALL GCLKS 99200000
C 99400000
3300 STOP 99600000
END 99800000
|
 Copyright IBM Corporation 1990, 2012 |
