*----------------------------------------------------------------------- * ENVIRONMENTAL CONTROL 93/05/07 S.Takehiro *----------------------------------------------------------------------- SUBROUTINE SWPACK PARAMETER (NFT=2) REAL WPX(*),WPY(*) LOGICAL LWDATR,LCLATR,LTNATR CHARACTER CP*(*),CPARA*(*),CDSN(NFT)*64 PARAMETER (MAXWNU=6) PARAMETER (NIP=5,NCP=8) INTEGER IX(NIP) REAL RX(NIP) LOGICAL LX(NIP),LCHREQ CC CHARACTER CIP(NIP)*8,CCP(NCP)*8,CX(NCP)*8,CDSNZ(NFT)*64,CMSG*80, CHARACTER CIP(NIP)*8,CCP(NCP)*8,CX(NCP)*80,CDSNZ(NFT)*64,CMSG*80, + COUT*64 EQUIVALENCE (IX,RX,LX) EQUIVALENCE (IX(2),IWS) EXTERNAL LCHREQ,LENC SAVE * NOTE : CIP(1) SHOULD BE 'MAXWNU'. * IX(1) SHOULD BE MAXWNU AND CANNOT BE CHANGED. * CIP(2) SHOULD BE 'IWS'. * CIP(I) (I=3,NIP) IS OPTIONAL. DATA CIP( 1)/'MAXWNU '/, IX( 1)/MAXWNU/ DATA CIP( 2)/'IWS '/, IX( 2)/1/ DATA CIP( 3)/'IUNITPS '/, IX( 3)/91/ DATA CIP( 4)/'IUNITMF '/, IX( 4)/92/ DATA CIP( 5)/'ASPECTR '/, RX( 5)/0.7/ * NOTE : CCP(I) (I=1,MAXWNU) SHOULD BE 'WSNAMEI'. * CCP(I) (I=MAXWNU+1,NCP) IS OPTIONAL. DATA CCP( 1)/'WSNAME01'/, CX( 1)/'Xm '/ DATA CCP( 2)/'WSNAME02'/, CX( 2)/'Xc '/ DATA CCP( 3)/'WSNAME03'/, CX( 3)/'PS '/ DATA CCP( 4)/'WSNAME04'/, CX( 4)/'Mf '/ DATA CCP( 5)/'WSNAME05'/, CX( 5)/'Tm '/ DATA CCP( 6)/'WSNAME06'/, CX( 6)/'Tc '/ DATA CCP( 7)/'PSFILE '/, CX( 7)/'sgks.ps '/ DATA CCP( 8)/'MFFILE '/, CX( 8)/'sgks.mf '/ * NOTE : CDSNZ(I) (I=1,NFT) ARE FONT FILE NAMES. DATA CDSNZ(1)/ + FONT1U_PATH / DATA CDSNZ(2)/ + FONT2U_PATH / DATA NPAGE/0/ RETURN *----------------------------------------------------------------------- ENTRY SWPGET(CP,IPARA) NC=LENC(CP) DO 10 N=1,NIP IF (LCHREQ(CP,CIP(N))) THEN IPARA=IX(N) RETURN END IF 10 CONTINUE CMSG='PARAMETER '''//CP(1:NC)//''' IS NOT DEFINED.' CALL MSGDMP('E','SWPGET',CMSG) RETURN *----------------------------------------------------------------------- ENTRY SWPSET(CP,IPARA) NC=LENC(CP) DO 15 N=1,NIP IF (LCHREQ(CP,CIP(N))) THEN IF (N.EQ.1) THEN CMSG='PARAMETER '''//CP(1:NC)//''' CANNOT BE SET.' CALL MSGDMP('E','SWPSET',CMSG) END IF IX(N)=IPARA RETURN END IF 15 CONTINUE CMSG='PARAMETER '''//CP(1:NC)//''' IS NOT DEFINED.' CALL MSGDMP('E','SWPSET',CMSG) RETURN *----------------------------------------------------------------------- ENTRY SWCGET(CP,CPARA) NC=LENC(CP) DO 20 N=1,NCP IF (LCHREQ(CP,CCP(N))) THEN CPARA=CX(N) RETURN END IF 20 CONTINUE CMSG='PARAMETER '''//CP(1:NC)//''' IS NOT DEFINED.' CALL MSGDMP('E','SWCGET',CMSG) RETURN *----------------------------------------------------------------------- ENTRY SWCSET(CP,CPARA) NC=LENC(CP) DO 25 N=1,NCP IF (LCHREQ(CP,CCP(N))) THEN IF (1.LE.N .AND. N.LE.MAXWNU) THEN CMSG='PARAMETER '''//CP(1:NC)//''' CANNOT BE SET.' CALL MSGDMP('E','SWCSET',CMSG) END IF CX(N)=CPARA RETURN END IF 25 CONTINUE CMSG='PARAMETER '''//CP(1:NC)//''' IS NOT DEFINED.' CALL MSGDMP('E','SWCSET',CMSG) RETURN *----------------------------------------------------------------------- ENTRY SWQFNM(CDSN) DO 30 N=1,NFT CDSN(N)=CDSNZ(N) 30 CONTINUE RETURN *----------------------------------------------------------------------- * GRAPHIC DRIVER CONTROL *----------------------------------------------------------------------- ENTRY SWQWDC(LWDATR) * / INQUIRE LINE WIDTH CAPABILITY / IF (IWS.EQ.1) CALL ZYQWDC(LWDATR) IF (IWS.EQ.2) CALL ZXQWDC(LWDATR) IF (IWS.EQ.3) CALL Z1QWDC(LWDATR) IF (IWS.EQ.4) CALL ZFQWDC(LWDATR) IF (IWS.EQ.5) CALL ZTQWDC(LWDATR) IF (IWS.EQ.6) CALL ZUQWDC(LWDATR) RETURN *----------------------------------------------------------------------- ENTRY SWQCLC(LCLATR) * / INQUIRE LINE COLOR CAPABILITY / IF (IWS.EQ.1) CALL ZYQCLC(LCLATR) IF (IWS.EQ.2) CALL ZXQCLC(LCLATR) IF (IWS.EQ.3) CALL Z1QCLC(LCLATR) IF (IWS.EQ.4) CALL ZFQCLC(LCLATR) IF (IWS.EQ.5) CALL ZTQCLC(LCLATR) IF (IWS.EQ.6) CALL ZUQCLC(LCLATR) RETURN *----------------------------------------------------------------------- ENTRY SWQTNC(LTNATR) * / INQUIRE HARD FILL CAPABILITY / IF (IWS.EQ.1) CALL ZYQTNC(LTNATR) IF (IWS.EQ.2) CALL ZXQTNC(LTNATR) IF (IWS.EQ.3) CALL Z1QTNC(LTNATR) IF (IWS.EQ.4) CALL ZFQTNC(LTNATR) IF (IWS.EQ.5) CALL ZTQTNC(LTNATR) IF (IWS.EQ.6) CALL ZUQTNC(LTNATR) RETURN *----------------------------------------------------------------------- ENTRY SWQRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) * / INQUIRE WORKSTATION RECTANGLE / IF (IWS.EQ.1) CALL ZYQRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) IF (IWS.EQ.2) CALL ZXQRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) IF (IWS.EQ.3) CALL Z1QRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) IF (IWS.EQ.4) CALL ZFQRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) IF (IWS.EQ.5) CALL ZTQRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) IF (IWS.EQ.6) CALL ZUQRCT(WSXMN,WSXMX,WSYMN,WSYMX,FACT) RETURN *----------------------------------------------------------------------- ENTRY SWSROT(IWTROT) * / SET FRAME ROTATION FLAG / IF (IWS.EQ.1) CALL ZYSROT(IWTROT) IF (IWS.EQ.2) CALL ZXSROT(IWTROT) IF (IWS.EQ.3) CALL Z1SROT(IWTROT) IF (IWS.EQ.4) CALL ZFSROT(IWTROT) IF (IWS.EQ.5) CALL ZTSROT(IWTROT) IF (IWS.EQ.6) CALL ZUSROT(IWTROT) RETURN *----------------------------------------------------------------------- ENTRY SWDOPN * / OPEN ( AND ACTIVATE ) WORKSTATION / CMSG='SGKS : STARTED.' CALL MSGDMP('M','SWDOPN',CMSG) CALL GLPGET('IOUNIT', IOUT) CALL GLPGET('IIUNIT', IIN) IF (IWS.EQ.1) CALL ZYDOPN IF (IWS.EQ.2) CALL ZXDOPN IF (IWS.EQ.3) THEN IPSF=INDXNF(CCP,NCP,8,'PSFILE ') IUPS=INDXNF(CIP,NIP,8,'IUNITPS ') COUT=CX(IPSF) IF (COUT(1:1).EQ.' ' .OR. COUT(1:1).EQ.'*') THEN CALL GLPGET('IOUNIT',IOU) CALL GLPGET('IIUNIT',IIU) WRITE(IOU,*) ' POSTSCRIPT FILE NAME (C) ? ;' READ(IIU,*) COUT END IF CALL Z1DOPN(IX(IUPS),COUT) END IF IF (IWS.EQ.4) THEN IMFF=INDXNF(CCP,NCP,8,'MFFILE ') IUMF=INDXNF(CIP,NIP,8,'IUNITMF ') IASP=INDXNF(CIP,NIP,8,'ASPECTR ') COUT=CX(IMFF) IF (COUT(1:1).EQ.' ' .OR. COUT(1:1).EQ.'*') THEN CALL GLPGET('IOUNIT',IOU) CALL GLPGET('IIUNIT',IIU) WRITE(IOU,*) ' SGKS META FILE NAME (C) ? ;' READ(IIU,*) COUT END IF CALL ZFDOPN(IX(IUMF),COUT,RX(IASP)) END IF IF (IWS.EQ.5) CALL ZTDOPN IF (IWS.EQ.6) CALL ZUDOPN RETURN *----------------------------------------------------------------------- ENTRY SWPOPN * / OPEN PAGE ( OR SCREEN ) / IF (IWS.EQ.1) CALL ZYPOPN IF (IWS.EQ.2) CALL ZXPOPN IF (IWS.EQ.3) CALL Z1POPN IF (IWS.EQ.4) CALL ZFPOPN IF (IWS.EQ.5) CALL ZTPOPN IF (IWS.EQ.6) CALL ZUPOPN RETURN *----------------------------------------------------------------------- ENTRY SWSWDI(IWDIDX) * / SET LINE WIDTH INDEX / IF (IWS.EQ.1) CALL ZYSWDI(IWDIDX) IF (IWS.EQ.2) CALL ZXSWDI(IWDIDX) IF (IWS.EQ.3) CALL Z1SWDI(IWDIDX) IF (IWS.EQ.4) CALL ZFSWDI(IWDIDX) IF (IWS.EQ.5) CALL ZTSWDI(IWDIDX) IF (IWS.EQ.6) CALL ZTSWDI(IWDIDX) RETURN *----------------------------------------------------------------------- ENTRY SWSCLI(ICLIDX) * / SET LINE COLOR INDEX / IF (IWS.EQ.1) CALL ZYSCLI(ICLIDX) IF (IWS.EQ.2) CALL ZXSCLI(ICLIDX) IF (IWS.EQ.3) CALL Z1SCLI(ICLIDX) IF (IWS.EQ.4) CALL ZFSCLI(ICLIDX) IF (IWS.EQ.5) CALL ZTSCLI(ICLIDX) IF (IWS.EQ.6) CALL ZUSCLI(ICLIDX) RETURN *----------------------------------------------------------------------- ENTRY SWGOPN * / OPEN GRAPHIC SEGMENT / IF (IWS.EQ.1) CALL ZYGOPN IF (IWS.EQ.2) CALL ZXGOPN IF (IWS.EQ.3) CALL Z1GOPN IF (IWS.EQ.4) CALL ZFGOPN IF (IWS.EQ.5) CALL ZTGOPN IF (IWS.EQ.6) CALL ZUGOPN RETURN *----------------------------------------------------------------------- ENTRY SWGMOV(WX,WY) * / PEN-UP MOVE / IF (IWS.EQ.1) CALL ZYGMOV(WX,WY) IF (IWS.EQ.2) CALL ZXGMOV(WX,WY) IF (IWS.EQ.3) CALL Z1GMOV(WX,WY) IF (IWS.EQ.4) CALL ZFGMOV(WX,WY) IF (IWS.EQ.5) CALL ZTGMOV(WX,WY) IF (IWS.EQ.6) CALL ZUGMOV(WX,WY) RETURN *----------------------------------------------------------------------- ENTRY SWGPLT(WX,WY) * / PEN-DOWN MOVE / IF (IWS.EQ.1) CALL ZYGPLT(WX,WY) IF (IWS.EQ.2) CALL ZXGPLT(WX,WY) IF (IWS.EQ.3) CALL Z1GPLT(WX,WY) IF (IWS.EQ.4) CALL ZFGPLT(WX,WY) IF (IWS.EQ.5) CALL ZTGPLT(WX,WY) IF (IWS.EQ.6) CALL ZUGPLT(WX,WY) RETURN *----------------------------------------------------------------------- ENTRY SWGCLS * / CLOSE GRAPHIC SEGMENT / IF (IWS.EQ.1) CALL ZYGCLS IF (IWS.EQ.2) CALL ZXGCLS IF (IWS.EQ.3) CALL Z1GCLS IF (IWS.EQ.4) CALL ZFGCLS IF (IWS.EQ.5) CALL ZTGCLS IF (IWS.EQ.6) CALL ZUGCLS RETURN *----------------------------------------------------------------------- ENTRY SWGTON(NP,WPX,WPY,ITPAT) * / HARD FILL / IF (IWS.EQ.1) CALL ZYGTON(NP,WPX,WPY,ITPAT) IF (IWS.EQ.2) CALL ZXGTON(NP,WPX,WPY,ITPAT) IF (IWS.EQ.3) CALL Z1GTON(NP,WPX,WPY,ITPAT) IF (IWS.EQ.4) CALL ZFGTON(NP,WPX,WPY,ITPAT) IF (IWS.EQ.5) CALL ZTGTON(NP,WPX,WPY,ITPAT) IF (IWS.EQ.6) CALL ZUGTON(NP,WPX,WPY,ITPAT) RETURN *----------------------------------------------------------------------- ENTRY SWPCLS * / CLOSE PAGE ( OR SCREEN ) / NPAGE=NPAGE+1 CMSG='SGKS : PAGE = ### COMPLETED.' CALL CHNGI(CMSG,'###',NPAGE,'(I3)') CALL MSGDMP('M','SWPCLS',CMSG) IF (IWS.EQ.1) CALL ZYPCLS IF (IWS.EQ.2) CALL ZXPCLS IF (IWS.EQ.3) CALL Z1PCLS IF (IWS.EQ.4) CALL ZFPCLS IF (IWS.EQ.5) CALL ZTPCLS IF (IWS.EQ.6) CALL ZUPCLS RETURN *----------------------------------------------------------------------- ENTRY SWDCLS * / ( DEACTIVATE AND ) CLOSE WORKSTATION / IF (IWS.EQ.1) CALL ZYDCLS IF (IWS.EQ.2) CALL ZXDCLS IF (IWS.EQ.3) CALL Z1DCLS IF (IWS.EQ.4) CALL ZFDCLS IF (IWS.EQ.5) CALL ZTDCLS IF (IWS.EQ.6) CALL ZUDCLS CMSG='SGKS : TERMINATED.' CALL MSGDMP('M','SWDCLS',CMSG) RETURN END