!ipk last change July 14 updating of cycw changes in 97 ! Last change: IPK 12 Jan 98 1:55 pm !ipk last update Nov 18 1997 !ipk last updated Oct 17 1996 !ipk last updated Oct 14 1996 SUBROUTINE RDRW(IS) ! Determine how to draw grid according to switch setting USE BLK1MOD ! INCLUDE 'BLK1.COM' CHARACTER*1 ANS,ANSW(10) character*38 mesg ! Draw box around selections DATA ANSW/'m','o','e','n','t','y','l','d','b','r'/ ! m 1 o 2 e 5 n 3 t 4 u 7 g 8 d 6 b 9 NHTP=5 NMESS=0 NBRR=0 100 CONTINUE CALL HEDR ! Get answer call xyloc(XPT,YPT,ANS,IBOX) IF(IRMAIN .EQ. 1) RETURN if(ibox .le. 0) go to 100 IF(ANS .EQ. 'c') THEN ANS=ANSW(IBOX) ENDIF IF(ANS .EQ. 'm') THEN !ipk oct96 if(ipsw(1) .eq. 0) then call getmpcl NHTP=5 endif !ipk oc96 end addition IPSW(1)=MOD(IPSW(1)+1,2) GO TO 100 ELSEIF(ANS .EQ. 'o') THEN IPSW(2)=MOD(IPSW(2)+1,2) GO TO 100 ELSEIF(ANS .EQ. 'n') THEN IPSW(3)=MOD(IPSW(3)+1,2) IF(IPSW(3) .EQ. 1) IPSW(9)=0 IF(IPSW(3) .EQ. 1) IPSW(14)=0 GO TO 100 ELSEIF(ANS .EQ. 't') THEN IPSW(4)=MOD(IPSW(4)+1,2) GO TO 100 ELSEIF(ANS .EQ. 'e') THEN IPSW(5)=MOD(IPSW(5)+1,2) if(ipsw(5) .eq. 1) ipsw(7)=0 GO TO 100 ELSEIF(ANS .EQ. 'd') THEN IPSW(6)=MOD(IPSW(6)+1,2) if(ipsw(6) .eq. 1) then !ipk apr02 call getmdis(nmapf,nsigf,icolsw,rad,colint) ! write(mesg,*) 'Enter output frequency for map display' ! call symbl (1.1,7.3,0.25,mesg,0.0,38) ! call getint(nmapf) endif GO TO 100 ELSEIF(ANS .EQ. 'y') THEN IPSW(7)=MOD(IPSW(7)+1,2) if(ipsw(7) .eq. 1) ipsw(5)=0 GO TO 100 !ipk feb01 drop this option in favour of ccline ELSEIF(ANS .EQ. 'g') THEN !ipk feb01 IPSW(8)=MOD(IPSW(8)+1,2) !ipk feb01 GO TO 100 ELSEIF(ANS .EQ. 'l') THEN IPSW(10)=MOD(IPSW(10)+1,2) GO TO 100 ELSEIF(ANS .EQ. 'b') THEN IPSW(9)=MOD(IPSW(9)+1,2) IF(IPSW(9) .EQ. 1) IPSW(3)=0 IF(IPSW(9) .EQ. 1) IPSW(14)=0 GO TO 100 ELSEIF(ANS .EQ. 'r') THEN ! CALL PLOTS(IS) !ipk nov97 add (0) CALL PLOTOT(1) RETURN ENDIF GO TO 100 END SUBROUTINE GETMPCL ! Determine how to draw grid according to switch setting USE BLK1MOD ! INCLUDE 'BLK1.COM' CHARACTER*1 ANS,ANSW(10) ! Draw box around selections DATA ANSW/'e','o','t','h','f','i','s','v','g','q'/ ! m 1 o 2 e 5 n 3 t 4 u 7 g 8 d 6 b 9 NHTP=12 100 CONTINUE CALL HEDR ! Get answer call xyloc(XPT,YPT,ANS,IBOX) IF(ANS .NE. 'c') then DO K=1,10 IF(ANS .EQ. ANSW(K)) THEN IBOX=K GO TO 102 ENDIF ENDDO 102 CONTINUE ENDIF IF(IBOX .EQ. 10) GO TO 150 ICOLON(IBOX)=MOD(ICOLON(IBOX)+1,2) CALL HEDR GO TO 100 150 NHTP=5 RETURN END SUBROUTINE GDIST USE BLK1MOD ! INCLUDE 'BLK1.COM' CHARACTER*1 ANS,ANSW(10) INCLUDE 'TXFRM.COM' !IPK MAY02 COMMON /TXFRM/ XS, YS, TXSCAL DATA ANSW/6*' ','n','z','r','q'/ ! NHTPSV=NHTP NMESSV=NMESS NBRRSV=NBRR 100 CONTINUE NHTP=0 NMESS=41 NBRR=4 CALL CLRBOX CALL HEDR call xyloc(XPT1,YPT1,ANS,IBOX) call xyloc(XPT2,YPT2,ANS,IBOX) DIST=SQRT((YPT2-YPT1)**2+(XPT2-XPT1)**2)*TXSCAL CALL CLRBOX NMESS=0 NBRR=4 CALL HEDR CALL NUMBR(0.5,7.55,0.20,DIST,0.0,2) CALL XYLOC(XPT1,YPT1,ANS,IBOX) IF(ANS .NE. 'c') then DO K=1,10 IF(ANS .EQ. ANSW(K)) THEN IBOX=K GO TO 102 ENDIF ENDDO 102 CONTINUE ENDIF IF(IBOX .EQ. 7) GO TO 100 NHTP=NHTPSV NMESS=NMESSV NBRR=NBRRSV CALL CLRBOX CALL HEDR RETURN END SUBROUTINE CHEXIT USE WINTERACTER TYPE(WIN_MESSAGE) :: MESSAGE INTEGER :: ITYPE COMMON /HEDS/ NP,NE,NHTP,NMESS,NBRR,IPSW(15),IRMAIN,ISCRN,icolon(12),IQSW(2),IRDISP,ntempin,igfgsw,igfgswb,ICRIN,IPW1,WIDEL,WIDSCL,itrianout CALL WMessagePeek(ITYPE, MESSAGE) SELECT CASE (ITYPE) CASE (-1) RETURN CASE (KeyDown) ! Key pressed IPSW(1)=0 IPSW(2)=1 IPSW(3)=0 IPSW(4)=0 IPSW(5)=0 IPSW(6)=0 IPSW(7)=0 IPSW(8)=0 IPSW(9)=0 IPSW(12)=0 RETURN ENDSELECT RETURN END