1 line
7.0 KiB
Plaintext
1 line
7.0 KiB
Plaintext
\ BLK2TXT - Information Convert forth screen files to ascii text. \ BLK2TXT - Load screen FORTH DEFINITIONS DECIMAL APPLICATION 2 LOAD \ compile program TURNKEY MAIN BLK2TXT \ create turnkey application \ BLK2TXT - HELP ARGV GETARG \ Show help : HELP ( -- ) ." Usage: BLK2TXT file[.SCR] file[.TXT]" CR ." Convert Forth screen files to ASCII text." 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 ; --> \ BLK2TXT - F1 F2 FERROR H1 H2 \ Filename buffers CREATE F1 80 ALLOT CREATE F2 80 ALLOT \ Display filename and exit : FERROR ( adr -- ) COUNT TYPE ABORT ; \ File handles VARIABLE H1 VARIABLE H2 --> \ BLK2TXT - GETLN PUT COPY-FILE \ Read a line (64 chars max), u = #chars actually read : GETLN ( -- u ) PAD 64 H1 @ READ-FILE ABORT" read error" ; \ Write u chars to output file : PUT ( u -- ) PAD SWAP -TRAILING H2 @ WRITE-LINE ABORT" write error: probably out of disk space" ; \ Copy loop : COPY-FILE ( -- ) BEGIN GETLN ?DUP WHILE ( not end-of-file ) PUT REPEAT ; --> \ BLK2TXT - OPEN-FILES \ Open source and destination files : OPEN-FILES ( -- ) 1 GETARG S" SCR" +EXT 2DUP F1 PLACE R/O OPEN-FILE \ open 1st IF ." can't open: " F1 FERROR THEN H1 ! \ save handle 2 GETARG S" TXT" +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 --> \ BLK2TXT - 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 ." BLK2TXT" CR OPEN-FILES COPY-FILE CLOSE-FILES ." file copied" CR ; |