\ Convert from a stream file to a block file.
\
\ Stream files contain variable-length lines terminated
\ by a newline character, without trailing blanks.  Characters
\ are lower case.
\
\ Block files contain a sequence of records each with c/l
\ (usually 64) upper case characters.
\
\ Any lines in the stream file which are longer than c/l characters
\ are truncated.  Any control character (including tab) in the
\ stream file is changed to a blank in the block file.
\
\ ftob   \ stream-filename block-filename  ( -- )
\ "ftob  ( stream-filename block-filename -- )
\ (ftob  ( -- )
\	Convert stream file in ifd to block file in ofd

only forth also definitions
needs fgetline extend/filetool.fth

only forth also hidden definitions

64 constant c/l
variable ftob-#lines
: sanitize	( adr len -- )	\ Convert control characters to blanks
	bounds
	?do i c@ dup bl < swap h# 7f = or if bl i c! then
	loop ;
: ftob-file	( -- )
	ftob-#lines off
	begin	pad c/l 1+ blank
		pad ifd @  fgetline		( string flag)
	while	count dup c/l >
		if  ." Truncating: " 2dup type cr  then  ( adr len )
		2dup upper   2dup sanitize   ( adr len )
		drop c/l  ofd @ fputs
		1 ftob-#lines +!
	repeat ;
: roundup	( n1 boundary -- n2 )	\ Round n1 up to next mod "boundary"
	tuck 1- +			( boundary  n1+ )
	over / * ;
only forth hidden also forth definitions

: (ftob		( -- )		\ Convert stream file at ifd to block file at ofd
	ftob-file
	\ Extend the block file to a multiple of 16 lines
	pad c/l 1+ blank
	ftob-#lines @ d# 16 roundup   ftob-#lines @
	?do  pad c/l ofd @ fputs  loop
	ofd @ fclose  ifd @ fclose ;
: "ftob  ( in-file-name out-file-name -- )
	new-file  read-open  (ftob ;
: ftob  \ stream-file-name block-file-name ( -- )
	blword astring "move blword  "ftob ;

only forth also definitions
