/*
   yorick functions to read and write FORTRAN binary files
   contributed by David Syer

Dave,

Here's my seqio.i with functions for FORTRAN sequential IO.  To mimic
ftell, and keep track of the file position I cheat and use get_addrs.
Files pretty much have to be strictly sequential, but I've provided
_len_rec to take a peek ahead without altering the value of _ftell.  I
suppose other functions could be written which take a peek at
non-integer values in the next read-position.

Writing structs works best with my new get_vars(struct) function (see
_struct_write), but will only fail if the file to be written has
different primitives than the native format.

I haven't implemented your suggestion of a _setup_rec function, but
I've added some low level routines _{read,write}_bare which could be
used to write C-style sequential files, or records with different
kinds of padding.  (I didn't call them _fread,_fwrite because their
syntax is a bit different.) I used them already to write records which
correspond to some weird fortran output statements.

Dave.
*/

func _ftell(f)  // like ftell
{ 
  local addr;
  addr= *(get_addrs(f)(1));
  if(is_void(addr)) addr= 0;
  else addr= addr(0) + sizeof(get_member(f,(*get_vars(f)(1))(0)));
  return addr;
}

func _write_rec(f,..)
/* DOCUMENT _write_rec, f, var1, var2
     write record to fortran file from var1, var2, ..
     return number of bytes written (excluding padding)
   SEE ALSO: _read_rec
*/
{
  local addr, pn0, pn1;
  addr= _ftell(f);
  pn0= swrite(format="pad%d",addr);
  add_variable,f,-1,pn0,int;
  addr+= sizeof(get_member(f,pn0));
  local size, arg;
  size=0;
  while(more_args()>0) {
    local len;
    arg= next_arg();
    len= _write_bare(f,arg);
    size+= len; addr+= len;
  }
  pn1= swrite(format="pad%d",addr);
  add_variable,f,-1,pn1,int;
  get_member(f,pn0)= get_member(f,pn1)= size; 
  return size;
}

func _read_rec(f,..)
/* DOCUMENT _read_rec, f, &var1, &var2, ..
     read record from fortran file into var1, var2, ..
     return number of bytes written (excluding padding)
   SEE ALSO: _write_rec
*/
{
  local addr, pn0, pn1;
  addr= _ftell(f);
  pn0= swrite(format="pad%d",addr);
  add_variable,f,-1,pn0,int;
  addr+= sizeof(get_member(f,pn0));
  local size0, size, arg;
  size0=get_member(f,pn0); size=0;
  while(more_args()>0) {
    local len;
    arg= next_arg();
    len= _read_bare(f,arg);
    size+= len; addr+= len;
  }
  pn1= swrite(format="pad%d",addr);
  add_variable,f,-1,pn1,int;
  if(size!=size0) error,"Wrong record length";
  return size;
}

func _len_rec(f)
/* DOCUMENT _len_rec,f
     return length of next record in sequential fortran file
*/
{
  local addr, len;
  addr= _ftell(f);
  len= 0;
  _read,f,addr,len;
  return len;
}

func _write_bare(f,arg,size)
/* DOCUMENT _write_bare, f, arg, size
     write var to file f in a record of size bytes
     if size is omitted just use sizeof(f.arg)
     return numberof bytes written
*/
{
  local addr, name, len;
  addr= _ftell(f);
  name= swrite(format="%s%d",typeof(arg),addr);
  add_variable,f,-1,name,structof(arg),dimsof(arg);
  if(typeof(arg)=="struct_instance") {
    _struct_write,f,arg,name;
  } else {
    get_member(f,name)= arg;
  }
  len= sizeof(get_member(f,name));
  if(is_void(size)) size= len;
  addr+= len;
  if(len<size) {
    name= swrite(format="char%d",addr);
    add_variable,f,-1,name,char,size-len;
    get_member(f,name)= array(char,size-len);
  }
  return size;
}

func _read_bare(f,arg,size)
/* DOCUMENT _read_bare, f, &arg, size
     read var from file f in a record of size bytes.
     if size is omitted just use sizeof(f.arg)
     return numberof bytes read

   N.B. if arg is not a pointer and it is scalar (e.g. long, float, ...), 
     then its value will not change.
*/
{
  local addr, name, len;
  if(typeof(arg)=="pointer" && typeof(*arg)=="void") {
    // do nothing if arg is void
    error,"Invalid pointer passed to _read_bare";
  }
  addr= _ftell(f);
  if(typeof(arg)!="pointer") {
    name= swrite(format="%s%d",typeof(arg),addr);
    add_variable,f,-1,name,structof(arg),dimsof(arg);
    if(dimsof(arg)(1)==0) 
      write,"Warning: cannot assign to scalar";
    arg= get_member(f,name);
  } else {
    name= swrite(format="%s%d",typeof(*arg),addr);
    add_variable,f,-1,name,structof(*arg),dimsof(*arg);
    *arg= get_member(f,name);
  }
  len= sizeof(get_member(f,name));
  if(is_void(size)) size= len;
  size= min(size,sizeof(f)-addr);
  addr+= len; 
  if(len<size) {
    name= swrite(format="char%d",addr);
    add_variable,f,-1,name,char,size-len;
  }
  return size;
}

func _skip_rec(f,nrec)
/* DOCUMENT _skip_rec, f, nrec
     skip nrec records in a fortran file (default 1)
     return number of records skipped
*/
{
  if(is_void(nrec)) nrec=1;

  local i;
  for (i=1;i<=nrec;i++) {
    local addr, pn0, ch, pn1;

    addr= _ftell(f);
    pn0= swrite(format="pad%d",addr);
    add_variable,f,-1,pn0,int;
    addr+= sizeof(get_member(f,pn0));

    local size;
    size=get_member(f,pn0);
    ch= swrite(format="char%d",addr);
    add_variable,f,-1,ch,char,size;
    addr+= sizeof(get_member(f,ch));

    pn1= swrite(format="pad%d",addr);
    add_variable,f,-1,pn1,int;
  }

  return --i;
} 

func _struct_write(f,sin,sname) 
/* DOCUMENT _struct_write, f, sin, sname
     write sin (structure) to f.sname, where sname is a string
   SEE ALSO: 
*/
{
  local i,nlist;
  if(typeof(f)!="stream") error,"f must be a binary stream";
  if(noneof(*get_vars(f)(1)==sname)) error,"No struct of that name in f";

  if(is_void(get_vars_struct)) {
    // This will fail in certain circumstances
    get_member(f,sname)= sin;
    return 1;
  } else {
    // so use get_vars(struct) to find member names
    nlist= get_vars(sin); 
    for(i=1;i<=numberof(nlist);i++) {
      get_member(get_member(f,sname),nlist(i))= get_member(sin,nlist(i));
    }
    return --i;
  }
}