PROGRAM F2T
C1    PROGRAM: F2T (MAIN)
C-    --------
C0    FUNCTION: CONVERTS A FIXED BLOCK FILE TO TEXT FOR TRANSMISSION
C-    ---------
C0    AUTHOR: R.A.WELLS, MAR81
C-    -------
C0    DESCRIPTION: EACH TWO BYTES OF THE INPUT FILE ARE CONVERTED TO
C-    ------------ THREE TEXT CHARACTERS IN THE OUTPUT FILE. THE TWO
C-      BYTES ARE TREATED AS THREE 6-BIT FIELDS (2 ZERO BITS ON THE
C-      FRONT). EACH 6-BIT FIELD IS CONVERTED TO AN ASCII CHARACTER
C-      BY ADDING 32. THE TEXT IS OUTPUT AS 64-CHARACTER LINES TO A
C-      SEQUENTIAL FILE.
C-         FOR EXAMPLE, EC 9A (1110 1100 1001 1010) BECOMES
C-      2E(10 1110)('.'), 41(100 0001)('A'), 3A(11 1010)(':')
C-         THE PROGRAM CHOOSES A BLOCK SIZE OF 256 BYTES IF THE INPUT
C-      FILE NAME ENDS WITH 'Q.QWK'. OTHERWISE, IT WILL USE FULL PAGE
C-      BLOCKS (512 BYTES).
C
      LOGICAL*1 FIXFIL(32),TXTFIL(32),TXTBF1(3,128),TXTBF2(3,256),
     *   QQWK(5),HY,HN,IYN,BELL
      DATA BELL /7/
      INTEGER*2 FIXBF1(128), FIXBF2(256), RETRY, MORE
      INTEGER*4 IWD
C
      EQUIVALENCE (FIXBF1(1),FIXBF2(1)),(TXTBF1(1,1),TXTBF2(1,1))
C
      DATA ITRMI,ITRMO,LUNFIX,LUNTXT/5,6,7,8/, HY,HN/1HY,1HN/,
     *   QQWK/1HQ,1H.,1HQ,1HW,1HK/
C - THE FOLLOWING DECLARATIONS ARE TO GET ALLOCATIONS IN MACRO-11 CODE
      DATA I,IBLK,KFIX,LBLK,LFFIX,LFTXT/6*0/,
     *   IWD/0/, IYN/0/, FIXFIL,TXTFIL/64*0/
C     *****************************************************************
C
      WRITE (ITRMO,1001)
 1001 FORMAT (//,20('*'),' PSDI *** F2T *** V1.0 ',20('*'),/)
      WRITE (ITRMO,1002)
 1002 FORMAT (' Converts fixed block files to text format')
      WRITE (ITRMO,1003)
 1003 FORMAT (/,' QWIKNET drawing files, named *Q.QWK, are assumed to'/
     *   ' be 256-byte blocks. Others must be 512-byte blocks.'/)
C
      ASSIGN 10 TO MORE
 10   ASSIGN 15 TO RETRY
 15   WRITE (ITRMO,1500)
 1500 FORMAT (' Enter full source file name: ',$)
      READ (ITRMI,1510,END=9999) LFFIX,FIXFIL
 1510 FORMAT (Q,32A1)
      IF (LFFIX.LE.0) GO TO RETRY
      FIXFIL(LFFIX+1)=0
C
C     SET THE BLOCK SIZE (FULL PAGE UNLESS Q.QWK FILE)
C
      LBLK=512
      DO 16 I=1,5
      IF (FIXFIL(I+LFFIX-5).NE.QQWK(I)) GO TO 17
 16   CONTINUE
      LBLK=256
C
C     OPEN THE DRAWING FILE
C
 17   OPEN (UNIT=LUNFIX,NAME=FIXFIL,ACCESS='DIRECT',READONLY,
     *   ERR=90,TYPE='OLD',RECORDSIZE=LBLK/4,ASSOCIATEVARIABLE=KFIX)
C
      ASSIGN 18 TO RETRY
 18   WRITE (ITRMO,1800)
 1800 FORMAT (' Enter full text file name: ',$)
      READ (ITRMI,1510,END=9999) LFTXT,TXTFIL
      IF (LFTXT.LE.0) GO TO RETRY
      TXTFIL(LFTXT+1)=0
C
C     OPEN THE TEXT FILE
C
      OPEN (UNIT=LUNTXT,NAME=TXTFIL,TYPE='NEW',CARRIAGECONTROL='LIST',
     *   ERR=91)
C
C     PUT THE SOURCE FILE NAME AND BLOCKSIZE AS A NOTE IN THE TEXT FILE
      WRITE (LUNTXT,1900) FIXFIL,LBLK
 1900 FORMAT (32A1,I3)
C
C     TURN OFF END-OF-FILE  ERROR MESSAGE
      CALL ERRSET(39,.TRUE.,.FALSE.,.TRUE.,.FALSE.,31)
C
      IBLK=0
C
 25   IBLK=IBLK+1
      IF (LBLK.EQ.256) READ (LUNFIX'IBLK,ERR=50,END=50) FIXBF1
      IF (LBLK.EQ.512) READ (LUNFIX'IBLK,ERR=50,END=50) FIXBF2
C
      DO 30 I=1,LBLK/2
      IWD=FIXBF2(I)
      IWD=IWD.AND.65535
      TXTBF2(1,I)=(IWD.AND.63)+32
      IWD=IWD/64
      TXTBF2(2,I)=(IWD.AND.63)+32
      IWD=IWD/64
      TXTBF2(3,I)=(IWD.AND.15)+32
 30   CONTINUE
C
 31   CONTINUE
      IF (LBLK.EQ.256) WRITE (LUNTXT,3500) TXTBF1
      IF (LBLK.EQ.512) WRITE (LUNTXT,3500) TXTBF2
 3500 FORMAT (64A1)
      GO TO 25
C
C     FINISHED. LOOP FOR MORE.
C
 50   CLOSE (UNIT=LUNTXT)
      CLOSE (UNIT=LUNFIX)
      GO TO MORE
C
C	Here for open errors.
C
 90   WRITE (ITRMO,9000) FIXFIL, BELL
 9000 FORMAT (' Unable to open file "',32A1,'" please try again.',A1)
      GO TO RETRY
 91   WRITE (ITRMO,9000) TXTFIL, BELL
      GO TO RETRY
C
 9999 CALL EXIT(1)
      END