/***********************************************
        File selection procedure.


Syntax:
 {filename,dirname,usename}=g_askfil(oldfile,olddir,tempdir,g_only,sortby,header)
or
 {filename,dirname,usename}=g_askfil2(oldfile,olddir,tempdir,g_only,sortby,header,filter)

    filename : name of file returned.
    dirname : directory of filename (filename will include directory info)
    usename : gauss file corresponding to filename (if g_only=2)

    oldfile : default filename (if ENTER hit, or ESC hit)
    olddir  : directory to start in (relative oldfile is relative to this directory)  
    tempdir : tempdir (where generated gauss datasets    will be stored)
    g_only : 0=all files, 1 = gauss data files only,  2= all files, but convert to gauss datafile
	     3= choose between 1 and 2
    sortby : "" -- default (by name)
	     "SIZE" -- byte size
	     "DATE" -- last modification date
             "NAME"    -- no sort (same as default)
	     "-SIZE" -- byte size (large to small)
	     "-DATE" -- reverse date (latest to oldest)
	     "-NAME"  -- reverse (Z to A)
	
    header : header message. If "", use default message 
    filter: if 0, or "", display all files. Otherwise, only display files that match the filter.
	    For example, "*.IN" means "only display files that have a .IN extension"

Notes: 
  *  G_only=0 should be used if you want to select a non-data file

  *  If g_only>0, usename will point to a temporary file that contains a gauss dataset that
     is the same as the chosen gauss dataset, or is built from a chosen text file
     (the chosen text file's name is returned in filename). 

  * In  all other cases (when g_only = 0 or 1, or 3 with gauss chosen), usename will be the same as filename.

   *  Thus, if g_only =1 or 2 or 3, usename is the file that should be "opened" as a gauss dataset.
******************************************************/


@ Old version, with no filter @
proc (3)=g_askfil(oldfile,olddir,tempdir,g_only,sortby,header); 
  local filter,a,b,c;
  filter="";
  {a,b,c}=g_askfil2(oldfile,olddir,tempdir,g_only,sortby,header,filter); 
  retp(a,b,c);
endp;


proc (3)=g_askfil2(oldfile,olddir,tempdir,g_only,sortby,header,filter); 

 local ihlp,a,b,iarg,ans,nvars,nobs,dfnm,im,dd,ido,grblpath,tmp_path;
  local iok,atmp,grbl_tmn,tmp,foo;
  local dat_type,thedir,g_only0;
  local full_Filename ;

whichtyp: ;
if header $/= "" ; call boldon ;
    print header ; 
   call normalon ; 
   print " " ;
endif;

g_only0=g_only;


if g_only==3 ;  @ aSK IF GAUSS OR ASCII DATA FILE .... @
do while 1==1 ;

 {dat_type,ihlp}=g_yes_no(" Use GAUSS dataset (NO=ASCII dataset, F1=HELP, ESC=Cancel)",1);
  if scalmiss(ihlp) ;           @ ESC hit @
       retp(oldfile,olddir,oldfile);
  endif;
  if ihlp ne 0 ;
     ? ; ? ;
    call boldon ; call cyanon ;
     " This program can work with two different varieties of data files:";
    call normalon ;

?;" 1)" ;; call boldon; " GAUSS datafiles. "; call normalon ;
 "     GAUSS datafiles are special files that GAUSS can work with directly.
      They are typically created using the ATOG program.";

?;" 2)" ;; call boldon; " ASCII datafiles. "; call normalon ;
"  ASCII datafiles are simply 'text' files containing your data.
   Each value should be seperated by either spaces, a comma, or  a new line.
   You need NOT have all values for a particular observation on a single line.

NOTES:  GAUSS datafiles are (for practical purposes) not limited in size.
        ASCII datafiles are limited by the amount of memory in your system.
        If you use an ASCII datafiles, you will be given the opportunity of
        creating a GAUSS datafile from your data.
        All text enclosed within '@' characters is treated as comments (and
        is ignored).
";
    continue  ;

  else ;
        g_only=2-dat_type ;
	break ;
  endif;
endo;
endif;

if g_only==0 ;   if header$=="" ; header="Select a file" ; endif;
elseif g_only==1 ; if header$=="" ; header="Select a GAUSS data set " ; endif;
elseif g_only==2 ; if header$=="" ; header="Select a text file to convert to a GAUSS data set " ; endif;
endif;


{thedir,filename}=g_askfil_main(oldfile,olddir,g_only,sortby,header,filter);

full_filename=g_exists(filename,thedir);

@ Now, if ASCII,  a little processing before we are done . @


@ GAUSS dataset selected ..... @
if g_only==1 ;
   foo=csrlin ;
   if filename$=="";
      call g_askfil_showline(foo,0," No dataset selected ") ;?;
      call g_pause(0.2,0);
      retp("","","");      @ Nothing more to be done @
   else;
      call g_askfil_showline(foo,0," GAUSS dataset selected: " $+ filename) ;?;
      call g_pause(0.2,0);
      filename=g_fspec2("A",filename,thedir);
      tmp=filename$+".DAT";
      retp(tmp,thedir,filename);      @ Nothing more to be done @
   endif;
endif;

if g_only0==0 ;    @ no conversion @
   foo=csrlin ;
    call g_askfil_showline(foo,0," File selected: " $+ filename) ;?;
    call g_pause(0.2,0);
    filename=g_fspec2("A",filename,thedir);
    retp(filename,thedir,filename);      @ Nothing more to be done @
endif;


@  -----  IF ASCII, get info and create temp file ....@
cls ;
" ASCII data file selected: " ;; call boldon ; $filename ; call normalon ;
"
 You must provide some information on the structure of this data set:
   1) The number of variables (columns)
   2) The number of observations (rows)

(note that each variable in the dataset should be separated by a space,
 a comma, or a carriage return).
"; ?;
tbutt: ;
  {nvars,iarg}=g_askval(" Enter # of VARIABLES (ESC=Exit, F2=Preview)",0);
  if missrv(iarg,27)==27 ;
       " Cancel " ; retp(filename,thedir,miss(1,1));
  endif ;
  if iarg==1059 ;       @ F1 @
   "      Enter the number of VARIABLES (columns) in the dataset.
      If you enter an incorrect number, the results will be wrong in an
      unpredictable fashion." ;
      goto tbutt ;
  elseif iarg==1060 ;
      call g_askfil_preview(full_filename,"Previewing "); ?;?;
      goto tbutt ;
  endif;
