C C WORD11 to RUNOFF converter C C From: Phil Stephensen-Payne, C c/o Systime Ltd., C Concourse Computer Centre, C 432 Dewsbury Road, C LEEDS LS11 7DF, C England. C LOGICAL*1 ZCHR,ZBUFF(512),ZREC(200),ZFIL(20),UNDLST INTEGER*4 DBUFF(128) INTEGER*2 ITITLE,IFLAG,IMARG,ISTART,ITOP,I,ILAB,ILM1 INTEGER*2 IERROR,ISER,ITAB(15),ITABNO,IWRAP,ILMARG,IRMARG INTEGER*2 IPSIZE EQUIVALENCE (ZBUFF,DBUFF) TYPE 5010 5010 FORMAT ('$ENTER FILENAME (NO .EXT) > ') ACCEPT 5020,I,ZFIL 5020 FORMAT (Q,20A1) ZFIL(I+1) = "56 ZFIL(I+2) = "127 !ADD .WPS EXTENSION ZFIL(I+3) = "120 ! ZFIL(I+4) = "123 ! ZFIL(I+5) = 0 !TERMINATOR OPEN (UNIT=1,NAME=ZFIL,READONLY,TYPE='OLD', 1 ACCESS='DIRECT',RECORDSIZE=128) ZFIL(I+2) = "122 !ADD .RNO EXTENSION ZFIL(I+3) = "116 ! ZFIL(I+4) = "117 ! OPEN (UNIT=2,NAME=ZFIL,TYPE='NEW',CARRIAGECONTROL='LIST') ZFIL(I+2) = "105 !ADD .ERR EXTENSION ZFIL(I+3) = "122 ! ZFIL(I+4) = "122 ! OPEN (UNIT=3,NAME=ZFIL,TYPE='NEW',CARRIAGECONTROL='LIST') DO 70,J=1,900 READ (1'J,ERR=9999) DBUFF C DO 50,I=5,512 IF (IFLAG.GT.0) GOTO 1000 ! HANDLE RULER SEQUENCE IF (ZBUFF(I).GE.0) GOTO 100 ! COPY CHARACTER OVER ZBUFF(I) = "200 + ZBUFF(I) IF (ZBUFF(I).NE."30) UNDLST = 0 !IF NOT ^X CLEAR FLAG IF ((ZBUFF(I).EQ."30).AND.(UNDLST.NE.0)) GOTO 50 C !IGNORE ADJACENT ^Xs IF (ZBUFF(I).EQ.0) ISTART = 1 IF (ZBUFF(I).EQ.0) GOTO 50 ! START OF FILE - IGNORE IT IF (ISTART.EQ.0) GOTO 50 IF (ZBUFF(I).EQ."42) IFLAG = 1 IF (ZBUFF(I).EQ."42) GOTO 50 ! START OF RULER SEQUENCE - IGNORE IF (ZBUFF(I).EQ."177) GOTO 50 ! QUALIFIER - IGNORE IF (ZBUFF(I).EQ."22) GOTO 200 ! ^R - DO A NEW LINE IF (ZBUFF(I).EQ."6) GOTO 300 ! ^F - CHECK FOR TITLE IF (ZBUFF(I).EQ."30) GOTO 400 ! ^X - UNDERLINE NEXT CHAR IF (ZBUFF(I).EQ."24) GOTO 500 ! ^T - CENTRE PRECEDING TEXT IF (ZBUFF(I).EQ."10) GOTO 600 ! ^H - END OF ^F TEXT IF (ZBUFF(I).EQ."4) GOTO 700 ! ^D - NEW PAGE IF (ZBUFF(I).EQ."32) GOTO 800 ! ^Z - INDENT LEFT MARGIN IF (ZBUFF(I).EQ."44) GOTO 900 ! $ - END OF FILE IF (ZBUFF(I).EQ."56) GOTO 50 ! . - ? (IGNORE) ZCHR = "40 IF (ZBUFF(I) .LT. "40) ZCHR = "136 IF (ZBUFF(I) .LT. "40) ZBUFF(I) = ZBUFF(I) + "100 IF (ZBUFF(I) .GE. "140) ZCHR = "45 IF (ZBUFF(I) .GE. "140) ZBUFF(I) = ZBUFF(I) - "40 20 WRITE (3,5000) ZCHR,ZBUFF(I),J,I 5000 FORMAT ('UNKNOWN CONTROL CHARACTER ',2A1,' AT BLOCK ',I3, 1 '. OFFSET ',O3) IERROR = IERROR + 1 ISER = ISER + 1 50 CONTINUE C 70 CONTINUE C C COPY THE NEXT CHARACTER TO THE OUTPUT BUFFER C 100 UNDLST = 0 !NOT A ^X IF (ISTART.EQ.0) GOTO 50 !NOT STARTED - IGNORE IT IF (ZBUFF(I).EQ.0) GOTO 50 !IF NULL - IGNORE IT ILEN = ILEN + 1 !COUNT THIS CHARACTER IF (ZBUFF(I).EQ."46) GOTO 110 !IF & INSERT _ FIRST IF (ZBUFF(I).EQ."136) GOTO 110 !IF ^ INSERT _ FIRST IF (ZBUFF(I).EQ."134) GOTO 110 !IF \ INSERT _ FIRST IF (ZBUFF(I).EQ."137) GOTO 110 !IF _ INSERT _ FIRST IF (ZBUFF(I).EQ."43) GOTO 110 !IF # INSERT _ FIRST IF (ZBUFF(I).NE."40) GOTO 120 !IF NOT SPACE, CARRY ON IF (ILEN.EQ.1) GOTO 105 !IF FIRST CHAR - CARRY ON IF (ZREC(ILEN-1).EQ."40) ZREC(ILEN-1) = "43 ! CHANGE LAST SPACE IF (ZREC(ILEN-1).EQ."43) ZBUFF(I)="43 !AND THIS ONE 105 IF (ILEN.EQ.1) ZBUFF(I) = "43 IF (ZBUFF(I).NE."40) GOTO 120 !ONLY SPLIT AT END OF WORDS IF (ILEN.LT.80) GOTO 120 !IF MORE ROOM - CARRY ON IF (ILEN.GE.200) GOTO 9000 !NO ROOM FOR TITLE IF (ITITLE.NE.0) GOTO 120 !IF DOING TITLE - IGNORE NEW RECORDS IF (IMARG.LT.0) GOTO 107 ! NO MARGINS - CARRY ON WRITE (2,5110) IWRAP ! OUTPUT MARGIN CONTROL 5110 FORMAT ('.LM ',I2) ILM1 = IWRAP WRITE (2,5120) ILMARG-IWRAP !INDENT 5120 FORMAT ('.I ',I3) IMARG = -1 107 ASSIGN 50 TO ILAB !RETURN TO NEXT CHAR ILEN = ILEN - 1 !DISCOUNT SPACE GOTO 1100 !OUTPUT THE RECORD 110 ZREC(ILEN) = "137 ! INSERT _ ILEN = ILEN + 1 ! COUNT IT 120 ZREC(ILEN) = ZBUFF(I) !COPY IT TO THE BUFFER ICHAR = ICHAR + 1 !COUNT REAL CHARS INLINE = 0 !FLAG TO IGNORE FIRST ^R GOTO 50 !AND LOOK FOR THE NEXT ONE C C OUTPUT A NEW LINE C 200 IF (ITITLE.EQ.0) GOTO 210 !IF NOT DOING TITLE - CARRY ON IF (ILEN.EQ.0) GOTO 50 !IF NOTHING IN BUFFER - CARRY ON IF (ITITLE.GT.3) GOTO 9200 !TOO MANY LINES IN TITLE IF (ITITLE.GT.1) GOTO 205 !IF NOT DESCRIPTOR - CARRY ON ITOP = 1 !HOPE IT'S A TOP C DO 202,K=1,ILEN IF (ZREC(K).EQ."40) GOTO 202 !OMIT LEADING BLANKS IF (ZREC(K).EQ."43) GOTO 202 !AND PSEUDO-BLANKS GOTO 204 !OK - CHECK FOR TOP 202 CONTINUE C GOTO 9100 !CAN'T BE LEGAL 204 IF (ZREC(K).NE."124) ITOP = 0 !NOT TOP IF (ZREC(K+1).NE."117) ITOP = 0 ! IF (ZREC(K+2).NE."120) ITOP = 0 ! ITITLE = 2 !UPDATE TITLE NUMBER IF (ITOP.EQ.0) GOTO 9100 !IF NOT TOP - ERROR ILEN = 0 ICHAR = ILMARG GOTO 50 !GET NEXT CHAR 205 IF (ITOP.EQ.0) GOTO 9100 !IF NOT TOP - ERROR IF (ILMARG.NE.0) GOTO 206 ! LEFT MARGIN - HANDLE IT IF (ITITLE.EQ.2) WRITE(2,5200) (ZREC(K),K=1,ILEN) IF (ITITLE.EQ.3) WRITE(2,5210) (ZREC(K),K=1,ILEN) 5200 FORMAT ('.T ',128A1) 5210 FORMAT ('.ST ',128A1) GOTO 207 ! 206 ZCHR = "43 ! SET TO HASH IF (ITITLE.EQ.2) WRITE(2,5200) (ZCHR,K=1,ILMARG), 1 (ZREC(K),K=1,ILEN) IF (ITITLE.EQ.3) WRITE(2,5210) (ZCHR,K=1,ILMARG), 1 (ZREC(K),K=1,ILEN) 207 IF (ITITLE.LT.0) ITITLE = - ITITLE !RESET TITLE ITITLE = ITITLE + 1 ILEN = 0 !RESET BUFFER ICHAR = ILMARG ! GOTO 50 !GET NEXT CHAR 210 IF (ILEN.EQ.0) GOTO 220 !IF NOTHING IN BUFFER - CARRY ON IF (IMARG.LT.0) GOTO 215 ! NO MARGINS - CARRY ON WRITE (2,5110) IWRAP ! OUTPUT MARGIN CONTROL ilm1 = iwrap WRITE (2,5120) ILMARG-IWRAP !INDENT 215 ASSIGN 220 TO ILAB GOTO 1100 !OUTPUT THE RECORD 220 IF (IMARG.EQ.0) GOTO 230 !NO MARGINS - CARRY ON WRITE (2,5240) ILMARG !YES - RESET MARGINS 5240 FORMAT ('.LM ',I3) ILM1 = ILMARG IMARG = 0 230 IF (INLINE.NE.0) WRITE (2,5250) !OUTPUT NEW LINE IF (INLINE.EQ.0) WRITE (2,5260) 5250 FORMAT ('.B') 5260 FORMAT ('.BR') INLINE = 1 ! GOTO 50 !GET NEXT CHAR C C TITLE OR FOOTNOTE TEXT - IGNORE THE LATTER C 300 ASSIGN 310 TO ILAB GOTO 1100 !OUTPUT THE RECORD 310 ITITLE = 1 !SHOW DOING TITLE GOTO 50 !AND GET NEXT CHARACTER C C UNDERLINE THE NEXT CHARACTER C 400 UNDLST = 1 !FLAG ^X ILEN = ILEN + 1 !COUNT THE CHARACTER ZREC(ILEN) = "46 !INSERT UNDERLINE CHARACTER GOTO 50 !GET NEXT CHARACTER C C CENTRE THE PRECEDING TEXT C 500 IF (ITITLE.NE.0) GOTO 50 !IF DOING TITLES - CAN'T CENTRE WRITE (2,5500) IRMARG+ILMARG-ILM1,(ZREC(K),K=1,ILEN) !OUTPUT RECORD 5500 FORMAT ('.C ',I3,';',128A1) ILEN = 0 !RESET LENGTH ICHAR = ILMARG ! GOTO 50 !GET NEXT CHARACTER C C END OF TITLE OR FOOTNOTE TEXT C 600 IF (ITITLE.LE.1) GOTO 610 IF (ILEN.EQ.0) GOTO 610 !NOTHING IN BUFFER - EXIT IF (ITOP.NE.0) GOTO 605 ITITLE = 0 !END OF TITLES GOTO 9100 ! NOT TOP 605 IF (ITITLE.GT.3) GOTO 9200 !TOO MANY LINES IN TITLE IF (ILMARG.NE.0) GOTO 607 !IF LEFT MARGINS - HANDLE THEM IF (ITITLE.EQ.2) WRITE(2,5200) (ZREC(K),K=1,ILEN) IF (ITITLE.EQ.3) WRITE(2,5210) (ZREC(K),K=1,ILEN) GOTO 610 ! 607 ZCHR = "43 ! IF (ITITLE.EQ.2) WRITE(2,5200) (ZCHR,K=1,ILMARG), 1 (ZREC(K),K=1,ILEN) IF (ITITLE.EQ.3) WRITE(2,5210) (ZCHR,K=1,ILMARG), 1 (ZREC(K),K=1,ILEN) 610 ITITLE = 0 ILEN = 0 ICHAR = ILMARG ! GOTO 50 !GET THE NEXT CHARACTER C C NEW PAGE C 700 ASSIGN 710 TO ILAB GOTO 1100 ! 710 WRITE (2,5700) !OUTPUT NEW PAGE 5700 FORMAT ('.PG') GOTO 50 !GET THE NEXT CHARACTER C C MOVE THE LEFT MARGIN IN A BIT C 800 IF (ITABNO.EQ.0) GOTO 50 !NO TABS C DO 810,L=1,ITABNO !SEARCH FOR NEXT TAB IF (ITAB(L).GT.ICHAR) GOTO 820 !FOUND IT 810 CONTINUE C GOTO 50 !NO TAB LARGE ENOUGH - IGNORE IT 820 K = ITAB(L) - ICHAR !GET SIZE DIFFERENCE IF (K.EQ.0) GOTO 50 ! C DO 830,L=1,K ICHAR = ICHAR + 1 ILEN = ILEN + 1 ZREC(ILEN) = "43 830 CONTINUE C GOTO 50 !GET NEXT CHARACTER C C END OF FILE C 900 ASSIGN 9999 TO ILAB GOTO 1100 C C HANDLE RULER SEQUENCE C 1000 UNDLST = 0 !NOT A ^X IFLAG = IFLAG + 1 !COUNT CHAR IF (IFLAG.LT.5) GOTO 50 !DON'T UNDERSTAND FIRST FEW IF (IFLAG.EQ.5) ILMARG = ZBUFF(I) !LEFT MARGIN IF (IFLAG.EQ.6) IPSIZE = ZBUFF(I) !PAPER SIZE IF (IFLAG.EQ.7) IWRAP = ZBUFF(I) !WRAP IF (IFLAG.EQ.8) IRMARG = ZBUFF(I) !RIGHT MARGIN IF (IFLAG.EQ.8) WRITE (2,6000) IRMARG+1 !OUTPUT IT 6000 FORMAT ('.RM ',I3) IF (IFLAG.EQ.8) WRITE (2,6005) IPSIZE,IRMARG+1 6005 FORMAT ('.PS ',I3,',',I3) IF (IFLAG.LT.9) GOTO 50 !ENOUGH OF THEM IF (IFLAG.GT.50) GOTO 1010 !INTO THE TABS ITABNO = 0 !INITIALISE TAB COUNT IF (ZBUFF(I).EQ.-8) IFLAG = 50 !START OF TABS GOTO 50 1010 IF (ITABNO.LT.0) GOTO 1020 !SECOND HALF IF (ZBUFF(I).EQ.-2) IFLAG = 0 !END OF RULER SEQUENCE IF (ZBUFF(I).EQ.-2) GOTO 50 ! ITABNO = ITABNO + 1 !NEXT TAB IF (ITABNO.GT.15) GOTO 9300 !TOO MANY ITAB (ITABNO) = ZBUFF(I) !STORE TAB ITABNO = -ITABNO !FLAG FOR SECOND HALF GOTO 50 ! 1020 ITABNO = -ITABNO !BACK FOR FIRST HALF IF (ZBUFF(I).EQ.-2) GOTO 9400 !ILLEGAL TABS IF (ZBUFF(I).NE.0) GOTO 9500 !NOT ORDINARY TABS GOTO 50 !CARRY ON C C OUTPUT RECORD C 1100 IF (ILEN.EQ.0) GOTO ILAB C DO 1110,K=ILEN,1,-1 IF (ZREC(K).EQ."40) GOTO 1110 IF (ZREC(K).EQ."43) GOTO 1110 GOTO 1120 1110 CONTINUE C GOTO 1130 1120 ILEN = K IF (ILEN.LE.100) GOTO 1127 C K = 0 I1 = 0 DO 1125,J1=1,ILEN IF (I1.EQ.1) GOTO 1124 IF ((ZREC(J1).EQ."137).AND.(ZREC(J1+1).EQ."137)) GOTO 1123 K = K + 1 ZREC(K) = ZREC(J1) GOTO 1125 1123 I1 = 1 K = K + 1 ZREC(K) = "55 GOTO 1125 1124 I1 = 0 1125 CONTINUE C ILEN = K IF (K.GT.100) GOTO 9000 1127 WRITE (2,5100) (ZREC(K),K=1,ILEN) ! ELSE - OUTPUT THIS ONE 5100 FORMAT (128A1) 1130 ILEN = 0 !AND RESET THE LENGTH ICHAR = ILMARG ! GOTO ILAB C C NO ROOM FOR TEXT C 9000 WRITE (3,5900) (ZREC(K),K=1,80) 5900 FORMAT ('TEXT STRING TOO LONG:-'/80A1) IERROR = IERROR + 1 ISER = ISER + 1 ITITLE = -ITITLE ILEN = 0 !RESET LENGTH ICHAR = ILMARG ! GOTO 50 C C AN UNRECOGNISED ^F TYPE C 9100 IF (ILEN.GT.80) ILEN=80 WRITE (3,5910) (ZREC(K),K=1,ILEN) 5910 FORMAT ('CANNOT HANDLE ^F STRING:-'/80A1) IERROR = IERROR + 1 ILEN = 0 ICHAR = ILMARG ! GOTO 50 C C TOO MANY TITLE LINES C 9200 IF (ILEN.GT.80) ILEN = 80 WRITE (3,5920) (ZREC(K),K=1,ILEN) 5920 FORMAT ('TOO MANY TITLE LINES, LINE IGNORED:-'/80A1) IERROR = IERROR + 1 ILEN = 0 ICHAR = ILMARG ! GOTO 50 C C TOO MANY 'TAB'S C 9300 WRITE (3,5930) (ZREC(K),K=1,ILEN) 5930 FORMAT ('TOO MANY ^ZS, ONE OMITTED IN LINE:-'/80A1) IERROR = IERROR + 1 GOTO 50 C C ILLEGAL TAB ENDING C 9400 WRITE (3,5940) 5940 FORMAT ('ODD NUMBER OF CHARS IN TAB SEQUENCE IN RULER') IERROR = IERROR + 1 GOTO 50 C C UNHANDLEABLE TAB C 9500 WRITE (3,5950) ZBUFF(I) 5950 FORMAT ('CANNOT HANDLE TAB TYPE ',I3) IERROR = IERROR + 1 GOTO 50 9999 CLOSE (UNIT=1) CLOSE (UNIT=2) CLOSE (UNIT=3) TYPE 5990,IERROR,ISER 5990 FORMAT (' WTR -- ',I3,' ERRORS ',I3,' SERIOUS.') CALL EXIT END