;------------------------------------------------------------------------------
; NAME: IMAGEPDS
;
; PURPOSE: To read an image array into an array variable
;
; CALLING SEQUENCE: Result = IMAGEPDS (filename, label, [/SILENT])
;
; INPUTS:
;    Filename: Scalar string containing the name of the PDS file to read
;    Label: String array containing the image header information
; OUTPUTS:
;    Result: image array constructed from designated record
;
; OPTIONAL INPUT:
;    SILENT: suppresses any messages from the procedure
;
; EXAMPLES: 
;    To read an image file IMAGE.LBL into an array, img:
;       IDL> label = HEADPDS ('IMAGE.LBL',/SILENT)
;       IDL> img = IMAGEPDS ('IMAGE.LBL', label, /SILENT)
;    To read an image file IMAGEWIN.LBL with a window object into img:
;       IDL> label = HEADPDS ('IMAGEWIN.LBL',/SILENT)
;       IDL> img = IMAGEPDS ('IMAGEWIN.LBL',/SILENT)  
; 
; PROCEDURES USED:
;    Functions: GET_VIABLE, PDSPAR, STR2NUM, POINTPDS
;
; MODIFICATION HISTORY:
;    Adapted by John D. Koch from READFITS by Wayne Landsman, December,1994
;    25 Sep 1998, a.c.raugh: fixed bug which expected negative SAMPLE_BITS
;                            to be created rather than a fltarr; Fixed
;                            calculation of byte offsets in detached PDS
;                            labels; Added lines to close and free logical
;                            units before return.
;
;    02 Oct 1998, a.c.raugh: Analyzed code and added comments throughout;
;                            Added code to deal properly with unsigned
;                            integers and signed bytes; Re-wrote pointer
;                            parsing code to improve robustness
;
;    27 July 1999, M. Barker: fixed bug that produced a negative skip when
;                             there was no offset provided in file pointer
;
;    20 Aug 2002, P. Khetarpal: rewrote and modified the code to deal with
;                               multiple and non-image objects in the PDS
;                               PDS file. Also modified to work with
;                               window sub-objects, prefix and suffix
;                               bytes in an image object.
;
;   14 Feb 2003, P. Khetarpal: fixed window-processing and multiple object
;                              processing. Rewrote the sample_type
;                              analysis for image objects.
;------------------------------------------------------------------------------