tbutt2: ;
?;
  {nobs,iarg}=g_askval(" Enter # of OBSERVATIONS (ESC=Exit, F2=Preview)",0); 
  if missrv(iarg,27)==27 ; " Cancel " ;
       " Cancel " ; retp(filename,thedir,miss(1,1));
   endif ;
  if iarg==1059 ;
   "      Enter the number of OBSERVATIONS (rows) in the dataset.
      You can enter fewer then the actual number of observations.
      If you enter MORE then the actual number of observations,
      the results will be wrong in an unpredictable fashion." ;
      goto tbutt2 ;
  elseif iarg==1060 ;
      call g_askfil_preview(full_filename," Previewing  "); ?; ?; ?;
      goto tbutt ;
  endif;

 TMP=CORELEFT/10;
 IF TMP< (NVARS*NOBS*8) ;
    " Sorry: not enough memory to load this ASCII datafile... ";?;
    call g_pause(10,-1);
    goto whichtyp ;
 endif;

@ Double check @
 format /ld 5,0 ;
 ?; " You selected: " nvars " variables, and " nobs " observations.";
  tmp=g_yesno(" Is this okay ",1);
  if tmp==0 ; goto tbutt ; endif;

@ Get variable names, use X.. as default @
 cLS ; format /ld 5,0 ;
" Enter the names for the " nvars " variables (hit ESC to use Xnn defaults)...";
 im=0;
 dfnm=0 $+ "X" $+ ftocv(seqa(1,1,nvars),3,0);
 do until im==nvars ;
   im=im+1; format /ld 5,0;
honkie1: ;
   " Variable # " im "  (ENTER= " $dfnm[im] " ):";; ans=g_cons2 ;?;
   if ans$=="?" ;ans=1059 ; endif;      @ a hack @
   if type(ans)==6 ;
       if missrv(ans,27)==27 ;
          break ;
       elseif ans==1059 or  ans==1035 ;  @ f1 or alt-h@
          format /ld 5,0;?;
"  You MUST select variable names for the  " nvars " variables in your
   dataset.  You will use these names later to select independent, dependent,
   and other variables. ";
         goto honkie1 ;

       else;
         goto honkie1 ;
       endif;
   else ;
        if ans $/="" ;
          dfnm[im]=upper(ans) ;
        endif;
   endif;

 endo;

@ Get the data ! @
call normalon ; call blinkon ;
?; ?;  " ... loading data, please wait .... ";?;
call normalon ;
 dd=g_askfil_loadascii(full_filename,nobs,nvars);

@ Save as temp, or permanent, data set @
makeperm: ? ;
   call g_pause(0.15,0);  @clear keystroke buffer @
    {ido,ihlp}=g_yes_no(" Create a permanent GAUSS data set? ",0);
    if scalmiss(ihlp);
       " Cancel " ; retp(filename,thedir,miss(1,1));
    endif ;

    if ihlp ne 0 ;
"
    Answer YES if you with to retain the 'ascii' dataset
(you just read) as a permanent 'GAUSS' dataset (which can then be
called later).  NO will cause a temporary dataset to be created, which
will be deleted when the program finishes. ";
      goto makeperm ;

   endif;

@ temporary ... @
   if ido==0;           @ temporary -- where should it go ? @
     if tempdir$=="" ; tempdir=thedir;endif;
     grbl_tmn=g_fspec2("A","GRBL_TMP",tempdir);
     IOK=SAVED(DD,grbl_tmn,DFNM);

     IF IOK==0 ;
  "
    PROBLEM SAVING TEMPORARY DATA FILE -- PROBABLY BECAUSE OF LACK OF SPACE.
    TRY SAVING THE DATA AS A PERMANENT GAUSS DATASET. ";
        GOTO MAKEPERM ;
     else ;
         " ... temporary GAUSS data set created on " $tempdir ;
         call g_pause(0.2,0);
     ENDIF;

@ Permanent @
   else ;

gtnam:  " Enter name to use:" ;; grbl_tmn=upper(g_cons2);?;
        if type(grbl_tmn) ==6 ;
           if grbl_tmn==63 or grbl_tmn==1059 or grbl_tmn==1025 ;
  "
    Enter a file name (and a directory) for the permanent GAUSS dataset.
    Do NOT enter an extension; a default extension of .DAT and .DHT will
    be used (2 files are created). ";
               goto gtnam ;
            elseif missrv(grbl_tmn,27)==27 ;
               " Cancel " ; retp(filename,thedir,miss(1,1));
            endif;
         endif;
         if strindx(grbl_tmn,".",1) > 0 ;
             " Please re-enter name WITHOUT extension ! ";
             goto gtnam ;
         endif;
         if files(grbl_tmn$+".DAT",0) $/=0 ;  @ name exists @
            ido=g_yesno(" File exists: Overwrite? ",0);
            if ido==0 ;
                 " Please choose a different name ... ";
                 goto gtnam ;
            endif;
        endif;

       if tempdir$=="" ; tempdir=thedir;endif;
       grbl_tmn=g_fspec2("A", grbl_tmn,tempdir);

       IOK=SAVED(DD,grbl_tmn,DFNM);
       IF IOK==0 ;
  " PROBLEM SAVING PERMANENT DATA FILE -- PROBABLY BECAUSE OF LACK OF SPACE.
    TRY SAVING THE DATA IN A DIFFERENT DRIVE ... ";
        GOTO MAKEPERM ;

     else ;
         " ... permanent GAUSS data set created: " $grbl_tmn ;
         call g_pause(7,0);
     ENDIF;

   endif;
   filename=g_fspec2("A",filename,thedir);

   retp(filename,thedir,grbl_tmn);

endp;
@retp@

/*************/
proc g_askfil_preview(b,prompt);
     local gee,infile,gotfree,af;
      cls ;
      if g_exists(b,"") $=="" ;
	  "No such file: " $b ;
           call g_pause(2,-1); retp(0);
      endif;
      gee=getf(b,1);
      call cyanon ; $prompt ;; $b ; call normalon ;
      call blockon  ;" (ESC when done..)"; call normalon ;
      call g_dsptxt(3,22,gee,&boldon,&cyanon);
      ?;
    retp(0);
endp;



