C
C Program TRGLPS to display values defined in vertices of triangulated C 2-D sections in PostScript. C C Version: 5.40 C Date: 2000, February 21 C C Coded by Petr Bulant C Department of Geophysics, Charles University Prague C Ke Karlovu 3, 121 16 Praha 2, Czech Republic C E-mail: bulant@seis.karlov.mff.cuni.cz C C....................................................................... C C Description of data files: C C Input data read from the standard input device (*): C The data are read by the list directed input (free format) and C consist of a single string 'SEP': C 'SEP'...String in apostrophes containing the name of the input C SEP parameter or history file with the input data. C No default, 'SEP' must be specified and cannot be blank. C C C Input data file 'SEP': C File 'SEP' has the form of the SEP C parameter file. The parameters, which do not differ from their C defaults, need not be specified in file 'SEP'. C Data specifying input files: C VRTX='string'... Name of the file with vertices of the polygons. C Description of file VRTX C Default: VRTX='vrtx.out' C TRGL='string'... Name of the file describing the triangles C of the 2-D section. C Description of file TRGL C Default: TRGL='trgl.out' C Output PostScript file: C TRGLPS='string'... Name of the output PostScript file. C It is recommended to specify TRGLPS rather than to use the C default name. C Default: TRGLPS='trglps.ps' C Data describing dimensions and layout of the picture: C UNIT='string'... All lengths controlling the size and position of C the plot are assumed to be expressed in the units given C by the string. The units also influence the default C paper size, plot size and margins. Allowed values: C UNIT='cm': centimetres (default), C UNIT='in': inches (1in=2.54cm). C XSIGN=real... Determines the sign of the default value of HSIZE. C Default: XSIGN=1. C HSIZE=real... Size (in UNITs) of the image, corresponding to the C X1 axis (horizontal before a possible rotation). C If negative, the values will be displayed from the right C to the left. C Default: HSIZE=SIGN( 16.0,XSIGN) for UNIT='cm', C HSIZE=SIGN( 6.5,XSIGN) for UNIT='in', C YSIGN=real... Determines the sign of the default value of VSIZE. C Default: YSIGN=1. C VSIZE=real... Size (in UNITs) of the image, corresponding to the C X2 axis (vertical before a possible rotation). C If negative, the values will be displayed from the top to C the bottom. C Default (proportional display): C VSIZE=SIGN(HSIZE*DY/DX,YSIGN) where DY=YMAX-YMIN is the C extent of the coordinates of vertices corresponding to C X2 axis, DX is the extent corresponding to X1 axis. C HOFFSET=real... Distance (in UNITs) of the image from the leftmost C paper edge (before a possible rotation). Controls the C horizontal position of the figure. C Default: HOFFSET=2.5 for UNIT='cm', C HOFFSET=1.0 for UNIT='in', C VOFFSET=real... Distance (in UNITs) of the image from the bottom C paper edge (before a possible rotation). Controls the C vertical position of the figure. C Default: C if VSIZE.LE.HEIGHT-2*2.5: VOFFSET=HEIGHT-2.5-VSIZE C otherwise if VSIZE.LE.HEIGHT: VOFFSET=(HEIGHT-VSIZE)/2. C otherwise: VOFFSET=2.5 C HEIGHT=real... Height of the paper in a portrait position. C Default: HEIGHT=29.7 for UNIT='cm', C HEIGHT=11.0 for UNIT='in', C ROTATE=real... Enables to rotate the image by angle specified in C degrees (positive counterclockwise). The image is rotated C around the centre of the square paper of size HEIGHT. C If applied, the user will probably wish to specify the C value of ROTATE=90. C Parameters HSIZE,VSIZE,HOFFSET,VOFFSET apply to the image C before rotation. C Attention: BoundingBox is incorrect if ROTATE is not C multiple of 90 degrees. C Default: ROTATE=0. C LRIGHT='letter' ... Determines, whether the 2-D section is to be C displayed in right-handed coordinate system with the C horizontal axis corresponding to x1 (x2, x3) section axis C and vertical axis corresponding to x2 (x3, x1) section C axis, or rather to left-handed system with horizontal axis C corresponding to x2 (x3, x1) and vertical to x1 (x2, x3). C LRIGHT='T' ... Right-handed system C otherwise ... Left-handed system C Default: LRIGHT='T' C Data specifying the values to be scaled in colours: C KOLSRF=integer ... number of a row in file VRTX. The triangles C will be filled by colours according to the values written C in the KOLSRFth row of file VRTX. C Default: KOLSRF=7 C Data specifying the colour scale: C COLORS='string'... Name of the file containing the data describing C the colour map. C Description of file COLORS C Default: COLORS='hsv.dat' (mostly sufficient) C VADD=real, VMUL=real, VPER=real, VREF=real, CREF=real, CREF1=real, C CREF2=real, CREF3=real, etc... Refer to file C colors.for. C VDIV=real... Period of values corresponding to one colour. The C triangles are divided into smaller polygons, in such way, C that the extent of values in the vertices of the polygons C is less than VDIV. C Default: VDIV=VPER/10. C R=real, G=real, B=real... Colour of the undefined C values. C Defaults: R=0.80, G=0.80, B=0.80 (light grey) C C======================================================================= C Subroutines and external functions required: EXTERNAL CHANGE,ERROR,RSEP1,RSEP3T,RSEP3R,RSEP3I,FORM1,LOWER, *LENGTH,COLOR1,COLOR2,COLOR3 INTEGER LENGTH C CHANGE ... This file. C ERROR ... File error.for. C RSEP1,RSEP3T,RSEP3R,RSEP3I ... C File sep.for. C FORM1,LOWER ... File forms.for. C LENGTH ... File length.for. C COLOR1,COLOR2,COLOR3 ... File colors.for. C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C INTEGER IRAM(MRAM) EQUIVALENCE (IRAM,RAM) INTEGER NVRTX,NPLGN C....................................................................... C INTEGER LU PARAMETER (LU=1) CHARACTER*80 FSEP,FOUT,FVRTX,FTRGL,FCOLS CHARACTER*255 TEXT,FORMAT CHARACTER*1 LRIGHT INTEGER KOLSRF,KQ,NQ REAL ROTATE,R,G,B,COLOR,DC CHARACTER*2 UNIT REAL UNITPT,HEIGHT,OFFSET,WIDTH REAL XSIGN,YSIGN REAL XMIN,XMAX,YMIN,YMAX,CMIN,CMAX,DX,DY REAL BBOX1,BBOX2,BBOX3,BBOX4,BB1,BB2,BB3,BB4 REAL BB1P,BB2P,BB3P,BB4P,BB2DEF,BB4DEF,AUX,C,S INTEGER I1,I2 INTEGER JX1,JY1,JC1,JX2,JY2,JC2,JX3,JY3,JC3 REAL X2A,Y2A,X2B,Y2B,X3A,Y3A,X3B,Y3B REAL DC2,DC3,DC4,DX2,DY2,DX3,DY3,DX4,DY4 REAL B1,B2,B3,B4 C C UNIT... One of: 'cm', 'in', 'pt'. C UNITPT...Size of the length unit, in which input data controlling C the size and position of the plot are expressed, in big C points (pt). E.g., UNITPT=72./2.54 corresponds to C plotting in cm. C HEIGHT..Anticipated height of the paper sheet. C OFFSET..Left margin, and top or bottom margin for low or high C plots, respectively. C WIDTH...Default width of the plot. C C----------------------------------------------------------------------- C C Reading name of SEP file with input data: FSEP=' ' WRITE(*,'(A)') '+TRGLPS: Enter input filename:' READ(*,*) FSEP WRITE(*,'(A)') '+TRGLPS: Working... ' C C Reading all the data from the SEP file into the memory: IF (FSEP.NE.' ') THEN CALL RSEP1(LU,FSEP) ELSE C TRGLPS-01 CALL ERROR('TRGLPS-01: SEP file not given') C Input file in the form of the SEP (Stanford Exploration Project) C parameter or history file must be specified. C There is no default filename. ENDIF C C Reading input and output filenames: CALL RSEP3T('VRTX' ,FVRTX,'vrtx.out') CALL RSEP3T('TRGL' ,FTRGL,'trgl.out') CALL RSEP3T('COLORS',FCOLS,'hsv.dat' ) CALL RSEP3T('TRGLPS',FOUT ,'trglps.ps') C C C Reading vertices: CALL RSEP3I('KOLSRF',KOLSRF,7) KQ=MAX0(6,KOLSRF) IF (KOLSRF.LE.0) THEN C NQ=2 C TRGLPS-02 CALL ERROR('TRGLPS-02: Wrong value of KOLSRF') C KOLSRF must be positive integer. ELSE NQ=3 ENDIF OPEN(LU,FILE=FVRTX,FORM='FORMATTED',STATUS='OLD') READ(LU,*) (TEXT,I1=1,20) NVRTX=0 10 CONTINUE IF (NVRTX+KQ.GT.MRAM) THEN C TRGLPS-03 CALL ERROR('TRGLPS-03: Too small array RAM') ENDIF TEXT='$' RAM(NVRTX+4)=0. RAM(NVRTX+5)=0. RAM(NVRTX+6)=0. IF (KOLSRF.GT.0) THEN RAM(NVRTX+KOLSRF)=0. ENDIF READ(LU,*,END=19) TEXT,(RAM(I1),I1=NVRTX+1,NVRTX+KQ) IF (TEXT.EQ.'$') GOTO 19 C Shifting the coordinates to columns 1 to 2: IF (RAM(NVRTX+4).EQ.1.) THEN RAM(NVRTX+1)=RAM(NVRTX+2) RAM(NVRTX+2)=RAM(NVRTX+3) ELSEIF (RAM(NVRTX+5).EQ.1.) THEN RAM(NVRTX+2)=RAM(NVRTX+1) RAM(NVRTX+1)=RAM(NVRTX+3) ELSEIF (RAM(NVRTX+6).EQ.1.) THEN C RAM(NVRTX+1)=RAM(NVRTX+1) C RAM(NVRTX+2)=RAM(NVRTX+2) CONTINUE ELSE C TRGLPS-04 CALL ERROR('TRGLPS-04: Wrong normal') C Input grid must be 2-D, one of the components of the normal C must equal 1, and the other two must equal zero. ENDIF CALL RSEP3T('LRIGHT',LRIGHT,'T') CALL LOWER(LRIGHT) IF (LRIGHT.NE.'t') THEN AUX=RAM(NVRTX+1) RAM(NVRTX+1)=RAM(NVRTX+2) RAM(NVRTX+2)=AUX ENDIF C Shifting the value of color to column 3: IF (KOLSRF.GT.0) THEN RAM(NVRTX+3)=RAM(NVRTX+KOLSRF) ENDIF C Recording the minima and maxima of the coordinates: IF (NVRTX.EQ.0) THEN XMIN=RAM(NVRTX+1) XMAX=RAM(NVRTX+1) YMIN=RAM(NVRTX+2) YMAX=RAM(NVRTX+2) CMIN=RAM(NVRTX+3) CMAX=RAM(NVRTX+3) ELSE XMIN=AMIN1(XMIN,RAM(NVRTX+1)) XMAX=AMAX1(XMAX,RAM(NVRTX+1)) YMIN=AMIN1(YMIN,RAM(NVRTX+2)) YMAX=AMAX1(YMAX,RAM(NVRTX+2)) CMIN=AMIN1(CMIN,RAM(NVRTX+3)) CMAX=AMAX1(CMAX,RAM(NVRTX+3)) ENDIF NVRTX=NVRTX+NQ GOTO 10 19 CONTINUE CLOSE(LU) DX=XMAX-XMIN DY=YMAX-YMIN IF (DX.LE.0..OR.DY.LE.0.) THEN C TRGLPS-05 CALL ERROR('TRGLPS-05: Infinitely thin section') C The section should be two-dimensional. ENDIF C C C Recalling the plotting unit and setting default dimensions: CALL RSEP3T('UNIT',UNIT,'cm') CALL LOWER(UNIT) IF (UNIT.EQ.'cm') THEN UNITPT=72./2.54 HEIGHT=29.7 OFFSET=2.5 WIDTH=16.0 ELSEIF (UNIT.EQ.'in') THEN UNITPT=72. HEIGHT=11.0 OFFSET=1.0 WIDTH=6.5 * ELSEIF (UNIT.EQ.'pt') THEN * UNITPT=1. * HEIGHT=FLOAT(N32*N2) * OFFSET=0.0 * WIDTH=FLOAT(N31*N1) ELSE C TRGLPS-06 CALL ERROR('TRGLPS-06: Unrecognized plotting units') C Allocated plotting units are UNIT='cm', UNIT='in' or UNIT='pt'. ENDIF C C C Recalling the data for the plotting area: CALL RSEP3R('XSIGN' ,XSIGN,1.) CALL RSEP3R('YSIGN' ,YSIGN,1.) AUX=HEIGHT CALL RSEP3R('HEIGHT' ,HEIGHT,AUX) CALL RSEP3R('HSIZE' ,BB3,SIGN(WIDTH,XSIGN)) CALL RSEP3R('HOFFSET',BB1,OFFSET) C Default height of the figure (proportional image): BB4DEF=ABS(BB3)*DY/DX CALL RSEP3R('VSIZE' ,BB4,SIGN(BB4DEF,YSIGN)) C Default vertical position of the figure: IF (ABS(BB4).LE.HEIGHT-2.*OFFSET) THEN BB2DEF=HEIGHT-OFFSET-ABS(BB4) ELSEIF(ABS(BB4).LE.HEIGHT) THEN BB2DEF=(HEIGHT-ABS(BB4))/2. ELSE BB2DEF=OFFSET ENDIF CALL RSEP3R('VOFFSET',BB2,BB2DEF) IF (BB3.LT.0.) BB1=BB1-BB3 IF (BB4.LT.0.) BB2=BB2-BB4 CALL RSEP3R('ROTATE',ROTATE,0.) C C Transformation from plotting units (e.g. centimetres) to points: BB1P=BB1*UNITPT BB2P=BB2*UNITPT BB3P=BB3*UNITPT BB4P=BB4*UNITPT C C Bounding box: BBOX1=AMIN1(BB1P,BB1P+BB3P) BBOX2=AMIN1(BB2P,BB2P+BB4P) BBOX3=AMAX1(BB1P,BB1P+BB3P) BBOX4=AMAX1(BB2P,BB2P+BB4P) B1=BBOX1 B2=BBOX2 B3=BBOX3 B4=BBOX4 IF(ROTATE.NE.0.) THEN C=COS(ROTATE*3.14159/180.) S=SIN(ROTATE*3.14159/180.) BBOX1=BBOX1-HEIGHT*UNITPT/2. BBOX2=BBOX2-HEIGHT*UNITPT/2. BBOX3=BBOX3-HEIGHT*UNITPT/2. BBOX4=BBOX4-HEIGHT*UNITPT/2. AUX =C*BBOX1-S*BBOX2 BBOX2=S*BBOX1+C*BBOX2 BBOX1=AUX AUX =C*BBOX3-S*BBOX4 BBOX4=S*BBOX3+C*BBOX4 BBOX3=AUX BBOX1=BBOX1+HEIGHT*UNITPT/2. BBOX2=BBOX2+HEIGHT*UNITPT/2. BBOX3=BBOX3+HEIGHT*UNITPT/2. BBOX4=BBOX4+HEIGHT*UNITPT/2. AUX =AMIN1(BBOX1,BBOX3) BBOX3=AMAX1(BBOX1,BBOX3) BBOX1=AUX AUX =AMIN1(BBOX2,BBOX4) BBOX4=AMAX1(BBOX2,BBOX4) BBOX2=AUX ENDIF C C C Recomputing true coordinates of the vertices into page coordinates DO 20, I1=1,NVRTX,NQ RAM(I1)=(RAM(I1)-XMIN)/DX*BB3P+BB1P RAM(I1+1)=(RAM(I1+1)-YMIN)/DY*BB4P+BB2P 20 CONTINUE C C C Reading the triangles: DO 81 I1=NVRTX+1,MRAM IRAM(I1)=0 81 CONTINUE OPEN(LU,FILE=FTRGL,FORM='FORMATTED',STATUS='OLD') NPLGN=NVRTX 82 CONTINUE IF (NPLGN.GT.MRAM) THEN C TRGLPS-07 CALL ERROR('TRGLPS-07: Too small array RAM') ENDIF READ(LU,*,END=89) (IRAM(I1),I1=NPLGN+1,NPLGN+3) DO 83 I1=NPLGN+1,NPLGN+3 IF ((IRAM(I1).LE.0).OR.(IRAM(I1).GT.NVRTX/NQ)) THEN C TRGLPS-08 WRITE(TEXT,'(A,I6)')'TRGLPS-08: Wrong vertex index',IRAM(I1) CALL ERROR(TEXT(1:LENGTH(TEXT))) ENDIF 83 CONTINUE NPLGN=NPLGN+3 GOTO 82 89 CONTINUE CLOSE(LU) C C C Reading colours of undefined values: CALL RSEP3R('R',R,0.8) CALL RSEP3R('G',G,0.8) CALL RSEP3R('B',B,0.8) C Determining the colour map: IF (KOLSRF.GT.0) THEN CALL COLOR1(LU,MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,CMIN,CMAX) ENDIF C C Writing PostScript prolog: WRITE(*,'(''+'',79('' ''))') WRITE(*,'(2A)') '+TRGLPS: Writing ',FOUT(1:MIN0(LEN(FOUT),63)) OPEN(LU,FILE=FOUT) WRITE(LU,'(A/A,4I6,/(A))') *'%!PS-Adobe-3.0', *'%%BoundingBox:',INT(BBOX1+.5),INT(BBOX2+.5), * INT(BBOX3+.5),INT(BBOX4+.5), *'%%EndComments', *'%%BeginProlog', *'%%BeginProcSet: (trglps)', *'%%Creator: trglps', *'%-----------------------------------------------------------', *'/C {setrgbcolor} bind def', *'/M {moveto} bind def', *'/L {lineto} bind def', *'/F {lineto closepath fill} bind def', *'%-----------------------------------------------------------', *'%%EndProcSet', *'%%EndProlog', *'%-----------------------------------------------------------', *'%%BeginSetup', *'% Numerical values describing the image size and position:' cc WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB1',BB1P,' def %',BB1,'cm' cc WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB2',BB2P,' def %',BB2,'cm' cc WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB3',BB3P,' def %',BB3,'cm' cc WRITE(LU,'(A,F8.1,A,F8.3,A)') '/BB4',BB4P,' def %',BB4,'cm' WRITE(LU,'(A,F8.1,A)') '/PAPERSIZE',HEIGHT*UNITPT,' def' WRITE(LU,'(A,F8.1,A)') '/ROTATE',ROTATE,' def' WRITE(LU,'(A)') *'%%EndSetup', *'%-----------------------------------------------------------', *'%%BeginObject: (trglps)', *'PAPERSIZE 2 div dup translate ROTATE rotate', *'PAPERSIZE -2 div dup translate', *'%-----------------------------------------------------------' C Setting colour of undefined values: WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' C C C Writing the triangles: CALL COLOR3(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1),1,I1,I2) I1=I1+NPLGN+2 CALL RSEP3R('VDIV',DC,RAM(I1)/10.) DC=ABS(DC) IF (DC.EQ.0.) THEN C TRGLPS-09 CALL ERROR('TRGLPS-09: Wrong value of VDIV') C VDIV must be nonzero. ENDIF FORMAT='(F00.0,A,F00.0,A,F00.0,A,F00.0,A,F00.0,A,F00.0,A:F00.0,A,F *00.0,A)' CALL FORM1(AMIN1(AINT(BBOX1+.5),AINT(BBOX2+.5)), * AMAX1(AINT(BBOX3+.5),AINT(BBOX4+.5)),FORMAT(2:9)) FORMAT(11:14)=FORMAT(3:6) FORMAT(19:22)=FORMAT(3:6) FORMAT(27:30)=FORMAT(3:6) FORMAT(35:38)=FORMAT(3:6) FORMAT(43:46)=FORMAT(3:6) FORMAT(51:54)=FORMAT(3:6) FORMAT(59:62)=FORMAT(3:6) C Plotting undefined values: WRITE(LU,FORMAT) B1,' ',B2,' M ',B1,' ',B4,' L ', * B3,' ',B4,' L ',B3,' ',B2,' F' DO 99, I2=NVRTX+1,NPLGN,3 JX1=(IRAM(I2)-1)*3+1 JY1=JX1+1 JC1=JY1+1 JX2=(IRAM(I2+1)-1)*3+1 JY2=JX2+1 JC2=JY2+1 JX3=(IRAM(I2+2)-1)*3+1 JY3=JX3+1 JC3=JY3+1 IF (KOLSRF.GT.0) THEN C Ordering the vertices according to the colour: IF (RAM(JC1).GT.RAM(JC2)) CALL CHANGE(JX1,JY1,JC1,JX2,JY2,JC2) IF (RAM(JC2).GT.RAM(JC3)) CALL CHANGE(JX2,JY2,JC2,JX3,JY3,JC3) IF (RAM(JC1).GT.RAM(JC2)) CALL CHANGE(JX1,JY1,JC1,JX2,JY2,JC2) DC2=RAM(JC2)-RAM(JC1) DC3=RAM(JC3)-RAM(JC1) DC4=RAM(JC3)-RAM(JC2) IF (DC3.LE.DC) THEN C Writing the whole triangle: COLOR=(RAM(JC3)+RAM(JC1))/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ', * RAM(JX2),' ',RAM(JY2),' L ',RAM(JX3),' ',RAM(JY3),' F' ELSE DX2=RAM(JX2)-RAM(JX1) DY2=RAM(JY2)-RAM(JY1) DX3=RAM(JX3)-RAM(JX1) DY3=RAM(JY3)-RAM(JY1) DX4=RAM(JX3)-RAM(JX2) DY4=RAM(JY3)-RAM(JY2) IF (DC2.LE.DC) THEN C Writing the whole first part of the triangle: COLOR=(RAM(JC2)+RAM(JC1))/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2B=RAM(JX2) Y2B=RAM(JY2) X3B=RAM(JX1)+DC2/DC3*DX3 Y3B=RAM(JY1)+DC2/DC3*DY3 WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' ELSE C Writing the first part of the triangle by parts: COLOR=RAM(JC1)+DC/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2B=RAM(JX1)+DC/DC2*DX2 Y2B=RAM(JY1)+DC/DC2*DY2 X3B=RAM(JX1)+DC/DC3*DX3 Y3B=RAM(JY1)+DC/DC3*DY3 WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' DO 92, I1=1,INT(DC2/DC)-1 COLOR=COLOR+DC CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2A=X2B Y2A=Y2B X3A=X3B Y3A=Y3B X2B=X2B+DC/DC2*DX2 Y2B=Y2B+DC/DC2*DY2 X3B=X3B+DC/DC3*DX3 Y3B=Y3B+DC/DC3*DY3 WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' 92 CONTINUE COLOR=(COLOR+DC/2. + RAM(JC2))/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2A=X2B Y2A=Y2B X3A=X3B Y3A=Y3B X2B=RAM(JX2) Y2B=RAM(JY2) X3B=RAM(JX1)+DC2/DC3*DX3 Y3B=RAM(JY1)+DC2/DC3*DY3 WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' ENDIF IF (DC4.LE.DC) THEN C Writing the whole second part of the triangle: COLOR=(RAM(JC3)+RAM(JC2))/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' WRITE(LU,FORMAT) RAM(JX3),' ',RAM(JY3),' M ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' ELSE C Writing the second part of the triangle by parts: COLOR=RAM(JC2)+DC/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2A=X2B Y2A=Y2B X3A=X3B Y3A=Y3B X2B=X2B+DC/DC4*DX4 Y2B=Y2B+DC/DC4*DY4 X3B=X3B+DC/DC3*DX3 Y3B=Y3B+DC/DC3*DY3 WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' DO 94, I1=1,INT(DC4/DC)-1 COLOR=COLOR+DC CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2A=X2B Y2A=Y2B X3A=X3B Y3A=Y3B X2B=X2B+DC/DC4*DX4 Y2B=Y2B+DC/DC4*DY4 X3B=X3B+DC/DC3*DX3 Y3B=Y3B+DC/DC3*DY3 WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ', * X2B,' ',Y2B,' L ',X3B,' ',Y3B,' F' 94 CONTINUE COLOR=(COLOR+DC/2. + RAM(JC3))/2. CALL COLOR2(MRAM-NPLGN,IRAM(NPLGN+1),RAM(NPLGN+1), * 1,COLOR,R,G,B) WRITE(LU,'(3(F4.2,A))') R,' ',G,' ',B,' C ' X2A=X2B Y2A=Y2B X3A=X3B Y3A=Y3B X2B=RAM(JX3) Y2B=RAM(JY3) WRITE(LU,FORMAT) X3A,' ',Y3A,' M ',X2A,' ',Y2A,' L ', * X2B,' ',Y2B,' F ' ENDIF ENDIF ELSE C Writing the vertices of the triangle: WRITE(LU,FORMAT) RAM(JX1),' ',RAM(JY1),' M ', * RAM(JX2),' ',RAM(JY2),' L ',RAM(JX3),' ',RAM(JY3),' F' ENDIF 99 CONTINUE C C C Writing PostScript trailer: WRITE(LU,'(A)') *'PAPERSIZE 2 div dup translate ROTATE neg rotate', *'PAPERSIZE -2 div dup translate', *'%%EndObject', *'showpage', *'%%EOF' CLOSE(LU) C WRITE(*,'(''+'',79('' ''))') WRITE(*,'(A)') '+TRGLPS: Done.' C STOP END C----------------------------------------------------------------------- SUBROUTINE CHANGE(I,J,K,L,M,N) INTEGER I,J,K,L,M,N,IA,JA,KA IA=I JA=J KA=K I=L J=M K=N L=IA M=JA N=KA RETURN END C C======================================================================= C INCLUDE 'error.for' C error.for INCLUDE 'sep.for' C sep.for INCLUDE 'forms.for' C forms.for INCLUDE 'colors.for' C colors.for INCLUDE 'length.for' C length.for C C======================================================================= C