! @(#)indisk.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:12:25 
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! MIDAS procedure indisk.prg  to get FITS files from disk
! K. Banse	931104, 950322, 981127, 991014, 000315, 010628
! execute via INDISK/FITS in_files out_files option name_check INTAPE_flags
! where
!        option = OC or ON to keep the original name of the files,
!		  i.e if the result files should be named according to the 
!		  FITS keyword FILENAME, so we also execute RESTORE/NAME 
!		  OC - with overwrite confirmation, ON - without confirmation
!               = NO for not keeping the original name
!        name_check = 2 char.flag, (display_flag + action_flag)
!		      display_flag = Y(es) or N(o) (only if bad chars. found)
!                     action_flag = S(top), R(eplace) or C(ontinue) 
!                     with respect to dangerous characters in the output Midas
!		      name, defaulted to: YR  (bad chars are replaced by `_')
! 
!     the total no. of files created is stored in keyword OUTPUTI(10)
!
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
crossref IN OUT OPTION CHECK FLAG
!
!
define/param p1 ? c -
"Enter input FITS name(s) or ASCII file with list of names: "
define/param p2 toto* c -
"Enter output MIDAS name(s) or ASCII file with list of names: "
define/param p3 NO ? "Enter option: "
define/param p4 YR ? "Enter name_check_flag: "
define/param p5 NOY ? "Enter print,format,history option (for INTAPE):"
! 
define/local caty/i/1/2 0,0
define/local ftype/c/1/4 abcd
define/local kindx/i/1/2 0
define/local zindx/i/1/2 0
define/local oindx/i/1/2 0,0
define/local count/i/1/3 0,0,0
define/local outcount/i/1/1 0
define/local fin/i/1/2 -1,-1
define/local fout/i/1/2 -1,-1
define/local root/c/1/20 "toto " ? +lower
define/local names/c/1/80 " " all
define/local onames/c/1/80 " " all
define/local single/c/1/80 " " all
define/local osingle/c/1/80 " " all
define/local psingle/c/1/80 " " all
define/local freto/c/1/12 " " all
define/local chacha/c/1/1 x
define/local inspec/c/1/100 {p1}
if aux_mode .lt. 2 then
   define/local diri/c/1/1 ]
else
   define/local diri/c/1/1 /
endif
define/local mvflg/i/1/1 0
!
! look for wildcard stuff
! 
kindx = m$index(inspec,"*")
if kindx .gt. 0 then
comma_loop:
   kindx = m$index(inspec,",")
   if kindx .gt. 0 then
      inspec({kindx}:{kindx}) = " "
      goto comma_loop
   endif
   if aux_mode .lt. 2 then
      $dir/out=z__z.cat/column=1/version=1 {inspec}
      open/file z__z.cat read fin
      read/file {fin} names		!skip 1. line
      if fin(2) .le. 0 then
         write/error 30
         return/exit
      endif
      read/file {fin} names		!skip 2. line
      read/file {fin} names		!skip 3. line
      open/file y__y.cat write fout
vms_read:
      read/file {fin} names
      if fin(2) .le. 0 .or. names(1:1) .eq. " " then
         close/file {fout}
      else
         write/file {fout} {names(1:80)}
         goto vms_read
      endif
      close/file {fin}
   else
      $ls {inspec} > y__y.cat
   endif
   write/keyw names " " all
   write/keyw inspec "y__y.cat                "
endif
!
! check output names
!
fout = -1
if p2(1:1) .eq. "+" then
   count(2) = 1
   write/out -
   "We miss the names of the output files..." so we use `{root}*'
else
   if m$index(p2,".cat") .gt. 1 then
      open/file {p2} read fout
      if fout .lt. 1 then
         write/out Could not open file: {p2} ...
         return/exit
      endif
   else
      inputi = m$index(p2,"=")
      if inputi .gt. 1 then
         inputi = inputi+1              !move to following char.
         if p2(1:1) .eq. "r" then                           !root=abcd
            write/keyw root "{p2({inputi}:>)}  "
            inputc = root
            @a indisk,checkname {p4}
            root = inputc			!in case of changed chars.
         endif
      else
         inputi = m$index(p2,"*")
         if inputi .gt. 0 then
            inputi = inputi- 1
            write/keyw root {p2(1:{inputi})}
            inputc = root
            @a indisk,checkname {p4}
            root = inputc			!in case of changed chars.
         else
            write/keyw onames/c/1/80 {p2}
         endif
      endif
   endif
endif
! 
!  check if catalog of FITS files
!
kindx = m$index(inspec,".cat")
if kindx .gt. 1 then
   open/file {inspec} read fin
   if fin .lt. 1 then
      write/out Could not open file: {inspec} ...
      return/exit
   endif
   caty(1) = 1
   goto cat_loop
else
   write/keyw names/c/1/80 {inspec}
endif
! 
! -----------------------------------
! here for input names(s) on one line
! -----------------------------------
! 
in_loop:
if names(1:1) .eq. " " goto end_of_it			!we finished
! 
count = count+1
zindx = m$index(names,",")
if zindx .gt. 1 then
   zindx = zindx-1
   write/keyw single "{names(1:{zindx})} "
   zindx = zindx+2
   write/keyw names "{names({zindx}:)} "
else
   write/keyw single "{names(1:)} "
   names(1:1) = " "
endif
! 
if p3(1:1) .eq. "O" goto do_it
! 
if fout .gt. 0 then
  cato_loop:
   write/keyw onames/c/1/80 " " all
   read/file {fout} onames
   if onames(1:1) .eq. " " then             !look for ASCII or Image catalog
      if onames(2:7) .eq. "=Image" .or. onames(2:7) .eq. "=ASCII" -
         goto cato_loop
      if onames(2:7) .eq. "=Table" goto cato_loop
      write/keyw onames "{onames(2:)} "
   else
      if onames(1:2) .eq. "! " goto cato_loop
   endif
   if fout(2) .lt. 1 then
      close/file {fout}
      fout = -1
   endif
endif
!
if onames(1:1) .eq. " " then			!last file
   if count(2) .eq. 0 then
      count(2) = count(1)			!save the index
      set/format i1
      write/keyw p8 "{count}. output file..."
      set/format i4
      write/out -
      "We miss the name of the {p8}" so we use `{root}{count}'
   endif
   write/keyw osingle {root}{count}
else
   oindx = m$index(onames,",")
   if oindx .gt. 1 then
      oindx = oindx-1
      write/keyw osingle "{onames(1:{oindx})} "
      oindx = oindx+2
      write/keyw onames "{onames({oindx}:)} "
   else
      write/keyw osingle "{onames(1:)} "
      onames(1:1) = " "
   endif
endif
goto do_it
!
!  read name from catalog/file and prepare it for `in_loop'
!
cat_loop:
write/keyw names/c/1/80 " " all
read/file {fin} names
if fin(2) .lt. 1 then
   close/file {fin}
   if fout .gt. 0 close/file {fout}
   if caty(2) .eq. 0 then
      write/out "no files obtained from wildcard list => " -
                "no more space left in directory!"
   endif
   goto end_of_it
else
   caty(2) = caty(2)+1
endif
if names(1:1) .eq. " " then		!look for ASCII or Image catalog
   if names(2:7) .eq. "=Image" .or. names(2:7) .eq. "=ASCII" -
      goto cat_loop
   if names(2:7) .eq. "=Table" goto cat_loop
   write/keyw names "{names(2:)} "
else
   if names(1:2) .eq. "! " goto cat_loop
endif
zindx = m$index(names," ")
if zindx .gt. 1 names({zindx}:) = " "
goto in_loop				!now work like with command line input
! 
do_it:
kindx(2) = m$len(single)
mvflg = 0
type_loop:
chacha = single({kindx(2)}:{kindx(2)})
if chacha .eq. "." then
   goto dodo_it					!there is a filetype
elseif chacha .eq. diri then
   wait/secs 0					!NoOp
else
   kindx(2) = kindx(2)-1
   if kindx(2) .gt. 1 goto type_loop
endif
-rename {single} {single}.mt
mvflg = 1
! 
!  here we do a single INTAPE/FITS 
! 
dodo_it:
if aux_mode .lt. 2 then
   -delete x__x*.*.*
else
   -delete x__x*.*
endif
mid$info(4) = 0;
! 
if mvflg .eq. 1 then
   intape/fits 1 x__x {single}.mt {p5}
   if outputi(15) .ne. 0 then		!missing FITS data
      write/out "unexpected EOF, {outputi(16)} data values still missing..."
      write/error -100 "Could not convert file: {single}.mt ... bye, bye"
      return
   endif
   -rename {single}.mt {single}
else
   intape/fits 1 x__x {single} {p5}
   if outputi(15) .ne. 0 then		!missing FITS data
      write/out "unexpected EOF, {outputi(16)} data values still missing..."
      write/error -100 "Could not convert file: {single} ... bye, bye"
      return
   endif
endif
! 
count(3) = mid$info(4)			!get no. of extensions
if count(3) .lt. 1 then
   write/error -100 "Could not convert file: {single} ... bye, bye"
   return
else if count(3) .gt. 9 then
   count(3) = 9				!max. 9 extensions currently
endif
freto = "x__x0001 "
! 
multi_ext:
kindx = m$exist("{freto}.bdf")
if kindx .lt. 1 then
   kindx = m$exist("{freto}.tbl")
   if kindx .lt. 1 then
      kindx = m$exist("{freto}.fit")
      if kindx .lt. 1 then
         if p5(2:2) .eq. "N" then		!no create option
            goto after_multi_ext
         endif
         !
         if freto(9:9) .eq. " " then
            freto(9:9) = "a"
         else if freto(9:9) .eq. "a" then
            freto(9:9) = "b"
         else if freto(9:9) .eq. "b" then
            freto(9:9) = "c"
         else if freto(9:9) .eq. "c" then
            freto(9:9) = "d"
         else if freto(9:9) .eq. "d" then
            freto(9:9) = "e"
         else if freto(9:9) .eq. "e" then
            freto(9:9) = "f"
         else
            freto(9:9) = "g"
         endif
         goto multi_ext
      else
         write/keyw ftype .fit
      endif
   else
      write/keyw ftype .tbl
   endif
else
   write/keyw ftype .bdf
endif
count(3) = count(3)-1
! 
write/keyw psingle {osingle}{freto(9:9)}
kindx(2) = m$len(osingle)
otype_loop:
chacha = osingle({kindx(2)}:{kindx(2)})
if chacha .eq. "." then
   goto rename_it				!there is a filetype
elseif chacha .eq. diri then
   wait/secs 0
else
   kindx(2) = kindx(2)-1
   if kindx(2) .gt. 1 goto otype_loop
endif
write/keyw psingle {psingle}{ftype}
! 
rename_it:
if p3(1:1) .eq. "O" then
   restore/name {freto}{ftype} no no {p3(2:2)}
   if out_a(1:1) .ne. " " then
      write/keyw psingle {out_a}
   else
      goto after_multi_ext
   endif
else
   rename/image {freto}{ftype} {psingle} No	!avoid HISTORY update
endif
write/out FITS file: {single} "converted to: {psingle}"
outcount = outcount+1
if count(3) .gt. 0 goto multi_ext
! 
after_multi_ext:
if caty(1) .eq. 1 then
   goto cat_loop
else
   goto in_loop
endif
! 
end_of_it:				!here we leave...
outputi(10) = outcount			!save no. of files converted
! 
entry checkname
define/param p1 YR c "Enter check_flag:"
define/param p2 _ c "Enter replacing char:"
! 
define/local check/c/1/2 YR
check = m$upper("{p1(1:2)}")
if check .eq. "NC" return			!we ignore bad chars...
! 
define/local badguys/c/1/16 "@+-,^&!|\()# $[]"
define/local kk/i/1/4 0 all
if check(1:1) .ne. "N" then
   define/local showflag/i/1/1 0
else
   define/local showflag/i/1/1 1
endif
define/local oldname/c/1/80 {inputc}
kk(3) = m$len(inputc)
! 
do kk = 1 kk(3)
   if inputc({kk}:{kk}) .eq. """ then
      kk(2) = 1
   else if inputc({kk}:{kk}) .eq. "." then
      kk(4) = kk(4)+1
      if kk(4) .gt. 1 kk(2) = 1
   else
      kk(2) = m$index(badguys,"{inputc({kk}:{kk})}")
   endif
   if kk(2) .gt. 0 then
      if showflag .eq. 0 then
         write/out "Ojo: name = {inputc}"
         write/out "     contains bad character(s)..."
         showflag = 1
      endif
      if check(2:2) .eq. "C" then		!continue
         return 1
      else if check(2:2) .eq. "S" then		!stop
         write/error 100
         return 2
      else
         inputc({kk}:{kk}) = p2(1:1)		!replace bad char with `_'
      endif
   endif
enddo
if inputc .ne. oldname then
   write/out "     new" name = {inputc}
   return 1
else
   return 0					!name o.k.
endif