! @(#)listcrea.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:12:26
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! MIDAS procedure  listcrea.prg   for CREATE/IMAGE with func_type = LIST
!
! K.Banse        951106
!
! used as
! @a listcrea frame [dim_specs] offset listspec
! from CREATE/IMAGE with option LIST
! with list_spec = name of file containing the list of file names
!                  or the file names separated by a comma
!
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/param p1 ? ima "Enter image name:"
define/param p2 ? N "Enter Naxis,Npix1,Npix2,...:"
define/param p3 1 N "Enter first (new) plane no.:"
define/param p4 ? C "Enter list file: "
!
define/local nax/i/1/4 {p2}			!save Naxis + Npix
define/local kfid/i/1/2 0,0
define/local frec/c/1/60 " " all
define/local counter/i/1/2 {p3},0
define/local flag/c/1/1 N
define/local last/c/1/1 N
! 
if nax(1) .eq. 2 then
   counter(2) = nax(3)+1
else
   counter(2) = nax(4)+1
endif
set/format i1
! 
kfid(1) = m$index(p4,".cat")
if kfid(1) .gt. 1 then
   open/file {p4} read kfid
   if kfid(1) .eq. -1 then
      write/out problems opening catalog: {p4} 
      return 0
   endif
   read/file {kfid(1)} frec 10
   if frec(3:3) .ne. "I" then
      write/out "Invalid catalog..."
      close/file {kfid(1)}
      return 0
   endif
   flag = "C"
else
! 
   kfid(1) = m$index(p4,",")
   if kfid(1) .lt. 1 then				!lists or single frame
      kfid(1) = m$filtyp(p4,".bdf")			!test, if an image
      if kfid(1) .ne. 1 then				!image type = 1
         open/file {p4} read kfid
         if kfid(1) .eq. -1 then
            write/out problems opening list file: {p4} 
            return 0
         endif
         flag = "L"
      else
         define/local filelist/c/1/80 {p4}
         kfid(2) = 1			!so we don't try to close a file
      endif
   else
      define/local filelist/c/1/80 {p4}
      kfid(2) = 1			!so we don't try to close a file
   endif
endif
! 
! handle catalogs or list-file or explicit file list
! 
read_loop:
write/keyw frec/c/1/60 " " all
if flag .eq. "C" then
   read/file {kfid(1)} frec 20			!current file size in catalogs
elseif flag .eq. "L" then
   read/file {kfid(1)} frec 60
else
   if last .eq. "Y" goto end_of_it
!  
   kfid = m$index(filelist,",")
   if kfid .lt. 1 last = "Y"			!we reached the last file
   kfid = kfid-1
   write/keyw frec {filelist(1:{kfid})}
   kfid = kfid+2
   write/keyw filelist/c/1/80 {filelist({kfid}:)}
endif
if counter .eq. counter(2) then			!more frames than Npix(last)
   goto end_of_it
else if counter .eq. {p3} then			!copy CUTS of first frame
   cuts/image {p1} {frec} 
endif
! 
if kfid(2) .lt. 1 then
   close/file {kfid(1)}
   goto end_of_it
endif
!
! here we insert
!
if nax(1) .eq. 2 then
   insert/image {frec} {p1} <,@{counter} >Null
else
   insert/image {frec} {p1} <,<,@{counter} >Null
endif
counter = counter+1
goto read_loop
! 
end_of_it:
counter = counter-{p3}
write/out {counter} files inserted into {p1}
return {counter}