PDP-11 FORTRAN-77 V5.0-2 16:03:32 15-Oct-84 Page 1 COMPOSE.FTN;1 /F77/OP/TR:BLOCKS/WR 0001 PROGRAM COMPSE C 0002 EXTERNAL CELL, CONVRT C 0003 BYTE ESC 0004 DATA ESC /27/ C 0005 BYTE SI 0006 DATA SI /15/ C 0007 BYTE SO 0008 DATA SO /14/ C 0009 CHARACTER ASP 0010 DATA ASP /''''/ C 0011 INTEGER CHRNO, OPTION, COLUMN, ROW, ERRNO, FCS1, FCS2 C 0012 INTEGER GRID(8) 0013 DATA GRID /8*0/ C 0014 DATA IOATT /"1420/ C 0015 CHARACTER FILNAM*27 0016 DATA FILNAM /'DL3:[005,002]FILENAME.TXT'/ C 0017 CHARACTER CHRGRD(4)*18 C C DISABLE THE FILE NOT FOUND MESSAGE C 0018 CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.) C C ATTACH THE TERMINAL - RECOGNIZE ESCAPE SEQUENCES C 0019 CALL WTQIO(IOATT,5,1) C C GET THE NAME OF THE FILE TO SAVE THE CHARACTER SET IN C 0020 50 WRITE(UNIT=5,FMT=100) 0021 100 FORMAT(///,' ',10X,'Enter a file name for the character set: ',$) C 0022 READ (UNIT=5,FMT='(A27)') FILNAM C 0023 K = INDEX(FILNAM,'.') 0024 IF (K .EQ. 0) STOP 'YOU MUST GIVE THE FILE NAME AN EXTENSION' C C OPEN THE FILE C 0025 CALL ERRSNS C 0026 OPEN (UNIT=1,NAME=FILNAM,STATUS='OLD',ACCESS='DIRECT', * RECL=4,ERR=200) C 0027 GOTO 400 C PDP-11 FORTRAN-77 V5.0-2 16:03:32 15-Oct-84 Page 2 COMPOSE.FTN;1 /F77/OP/TR:BLOCKS/WR 0028 200 CALL ERRSNS(ERRNO,FCS1,FCS2,1) C 0029 IF (ERRNO .NE. 29) STOP 'Fatal Open Error' C 0030 OPEN (UNIT=1,NAME=FILNAM,STATUS='NEW',ACCESS='DIRECT', * RECL=4) C 0031 DO 300 CHRNO=1,94 0032 300 WRITE(UNIT=1,REC=CHRNO) (GRID(I), I=1,8) C C 0033 400 WRITE(UNIT=5,FMT='(1H+,A1,3H[2J)') ESC C 0034 450 WRITE(UNIT=5,FMT=500) 0035 500 FORMAT(' ',20X,'COMPOSE CHARACTER MENU',///, * 12X,'1 - Create a Selected Character',/, * 12X,'2 - Create a Complete Character Set File',/, * 12X,'3 - Create Another Character Set',/, * 12X,'4 - Exit this Program',///, * 16X,'Please select one of the above options: ',$) C 0036 READ(UNIT=5,FMT='(I1)') OPTION C 0037 GOTO (700,900,1050,1100), OPTION C 0038 WRITE(UNIT=5,FMT='(1H+,A1,3H[2J)') ESC C 0039 WRITE(UNIT=5,FMT=600) 0040 600 FORMAT(' ERROR - Invalid OPTION selected - try again',///) C 0041 GOTO 450 C C 0042 700 WRITE(UNIT=5,FMT=800) 0043 800 FORMAT('0',10X,'Enter the column, row of the character that') C 0044 WRITE(UNIT=5,FMT=850) 0045 850 FORMAT(' ',10X,'you want to create (range: 2,1 to 7,14): ',$) C 0046 READ(UNIT=5,FMT='(2I2)') COLUMN, ROW C 0047 CHRNO = 16 * (COLUMN - 2) + ROW C 0048 IF (CHRNO .LT. 1 .OR. CHRNO .GT. 94) THEN C 0049 WRITE(UNIT=5,FMT=865) 0050 865 FORMAT(1H0,3X,'ERROR - The column and/or the row number is * out of range - please re-enter the values.',//) 0051 GOTO 700 C 0052 ENDIF C C C READ IN THE CURRENT VALUE OF THE BINARY CHARACTER GRID C PDP-11 FORTRAN-77 V5.0-2 16:03:32 15-Oct-84 Page 3 COMPOSE.FTN;1 /F77/OP/TR:BLOCKS/WR 0053 READ(UNIT=1,REC=CHRNO) (GRID(I), I=1,8) C 0054 WRITE(UNIT=5,FMT=875) ESC, COLUMN, ROW 0055 875 FORMAT('+',A1,'[2J',15X,'CURRENTLY COMPOSING CHARACTER NO. ',I1, * '/',I2.2,//) C C CALL THE CELL MACRO SUBROUTINE C 0056 CALL CELL(GRID) C C SAVE THE CHARACTER GRID IN THE CHARACTER SET FILE C 0057 WRITE(UNIT=1,REC=CHRNO) (GRID(I), I=1,8) C 0058 GOTO 400 C C 0059 900 FILNAM(K+1:K+3) = 'TXT' C 0060 OPEN (UNIT=2,NAME=FILNAM,STATUS='NEW',FORM='FORMATTED', * CARRIAGECONTROL='LIST') C 0061 WRITE(UNIT=2,FMT='(A1,8HP1;1;1{1)') ESC C 0062 K = 1 0063 DO 1000 CHRNO=1,94 C 0064 READ(UNIT=1,REC=CHRNO) (GRID(I), I=1,8) 0065 CALL CONVRT(GRID,CHRGRD(K)) 0066 IF (IMOD(CHRNO,4) .NE. 0) GOTO 1000 0067 WRITE(UNIT=2,FMT='(4A18)') (CHRGRD(K), K = 1,4) 0068 K = 0 C 0069 1000 K = K + 1 C 0070 CHRGRD(2) (18:18) = ' ' 0071 WRITE(UNIT=2,FMT='(2A18)') (CHRGRD(K), K=1,2) C 0072 WRITE(UNIT=2,FMT='(A1,1H\)') ESC 0073 WRITE(UNIT=2,FMT='(A1,2H)B)') ESC 0074 WRITE(UNIT=2,FMT='(A1,2H)1)') ESC 0075 WRITE(UNIT=2,FMT='(A1,3H[2J)') ESC 0076 WRITE(UNIT=2,FMT='(A1,2H[H)') ESC C 0077 WRITE(UNIT=2,FMT='(A1)') SO C 0078 WRITE(UNIT=2,FMT='(7H !"#$%&,A1,24H()*+,-./0123456789:;<=>?)') ASP 0079 WRITE(UNIT=2,FMT='(32H@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_)') 0080 WRITE(UNIT=2,FMT='(31H`abcdefghijklmnopqrstuvwxyz{|}~)') C 0081 WRITE(UNIT=2,FMT='(1H )') 0082 WRITE(UNIT=2,FMT='(1H )') C 0083 WRITE(UNIT=2,FMT='(A1,9H#3 !"#$%&,A1,24H()*+,-./0123456789:; *<=>?)') ESC, ASP PDP-11 FORTRAN-77 V5.0-2 16:03:32 15-Oct-84 Page 4 COMPOSE.FTN;1 /F77/OP/TR:BLOCKS/WR 0084 WRITE(UNIT=2,FMT='(A1,9H#4 !"#$%&,A1,24H()*+,-./0123456789:; *<=>?)') ESC, ASP C 0085 WRITE(UNIT=2,FMT='(A1,34H#3@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_)') ESC 0086 WRITE(UNIT=2,FMT='(A1,34H#4@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_)') ESC C 0087 WRITE(UNIT=2,FMT='(A1,33H#3`abcdefghijklmnopqrstuvwxyz{|}~)') ESC 0088 WRITE(UNIT=2,FMT='(A1,33H#4`abcdefghijklmnopqrstuvwxyz{|}~)') ESC C 0089 WRITE(UNIT=2,FMT='(A1)') SI C 0090 CLOSE (UNIT=2) C 0091 GOTO 400 C C 0092 1050 CLOSE(UNIT=1) C 0093 GOTO 50 C C 0094 1100 CALL EXIT C 0095 END PDP-11 FORTRAN-77 V5.0-2 16:03:32 15-Oct-84 Page 5 COMPOSE.FTN;1 /F77/OP/TR:BLOCKS/WR PROGRAM SECTIONS Number Name Size Attributes 1 $CODE1 002746 755 RW,I,CON,LCL 2 $PDATA 002400 640 RW,D,CON,LCL 3 $IDATA 000006 3 RW,D,CON,LCL 4 $VARS 000214 70 RW,D,CON,LCL 5 $TEMPS 000004 2 RW,D,CON,LCL VARIABLES Name Type Address Name Type Address Name Type Address ASP CHR 4-000003 CHRNO I*2 4-000004 COLUMN I*2 4-000010 ERRNO I*2 4-000014 ESC L*1 4-000000 FCS1 I*2 4-000016 FCS2 I*2 4-000020 FILNAM CHR 4-000044 I I*2 4-000212 IOATT I*2 4-000042 K I*2 4-000210 OPTION I*2 4-000006 ROW I*2 4-000012 SI L*1 4-000001 SO L*1 4-000002 ARRAYS Name Type Address Size Dimensions CHRGRD CHR 4-000077 000110 36 (4) GRID I*2 4-000022 000020 8 (8) LABELS Label Address Label Address Label Address 50 1-000046 100' 2-000000 200 1-000210 300 ** 400 1-000400 450 1-000436 500' 2-000102 600' 2-000460 700 1-000602 800' 2-000546 850' 2-000630 865' 2-000716 875' 2-001056 900 1-001256 1000 1-001652 1050 1-002702 1100 1-002724 FUNCTIONS AND SUBROUTINES REFERENCED CELL CLOS$ CONVRT ERRSET ERRSNS EXIT OPEN$ WTQIO $INDEX Total Space Allocated = 005574 1470 No FPP Instructions Generated