C C C P R T N . F O R C C *** V1 *** 6-NOV-84 C C This Subroutine prompts the user to enter a RT11-filespecification C (default is 'TT:'). If he enters a device only, the CPM-filename will C be copied if there is one. If the resulting RT-filename is longer than C 6 characters, it prints a warning and the user can decide wether he C wants to enter another filename or not. A leading space is not accep- C ted. C SUBROUTINE CPRTN (RTNAME, CPMNAM) C BYTE CPMNAM(12), INNAME(16), RTNAME(17), EXT(3), SCRSTR(7), ANTW LOGICAL*1 IERR C DO 50 I = 1,16 50 RTNAME(I) = ' ' 100 TYPE 1000 1000 FORMAT ('$RT filespec. (TT:) ......... : ') ACCEPT 1010, NCH, INNAME 1010 FORMAT (Q,16A1) IF (NCH.NE.0) GOTO 110 CALL SCOPY('TT:',RTNAME) GOTO 500 110 IF (INNAME(1).EQ.' ') GOTO 100 IF (INNAME(NCH).NE.':') GOTO 200 IF (CPMNAM(1).EQ.' ') GOTO 100 I = 1 120 INNAME(NCH+I) = CPMNAM(I) I = I+1 IF (CPMNAM(I).NE.' '.AND.I.NE.9) GOTO 120 INNAME(NCH+I) = '.' I = I+1 DO 130 J = 9,11 130 INNAME(NCH+J-9+I) = CPMNAM(J) 200 IERR = .FALSE. CALL VERIFY(':.', INNAME, ITYP) IF (ITYP-1) 220, 240, 260 220 DO 230 I = 1,16 ! dev:filname.ext IF (INNAME(I).EQ.':') IDPPKT = I IF (INNAME(I).EQ.'.') IPKT = I 230 CONTINUE CALL SUBSTR (INNAME, RTNAME, 1, IDPPKT) CALL SUBSTR (INNAME, SCRSTR, IDPPKT+1, IPKT-IDPPKT-1) CALL CONCAT (RTNAME, SCRSTR, RTNAME, 6+IDPPKT, IERR) CALL SUBSTR (INNAME, SCRSTR, IPKT, 4) CALL CONCAT (RTNAME, SCRSTR, RTNAME) IF (IERR.EQ..TRUE.) GOTO 900 GOTO 300 240 IF (IVERIF('.', INNAME).EQ.0) GOTO 245 CALL SUBSTR (INNAME, RTNAME, 1, 6) ! filename IF (INNAME(7).NE.' ') GOTO 900 GOTO 300 245 DO 250 I = 1,16 ! filename.ext IF (INNAME(I).EQ.'.') IPKT = I 250 CONTINUE CALL SUBSTR (INNAME, SCRSTR, 1, IPKT-1) CALL SCOPY (SCRSTR, RTNAME, 6, IERR) CALL SUBSTR (INNAME, SCRSTR, IPKT, 4) CALL CONCAT (RTNAME, SCRSTR, RTNAME) IF (IERR.EQ..TRUE.) GOTO 900 GOTO 300 260 DO 270 I = 1,16 ! dev:filename IF (INNAME(I).EQ.':') IDPPKT = I 270 CONTINUE CALL SUBSTR (INNAME, RTNAME, 1, IDPPKT) CALL SUBSTR (INNAME, SCRSTR, IDPPKT+1, 6) CALL CONCAT (RTNAME, SCRSTR, RTNAME, 6+IDPPKT) IF (INNAME(IDPPKT+7).EQ.' ') GOTO 300 900 TYPE 1100 1100 FORMAT (/'$?CPMRT-W-Filename too long for RT, truncate ? ') ACCEPT 1110, ANTW 1110 FORMAT (A) IF (ANTW.NE.'Y'.AND.ANTW.NE.'y') GOTO 100 300 CONTINUE CALL CONCAT (RTNAME, '/C', RTNAME) 500 CONTINUE C>>>> C TYPE 5000, RTNAME C5000 FORMAT ('$RTNAME: ', 17A1) C>>>> RETURN C END