1 line
9.0 KiB
Plaintext
1 line
9.0 KiB
Plaintext
\ TXT2BLK - Information Convert ascii text files to forth screens. A minor quirk with this utility is that if a text line is exactly 64 characters then an extra blank line will appear in the screen file. This can be avoided by using the -T option; however lines greater than 64 characters will be truncated. The -1 switch permits writing one line per screen. \ TXT2BLK - Load screen FORTH DEFINITIONS DECIMAL APPLICATION 2 #SCREENS 1- THRU \ compile program TURNKEY MAIN TXT2BLK \ create turnkey application \ TXT2BLK - HELP ARGV GETARG \ Show help : HELP ( -- ) ." Usage: TXT2BLK [-opt] file[.TXT] file[.SCR]" CR ." Convert ASCII text files to Forth screens." CR ." -T truncate lines" CR ." -1 one line per screen" CR ; \ Parse blank delimited argument from commandline. : ARGV ( n -- adr u -1 | 0 ) 0 0 ROT 128 COUNT ROT 0 ?DO 2NIP BL SKIP 2DUP BL SCAN ROT OVER - -ROT LOOP 2DROP DUP IF -1 ELSE AND THEN ; \ Get argument, if none show help and exit : GETARG ( n -- adr u ) ARGV 0= IF HELP ABORT THEN ; \ TXT2BLK - F1 F2 H1 H2 CNT TFLAG 1LINE C/L FERROR \ Filename buffers CREATE F1 80 ALLOT CREATE F2 80 ALLOT \ File handles VARIABLE H1 VARIABLE H2 VARIABLE CNT VARIABLE TFLAG VARIABLE 1LINE 64 VALUE C/L 1024 VALUE B/BUF \ Display filename and exit : FERROR ( adr -- ) COUNT TYPE ABORT ; \ TXT2BLK - CLEAN BLANKBUF GETLN \ Convert tabs or control chars in text to blanks : CLEAN ( -- ) PAD B/BUF OVER + SWAP DO I C@ BL MAX I C! LOOP ; \ Fill text buffer with blanks : BLANKBUF ( -- ) PAD B/BUF BLANK ; \ Read a line : GETLN ( -- flag ) PAD B/BUF + DUP C/L TFLAG @ IF 2* THEN H1 @ READ-LINE ABORT" read error" >R PAD CNT @ + SWAP C/L MIN CMOVE R> ; \ TXT2BLK - PUT COPY-FILE \ Write buffer to output file : PUT ( -- ) CLEAN PAD B/BUF H2 @ WRITE-FILE ABORT" write error: probably out of disk space" BLANKBUF CNT OFF ; \ Copy loop : COPY-FILE ( -- ) BLANKBUF CNT OFF BEGIN GETLN WHILE ( not end of file ) C/L CNT +! CNT @ B/BUF = IF PUT THEN REPEAT CNT @ IF ( buffer not empty ) PUT THEN ; \ TXT2BLK - PARSEOPT \ Get commandline options : PARSEOPT ( -- arg# ) 64 TO C/L TFLAG OFF 1 DUP GETARG S" -1" COMPARE 0= IF B/BUF TO C/L 1+ THEN DUP GETARG S" -T" COMPARE 0= OVER GETARG S" -t" COMPARE 0= OR IF TFLAG ON 1+ THEN ; \ TXT2BLK - OPEN-FILES \ Open source and destination files : OPEN-FILES ( -- ) PARSEOPT DUP GETARG S" TXT" +EXT 2DUP F1 PLACE R/W OPEN-FILE \ open 1st IF ." can't open: " F1 FERROR THEN H1 ! \ save handle 1+ GETARG S" SCR" +EXT 2DUP F2 PLACE 2DUP R/O OPEN-FILE NIP 0= \ create 2nd IF ." file exists: " F2 FERROR THEN R/W CREATE-FILE IF ." can't create: " F2 FERROR THEN H2 ! ; \ save handle \ TXT2BLK - CLOSE-FILES MAIN \ Close source and destination files : CLOSE-FILES ( -- ) H1 @ CLOSE-FILE IF ." error closing: " F1 FERROR THEN H2 @ CLOSE-FILE IF ." error closing: " F2 FERROR THEN ; : MAIN ( -- ) CR ." TXT2BLK" CR OPEN-FILES COPY-FILE CLOSE-FILES ." file copied" CR ; |