function IMAGEPDS, fname, label, SILENT=silent
   ; error protection
   ON_ERROR, 2
   
   if n_params() LT 2 then begin
      print, 'Syntax: result = IMAGEPDS (filename [,/SILENT])'
      return, -1
   endif

   if keyword_set(SILENT) then silent = 1 else silent = 0
   
   ; obtain image and window objects from label:
   objects = GET_VIABLE (label, 'IMAGE')
   objarray = objects.array
   objcount = objects.count
   objindex = objects.index

   wobjects = GET_VIABLE (label,'WINDOW')
   if wobjects.count GT 0 then begin
      objarray = [objarray,wobjects.array]
      objcount = objcount+wobjects.count
      objindex = [objindex,wobjects.index]
      window_flag = 1                     ; there is a window object
   endif else window_flag = -1            ; there is no window object

   ; obtain required keyword parameters from label:
   Xvar = PDSPAR (label,'LINE_SAMPLES',COUNT=xcount,INDEX=xind)
   Yvar = PDSPAR (label,'LINES',COUNT=ycount,INDEX=yind)
   if xcount NE ycount then begin
      print, 'ERROR: LINE_SAMPLES and LINES count discrepancy.'
      return, -1
   endif

   samplebits = PDSPAR (label,'SAMPLE_BITS',COUNT=bitcount,INDEX=bitind)
   if (bitcount NE xcount) AND (window_flag EQ -1) then begin
      print, 'ERROR: LINES_SAMPLES and SAMPLE_BITS count discrepancy.'
      return, -1
   endif

   sampletype = PDSPAR (label,'SAMPLE_TYPE',COUNT=sampcount,INDEX=sampind)

   lnprefix = long(PDSPAR(label,'LINE_PREFIX_BYTES',COUNT=lpcount,INDEX=lpind))
   if !ERR EQ -1 then pflag = -1 else pflag = 0

   lnsuffix = long(PDSPAR(label,'LINE_SUFFIX_BYTES',COUNT=lscount,INDEX=lsind))
   if !ERR EQ -1 then sflag = -1 else sflag = 0

   if objcount GT 1 then data = CREATE_STRUCT('images',objcount)

   ; process each image object:
   for i = 0, objcount-1 do begin
      cur_obj = objindex[i]
      if i LT objcount-1 then $
         next_obj = objindex[i+1] $
      else begin
         labelsize = size(label)
         next_obj = labelsize[1]
      endelse

      ; obtain element index for the current image:
      xpos = where(xind GT cur_obj AND xind LT next_obj)      ;LINE_SAMPLES
      ypos = where(yind GT cur_obj AND yind LT next_obj)      ;LINES
      bpos = where(bitind GT cur_obj AND bitind LT next_obj)  ;SAMPLE_BITS
      spos = where(sampind GT cur_obj AND sampind LT next_obj);SAMPLE_TYPE

      if pflag GT -1 then begin
         lppos = where(lpind GT cur_obj AND lpind LT next_obj) ; prefix
         if lppos[0] GT -1 then begin
            prefix_byte = long(lnprefix[lppos[0]])
            if prefix_byte EQ 0 then pflag = -1
         endif else begin
            prefix_byte = 0
            pflag = -1
         endelse
      endif
     
      if sflag GT -1 then begin
         lspos = where(lsind GT cur_obj AND lsind LT next_obj) ; suffix
         if lspos[0] GT -1 then begin
            suffix_byte = long(lnsuffix[lspos[0]])
            if suffix_byte EQ 0 then sflag = -1
         endif else begin
            suffix_byte = 0
            sflag = -1
         endelse
      endif

      if (xpos[0] GT -1) AND (ypos[0] GT -1) AND $
         (bpos[0] GT -1) AND (spos[0] GT -1) then begin
         X = long(Xvar[xpos[0]])
         Y = long(Yvar[ypos[0]])
        
         ; print dimensions of array if not in silent mode:
         if NOT(keyword_set(SILENT)) then begin
            if X GT 0 AND Y GT 0 then begin
               text = strcompress(string(X),/REMOVE_ALL)+ $
                  ' by '+strcompress(string(Y),/REMOVE_ALL)
               print, 'Now reading ' + text + ' array'
            endif else begin
               print, fname + " has X or Y = 0, no data array read."
               data = 0
               return, data
            endelse
         endif

         ; process SAMPLE_BITS and SAMPLE_TYPE:
         bits = STR2NUM (samplebits[bpos[0]])
         bits = bits[0]
         sample_type = sampletype[spos[0]]
         sample_type = sample_type[0]

         ; check sample type for MSB, LSB, IEEE, or VAX:
         samples = str_sep(sample_type, '_')
         n_samples = n_elements(samples)
         j = 0
         flag = 1
         while j LT n_samples AND flag NE -1 do begin
            if (samples[j] EQ 'MSB') OR (samples[j] EQ 'INTEGER') OR $
               (samples[j] EQ 'UNSIGNED') then begin
               sample_type = 'MSB'
               flag = -1
            endif else if (samples[j] EQ 'LSB') then begin
               sample_type = 'LSB'
               flag = -1
            endif else if (samples[j] EQ 'VAX') then begin
               sample_type = 'VAX'
               flag = -1
            endif else if (samples[j] EQ 'IEEE') OR $
                  (samples[j] EQ 'REAL') then begin
               sample_type = 'IEEE'
               flag = -1
            endif 
            j = j+1
         endwhile

         ; check for integer type either SIGNED or UNSIGNED:
         integer_type = sampletype[spos[0]]
         integer_type = integer_type[0]
         rightpos = strpos (strupcase (integer_type),'UNSIGNED')
         if (rightpos GT -1) then begin
            integer_type = 'UNSIGNED'
         endif else begin
            integer_type = 'SIGNED'
         endelse

         ; obtain pointer information:
         pointer = POINTPDS (label, fname, objarray[i])
         datafile = pointer.datafile
         skip = pointer.skip

         ; initialize the image array for respective SAMPLE_BITS:
         CASE bits OF
            8: begin
                  IDL_TYPE = 1
                  element = bytarr (X,Y,/NOZERO)
                  tempimg = bytarr (X,/NOZERO)
               end
           16: begin
                  IDL_TYPE = 2
                  element = intarr (X,Y,/NOZERO)
                  tempimg = intarr (X,/NOZERO)
               end
           32: begin
                  if sample_type EQ 'MSB' OR sample_type EQ 'LSB' then begin
                     IDL_TYPE = 3
                     element = lonarr (X,Y,/NOZERO)
                     tempimg = lonarr (X,/NOZERO)
                  endif else begin
                     IDL_TYPE = 4
                     element = fltarr (X,Y,/NOZERO)
                     tempimg = fltarr (X,/NOZERO)
                  endelse
               end
           64: begin
                  IDL_TYPE = 5
                  element = dblarr (X,Y,/NOZERO)
                  tempimg = dblarr (X,/NOZERO)
               end
         else: message, 'ERROR: Illegal value of SAMPLE_BITS - ' + $
                  strtrim (string(bitpix),2)
         ENDCASE

         if pflag GT -1 then $
            frontimg = bytarr (prefix_byte)
         if sflag GT -1 then $
            backimg = bytarr (suffix_byte)

         ; start reading the image data:
         openr, unit, datafile, /GET_LUN
         point_lun, unit, skip

         counter = 0
         while counter LT Y do begin
            if pflag GT -1 then $
               readu, unit, frontimg
            readu, unit, tempimg
            if sflag GT -1 then $
               readu, unit, backimg
            element [*, counter] = tempimg[*]
            counter = counter + 1
         endwhile

         close, unit
         free_lun, unit

         ; conversion to UNIX readable type:
         CASE sample_type OF
            'MSB': ; no conversion needed
           'IEEE': ; no conversion needed
            'VAX': element = conv_vax_unix (element)
            'LSB': element = conv_vax_unix (element)
             else: begin
                      message, 'WARNING: unrecognized SAMPLE_TYPE - ' + $
                      sampletype[spos[0]]+' no conversion performed.'
                   end
         ENDCASE

         ; convert data if unsupported by IDL:
         if (bits EQ 8 AND integer_type EQ 'SIGNED') then begin
            element = fix(element)
            fixitlist = where (element GT 127)
            if fixitlist[0] GT -1 then begin
               element [fixitlist] = element[fixitlist] - 256
            endif
         endif else if (bits EQ 16 AND integer_type EQ 'UNSIGNED') then begin
            element = long(element)
            fixitlist = where (element LT 0)
            if fixitlist[0] GT -1 then begin
               element[fixitlist] = element[fixitlist] + 65536
            endif
         endif else if (bits EQ 32 AND integer_type EQ 'UNSIGNED') then begin
            element = double(element)
            fixitlist = where (element LT 0.D0)
            if fixitlist[0] GT -1 then begin
               element[fixitlist] = element[fixitlist] + 4.294967296D+9
            endif
         endif

         ; process window object if exists:
         if window_flag GT -1 then begin
            if silent EQ 0 then print, "Processing window object"
            xwpos = where(xind GT next_obj) ; LINE_SAMPLES
            ywpos = where(yind GT next_obj) ; LINES
            ybegin = PDSPAR (label, 'FIRST_LINE')
            xbegin = PDSPAR (label, 'FIRST_LINE_SAMPLE')
            win_X = long(Xvar[xwpos[0]])
            win_Y = long(Yvar[ywpos[0]])

            CASE bits OF
               8: temp = bytarr (win_X, win_Y, /NOZERO)
              16: temp = intarr (win_X, win_Y, /NOZERO)
              32: temp = lonarr (win_X, win_Y, /NOZERO)
              64: temp = dblarr (win_X, win_Y, /NOZERO)
            ENDCASE

            for wx = 0, win_X - 1 do begin
               for wy = 0, win_Y - 1 do begin
                  temp [wx, wy] = element[wx+xbegin[0], wy+ybegin[0]]
               endfor
            endfor
            elementw = temp
         endif

         ; save image:
         if objcount GT 1 then begin
            if window_flag GT -1 then begin
               data = CREATE_STRUCT(data,objarray[i],elementw)
            endif else $
               data = CREATE_STRUCT(data,objarray[i],element)
         endif else if window_flag GT -1 then begin
            data = elementw
         endif else data = element
      endif
   endfor

   if i NE objcount then message, $
      'ERROR: Number of images expected does not equal number found.'

   return, data
end