PROGRAM TXTWRT C C TXTWRT is an RT-11 text formatting program. It is not C a text editor! TXTWRT was written to help programmers create C effective text and graphics displays on today's "smart" terminals. C This software tool can generate a "real-time" look at trial output C forms and then format the finished product so it can be included C in FORTRAN-IV or MACRO-11 programs. (see TXTWRT.HLP) C C Author: Stephen C. Cribbs C Atomic Energy of Canada Limited C Whiteshell Nuclear Research Establishment C Pinawa, Manitoba C CANADA R0E1L0 C C Version: 1.0 February 1983 C 1.1 July 1983 -Correct interpretation of C IDSTAT returned values. C 1.2 October 1983 -For FORTRAN output, the C Single Quote must be numeric C -Default input file type = FRM C C C Files required: TXTWRT.FOR,IPARSE.FOR,MATCH.FOR,NEST.FOR,ENC.FOR C KMP2WU.MAC,IDSPTC.MAC, & C MACRO PTXTW+TCFLIO/OBJ C MACRO PTXTW+TCFLO/OBJ C LIBRARY/CREATE TCFL.BFO TCFLIO,TCFLO C C Documentation: TXTWRT.RNO -> TXTWRT.HLP C C INTEGER FBUF(39),OPTION(4,6),DEVTYP(4),TTNME,I INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP LOGICAL*1 TTIN,TTOUT,FMTRQ,TRMNTE BYTE OBUF,ESCBUF(135),PID(54) BYTE HELP1(220),HELP2(219),HELP3(250),HELP4(191),HELP5(93) COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10), # OBUF(512,10),TTIN,TTOUT DATA DEVTYP/3RFRM,3*0/,TTNME/3RTT / DATA OPTION(1,1)/'F'/, OPTION(1,2)/'M'/, OPTION(1,3)/'L'/ # OPTION(1,4)/'H'/, OPTION(1,5)/'E'/, OPTION(1,6)/'S'/ DATA PID /'T','X','T','W','R','T','/','R','T','-','1','1', # ' ',' ','V','e','r','s','i','o','n',' ','1','.','2',' ',' ', # 'O','c','t','o','b','e','r',' ','1','9','8','3',' ',' ', # ' ','/','H',' ','f','o','r',' ','H','e','l','p',0/ DATA HELP1 /"11,'T','X','T','W','R','T',' ','i','s',' ','a', # 'n',' ','R','T','-','1','1',' ','t','e','x','t',' ','f','o', # 'r','m','a','t','t','i','n','g',' ','p','r','o','g','r','a', # 'm',' ','t','h','a','t',' ','h','a','s',' ','b','e','e','n', # ' ','d','e','s','i','g','n','e','d',"15,"12,'s','p','e','c', # 'i','f','i','c','a','l','l','y',' ','t','o',' ','a','i','d', # ' ','t','h','e',' ','u','s','e','r',' ','i','n',' ','i','n', # 'c','o','r','p','o','r','a','t','i','n','g',' ','A','N','S', # 'I',' ','s','t','a','n','d','a','r','d',':',' ','X','3','.', # '4','1','-','1','9','7','4',' ','&',"15,"12,'X','3','.','6', # '4','-','1','9','7','9',' ','c','o','d','e',' ','e','x','t', # 'e','n','s','i','o','n',' ','t','e','c','h','n','i','q','u', # 'e','s',' ','i','n','t','o',' ','A','S','C','I','I',' ','t', # 'e','x','t',' ','s','t','r','i','n','g','s','.',' ',' ','T', # 'h','e','s','e',' ','c','o','n','t','r','o','l',0/ DATA HELP2 /'c','o','m','m','a','n','d','s',' ','a','r','e', # ' ','r','e','c','o','g','n','i','z','e','d',' ','b','y',' ', # 't','h','e',' ','V','T','1','0','0',' ','v','i','d','e','o', # ' ','a','n','d',' ','L','A','1','2','0',' ','h','a','r','d', # 'c','o','p','y',' ','f','a','m','i','l','i','e','s',' ','o', # 'f',"15,"12,'D','i','g','i','t','a','l',' ','E','q','u','i', # 'p','m','e','n','t',' ','t','e','r','m','i','n','a','l','s', # '.',' ',' ','U','s','e','r',' ','c','o','n','t','r','o','l', # ' ','o','f',' ','t','h','e',' ','p','r','o','g','r','a','m', # ' ','c','o','n','s','i','s','t','s',' ','o','f',' ','a','n', # "15,"12,'I','/','O',' ','s','p','e','c','i','f','i','c','a', # 't','i','o','n',' ','c','o','m','m','a','n','d',' ','f','o', # 'l','l','o','w','e','d',' ','b','y',' ','a',' ','s','e','r', # 'i','e','s',' ','o','f',' ','i','n','p','u','t',' ','t','e', # 'x','t',' ','s','t','r','i','n','g','s','.',0/ DATA HELP3/"11,'I','/','O',' ','C','o','m','m','a','n','d', # ' ','S','t','r','i','n','g',' ','E','x','a','m','p','l','e', # 's',':',"15,"12,"15,"12,'*','D','L','0',':','O','U','T','P', # 'U','T','.','F','O','R','/','F','=','T','T',':',"11,"11,'!', # 'O','u','t','p','u','t',' ','i','n',' ','F','O','R','T','R', # 'A','N',' ','f','o','r','m','a','t',' ','(','7','2',' ','c', # 'h','a','r','a','c','t','e','r','s','/','l','i','n','e',')', # "15,"12,"15,"12,'*','O','U','T','P','U','T','.','F','O','R', # '/','F',':','6','0','.','=','I','N','P','U','T','.','T','X', # 'T',"11,'!','F','O','R','T','R','A','N',' ','f','o','r','m', # 'a','t',' ','(','6','0',' ','c','h','a','r','a','c','t','e', # 'r','s','/','l','i','n','e',')',"15,"12,"15,"12,'*','O','U', # 'T','P','U','T','.','F','O','R','/','L',':','1','3','7','=', # 'D','Y','1',':','I','N','P','U','T','.','T','X','T',"11,'!', # 'L','o','w','e','r','c','a','s','e',' ','c','h','a','r','a', # 'c','t','e','r','s',' ','o','u','t','p','u','t',' ','a','s', # ' ','o','c','t','a','l',' ','b','y','t','e','s',0/ DATA HELP4/"15,"12,'*','O','U','T','P','U','T','.','M','A', # 'C','/','M',':','8','0','.','=','T','T',':',"11,"11,'!','O', # 'u','t','p','u','t',' ','i','n',' ','M','A','C','R','O',' ', # 'f','o','r','m','a','t',' ','(','8','0',' ','c','h','a','r', # 'a','c','t','e','r','s','/','l','i','n','e',')',"15,"12,"15, # "12,'*','T','T',':','=','I','N','P','U','T','.','T','X','T', # "11,"11,"11,'!','O','u','t','p','u','t',' ','a','s',' ','u', # 'n','f','o','r','m','a','t','t','e','d',' ','A','S','C','I', # 'I',' ','t','o',' ','t','e','r','m','i','n','a','l',"15,"12, # "15,"12,'*','T','T',':','=','T','T',':',"11,"11,"11,'!','R', # 'e','a','d',' ','f','r','o','m',' ','a','n','d',' ','w','r', # 'i','t','e',' ','t','o',' ','t','h','e',' ','u','s','e','r', # "47,'s',' ','t','e','r','m','i','n','a','l',"15,"12,0/ DATA HELP5 /"11,'F','i','l','e',' ','T','X','T','W','R','T', # '.','H','L','P',' ','c','o','n','t','a','i','n','s',' ','a', # ' ','m','o','r','e',' ','d','e','t','a','i','l','e','d',' ', # 'd','e','s','c','r','i','p','t','i','o','n',' ','o','f',' ', # 'p','r','o','g','r','a','m',' ','u','s','e',"15,"12,'a','n', # 'd',' ','i','n','p','u','t',' ','t','e','x','t',' ','f','o', # 'r','m','a','t','.',0/ CALL PRINT(PID) CALL DFNBUF(ESCBUF) !Tell TCFL where to write output TRMNTE = .FALSE. 10 IF(TRMNTE) CALL EXIT ! /E request to stop program FMTRQ = .FALSE. TTIN = .FALSE. TTOUT = .FALSE. I = ICSI(FBUF,DEVTYP,,OPTION,6) IF(I .EQ. 0) GO TO 20 IF(I-2) 11,12,13 11 CALL PRINT('?TXTWRT-W-MAIN Illegal Command Line') GO TO 10 12 CALL PRINT('?TXTWRT-W-MAIN Illegal Device Specified') GO TO 10 13 CALL PRINT('?TXTWRT-W-MAIN Illegal Option Specified') GO TO 10 20 IF(OPTION(2,5) .NE. 0) TRMNTE = .TRUE. ! /E option IF(OPTION(2,4) .NE. 0) GO TO 65 ! /H help request IF(FBUF(1).EQ.0 .AND. FBUF(16).EQ.0) GO TO 10 IF(OPTION(2,1).NE.0 .AND. OPTION(2,2).NE. 0) GO TO 11 IF(OPTION(2,1).NE.0 .OR. OPTION(2,2).NE. 0) FMTRQ = .TRUE. IF(.NOT. FMTRQ) GO TO 25 CALL IDSTAT(FBUF(1),FBUF(25)) IF((FBUF(25) .AND. "100000) .NE. 0) GO TO 25 CALL PRINT( # '?TXTWRT-F-MAIN Formatted output must be file structured') GO TO 10 25 IF(OPTION(2,6) .EQ. 0) GO TO 35 CALL IDSTAT(FBUF(16),FBUF(25)) !/S input ASCII stream IF((FBUF(25) .AND. "100000) .NE. 0) GO TO 30 CALL PRINT( # '?TXTWRT-F-MAIN Input device must be file structured') GO TO 10 30 IF(FMTRQ) GO TO 60 GO TO 11 35 IF(FBUF(1) .EQ. TTNME) TTOUT = .TRUE. IF(FBUF(16) .EQ. TTNME) TTIN = .TRUE. IF(TTOUT) GO TO 40 OCHAN(1) = IGETC() IF(OCHAN(1) .LT. 0) # STOP '?TXTWRT-F-MAIN No channel available for output' IF(IFETCH(FBUF(1)) .NE.0) # STOP '?TXTWRT-F-MAIN Handler FETCH failure' IF(IENTER(OCHAN(1),FBUF(1),FBUF(5)) .LT. 0) # STOP '?TXTWRT-F-MAIN ENTER failure' 40 IF(TTIN) GO TO 45 CALL IASIGN(1,FBUF(16),FBUF(17),0,4) 45 IF(TTIN .AND. .NOT. TTOUT) CALL IPOKE("44,IPEEK("44).OR."10) DO 1000 I = 2,10 !Initialize workspace OCHAN(I) = -1 1000 CONTINUE LEVEL = 1 OBLK(1) = 0 OBP(1) = 1 CALL BLDSTR(ESCBUF) !Create the ASCII output file IF(OBLK(1) .NE. 0 .OR. OBP(1) .NE. 0) GO TO 50 CALL PURGE(OCHAN(1)) FMTRQ = .FALSE. !No point in format attempt GO TO 55 50 CALL CLOSEC(OCHAN(1)) 55 IF(.NOT. TTIN) CLOSE(UNIT=1) DO 2000 I = 1,10 IF(OCHAN(I) .GE. 0) CALL IFREEC(OCHAN(I)) 2000 CONTINUE 60 IF(FMTRQ) CALL ENC(FBUF,OPTION) !Prepare formatted output GO TO 10 65 CALL PRINT(HELP1) !/H help request CALL PRINT(HELP2) CALL PRINT(HELP3) CALL PRINT(HELP4) CALL PRINT(HELP5) GO TO 10 END SUBROUTINE BLDSTR(ESCBUF) C C This subroutine builds the ASCII stream output from the user's C input. It serves as a controller for IPARSE,MATCH,NEST & IDSPTC. C REAL COMAND INTEGER NARGS,IARGS(20),NCMD,I INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP,LNECNT LOGICAL*1 TTIN,TTOUT,GSERR BYTE OBUF,ESCBUF(1),LINE,PROMPT(3) COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10), # OBUF(512,10),TTIN,TTOUT COMMON /TXTW02/ LNECNT,LINE(135) DATA PROMPT/'>',' ',"200/ LNECNT = 0 IF(TTIN) CALL IPOKE("44,IPEEK("44).OR."40000) !Enable lowercase 10 IF(TTIN) GO TO 20 CALL GETSTR(1,LINE,134,GSERR) IF(.NOT. GSERR) GO TO 30 IF(GSERR .EQ. -1) GO TO 70 !Input EOF (File) IF(GSERR .EQ. -2) # STOP '?TXTWRT-F-BLDSTR Input hardware error or file not found' IF(GSERR .EQ. -3) # STOP '?TXTWRT-F-BLDSTR Input line longer than 134 characters' 20 CALL GTLIN(LINE,PROMPT) 30 IF(LINE(1) .EQ. 0) GO TO 10 LNECNT = LNECNT + 1 IF(LINE(1) .EQ. "32) GO TO 70 !Input EOF (TT:) IF(LINE(1) .NE. '\') GO TO 60 I = IPARSE(LINE(2),COMAND,NARGS,IARGS) IF(I .LT. 0) GO TO 75 !Error IF(I .EQ. 0) GO TO 35 !Normal text command found LINE(1) = I !Octal input character command LINE(2) = 0 GO TO 60 35 NCMD = MATCH(COMAND) IF(NCMD) 40,80,50 40 CALL NEST(NCMD,NARGS,IARGS) GO TO 10 50 ESCBUF(1) = 0 !Null length I = IDSPTC(NCMD,NARGS,IARGS) IF(I .NE. 0) GO TO 85 CALL KPYOUT(ESCBUF) GO TO 10 60 CALL KPYOUT(LINE) GO TO 10 70 CALL LBOUTP IF(TTIN) CALL IPOKE("44,IPEEK("44).AND."137777) RETURN 75 TYPE 100,LNECNT 100 FORMAT(1H0'?TXTWRT-F-IPARSE detected error in line #',I5,':',/) CALL PRINT(LINE) IF(I+2) 76,77,78 76 STOP' No closing parenthesis on argument list' 77 STOP' Illegal character found in argument list' 78 STOP' Too many characters in argument string' 80 TYPE 150,LNECNT 150 FORMAT(1H0,'?TXTWRT-F-MATCH detected error in line #',I5,':',/) CALL PRINT(LINE) STOP 85 TYPE 200,LNECNT 200 FORMAT(1H0,'?TXTWRT-F-IDSPTC detected error in line #',I5,':',/) CALL PRINT(LINE) IF(I .EQ. -1) STOP ' Unrecognized command in line' IF(I .EQ. -2) STOP ' Too many arguments for this command' END SUBROUTINE KPYOUT(INP) C C Copy the string from INP into buffer BUF, writing out BUF C as required. C INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP,I,LNECNT,K LOGICAL*1 TTIN,TTOUT BYTE OBUF,INP(1),TMP(2),LINE COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10), # OBUF(512,10),TTIN,TTOUT COMMON /TXTW02/ LNECNT,LINE(135) DATA TMP/0,"200/ IF(LEVEL .EQ. 1 .AND. TTOUT) GO TO 40 I = 0 K = OBP(LEVEL) 10 IF(K .LE. 512) GO TO 20 KPYOUT = IWRITW(256,OBUF(1,LEVEL),OBLK(LEVEL),OCHAN(LEVEL)) IF(KPYOUT .LT. 0) GO TO 90 OBLK(LEVEL) = OBLK(LEVEL) + 1 K = 1 20 I = I + 1 IF(INP(I) .EQ. 0 .OR. INP(I) .EQ. "200 .OR. I .GT. 512) GO TO 30 OBUF(K,LEVEL) = INP(I) K = K + 1 GO TO 10 30 OBP(LEVEL) = K GO TO 60 C C Must provide a method of printing 512 characters (ie. no terminator) C 40 I = LEN(INP) IF(I .LT. 512) GO TO 50 TMP(1) = INP(512) I = 511 50 INP(I+1) = "200 CALL PRINT(INP) IF(I .EQ. 511) CALL PRINT(TMP) 60 KPYOUT = 0 RETURN 90 CALL PRINT('?TXTWRT-F-KPYOUT WRITW error to output file') IF(I+2) 91,92,93 91 STOP ' Attempt to write past EOF' 92 STOP ' Hardware error occurred' 93 STOP ' Output channel not open' END SUBROUTINE LBOUTP !Last Block OUTPut C C LBOUTP is called to write out the remaining text in a buffer C when the end of input is detected. C INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP,I LOGICAL*1 TTIN,TTOUT BYTE OBUF COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10), # OBUF(512,10),TTIN,TTOUT IF(TTOUT .OR. OBP(1) .EQ. 1) RETURN DO 1000 I = OBP(1),512 OBUF(I,1) = 0 !Null 1000 CONTINUE I = IWRITW(256,OBUF(1,1),OBLK(1),OCHAN(1)) IF(I .LT. 0) GO TO 90 RETURN 90 CALL PRINT('?TXTWRT-F-LBOUTP WRITW error to output file') IF(I+2) 91,92,93 91 STOP ' Attempt to write past EOF' 92 STOP ' Hardware error occurred' 93 STOP ' Output channel not open' END