C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE AYPSTR(LF)
C STARTER OF AYPLOT
C LF: FILE NUMBER
C 2001/01/31 BY A.YANASE
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE AYPSTR(LF)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
ILLF=LF
CALL HEAD(1,ILLF)
IUDM=2
XAM=9999.9
YAM=9999.9
X0=0.0
Y0=0.0
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE AYPEND
C CLOSER OF AYPLOT
C 2001/01/31 BY A.YANASE
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE AYPEND
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CALL HEAD(2,ILLF)
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE AYORIG(X,Y)
C SHIFT OF ORIGIN
C X,Y SHIFT DISTANCE IN MILIMETER
C 2001/01/31 BY A.YANASE
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE AYORIG(X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in AYORIG(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in AYORIG(YA)',YA
STOP
END IF
X0=XA
Y0=YA
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE MOVETO(X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IUDM=2
XAM=XA
YAM=YA
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE LINETO(X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in LINETO(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in LINETO(YA)',YA
STOP
END IF
IF(IUDM.EQ.2) THEN
IF(JSTART.EQ.1) THEN
WRITE(ILLF,*) 'S'
ELSE IF(JSTART.EQ.0) THEN
JSTART=1
END IF
IF(XAM.LT.0.0.OR.XAM.GT.9999.9) THEN
WRITE(6,*) ' STOP in MOVETO(XA)',XA
STOP
END IF
IF(YAM.LT.0.0.OR.YAM.GT.9999.9) THEN
WRITE(6,*) ' STOP in MOVETO(YA)',YA
STOP
END IF
WRITE(ILLF,201) XAM,YAM
201 FORMAT(2F7.2,' m')
WRITE(ILLF,202) XA,YA
202 FORMAT(2F7.2,' l')
IUDM=1
ELSE
WRITE(ILLF,202) XA,YA
IUDM=1
END IF
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE AWRITE(IPOINT,AA,NA,X,Y,IANG)
C PLOT CHARACTER LINE
C IPOINT: POINT OF CHARATER
C AA : CHARCTER LINE
C NA : NUMBER OD CHARACTER
C X,Y : START POSITION
C IANG : ANGLE IN ANTI-CLOCK-WISE
C 2001/01/31 BY A.YANASE
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE AWRITE(IPOINT,AA,NA,X,Y,IANG)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*80 AA,AB
CHARACTER*1 CC
CHARACTER*4 IAN
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in AWRITE(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in AWRITE(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
IF(IANG.NE.0) THEN
WRITE(IAN,'(I4)') IANG
WRITE(ILLF,*) IAN,' rotate'
ENDIF
NB=0
DO 1 I=1,NA
NB=NB+1
CC=AA(I:I)
IF(CC.EQ.'(') THEN
AB(NB:NB+1)='\\('
NB=NB+1
ELSE IF(CC.EQ.')') THEN
AB(NB:NB+1)='\\)'
NB=NB+1
ELSE
AB(NB:NB)=CC
END IF
1 CONTINUE
C write(6,*) NB,AB(1:NB)
WRITE(ILLF,*) '/Times-Roman findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '(',AB(1:NB),') show'
IF(IANG.NE.0) THEN
WRITE(IAN,'(I4)') -IANG
WRITE(ILLF,*) IAN,' rotate'
ENDIF
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE IWRITE(IPOINT,IA,NA,X,Y,IANG)
C PLOT INTEGER
C IPOINT: POINT OF CHARATER
C IA : INTEGER
C NA : NUMBER OF FIGUURES
C X,Y : START POSITION
C IANG : ANGLE IN ANTI-CLOCK-WISE
C 2001/01/31 BY A.YANASE
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE IWRITE(IPOINT,IA,NA,X,Y,IANG)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*5 FMT
CHARACTER*4 IAN
CHARACTER*50 D
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in IWRITE(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in IWRITE(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
IF(IANG.NE.0) THEN
WRITE(IAN,'(I4)') IANG
WRITE(ILLF,*) IAN,' rotate'
ENDIF
WRITE(ILLF,*) '/Times-Roman findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
FMT='(I )'
WRITE(FMT(3:4),'(I2)') NA
WRITE(D(1:NA),FMT) IA
WRITE(ILLF,*) '(',D(1:NA),') show'
IF(IANG.NE.0) THEN
WRITE(IAN,'(I4)') -IANG
WRITE(ILLF,*) IAN,' rotate'
ENDIF
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE FWRITE(IPOINT,FF,NF,ND,X,Y,IANG)
C PLOT INTEGER
C IPOINT: POINT OF CHARATER
C FF : REAL MUBER
C NF,ND : FORMAT IS fNF.ND
C X,Y : START POSITION
C IANG : ANGLE IN ANTI-CLOCK-WISE
C 2001/01/31 BY A.YANASE
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE FWRITE(IPOINT,FF,NF,ND,X,Y,IANG)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*8 FMT
CHARACTER*4 IAN
CHARACTER*50 D
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in FWRITE(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in FWRITE(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
IF(IANG.NE.0) THEN
WRITE(IAN,'(I4)') IANG
WRITE(ILLF,*) IAN,' rotate'
ENDIF
WRITE(ILLF,*) '/Times-Roman findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
FMT='(F . )'
WRITE(FMT(3:4),'(I2)') NF
WRITE(FMT(6:7),'(I2)') ND
WRITE(D(1:NF),FMT) FF
WRITE(ILLF,*) '(',D(1:NF),') show'
IF(IANG.NE.0) THEN
WRITE(IAN,'(I4)') -IANG
WRITE(ILLF,*) IAN,' rotate'
ENDIF
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE CWRITE(IPOINT,A,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*1 A
C write(6,*) A
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in MWRITE(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in MWRITE(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/Times-Roman findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '(',A,') show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE ZDFONT(IPOINT,A,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*3 A
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in ZDFONT(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in ZDFONT(YA)',YA
STOP
END IF
IF(JSTART.EQ.1) WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/ZapfDingbats findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '(','\\',A,') show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE ZDMARK(IPOINT,A,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*3 A
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in ZDMARK(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in ZDMARK(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
XA=XA-0.4*IPOINT
YA=YA-0.37*IPOINT
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/ZapfDingbats findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '(','\\',A,') show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE CNFONT(IPOINT,I,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*4 CIRCLN(20)/'8540','8541','8542','8543',
& '8544','8545','8546','8547','8548','8549','854a',
& '854b','854c','854d','854e','854f','8550','8551','8552','8553'/
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in CNFONT(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in CNFONT(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/Osaka findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '<',CIRCLN(I),'> show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE CNMARK(IPOINT,I,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*4 CIRCLN(20)/'8540','8541','8542','8543',
& '8544','8545','8546','8547','8548','8549','854a',
& '854b','854c','854d','854e','854f','8550','8551','8552','8553'/
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in CNMARK(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in CNMARK(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
XA=XA-0.48*IPOINT
YA=YA-0.38*IPOINT
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/Osaka findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '<',CIRCLN(I),'> show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE NRMARK(IPOINT,A,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*1 A
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in NRMARK(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in NRMARK(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
XA=XA-0.30*IPOINT
YA=YA-0.27*IPOINT
IF(A.EQ.'*') YA=YA-0.2*IPOINT
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/Times-Roman findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '(',A,') show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE GWRITE(IPOINT,A,X,Y)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
CHARACTER*1 A
XA=X*(7200.0/2539.9)+X0
YA=Y*(7200.0/2539.9)+Y0
IF(XA.LT.0.0.OR.XA.GT.9999.9) THEN
WRITE(6,*) ' STOP in GWRITE(XA)',XA
STOP
END IF
IF(YA.LT.0.0.OR.YA.GT.9999.9) THEN
WRITE(6,*) ' STOP in GRITE(YA)',YA
STOP
END IF
WRITE(ILLF,*) 'S'
WRITE(ILLF,210) XA,YA
210 FORMAT(2F7.2,' m')
WRITE(ILLF,*) '/Symbol findfont'
WRITE(ILLF,*) IPOINT,'scalefont'
WRITE(ILLF,*) 'setfont'
WRITE(ILLF,*) '(',A,') show'
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE LINEWD(WIDTH)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
IF(JSTART.EQ.1) WRITE(ILLF,*) 'S'
WRITE(ILLF,203) WIDTH
203 FORMAT(F6.2,' w')
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE SETDAS(IS1,IS2,IS3)
COMMON/PSP/ILLF,IUDM,XAM,YAM,X0,Y0,JSTART
IF(JSTART.EQ.1) WRITE(ILLF,*) 'S'
C write(6,*) JSTART,IST,ISP
IF(IS1.EQ.0) THEN
WRITE(ILLF,*) '[] 0 setdash'
ELSE IF(IS1.GT.0) THEN
IF(IS3.GT.0) THEN
IF(IS2.GT.0) THEN
WRITE(ILLF,204) IS1,IS2,IS3,IS2
204 FORMAT('[',I3,I3,I3,I3,'] 0 setdash')
ELSE
WRITE(6,*) ' STOP IN SETDAS, IS1,IS2,IS3=',IS1,IS2,IS3
STOP
END IF
ELSE IF(IS3.EQ.0) THEN
IF(IS2.GT.0) THEN
WRITE(ILLF,205) IS1,IS2
205 FORMAT('[',I3,I3,'] 0 setdash')
ELSE IF(IS2.EQ.0) THEN
WRITE(ILLF,206) IS1
206 FORMAT('[',I3,'] 0 setdash')
ELSE
WRITE(6,*) ' STOP IN SETDAS, IS1,IS2,IS3=',IS1,IS2,IS3
STOP
END IF
END IF
ELSE
WRITE(6,*) ' STOP IN SETDAS, IS1,IS2,IS3=',IS1,IS2,IS3
STOP
END IF
JSTART=0
RETURN
END
C--------1---------2---------3---------4---------5---------6---------7---------8
C SUBROUTINE HEAD(IND,ILLF)
C IND=1 HEADER
C IND=2 CLOSER
C ILLF: FILE NUMBER
C MODIFIED FROM PIG2PS BY A.Yanase
C 2001/01/31
C
C--------1---------2---------3---------4---------5---------6---------7---------8
SUBROUTINE HEAD(IND,ILLF)
C
IF(IND.EQ.1) THEN
WRITE(6,*) ' ----- WELCOME TO AYPLOT V1.0 2001/01/31 -----'
WRITE(ILLF,700)
WRITE(ILLF,710)
WRITE(ILLF,720)
WRITE(ILLF,730) 1.0,1.0
700 FORMAT('%!PS-Adobe-2.0',/,'%%Creator AYPLOT',/,
& '%%CreationDate:2001:01:31 by A.Yanase ',/,
& '%%EndComments')
710 FORMAT('/m {moveto} def',/,'/l {lineto} def',/,
& '/S {stroke} def',/,'/w {setlinewidth} def')
720 FORMAT('newpath',/,'1 setlinecap',/,'1 setlinejoin')
730 FORMAT(2F8.2,' scale')
WRITE(ILLF,*) ' 1.00 w'
ELSEIF(IND.EQ.2) THEN
C
WRITE(ILLF,*) 'S'
WRITE(ILLF,780)
780 FORMAT('showpage',/,'%%EOF')
ELSE
WRITE(6,910)
910 FORMAT(1H ,' IN HEAD, IND.NE.1 OR 2')
STOP
ENDIF
RETURN
END