C SUBROUTINE TO FORM POLYGONS C SUBROUTINE POLY(MODFIL) LOGICAL LP,INC,DEC,R3D,S3D,REP,INOUT INTEGER SIDES,RAD,XCENT,YCENT DIMENSION LIST(2) COMMON/FILE/LYNUM,LINE(4,200) COMMON/COORD/JX,JY COMMON/LTPEN/LP,IX,IY,IA COMMON/BOOKKP/LINSAV(200),MODSAV(50),ITAG DATA P,B,C,D,E,F,G,H,R,S,T,U/5H( 1X8,5HHRADI,5HUS =,,5HI3 ,,5H 3X 17H,5HSIDES,5H =,I3,5H, 3X4,5HHPLUS,5H, 3X5,5HHMINU,5HS) / DATA ACD,ADD,AED/5H(1X,4,5HHMORE,5H) / DATA V,W/5H( 1X3,5HHOUT)/ DATA AXA,AXB,AXC,AXD,AXE,AXF,ARG,ARH/5H(1X9H,5HREPLI,5HCATE,, 15H3X6HR,5HETURN,5H,3X7H,5HRESTA,5HRT) / DATA AXG,AXH,AXI,AXJ,AXK,AXL,AXM/5H(1X14,5HHRAND, 15H0M CE,5HNTRES,5H,3X7H,5HREGUL,5HAR) / DATA AZA,AZB,AZC,AZD,AZE,AZF,AZG,AZH,AZI,AZJ,AZK,AZL 1/5H(1X2H,5HUP,3X,5H4HDOW,5HN,3X4,5HHLEFT,5H,3X5H, 15HRIGHT,5H,3X8H,5H ,5H ,3,5HX6HRE,5HTURN)/ DATA ABT,ACT,ADT/5H(1X,4,5HHDRAW,5H) / 101 CALL TEXT(158,25,0,1,AXA) SIDES=0 RAD=0 XCENT=0 YCENT=0 PI=3.14159 THET=00. R3D=.FALSE. S3D=.FALSE. REP=.FALSE. INOUT=.TRUE. C C ASSIGN CENTRE,SIDES AND RADIUS VALUES USING LIGHTPEN . C CALL LITPEN(LP,IX,IY,IA) 30 CALL TEXT(128,128,5,1,P,RAD,SIDES) CALL TEXT(128,64,5,1,V) 32 INC=.FALSE. DEC=.FALSE. 39 LP=.FALSE. 40 IF(.NOT.LP)GO TO 40 C C BRANCH TO GENERATE A POLYGON , OR TO SPECIFY A POLYGON . C IF(IY.LE.80)GO TO 79 C C SPECIFY : BRANCH TO INCREMENT OR DECREMENT PARAMETERS . C IF((IX.GT.430).AND.(IX.LT.500))INC=.TRUE. IF((IX.GT.509).AND.(IX.LT.550))DEC=.TRUE. C C RADIUS C IF((IX.GT.230).AND.(IX.LT.280))R3D=.TRUE. C C SIDES C IF((IX.GT.370).AND.(IX.LT.415))S3D=.TRUE. C C DO THE ARITHMETIC C IF(R3D.AND.INC)RAD=RAD+10 IF(R3D.AND.DEC)RAD=RAD-10 IF(S3D.AND.INC)SIDES=SIDES+1 IF(S3D.AND.DEC)SIDES=SIDES-1 C C DISPLAY NEW RADIUS,SIDES OR CENTRE VALUE . C CALL TEXT(128,128,0,1,P,RAD,SIDES) CALL TEXT(128,128,5,1,P,RAD,SIDES) CALL TEXT(128,64,5,1,V) DO 3 I=1,25000 3 CONTINUE R3D=.FALSE. S3D=.FALSE. LP=.FALSE. 68 IF(.NOT.LP)GO TO 68 IF((IX.GT.430).AND.(IX.LT.550))GO TO 32 GO TO 39 C C ASSIGN CENTRE COORDINATES WITH SUBROUTINE CROSS (LIGHTPEN C AND FOLLOWING CROSS ). C 79 CALL TEXT(128,128,0,1,P,RAD,SIDES) CALL TEXT(128,64,0,1,V) XCENT=512 YCENT=512 986 CALL CROSS(.TRUE.,XCENT,YCENT) DO 987 K=1,1500 DUM=SIN(3.1415) 987 CONTINUE CALL CROSS(.FALSE.,XCENT,YCENT) CALL TEXT(128,128,5,1,ACD) CALL TEXT(128,64,5,1,ABT) CALL LITPEN(LP,IX,IY,IA) LP=.FALSE. 988 IF(.NOT.LP)GO TO 988 IF(IY.LT.80)GO TO 80 IF((IY.GT.100).AND.(IY.LT.140))GO TO 986 C C GENERATE THE POLYGON . C 80 CALL TEXT(128,128,0,1,ACD) CALL TEXT(128,64,0,1,ABT) IF((SIDES.EQ.3).OR.(SIDES.EQ.5))GO TO 880 ISAVEX=XCENT+RAD ISAVEY=YCENT GO TO 881 880 THET=PI/2. ISAVEX=XCENT ISAVEY=YCENT+RAD 881 S2DES=FLOAT(SIDES) R2D=FLOAT(RAD) RINC=(2.*PI)/S2DES 81 DO 90 I=1,SIDES THET=THET+RINC SJY=R2D*SIN(THET) SJX=R2D*COS(THET) JX=IFIX(SJX)+XCENT JY=IFIX(SJY)+YCENT LYNUM=LYNUM+1 IF(LYNUM.GT.200) GO TO 90 LINE(1,LYNUM)=ISAVEX LINE(2,LYNUM)=ISAVEY LINE(3,LYNUM)=JX LINE(4,LYNUM)=JY ISAVEX=JX ISAVEY=JY CALL CODER(LINE,LYNUM,LINSAV,MODFIL) MODFIL=0 90 CONTINUE CALL TEXT(128,128,0,1,P,RAD,SIDES) CALL TEXT(128,64,0,1,V) C C BRANCH TO REPLICATE OR RETURN OR RESTART . C CALL LITPEN(LP,IX,IY,IA) 920 CALL TEXT(158,20,5,1,AXA) LP=.FALSE. 92 IF(.NOT.LP)GO TO 92 IF((IX.GT.150).AND.(IX.LT.191).AND.(IY.LT.50))GO TO 93 IF((IX.GT.279).AND.(IX.LT.323).AND.(IY.LT.50))GO TO 922 IF((IX.GT.411).AND.(IX.LT.450).AND.(IY.LT.50))GO TO 101 922 CALL TEXT(158,20,0,1,AXA) RETURN C C REPLICATE WITH RANDOM CENTRES OR REGULAR? C 93 CALL TEXT(158,20,0,1,AXA) 930 CALL TEXT(128,200,5,1,AXG) 933 LP=.FALSE. REP=.FALSE. 94 IF(.NOT.LP)GO TO 94 C C RANDOM C IF((IX.GT.120).AND.(IX.LT.161).AND.(IY.LT.220))GO TO 940 C C REGULAR C IF((IX.GT.320).AND.(IX.LT.370).AND.(IY.LT.220))GO TO 944 940 CALL TEXT(128,200,0,1,AXG) GO TO 79 944 CALL TEXT(128,200,0,1,AXG) CALL TEXT(128,64,5,1,AZA) LP=.FALSE. 95 IF(.NOT.LP)GO TO 95 C C UP C IF((IX.GT.120).AND.(IX.LT.162).AND.(IY.LT.80))GO TO 96 C C DOWN C IF((IX.GT.180).AND.(IX.LT.228).AND.(IY.LT.80))GO TO 97 C C LEFT C IF((IX.GT.260).AND.(IX.LT.320).AND.(IY.LT.80))GO TO 98 C C RIGHT C IF((IX.GT.349).AND.(IX.LT.383).AND.(IY.LT.80))GO TO 99 C C RETURN C IF((IX.GT.558).AND.(IX.LT.591).AND.(IY.LT.80))GO TO 100 96 YCENT=YCENT+2*RAD GO TO 80 97 YCENT=YCENT-2*RAD GO TO 80 98 XCENT=XCENT-2*RAD GO TO 80 99 XCENT=XCENT+2*RAD GO TO 80 100 CALL TEXT(128,64,0,1,AZA) GO TO 922 END