SUBROUTINE SWOFF COMMON /SW/ ICONT(6) DO 100 I=4,6 CALL MSILP(ICONT(I)) 100 CONTINUE RETURN END SUBROUTINE BUTTONS DIMENSION ISH(2,6) COMMON /SW/ ICONT(6) DATA ISH/'CLOSE',0,'DISPL','AY','SPECI','AL', 1'UPDAT','E','EDIT',0,'CREAT','E'/ DO 100 I=0,5 ICONT(I+1)=NEWSEG(3) CALL MOVETO(200,600+I*50,.FALSE.,0,5) CALL STRING(ISH(1,I+1),9) CALL MSSLP(ICONT(I+1)) 100 CONTINUE END SUBROUTINE JOIN(IDISP) C C C THIS SUBROUTINE JOINS TWO POINTS IN A LIGHT SENSITIVE LINE. C C DIMENSION IDISP(1) COMMON /JN/ IDX,IDY ISEG=NEWSEG(5) CALL LINE(IDX,IDY,.TRUE.) CALL DEPICT(IDISP,1) CALL MSSLP(ISEG) RETURN END SUBROUTINE CVS DIMENSION IQUANT(3,4) COMMON/NDX/ IN1,IN2,DELX,DELY COMMON /IN/ IXCD(100),IYCD(100) COMMON /OT/IRES(3),NOS,NOEL(10) DATA IQUANT/0,1,2,0,7,6,4,3,2,4,5,6/ IP1=ISTBP0(IRES(1),3) DO 99 J=1,3 IRES(J)=0 99 CONTINUE IST=1 DO 100 J=1,NOS INUM=NOEL(J)-1 IF (INUM.LT.6)GOTO101 IQ=INUM/6 IREM=INUM-IQ*6 IND=0 IF(IREM.GT.2)IND=1 IF (IREM.EQ.2.OR.IREM.EQ.5) IST=IST+1 DO 102 K=1,6 IST1=IST+IQ+(K.AND.IND) DELX=FLOAT(IXCD(IST1)-IXCD(IST)) DELY=FLOAT(IYCD(IST1)-IYCD(IST)) IST=IST1 CALL INDEX M=IQUANT(IN1,IN2) CALL IDPB(M,IP1) 102 CONTINUE IF(IREM.NE.0.AND.IREM.NE.3)IST=IST+1 GOTO 100 101 IF(INUM.LT.3)GOTO 103 IST1=IST+INUM DELX=FLOAT(IXCD(IST1)-IXCD(IST)) DELY=FLOAT(IYCD(IST1)-IYCD(IST)) IST=IST1 CALL INDEX M=IQUANT(IN1,IN2) DO 105 L=1,6 CALL IDPB(M,IP1) 105 CONTINUE GOTO100 103 M=0 DO 104 L=1,6 CALL IDPB(M,IP1) 104 CONTINUE IST=IST+INUM 100 IST=IST+1 RETURN END SUBROUTINE INDEX COMMON/NDX/ IN1,IN2,X,Y REAL TAN67,TAN22, X,Y,RAT,ABSTAN DATA TAN67,TAN22/2.4142136,0.3939105/ RAT=ABSTAN(X,Y) IN1=1 IF(RAT.LT.TAN67)IN1=2 IF(RAT.LT.TAN22)IN1=3 IN2=1 IF(X.LE.0)IN2=2 IF(Y.LE.0)IN2=IN2+2 RETURN RETURN END REAL FUNCTION ABSTAN(X,Y) REAL X,Y,ABS IF (X.EQ.0)GOTO 100 ABSTAN=ABS(Y/X) RETURN 100 ABSTAN=1000 RETURN END SUBROUTINE SPOTS DATA J,K,L/622,342,702/ DATA IYD/113/ ISEG=NEWSEG(2) DO 100 I=1,2 CALL MOVETO(J,K+IYD*I,.FALSE.,0,5) CALL HOLSTR('@$@') CALL MOVETO(L,-1,.FALSE.,-1,-1) CALL HOLSTR('@$@') 100 CONTINUE CALL MSSLP(ISEG) RETURN END SUBROUTINE BOX(IX,IY,IH,IW,ISC,INT,ISEG,SENSE) C C C THIS SUBROUTINE DRAWS A BOX OF GIVEN HEIGHT C C LOGICAL SENSE ISEG=NEWSEG(1) CALL MOVETO(IX,IY,.FALSE.,ISC,INT) CALL LINE(0,IH,.TRUE.) CALL LINE(IW,0,.TRUE.) CALL LINE(0,-IH,.TRUE.) CALL LINE (-IW,0,.TRUE.) IF(SENSE)CALL MSSLP(ISEG) RETURN END SUBROUTINE QUERY(SEGN,IDISP) DIMENSION IDISP(1) INTEGER SEGN SEGN=NEWSEG(2) CALL MOVETO(800,200,.FALSE.,1,5) CALL HOLSTR('?') CALL MOVETO(-1,-1,.FALSE.,0,5) CALL DEPICT(IDISP,1) END SUBROUTINE CLEAR(SEGN,IDISP) DIMENSION IDISP(1) INTEGER SEGN CALL STRIP(SEGN) CALL DEPICT(IDISP,1) END SUBROUTINE ACK(LET,IDISP,ICHAR) DIMENSION IDISP(1),ICHAR(90) M=LET-32 CALL CHINTS(ICHAR(M),1,7) IT=NEWSEG(3) CALL RIBS(ICHAR(M),J,K) CALL MOVETO(J,K,.FALSE.,1,7) CALL HOLSTR('@0@') CALL DEPICT(IDISP,1) CALL MSILP(ICHAR(M)) RETURN END SUBROUTINE PACK(IASC,ITY,IDISP) DIMENSION IDISP(1) COMMON /PK/INM(6), ICVA(6,200),IV(6) COMMON /OT/IRES(3),NOS,NOEL(10) ICNT=IV(NOS)+1 IF(ICNT.GE.197)GOTO101 K=IHRL(IASC) K=IHRR(ITY) ICVA(NOS,ICNT)=K M=(NOS+1)/2 DO 100 I=1,M ICNT=ICNT+1 ICVA(NOS,ICNT)=IRES(I) 100 CONTINUE 102 INM(NOS)=INM(NOS)+1 IV(NOS)=IV(NOS)+M+1 RETURN 101 CALL REDUCE CALL MOVETO( 600,100,.FALSE.,0,5) CALL HOLSTR(' TOO MANY CHARACTERS, RERUN PROGRAM!!!!!') CALL DEPICT(IDISP,1) STOP END BLOCK DATA COMMON/LT/ILET(90) COMMON/SB/ IHL(6) DATA ILET/'!','"','#','$','%','&','''','(',')','*','+', 1',','-', 1'.','/','0','1','2','3','4','5','6','7','8','9', 2':',';','<','=','>','?','@@','A','B','C','D','E','F','G', 3'H','I','J','K','L','M','N','O','P','Q','R','S','T','U', 4'V','W','X','Y','Z','@+@','@1@','@,@','@&@','@)@',' ' 5,'@A@','@B@','@C@','@D@','@E@','@F@','@G@','@H@', 6'@I@','@J@','@K@','@L@','@M@','@N@','@O@','@P@','@Q@', 6'@R@', 7'@S@','@T@','@U@','@V@','@W@','@X@','@Y@','@Z@'/ DATA IHL/2,2,3,3,4,4/ END SUBROUTINE BOARD(ICHAR) DIMENSION ICHAR(90) COMMON/LT/ILET(90) DO 100 I=33,58 ICHAR(I)=NEWSEG(I) K=(I-33)/8 L=(I-33)-K*8 CALL MOVETO(L*48,500-K*36,.FALSE.,0,5) CALL STRING(ILET(I),3) CALL MSSLP(ICHAR(I)) 100 CONTINUE DO 101 I=65,90 K=(I-65)/8 L=(I-65)-K*8 ICHAR(I)=NEWSEG(I) CALL MOVETO(L*48,360-K*36,.FALSE.,0,5) CALL STRING(ILET(I),3) CALL MSSLP(ICHAR(I)) 101 CONTINUE DO 102 I=1,32 K=(I-1)/8 L=(I-1)-K*8 ICHAR(I)=NEWSEG(I) CALL MOVETO(L*48,220-K*36,.FALSE.,0,5) CALL STRING(ILET(I),3) CALL MSSLP(ICHAR(I)) 102 CONTINUE DO 103 I=59,63 K=(I-57)/8 L=(I-57)-K*8 ICHAR(I)=NEWSEG(I) CALL MOVETO(L*48,76,.FALSE.,0,5) CALL STRING(ILET(I),3) CALL MSSLP(ICHAR(I)) 103 CONTINUE END INTEGER FUNCTION IPNT(DUM) COMMON/OT/ IRES(3),NOS,NOEL(10) I=0 IST=1 DO 101 L=1,NOS I=I.OR.IEN(IST) IST=IST+NOEL(L)-1 I=I.OR.IEN(IST) IST=IST+1 101 CONTINUE IPNT=I RETURN END INTEGER FUNCTION IEN(NUM) COMMON /IN/ IXCD(100),IYCD(100) J=(IXCD(NUM)-542)/80 K=(IYCD(NUM)-342)/113 IF(J.LT.0)J=0 IF(K.LT.0)K=0 IF(J.GT.2)J=2 IF(K.GT.2)K=2 IEN=2**(J+3*K) RETURN END