\ 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 fgetline.fth

only forth also hidden definitions

variable ftob-#lines
: sanitize	( adr len -- )	\ Convert control characters to blanks
	bounds
	?do	i c@  bl <  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 @ close  ifd @ close ;
: "ftob  ( in-file-name out-file-name -- )
	new-file  read-open  (ftob ;
: ftob  \ stream-file-name block-file-name ( -- )
	blword save-string  blword  "ftob ;

only forth also definitions
