\ Simplified ANS Forth array input

FALSE [IF]
        Copyright (c) 1998  Julian V. Noble.
        Permission is granted by the author to
        use this software for any application pro-
        vided this copyright notice is preserved.

The file must be in the following format:

    1. The first line is an integer (1=real or 2=complex) followed by
       the length of the array: a complex array of length 64 would then
       have the first line 2 64 .

    2. Each array element must be on a new line, and the numbers are
       in floating point format (number followed by E with optional
       exponent). Thus a line corresponding to a complex array element
       might be  93.72E  -5.7E-2 .

    3. A line must, apparently, begin with a blank character and end with
       a hard carriage return.

Environmental dependencies:
    assumes separate floating point stack
    requires FLOAT, FILE and TOOLS EXT wordsets

\ -----------------------------------------------------------------------
\ conditional compilation
\ -----------------------------------------------------------------------
BL PARSE undefined DUP PAD C! PAD CHAR+ SWAP CHARS MOVE PAD FIND NIP 0=
[IF]  : undefined    BL WORD  FIND  NIP  0=  ;   [THEN]

[THEN]

MARKER  -input

undefined 1array  [IF]
    : long   ;
    : 1array    ( len data_size --)     CREATE  2DUP  ,  ,  *  ALLOT   ;
    : _len      ( base_addr -- len)  \ determine length of an array
            CELL+  @  ;
    : }         ( base_adr indx -- adr[indx] )
            OVER  _len  OVER  <=  OVER  0<  OR  ABORT" Index out of range"
            OVER  @   *  +  CELL+  CELL+  ;
[THEN]

undefined z!  [IF] : z!  DUP  FLOAT+  F!  F! ;  [THEN]

0 VALUE  myfile
0 VALUE  data_len
0 VALUE  data_type

: get_line    ( fileid -- iax)
        PAD  40  ROT  READ-LINE
        0=  AND  IF     PAD 1+  SWAP   EVALUATE
                 ELSE   ." Could not get line" ABORT  THEN  ;

\ fill an array from a file containing 1 elt/line
\ the first line contains data_type and data_length
\   1=real, 2=complex

: check_size    ( base-adr --)    \ check array size
    _len  data_len <   ABORT" Array too small to hold file!"  ;

: fill_array    ( base-adr Ndata --)
    0  DO
        DUP  I  }  myfile  get_line
        data_type
        CASE  1  OF  F!  ENDOF
              2  OF  z!  ENDOF
        ENDCASE
    LOOP
    DROP  ;

: closed?       ( ior --)
    0=   IF   ." File closed."  ELSE  ." File not closed!"  THEN  ;


: }from     ( adr "file_name" --)   \ fill 1array from file
    BL WORD                                 \ get filename
    COUNT   R/O         ( c-addr u fam)     \ "fam" = file access method
    OPEN-FILE           ( -- fileid ior )
    0=                                      \ ior = 0 if successful
    IF   TO  myfile                         \ save file handle
         myfile get_line                    \ first line: type & size
         TO  data_len   TO data_type
         DUP  check_size
         data_len  fill_array               \ get the rest of the lines
    ELSE   ." FILE I/O failed"  ABORT    THEN
    myfile  CLOSE-FILE   closed?   ;


\ Ex:  a{ }from  filename