! UTFIXL.BAS - FIX a FILe that has lines longer than 510 characters
!
! Copyright @1985 by David W. Barrow III
!
! Date Who L What
!-------- --- - ---------------------------------------------------
!04-28-85 DWB Original Coding
!
MAP1 VERSION,S,9,"VER042885"
PROGRAM UTFIXL,85.04A(28)
MAP1 MISC'STR'MAPS
MAP2 CHAR,S,1,"" ! Test for control
MAP2 CLEAN'LINE,S,80,"" ! out'line cleaned of CTRL-?
MAP2 CONTINUE,S,1,"N" ! ans to do you want
MAP2 IN'FILESPEC,S,24,"" ! Input file specifcation
MAP2 IN'LINE,S,10000,"" ! Input line
MAP2 OUT'FILESPEC,S,24,"" ! Output file specification
MAP2 OUT'LINE,S,80,"" ! Output line
MAP1 MISC'FP'MAPS
MAP2 CHAR'NUM,F,6,0 ! Line character check loop
MAP2 COUNTER,F,6,0 ! File line counter loop
MAP2 COUNTER2,F,6,0 ! Line parcer loop counter
MAP2 EXIST,F,6,0 ! Lookup answer
MAP2 LINE'LEN,F,6,0 ! line length
MAP2 NAME'LEN,F,6,0 ! Length of input file name
HOUSEKEEPING:
! Standard Error Routine
ON ERROR GOTO ERR'ROUTINE
PRINT TAB(-1,0)
PRINT TAB(01,10); "UTFIXL - David W. Barrow III's LINE FIXER"
PRINT TAB(03,05); "This program takes a file with lines longer"; &
" than 510 characters "
PRINT TAB(04,01); "and outputs a file with the same name.RFM "; &
"which will have those"
PRINT TAB(05,01); "lines divided into 80 character lines"
PRINT TAB(06,05); "The process also cleans out the Control characters"
PRINT TAB(08,10); "Are you SURE you want to run this program (Y/N) ";
INPUT CONTINUE
IF ( CONTINUE # "Y" ) &
THEN GOTO QUIT
PRINT TAB(10,10); "File to reformat (NNNNNN.NNN)";
INPUT IN'FILESPEC
NAME'LEN = INSTR(1,IN'FILESPEC,".")
LOOKUP IN'FILESPEC, EXIST
IF ( EXIST = 0 ) &
THEN PRINT TAB(10,10); "That file does not exist" &
: STOP &
: GOTO HOUSEKEEPING
OPEN #1, IN'FILESPEC, INPUT
OUT'FILESPEC = LEFT$(IN'FILESPEC,NAME'LEN) + "RFM"
OPEN #2, OUT'FILESPEC, OUTPUT
! MAINLINE:
PRINT TAB(12,24); "The line# being processed is ";
FOR COUNTER = 1 TO 10000
PRINT TAB(12,55); COUNTER;
IF ( EOF(1) # 0 ) &
THEN COUNTER = 10000 &
: GOTO NEXT'IN'LINE
INPUT LINE #1, IN'LINE
LINE'LEN = LEN(IN'LINE)
FOR COUNTER2 = 1 TO LINE'LEN STEP 80
OUT'LINE = MID$(IN'LINE,COUNTER2,80)
CALL CONTROL'ERASE
PRINT #2, OUT'LINE
NEXT COUNTER2
NEXT'IN'LINE:
NEXT COUNTER
EXIT:
CLOSE #1
CLOSE #2
PRINT TAB(23,01); "The file has been reformatted"
QUIT:
END
!!!!!!!!!!!!!!!!!!!!!!!
! PROGRAM SUBROUTINES !
!!!!!!!!!!!!!!!!!!!!!!!
CONTROL'ERASE:
CLEAN'LINE = SPACE$(80)
XCALL STRIP, CLEAN'LINE
FOR CHAR'NUM = 1 TO 80
CHAR = MID$(OUT'LINE,CHAR'NUM,1)
IF ( ASC(CHAR) > 31 ) &
AND ( ASC(CHAR) < 127 ) &
THEN CLEAN'LINE = CLEAN'LINE + CHAR
NEXT CHAR'NUM
OUT'LINE = CLEAN'LINE
RETURN
!!!!!!!!!!!!!!!!!!!!!!!!
! STANDARD SUBROUTINES !
!!!!!!!!!!!!!!!!!!!!!!!!
ERR'ROUTINE:
! Check for AlphaBASIC error
IF ( ERR(0) = 0 ) &
THEN GOTO ISAM'ERROR
! Display Basic error
PRINT TAB(-1,0) ! Clear Screen
PRINT TAB(12,15); "?? Fatal AlphaBASIC Error "; STR$(ERR(0))
IF ( ERR(1) ) &
THEN PRINT TAB(13,15); " at line "; STR$(ERR(1))
IF ( ERR(2) ) &
THEN PRINT TAB(14,15); " on Channel "; STR$(ERR(2))
GOTO ERROR'ABORT
ISAM'ERROR:
! IF (
ERROR'ABORT:
PRINT TAB(20,15); "!! Contact System Operator Immediately !!"
PRINT TAB(21,01);
END
! ******* END OF UTFIXL.BAS *******
