'HEAD'  LIST 6502 RB FILES
C     EDIT DATE   01FEB79  17:54
C     SOURCE FILE LISTRBGAK.FS
C     AUTHOR      GARY A. KUDIS
      'OUTFILE' LISTRBGAK.FR
      INTEGER     GCHAR
      'INCLUDE' CHARACGAK.IN,
      'INCLUDE' IODEFNGAK.IN,
      'INCLUDE' IOFILEGAK.IN,
      INTEGER     RBQUES (7)
      INTEGER     LSQUES (4)
      INTEGER     ANSWER (16)
      INTEGER     DFAULT (5)
      DATA        RBQUES /'RB FILE NAME? '/
      DATA        LSQUES /'LS FILE?'/
      DATA        DFAULT /'LISTRB.LST'/
      'EJECT'
C LISTRB ::
      CALL OPENF (TTYIN, TIFILE, ECODE)
N     CALL OPENF (TTYOUT, TOFILE, ECODE)
      'DO'
         CALL SET (BLANKS, ANSWER, 14)
         CALL SET (BLANKS, RBFILE, 14)
         CALL WRLIN (TTYOUT, RBQUES, 14)
         CALL RDLIN (TTYIN, ANSWER, 30, ECODE)
         IF (ECODE .NE. 1) STOP
         CHAR = GCHAR (ANSWER, 1)
         IF (CHAR.EQ.0) CHAR = BLANK
         'IF' ((CHAR.EQ.BLANK).OR.(CHAR.EQ.CR))
            'BREAK'
            'ENDIF'
         CALL MOVE (ANSWER, RBFILE, 14)
P        CALL DEVICE (RBFILE)
         CALL OPENF (RBCHAN, RBFILE, ECODE)
         'IF' (ECODE.NE.1)
            CALL ERROR(3)
            'BREAK'
            'ENDIF'
         CALL SET (BLANKS, ANSWER, 14)
         CALL WRLIN (TTYOUT, LSQUES, 8)
         CALL RDLIN (TTYIN, ANSWER, 30, ECODE)
         IF (ECODE .NE. 1) STOP
         CHAR = GCHAR (ANSWER, 1)
         'IF' ((CHAR.EQ.BLANK).OR.(CHAR.EQ.CR))
            CALL MOVE (DFAULT, ANSWER, 5)
            'ENDIF'
         CALL MOVE (ANSWER, MPFILE, 14)
P        CALL DEVICE (RBFILE)
         CALL OPENN (MPCHAN, MPFILE, ECODE)
         CALL WRLIN (MPCHAN, RBFILE, 30)
         CALL FMTRB
         CALL CLOSF (RBCHAN, ECODE)
         'IF' (ECODE.NE.1)
            CALL ERROR(3)
            'BREAK'
            'ENDIF'
N        CALL CLOSF (MPCHAN, ECODE)
N        'IF' (ECODE.NE.1)
N           CALL ERROR(3)
N           'BREAK'
N           'ENDIF'
P        CALL SPOOL (MPCHAN, ECODE)
         'END'
      STOP
      END
      'OUTFILE' FMTRBGAK.FR
      SUBROUTINE FMTRB
      'INCLUDE' RECORDGAK.IN,
      'INCLUDE' IODEFNGAK.IN,
      'INCLUDE' CHARACGAK.IN,
      LOGICAL     ERX, EOF
      INTEGER     RBTEXT (82)
      INTEGER     GCHAR
      INTEGER     LINES
      INTEGER     I, J
C FMTRB :
      'DO'
         CALL SET (DASHES, RBTEXT, 20)
         CALL WRLIN (MPCHAN, RBTEXT, 40)
         CALL SET (BLANKS, RBTEXT, 82)
         LINES = 1
         CALL GRCORD (ERX, EOF)
         IF (ERX) GO TO 9998
         IF (EOF) GO TO 9999
         GO TO (100,200,300,400,500,600,700,800,900,^
            1000,1100,1200,1300,1400,1500,1600,1700,^
            1800,1900,2000) RTYPE
100         CONTINUE
            CALL MOVE (RECORD(2), RBTEXT(3), 8)
            GO TO 5000
200         CONTINUE
            LINES = 0
            GO TO 5000
300         CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            GO TO 5000
400         CONTINUE
            LINES = 2
            CALL MOVE (RECORD(2), RBTEXT(3), 40)
            GO TO 5000
500         CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            CALL EHX (RECORD(3), RBTEXT, 9,12)
            CALL MOVE (RECORD(4), RBTEXT(7), 8)
            GO TO 5000
600         CONTINUE
            GO TO 500
700         CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            CALL EHX (RECORD(3), RBTEXT, 9,12)
            CALL EHX (RECORD(4), RBTEXT, 13,16)
            CALL MOVE (RECORD(5), RBTEXT(9), 8)
            GO TO 5000
800         CONTINUE
            GO TO 700
900         CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            CALL MOVE (RECORD(3), RBTEXT(5), 8)
            GO TO 5000
1000        CONTINUE
            LINES = (RSTYPE+19)/20
            'DOLOOP' I = 1, RSTYPE
               CALL EHX (RECORD(I+1), RBTEXT(2*I+1), 1,4)
               'END'
            GO TO 5000
1100        CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            CALL EHX (RECORD(3), RBTEXT, 9,12)
            GO TO 5000
1200        CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            CALL EHX (RECORD(3), RBTEXT, 9,12)
            CALL EHX (RECORD(4), RBTEXT, 13,16)
            GO TO 5000
1300        CONTINUE
            GO TO 1200
1400        CONTINUE
            GO TO 1100
1500        CONTINUE
            CALL EHX (RECORD(2), RBTEXT, 5,8)
            GO TO 5000
1600        CONTINUE
            GO TO 1500
1700        CONTINUE
            GO TO 1100
1800        CONTINUE
            GO TO 500
1900        CONTINUE
2000        CONTINUE
            LINES = 0
5000     CONTINUE
         CALL EHX (RTYPE, RBTEXT, 1, 2)
         CALL EHX (RSTYPE, RBTEXT, 3, 4)
         CALL WRLIN (MPCHAN, RBTEXT, 4)
         IF (LINES .NE. 0) CALL WRLINE (MPCHAN, RBTEXT (3), 40)
         IF (LINES .EQ. 2) CALL WRLINE (MPCHAN, RBTEXT (23), 40)
         'END'
9998  CONTINUE
9999  CONTINUE
      RETURN
      END