/*********************/
@ Get data from ascii file.  Similar to LOAD x[n,m]=filename ; but
less sensitive to screw ups (set things to missing if any ? @

proc g_askfil_loadascii(fll,nobs,nvars);

local nr,nc,a,b,ie,ic,ir,tmp,aword ;

a=files(fll,0);
if a==0; errorlog "No such dataset (g_askfil_loadascii): " $+ fll;
retp(miss(1,1)); endif;

a=getf(fll,1);
nr=nobs; nc=nvars ;
a=g_zapcmt(a,"@");

ie=1; ic=0;ir=1;
tmp=zeros(nr,nc);
tmp=miss(tmp,0);
" .. parsing dataset, please wait .... ";
do until ie==0;
  {aword,ie}=g_getwrd(a,ie);
  if ie==0 ; break ; endif ;
  ic=ic+1;
  tmp[ir,ic]=stof(aword);
  if ic==nc ;
     ic=0; ir=ir+1;
     if ir gt nr ;
        break ;
     endif ;
   endif;
   ie=ie+1;
endo ;
retp(tmp);
endp;


/***********************/
@ select a data file: given current default datafile, current
  default data directory, and type of file to select (GAUSS or ASCII)
  Returns datafile,datadir
@

PROC (2)= g_askfil_main(DATAFIL0,DATADIR0,isdht,sortby,header,filter);

  local  shtname,irow,ddhts,curpath,cdhts,nowfile,ans,iat0,iat;
  local foo,alldone,ans0,nowfile0,dfath,datafile,tmp,tmp2,ok_file,theans ;
  local inew,filelist,dirlist,curpath0,matchat ;
local subdir_smtx,file_smtx,usubdir_smtx;
local file_row1,subdir_row1 ;
local ufile_smtx,ii,jj,uans,tmp1,soldmatch,smatchat;
LOCAL PROMPT_ROW,newdir,toprow,ithl,dpath,dpath2 ;
local say_files,samess,famess,srange,frange,sub_r1,file_r1,f1list;
local file_sindex,subdir_sindex,s1list,pgsubs,header0;


sortby=g_strip(upper(sortby));
if scalmiss(indcv(sortby,"-NAME"|"NAME"|"SIZE"|"-SIZE"|"DATE"|"-DATE"));
  sortby="NAME";
endif;

cls; 
toprow=1 ;

shtname="" ;
if datafil0$/="" ; shtname=g_fspec("N",datafil0); endif;

curpath=g_is_dir(datadir0);     @ datadir0 may be set by caller @
if curpath$=="" ; curpath=g_is_dir(""); endif; @ if ugly, use current path @

curpath0=curpath ;		@ original starting directory @
nowfile=datafil0;  

ithl=0;
pgsubs=0 ;

famess="" ;samess=" ";

header0=header;
tmp1=trunc((80-strlen(header))/2);
if tmp1>1 ; 
   header=chrs(ones(tmp1,1)*32) $+ header;
  header=header $+ chrs(ones(tmp1,1)*32) ;
 endif;


START1: ;    	@ ======== jump here when new directory selected ===== @

if sortby$=="" ;
  say_files="Files: ";
else;
  say_files="Files (" $+ sortby $+ "): ";
endif;
if filter $/="";
  say_files=say_files $+ "[" $+ filter $+ "]" ;
endif;


f1list=1 ;   @ starting "first row" is row 1 (of displayed-matrix @
s1list=1 ;


ithl=ithl+1 ;    @ counter of times through this loop @
sub_r1=1 ; file_r1=1;  @ start at these rows of the file & dir string matrices @
ans="" ;
matchat=miss(1,1);   @ the index, info filelist, of current selection @

{filelist,dirlist}=g_askfil_dirlst(curpath,isdht,sortby,filter);    @ get list of files and subdirs under curpath @

WRITE_INFOLINEs:

call g_askfil_showline(toprow,"CYAN",header); ?;

if curpath$==curpath0 ;
    call g_askfil_write_curdir(curpath,"",toprow+1,"The default data directory:");
else;
    call g_askfil_write_curdir(curpath,"",toprow+1, "The Current directory:");
endif;
subdir_Row1=csrlin;

DISPLAY_DIRS: ;

call g_askfil_showline(subdir_row1,"BOLD","Subdirectories: "   );
?;
{subdir_smtx,subdir_sindex,smatchat}=askfil_make_mtx(dirlist,"");


{samess,srange}=askfil_showfiles(subdir_smtx,subdir_sindex,0,sub_r1,8);
usubdir_smtx=g_strip(upper(subdir_smtx));

DISPLAY_FILES:   
file_row1=csrlin ;
DISPLAY_FILES2:    ;

call g_askfil_showline(file_row1,"HILITEON",say_files);
?;
{file_smtx,file_sindex,matchat}=askfil_make_mtx(filelist,shtname);
{famess,frange}=askfil_showfiles(file_smtx,file_sindex,matchat,file_r1,20-file_row1);
ufile_smtx=g_strip(upper(file_smtx));


@ prompt .. @
PROMPT_row=csrlin ;
 
if famess$/=" " ; call g_askfil_showline(file_row1,"HILITEON",say_files $+ famess ); endif;
if samess$/=" " ; call g_askfil_showline(subdir_row1,"BOLD","Subdirectories: " $+ samess   ); endif;


if ithl gt 1 or pgsubs==1  ;  ans=1060 ; goto get_dirs ; endif;

GET_FILES:  ;   @ ============ ASK/CURSOR FOR A FILE NAME  -------- @


{ans,matchat}=g_askfil_select1(file_smtx,file_sindex,frange,ufile_smtx,matchat,FILE_ROW1,PROMPT_ROw, "Select file (F1=Help, F2=DIR):");

@     F1 = 1059, F2=1060, F3=1061,...,F9=1067
     HOME=1071,  PGUP=1073, END=1079, PGDN=1081
     Uparrow=1072   left=1075    right=1077 down=1080 @

@ ESC hit @
if scalmiss(ans);   retp(datadir0,datafil0);  ENDIF;  @ esc == use priors @

@ CRLF hit (use ans as filename) @

if type(ans)==13 ;
   if MISSRV(matchat,0)==0 ;  @ no match @ 
      goto get_Files ;   @ keep asking @
   endif;
   tmp2=fileLIST[MATCHAT];
   tmp=curpath;
   retp(tmp,tmp2);
endif;

if ans==1062 ;   @ F4 for sortby @
   if sortby$=="" ; sortby="NAME" ;endif;
   sortby=g_askopt("Choose a sort-mode:",
  	            "NAME"|"-NAME"|"SIZE"|"-SIZE"|"DATE"|"-DATE",
		   sortby,0,1,3);
   goto start1 ;
endif;

if ans==1063 ;   @ F5 for  specify fully-qualified name @

   {tmp,tmp2}=g_askfil_entername(prompt_row,isdht);  @ returns dir,filename @

   if tmp$=="" ; goto start1 ; endif;
    retp(tmp,tmp2);
endif;


/* pgup pgdn check */
if ans== 1081 or ans==1073  ;      @ pg up/ down @
  if ans==1081 ;		@ down @
     if frange[2]==rows(file_smtx) ; 
	ans=1060 ;
     else;
         file_r1=frange[2]+1 ;
         f1list=f1list|frange[1] ;    @ add to popoff list @
     endif;
  else;				@ up @
     if rows(f1list)==1 ;
      	  ans=1060 ;
     else;
         file_r1=f1list[rows(f1list)];
         f1list=f1list[1:(rows(f1list)-1)];	
     endif;
  endif;
  if ans ne 1060 ;		@ pgup/pgdn is f2 if top/bottom of list @
       scroll file_row1|1|25|80|0|0 ;
       locate file_row1+1,1 ;
       {famess,frange}=askfil_showfiles(file_smtx,file_sindex,matchat,file_r1,20-file_row1);
       PROMPT_row=csrlin ;
       if famess$/=" " ; call g_askfil_showline(file_row1,"HILITEON",say_files $+ famess ); endif;
       goto get_files ;
  endif;
endif;

@ otherwise, non-arrow cursor key hit @

GET_DIRS: ;		@ indirectly skip here on subirectory traversals @
pgsubs=0;
if ans==1060 ;   @ ==== (after F2 or synonym) +++++++++ ASK/CURSOR FOR A SUBDIRECTORY   @

   call g_askfil_showline(subdir_row1,"HILITEON","Subdirectories: " $+ samess );?;
   call g_askfil_showline(file_row1,"BOLD",say_files $+ famess );?;

   call g_askfil_refreshrow(subdir_row1,subdir_smtx,0|0|1,1);

   {ans,smatchat}=g_askfil_select1(subdir_smtx,subdir_sindex,srange,usubdir_smtx,0,subdir_ROW1,PROMPT_ROw, "Select directory (F1=Help, F2=Files):");

   if scalmiss(ans);   retp(datadir0,datafil0);  ENDIF;  @ esc == use priors @

   if type(ans)==13 ;     			@ character answer? @
     if missrv(smatchat,0)==0   ; @ no match -- back to file entry without changing directories @ 
        call g_askfil_showline(subdir_row1,"BOLD","Subdirectories: " $+ samess);?;
        call g_askfil_showline(file_row1,"HILITEON",say_files $+ famess );?;
        matchat=0 ;
        goto get_files ;
      endif;

      tmp=dirlist[smatchat] ;

      if tmp$=="Select..";
         call g_askfil_refreshrow(subdir_row1,subdir_smtx,1|1|0,0);
         call g_askfil_showline(prompt_row,0,"");
	 do while 1==1 ;
            call g_askfil_showline(prompt_row+1,"BOLD","Enter directory path: ");
            dpath=cons; dpath=g_strip(dpath) ;
	    if dpath$=="" ;   @ back to cursor mode @
    	         call g_askfil_showline(prompt_row,0,"");
    	         call g_askfil_showline(prompt_row+1,0,"");
     	         call g_askfil_showline(prompt_row+2,0,"");
 	        ans=1060 ; goto get_dirs ;  @ using current curpath @ 
	    endif;
            dpath2=g_is_dir(dpath);
	    if dpath2$=="" ; 
   	       call g_askfil_showline(prompt_row+2,"BOLD","Please reenter (no such directory: " $+ dpath );
	       continue ;
	    endif;
	    curpath=dpath2 ;
            sub_r1=1 ;
	    cls ; 
	    goto start1;  
        endo;		@ forever loop @
      endif;		@ string answer recieved @

      if tmp$=="..";     @ goto parent? @
	 curpath=g_fspec2("DP","..",curpath);
      else ;			@ a specific subdirectory @
         curpath=curpath $+ tmp $+ "\\";
      endif;
      cls ;
      goto start1;
   endif;

/* pgup pgdn check */
  if ans== 1081 or ans==1073  ;      @ pg up/ down @
     if ans==1081 ;		@ down @
         if srange[2]==rows(subdir_smtx) ; 
             ans=1060 ;
         else;
             sub_r1=srange[2]+1 ;
             s1list=s1list|srange[1] ;    @ add to popoff list @
         endif;
      else;				@ up @
         if rows(s1list)==1 ;
      	   ans=1060 ;
         else;
            sub_r1=s1list[rows(s1list)];
            s1list=s1list[1:(rows(s1list)-1)];	
         endif;
     endif;
     if ans ne 1060 ;		@ pgup/pgdn is f2 if top/bottom of list @
         scroll subdir_row1|1|25|80|0|0 ;
         locate subdir_row1+1,1 ;
         {samess,srange}=askfil_showfiles(subdir_smtx,subdir_sindex,smatchat,sub_r1,8);
         if samess$/=" " ; call g_askfil_showline(subdir_row1,"HILITEON","Subdirectories: " $+ samess ); endif;
	 pgsubs=1 ; 
         goto display_dirs ;
     endif;


   endif;		@ pgup down @

   if ans==1060 ;    @ F2 in subdirectory ::::: BACK TO FILE MODE _---------- @
     call g_askfil_showline(subdir_row1,"BOLD","Subdirectories: " $+ samess );?;
     call g_askfil_showline(file_row1,"HILITEON",say_files $+ famess );?;
     goto get_files ;
  endif;

endif;   @ ans=1060 from file-menu @



/* if here, F1 hit */

scroll subdir_row1|1|25|80|0|0 ;
locate subdir_row1+1,1 ;
print "             ";;
call g_screen("",1|33|42); 
print "Help for: select a file ";
call normalon ;
print "You can enter a file name from the keyboard, or you can use the cursor keys ";
print "to choose a file. ";
print "To change directories, hit the F2 key, and then choose a directory.";
print "" ;
print "Notes: ";
print "  * If there is more then 1 screen worth of files (or directories), you can ";
print "    use the  Page Up, Page Down, Home, and End keys to move up & down a screen ";
print "  * If you enter an incorrect name from the keyboard, hit ESC to clear the ";
print "    entry (sorry, the backspace key does not work -- though the Del key ";
print "    sometimes does)";
print "  * However, hitting ESC when there is no keyboard entry means CANCEL -- the ";
print "    the default is used (";;datafil0;;")";
print "  * To change sort order of files, hit F4 (sort can be by Name, ";
print "     Last-mod date, or Size)";
print "  * To enter a fully-qualified file name, cursor to file-entry area and hit F5 ";

print " ";
print " hit any key to continue ...";;
call waitc ;
scroll subdir_row1|1|25|80|0|0 ;

goto start1;



endp;



/* returns dir,filename (no path) *****************/
proc (2)=g_askfil_entername(irow,isdht);
local filename,aname,ff,nm,dr;
scroll irow|1|25|80|0|0 ;
a1: locate irow+1,1 ;
if isdht==0;
  " Enter a fully qualified file name .. "; ? ; "  ? ";;
else ;
  " Enter a fully qualified file name, for a GAUSS data file. Do NOT INCLUDE THE .DAT extension .. " ;  ? ; "  ? ";;
endif;
filename=cons;
if filename$=="" ;retp("",""); endif;

aname=filename;
if isdht==1 ;
  aname=filename $+ ".DAT" ;
endif;
ff=g_exists(aname,"");
if ff$=="" ; "no such file "; call g_pause(3,27) ; goto a1 ; endif;
nm=g_fspec("N",filename);
dr=g_fspec("DP",filename);
retp(dr,nm);
endp;



/******************/
@ choose a file/dir from a list (using keyboard and cursor keys @
@ modified 7 april 05 (fix annoying habits when cursoring from FILES or DIRECTORIES line) @

proc (2)=g_askfil_select1(alist,aindex,arange,ualist,matchat,scr_row1,PIROW,MESSAGE);

local oldrow,oldcol,ans0,ans,iat,i,j,ncols,nrows,krow,kcol,at1 ;
local matchrow, matchcol,isempty;
local amatch,AT2 ,tmp,ans_file;

isempty=0;

nrows=rows(alist);
if nrows==1  and alist[1,1]$=="";
  isempty=1 ;nrows=0;
endif;
if cols(aindex)==9 ; ncols=aindex[.,9]; else ; ncols=0 ; endif;

at1=arange[1];
at2=arange[2];

oldrow=0 ; oldcol=0;

@ find current match row and column @
{krow,kcol}=g_askfil_indtolist(matchat,aindex,at1,at2) ;
if krow==0 ; matchat=0 ;  krow=at1 ; kcol=1;  endif;    

DO  WHILE 1==1  ;

scroll PIROW|1|PIROW+2|80|0|0 ;
locate PIROW,1; 

call cyanon ;print  MESSAGE ;; call normalon ; print "  ";;

ans="" ; iat=0;ans0="";
ans_file="";

 @ do the arrows Uparrow=1072   left=1075    right=1077 down=1080 @ 

do while 1==1 ;
   {ans,iat}=g_cons3(ans,iat);   @ start reading string @

 
   if iat==0 ;  
     if type(ans) ne 6 ; break  ; endif;  @ crlf -- so check the "ANS" string @


     if ans==1075 ;      @ LEFT @
        if isempty==1 ; ans=1060 ; goto fakef2 ; endif;
         if kcol==1 ;
	    if krow==1 ; ans=1060 ; goto fakef2 ; endif ;
	    kcol=ncols[krow-1];  krow=maxc(1|(krow-1)); 
	 else ;
            kcol=maxc(1|(kcol-1));
	 endif;
     elseif ans==1077 ;	    @ RIGHT @
        if isempty==1 ; ans=1060 ; goto fakef2 ; endif;
        if kcol==ncols[krow];
	   if krow==nrows ; 
	      krow=1 ;kcol=1 ;
	    else ;
               krow=minc(nrows|(krow+1)) ; kcol=1 ;
	    endif;
        else;
           if oldrow == 0 ;
		kcol=1;
	   else ;
              kcol=minc((kcol+1)|ncols[krow]) ;
	   endif;
	endif;
     elseif ans==1072 ;	      @ UP @
        if isempty==1 ; ans=1060 ; goto fakef2 ; endif;
        if krow==1 ; ans=1060 ; goto fakef2 ; endif ;
        krow=maxc(1|(krow-1)); 
        if aindex[krow,kcol]==0 ; kcol=ncols[krow]; endif;

     elseif ans==1080 ;       @ DOWN @
        if  (isempty==1 ) or (nrows==krow and oldrow ne 0) ; ans=1060 ; goto fakef2 ; endif;
        if oldrow==0 ;
	   krow=minc(nrows|1);
	else;
           krow=minc(nrows|(krow+1)) ;
        endif;
        if aindex[krow,kcol]==0 ; kcol=ncols[krow]; endif;

     elseif ans==1071 ;  @ home @
          if isempty==1 ; ans=1060 ; goto fakef2 ; endif;
	  if krow==at1 ; ans=1073 ; break ; endif;	
	  krow=at1 ; kcol=1 ;

     elseif ans==1079	 ;   @ END @
          if isempty==1 ; ans=1060 ; goto fakef2 ; endif;
	  if krow==at2 ; ans=1081 ; break ; endif;
	  krow=at2 ; kcol=ncols[krow] ;
     else ;
 	break ;    @ more extreme cursor key, or a crlf @
     endif;

     matchat=aindex[krow,kcol] ;

     if krow le at2 and krow ge at1 ;
        call g_askfil_refreshrow(scr_row1,alist,krow|kcol|AT1,1);  
     endif;
	

     if oldrow ne 0 ;   @ unhighlight prior match ? @
       if oldrow le at2 and oldrow ge at1 ;
           call g_askfil_refreshrow(scr_row1,Alist,OLDROW|oldcol|AT1,0);
       endif;
     endif;	
     oldrow=krow ;oldcol=kcol;

     ans="" ; iat=0;ans0="";   @ reset prompt @
     scroll PIROW|1|PIROW+2|80|0|0 ;
     locate PIROW,1; 
     print  MESSAGE ;;

     continue;			@ get more input @
  endif;		@ iat=0 @
 
  ans0=ans;     @ else, still building a string @

  if ans$/="" and ans$/=" " ;    @ find  if a substring match @

      amatch=g_askfil_match1(ualist,upper(ans));   @ match answer to list of files @

      if oldrow ne 0 ;   @ unhighlight prior match ? @
       if oldrow le at2 and oldrow ge at1 ;
           call g_askfil_refreshrow(scr_row1,Alist,oldroW|oldcol|AT1,0);
       endif;
      endif;	

      tmp=csrcol ;
      if amatch[1] ne 0 ;	@ a match @
          ans_file=alist[amatch[1],amatch[2]];
	  matchat=aindex[amatch[1],amatch[2]];
          call g_askfil_showline(pirow+1,1,"Match: " $+ ans_file );
 	  locate pirow,tmp;
          if amatch[1] ge at1 and amatch[1] le at2 ;  @ out of displayed row range @
	     call g_askfil_refreshrow(scr_row1,alist,AMATCH|AT1,1);
             oldrow=amatch[1]; oldcol=amatch[2]; 
	  else;
	      oldrow=0 ; oldcol=0 ; 
  	      continue ;
          endif;
      else;  		@ no match @
          call g_askfil_showline(pirow+1,1," " );
 	  locate pirow,tmp;
          oldrow=0 ; oldcol=0 ;  matchat=0; ans_File="" ;
      endif;		@ amatch[1] ne 0 @
      IF OLDROW==0 ; CONTINUE ; ENDIF ;  @ non-match means keep searching @
   endif;			    @ ans=something @

endo;			@ forever loop @

@ if here, break on some function keys, or crlf hit @

if scalmiss(ans);             @ esc hit @
   if ans0$=="";             @ no prior string @
      RETP(MISS(1,1),MISS(1,1));
   ELSE;
	CONTINUE   ; 	@OTHERWISE, BLANK STRING AND ASK AGAIN @
   ENDIF;	
ENDIF;

if type(ans) ne 6 ;	@ a string entered, so we got something @
  if matchat==0 ; continue; endif;   @ non matchinge string @
  RETP(ANS,MATCHAT);
endif;

@ if here, cursor key @

fakef2:  ;		@ skip here on upper arrow from top row, or down from bottom @


@     F1 = 1059, F2=1060, F3=1061,...,F9=1067
     HOME=1071,  PGUP=1073, END=1079, PGDN=1081
     Uparrow=1072   left=1075    right=1077 down=1080 @

if not(scalmiss(indnv(ans,1060|1059|1062|1063|1071|1073|1079|1081)));
 if OLDROW NE 0 ;   @ unhighlight prior match ? @
     if oldrow ge at1 and oldrow le at2 ;
         call g_askfil_refreshrow(scr_row1,Alist,oldrow|oldcol|AT1,0);
     endif;
  endif;	
  retp(ans,0) ;			@ both of which are handled by caller @
endif;



@ other keys: ignore @

ENDO;		@ FOREVER LOOP -- LEAVE VIA RETP @

ENDP;




/*******************************/
/* match list index to string-matrix index (possibly within ranges)
 returns row,column (in aindex) that matches matchat. 
 or 0,0 if no match 
*/
proc (2)=g_askfil_indtolist(matchat,aindex,at1,at2);
local i,j,ncols,krow,kcol;

krow=0; kcol=0;

if at1 lt 0 or at1 gt rows(aindex) or at2 lt 0 or at2 gt rows(aindex) ;
  call grbl2_error("ERROR in g_askfile_inddolist " $+ at1  $+ " " $+ at2   $+ " " $+ g_ftos2(rows(aindex),1),1) ;
   stop;
endif;

if at1 eq 0 ; at1 =1 ; endif;
if at2 eq 0 ; at2=rows(aindex) ; endif;

if cols(aindex)==9 ; ncols=aindex[.,9]; else ; ncols=0 ; endif;
for i (at1,at2,1) ;
  for j (1,ncols[i],1) ;
    if aindex[i,j] eq matchat ;
	krow=i ; kcol=j ;
	goto out1 ;
    endif;
  endfor;
endfor;
out1: ;
retp(krow,kcol);
endp;


/*  **************/
@ refresh aname, at location matchat, relative to irow, possibly using block hightling @

proc g_askfil_refreshrow(irow,alist,matchat,iblock);

local ii,jj,jj2,tocol,trow,tcol,t1,AOFFSET;

trow=csrlin;tcol=csrcol;  

tocol=0;
ii=matchat[1] ;
jj=matchat[2];
if ii==0 or jj==0 ; retp(1) ;endif;

IF ROWS(MATCHAT) lt 3;  AOFFSET=1 ; ELSE ; AOFFSET=MATCHAT[3]; ENDIF;

for jj2 (1,8,1) ;
 if jj2 ne jj ;	
     tocol=tocol+strlen(alist[ii,jj2]);
 else;
     locate (1+irow+ii-AOFFSET),tocol+4;
     if iblock==1 ;
         call blockon ;  
	 print $alist[ii,jj] ;; 
        call normalon ; 
     else;
        call g_askfil_printwithspaces(alist[ii,jj],1,jj2) ;
     endif ;
     locate trow,tcol ;
     retp(1);
  endif ;
endfor ;
retp(0);
endp;


/***************/
@ match substring to names in string matrix -- ulist must be upper case
 First check for exact match  @
proc g_askfil_match1(ulist,uans);
local  ii,jj;

uans=g_strip(uans);
if uans$=="" ; retp(miss(1,1));      endif; 

for  ii (1,rows(ulist),1) ;
 for jj (1,cols(ulist),1);
  if g_strip(ulist[ii,jj])$==uans ;  @ a match @
      retp(ii|jj);
  endif;
endfor;
endfor;
   
@ now look for substring matches @

for  ii (1,rows(ulist),1) ;
 for jj (1,cols(ulist),1);
  if strindx(ulist[ii,jj],uans,1)>0 ;  @ a match @
     retp(ii|jj);
   endif;		@ uans match @
  endfor ;
endfor ;
retp(0|0);      @ no change (no match) @ 
endp;



/*********/
@ construct a displayable matrix  (R x 8) of the strings (file or directory names)
  in the alist vector. 

     Returns file_string_matrix,filenumber_index,match_number

  File_string_matrix is the R x 8 string matrix containing strings, padded to multiples
  of 14 (in length)
  Filenumber_index is Rx9. It is an index from file_string_matrix to alist. Or 0, if
  a cell (in file_string_matrix) is not used.
  The 9th column is number of used columns in this row (of file_string_matrix)
  Match_number is match of shtname to alist (the row in alist). 0 if no match:

@
proc (3)=askfil_make_mtx(alist,shtname);

local defcol,defrow,arows,arow,a1,lena1,lenrow,ifill,ii;
local arow0,inrow,runlen,jj,ga1,t1,imatch,at2;
local irow0,irows,irow;

if alist $=="" ;  
  retp("",0,0); 
endif ;


shtname=upper(shtname);
imatch=0;

arow0=" "$~" "$~" "$~" "$~" "$~" "$~" "$~" "  ;
arow=arow0;
arows=arow;   @ stub of arows @

irow0=zeros(9,1);
irow=irow0;
irows=irow' ;

inrow=0;
runlen=0 ;

for ii (1,rows(alist),1) ;
  a1=alist[ii];
  ga1=a1;
  lena1=strlen(a1);
  ifill=14-(lena1%14) ;
  a1=a1 $+ chrs(32*ones(ifill,1)) ;
  if (lena1+ifill+runlen)< 78 ;
	inrow=inrow+1;
	arow[inrow]=a1 ;
	irow[inrow]=ii ;
	irow[9]=inrow ;
	runlen=runlen+lena1+ifill;
  else;
	arows=arows$|arow;
	irows=irows|irow' ;
	arow=arow0;
        irow=irow0;
        arow[1]=a1 ;
	irow[1]=ii;
	runlen=lena1+ifill;
	inrow=1;
  endif;
  if upper(ga1)$==shtname ;  imatch=ii; endif;
endfor ;    

arows=arows$|arow;          @ add last row @
irows=irows|irow' ;
arows=arows[2:rows(arows),.] ;  @ drop stub @
irows=irows[2:rows(irows),.];

retp(arows,irows,imatch);

endp;


/*********/
@ write to screen maxlines lines from the arows string-matrix (starting at line at1)
  Highlight name if it appears in the nx3 match vector    (currently, n must be 1)

  Also returns a "pgdn/pgup" message string, and the row range (at1|at2) that is displayed

  example: {famess,frange}=askfil_showfiles(file_smtx,file_indx,match_index,file_r1,20-file_row1)

 match points to row|col in arows (match[3] is row in original file list)

  at1,at2: rows in string_mtx 
  r1,r2 : rows in filelist 

@
proc (2)=askfil_showfiles(arows,aindex,match,at1,maxlines);

local ifill,ii;
local arow0,inrow,runlen,jj,ga1,t1,imatch,at2;
local f1,f2,f2use ;

if arows $=="" ;  
  retp("",0|0); 
endif ;

if at1 gt rows(aindex) ;
  call grbl2_error("askfil_showfiles ERROR: "  $+ at1 $+ " gt then rows(aindex) " $+ g_ftos2(rows(aindex),1),1); 
  stop;
endif;

f1=aindex[at1,1] ; f2=f1; f2use=f2 ;
at2=at1;
for ii (at1,minc(rows(arows)|(at1+maxlines-1)),1);
   print "   ";; 
   at2=ii ;
   for jj (1,cols(arows),1) ;
	f2=aindex[ii,jj];
	if f2==0 ; continue ; endif;	 @ 0 signals "blank cell @
	f2use=f2;
	t1=arows[ii,jj];
	if f2==match ;
	   call blockon ;  print $t1  ;;  call normalon ;
	   ifill=strlen(arows[ii,jj])-strlen(t1) ;
	   if ifill gt 0 ;
              print chrs(32*ones(ifill,1));; 
           endif;
	else;
           call g_askfil_printwithspaces(t1,1,jj);
        endif;
   endfor ;
   print ""; 
endfor;

t1="";
if at1 gt 1 or at2 lt rows(arows) ;
  t1=" Displaying " $+ ftos(f1,"%*.*lf",3,0)  $+ " to  " $+ ftos(f2use,"%*.*lf" ,3,0) $+ " (" ;
  if at1 gt 1 ; t1=t1 $+ "PgUp "; endif;
  if at2 lt rows(arows) ; t1=t1 $+ "PgDn" ; endif;
  t1=t1 $+ " for more) ";
endif;
retp(t1,at1|at2);
endp;


/********/
/* print a name with embedded spaces */
proc g_askfil_printwithspaces(amess,itype,jcol);

local amess2,goob,didprint,ifill,jj,aword,ii,ac;
local colors ;

colors=(1~1)|(32~33) ;
ii=1+(jcol%2) ;
ac=colors[.,ii];

amess2=g_strip(amess);
if strindx(amess2," ",1) gt 0 ;
  didprint=0;
  do until amess2$=="" ;
    {aword,amess2}=token(amess2);
    call g_screen("",ac);
    print $aword;; 
    call normalon ;
    didprint=didprint+strlen(aword) ;
    if amess2$/=""; 
       if itype eq 1 ; call boldon ; else ; call blockon ; endif;
       print  "_";; call normalon ; didprint=didprint+1;
    endif;
  endo ;
  ifill=strlen(amess)-didprint ;
  if ifill gt 0 ;
     print   chrs(32*ones(ifill,1)) ;;
  endif;
   
else ;
  call g_screen("",ac);
  print $amess;;
  call normalon ;
endif;
retp(0);
endp;



/********/
@ slight mod of g_dirlst @
proc (2)=g_askfil_dirlst(curpath,isdht,sortby,filter);
local inew,jj,filelist,dirlist,fbytes,fdate,aindex;

sortby=g_strip(sortby);

{filelist,fbytes,fdate,dirlist}=g_dirlst2(curpath,filter);

if scalmiss(filelist); retp(miss(1,1),miss(1,1)) ; endif;  @ should NEVER happen @

if sortby$=="DATE" or sortby$=="SIZE"  or sortby$=="-DATE" or sortby$=="-SIZE" ;
  if sortby$=="SIZE";
    aindex=sortind(fbytes);
  elseif sortby$=="-SIZE";
    aindex=rev(sortind(fbytes));
  elseif sortby$=="DATE";
    aindex=sortind(fdate);
  elseif sortby$=="-DATE";
    aindex=rev(sortind(fdate));
  endif;

  filelist=filelist[aindex];
endif;
if sortby$=="-NAME"; 
  filelist=rev(filelist);
endif;

if rows(dirlist)>0 ;
  dirlist="Select.."$|".."$|dirlist ;
else;
  dirlist="Select.."$|".." ;
endif;


@ if isdht, then only retain .DAT files @
if isdht==1 and filelist $/="" ; 
      inew=0 ;
      for jj (1, rows(filelist),1) ;
	  if strindx(upper(filelist[jj]),".DAT",1)>0 ;
  	     inew=inew+1 ;
 	     filelist[inew]=g_fspec("F",filelist[jj]);
          endif;
      endfor;
      if inew gt 0 ;
         filelist=filelist[1:inew] ;
      else ;
	 filelist="" ;
      endif;
endif;

retp(filelist,dirlist);
endp;


/************************/
@ clear a line, and write string to it. Use normal , bold block, or cyan (0,1,2,3 respectively) @
proc g_askfil_showline(irow,icolor,astring);
local don ;
 
don=1;

if type(icolor) ne 6 ; icolor=0 $+ icolor ; endif;

scroll irow|1|irow|80|0|0; 
locate irow,1;
if icolor$=="BOLD" or icolor==1  ;
  call boldon ;
elseif icolor==2 or icolor$=="BLOCK" ;
  call blockon ;
elseif icolor==4 or icolor$=="HILITEON"; 
 call hiliteon ;

elseif icolor==3 or icolor$=="CYAN";
  call g_screen("",1|46);
else ;
  call normalon ;
  don=0;
endif;
print astring ;;" ";;
if don==1 ; call normalon ;endif;
retp(0);
endp;


/************************/
@ Write, at row irow, Astr, followed by pth\dfl in bold @
proc g_askfil_write_curdir(pth,dfl,irow,astrg);
   local tmp,tmp2 ;
   tmp2=strlen(astrg)+2;
   if pth$/="" ;   pth=g_as_dir(pth,0); endif;
   tmp=pth$+dfl;
   if irow==0; retp(tmp); endif ;    @dont write, just concatenate @
    tmp=strsect(tmp,maxc((strlen(tmp)-(80-tmp2))|1),80-tmp2);
    locate irow,1;scroll irow|1|irow|80|0|0; astrg ;; " " ;;
    call boldon ; $tmp; call normalon ;
    retP(pth$+dfl);
endp;





/**************** View/Edit a gauss dataset ******************************/
@ view a gauss data file
  afile: name of a gauss datafile
  nowrite: if 1, do NOT write changes (view, but no changing)  @

proc g_editdata(afile,nowrite);
    local in_row,is_alpha,aline2,tmp;
    local f1,nms,maxl,avals,indx,stat ;
    local iline,srchval,resol,avu;
    local foo,u,oldvar,oldid,oldval,newval,jj,dta,linedo,af ;
    af=afile;
    closeall ;
    is_alpha=0;
    open f1=^af for update;
    in_Row=4 ;
    IF  F1<0;
       " Problem accessing " $af ; stop ;
    endif;

    tmp=colsf(f1);
    if tmp<10 ; in_row=2 ;
    elseif tmp<30 ; in_row=3 ;
    endif;

    nms=getname(af);
    oldvar=nms[1]; indx=1;
    srchval=0; resol=0;
    maxl=rowsf(f1);
    iline=0;
    avu="edit";
    if nowrite==1 ; avu="view"; endif;

aa1:  CLS;
    format /ld 5,0 ;
aa: " Observation # to ";; $avu ;; " (ESC=Stop viewing data, F1=Help ) ";;
     foo=g_cons2() ;?;
     if foo$=="" ; foo="1"; endif;
     if scalmiss(foo);
        retp(0);
     endif ;
aa2: ;
     if type(foo)==6 ;    @ non-ascii text @
            if foo==1045 ;       @alt-x @
                retp(0);

           elseif foo==1081 ;   @ pgdn @
               iline=minc((iline+1)|maxl);
           elseif foo==1059    ;     @ ALT-H or F1 @
               " Select an observation number, or...";
               "  F3=Search ";
               "  F4=Search again ";
               "  F9=Change display options ";
               "  PGUP/PGDN=next/prior observation ";
               "  END = Last observation ";
               "  HOME = First observation ";
               call g_pause(10,-1);
               goto aa ;
           
           elseif foo==1067  ;     @ f9 @
               {in_row,stat}=g_askval(" Number of variables per row ",in_row);
               is_alpha=g_yesno(" Display as characters ",is_alpha);
           elseif foo==1071     ;      @ home @
             iline=1 ;
           elseif foo==1079     ;      @ end @
             iline=maxl;
           elseif foo==1073 ;
               iline=maxc((iline-1)|1);
           elseif foo==1061 or foo==1062 ;     @ f3 f4@
              if foo eq 1061 ;
                {indx,oldvar}=g_askv1(" Select a variable to search over (ESC to cancel) ",
                               oldvar,nms," Values of this variable will be compared to requested value",
                               0,0);
                if  scalmiss(indx);
                   goto aa ;
                 endif ;
                 {srchval,stat}=g_askval(" Value to search for ",srchval);
                 {resol,stat}=g_askval(" Resolution (0=Exact)",resol);
                 {linedo,stat}=g_askval(" Enter first record of search:",
                                  iline+1);
                 if linedo<1 or linedo ge maxl ; format /ld 5,0;
                    " Observation number must be between 1 and " maxl ;
                    goto aa ;
                  endif ;
              else ;
                  linedo=iline+1;
              endif ;
              {srchval,oldvar,iline}=g__srchline(f1,nms,af,oldvar,
                                              indx,linedo,srchval,resol);
             format /ld 7,0;
             if iline le 0 ;
                 " No match " ; call pause(1.2); goto aa1 ;
             else;
                   cls ;
             endif;
           endif;           @ types of non-ascii @
      else;
             if foo$=="?";
                foo=1059 ; goto aa2 ;
             endif ;

             if isnumber(foo)==0;
                ?; goto aa ;
             else ;
                iline=stof(foo);
                ?;         format /ld 6,0;
              if iline<1 or iline > maxl ;
                 " No such observation (file length=" maxl ;
                    call g_pause(3,0); goto aa ;
                endif ; format /ld 5,0 ;
                cls ;
             endif;
       endif ;     @ scalmiss @

@ global used in dodisp @
      aline2=" Data from " $+ afile $+ " , observation " $+ ftocv(iline,5,0) ;

      avals=g__DODISP(ILINE,F1,NMS,in_Row,1-nowrite);

  if scalmiss(avals) ; goto aa1 ; endif ;
  u=seekr(f1,iline);
  if nowrite ne 1 ;  jj=writer(f1,avals'); endif;
  GOTO AA1;


  retp(0);

endp;


/*************************/
@ search for first occurence of a variable value within file (with offset) @

proc (3)=g__srchline(ff,nms,dataset,oldvar,indx,igot,srchval,resol);
        local aa,ival,istart,jj,dd;
        local nr,tmp,nrows,sumtmp,foo,iline;

       nr=1000;
       istart=igot ;

        foo=seekr(ff,istart);
       iline=istart; igot=0;

       do until eof(ff);
          dd=readr(ff,nr);
          nrows=rows(dd);
          jj=dd[.,indx];
          tmp= (abs(jj-srchval) .le abs(resol));  sumtmp=sumc(tmp);
          if sumtmp==0;         @ no match @
              iline=iline+nrows ;
          elseif sumtmp==1;      @ one match @
              retp(srchval,oldvar,iline+maxindc(tmp)-1);
          else ;                   @ take first @
              tmp=selif(tmp.*seqa(1,1,rows(tmp)),tmp.>0);
              retp(srchval,oldvar,iline+minc(tmp)-1);
          endif;
       endo;
       retp(srchval,oldvar,0);
     endp;



PROC g__DODISP(ILINE,F1,NMS,in_row,nowrite);
  LOCAL DTA,I,L1,L2,FOO,IDO ;

  IF  iline lt 1 or ILINE GT ROWSF(F1);
     " % ATTEMPT TO READ PAST END OF FILE "; call g_pause(4,0);
      RETP(miss(1,1));
  ENDIF;

  CALL SEEKR(F1,ILINE);
  DTA=READR(F1,1);
  dta=g_usrset("Row " $+ Ftos(iline,"%- *.*lf" ,5,0) $+ " of " $+ filename ,nms,dta',0,in_row,nowrite,0);
  retp(dta);

ENDP;







