Test new READ-LINE

empty

0 value ifid
0 value ofid

: readtext0 ( a u1 -- a u2 flag )  over swap ifid read-line throw ;

\ EOL string
 here  2 c, 13 c, 10 c,  count 2constant (cr) ( -- a u )
\ here  1 c, 10 c,        count 2constant (cr) ( -- a u )
\ here  1 c, 13 c,        count 2constant (cr) ( -- a u )

\ EOL scanner
: /EOL ( a u -- u' offs )
   over swap  begin  dup while
     over c@ dup $0D - while  $0A - while  1 /string
   repeat  \ got LF
     drop swap - dup 1+  exit
   then  \ got CR
     2drop tuck swap - swap 1+ c@ $0A <> over + 2 +  exit
   then  \ neither
   drop swap - dup ;

\ READ-LINE alternate spec
\ buffer size at least u chars and a minimum of one
\ n3: 0 = EOF, -1 = EOL received, 1 = EOL not received
: READ-LINE ( a u1 fid -- u2 n3 ior )
  >r  2dup r@ read-file
  dup if  r> drop  nip  exit  then  \ ior
  over 0= if  r> drop  2swap 2drop  0  exit  then  \ EOF
  drop  >r  tuck  1- r@ min  /eol  r> - s>d
  r@ file-position drop  d+  r> reposition-file drop
  tuck 1+ = 2* 1+  0 ;

: writedata ( a u -- )  ofid write-file throw ;
: readtext ( a u1 -- a u2 flag )  over swap ifid read-line throw ;

: open ( a u -- )  r/o open-file throw to ifid ;
: make ( a u -- )  r/w create-file throw to ofid ;
: closein  ( -- )  ifid close-file drop ;
: closeout ( -- )  ofid close-file drop ;

: ?cr ( flag -- )  if  (cr) writedata  then ;

5 value bufsize

: read&write ( a u a2 u2 -- )
  2swap 2dup open
  cr ." Reading: " type ."  using READ-LINE u1 = " bufsize . cr
  cr ." Writing: " 2dup type ."  u2 chars using WRITE-FILE;"
  cr ." also EOL sequence when flag = 1" cr
  make
  0  begin
    ?cr  pad bufsize readtext  dup while  \ not done
    ( a u2 flag) >r  writedata  r> 1+
  repeat drop drop drop
  closein  closeout ;

: make-test ( a u -- )
  cr ." Making text file: " 2dup type cr  make
  s" 123456789"
  2dup 8 - writedata (cr) writedata
  2dup 7 - writedata (cr) writedata
  2dup 6 - writedata (cr) writedata
  2dup 5 - writedata (cr) writedata
  2dup 4 - writedata (cr) writedata
  2dup 3 - writedata (cr) writedata
  2dup 2 - writedata (cr) writedata
  2dup 1 - writedata (cr) writedata
           writedata (cr) writedata
  closeout ;

: show ( a u -- )
  cr ." Showing: " 2dup type   open
  cr  begin  pad 100 readtext0 while type cr repeat 2drop
  closein ;

: foobar
  page
  s" FOO" make-test  s" FOO" show
  s" FOO" s" BAR" read&write  s" BAR" show ;

foobar