;------------------------------------------------------------------------------
; NAME: TBINPDS
;
; PURPOSE: To read a PDS binary table file into an IDL structure containing
;          columns of the data table as elements
;
; CALLING SEQUENCE: Result = TBINPDS (filename, label, [/SILENT])
;
; INPUTS:
;    Filename: Scalar string containing the name of the PDS file to read
;    Label: String array containing the table header information
; OUTPUTS:
;    Result: Table structure constructed from designated records
;
; OPTIONAL INPUT:
;    SILENT: suppresses any messages from the procedure
;
; EXAMPLES:
;    To read a binary table file TABLE.LBL into a structure, tab:
;       IDL> label = HEADPDS ('TABLE.LBL',/SILENT)
;       IDL> tab = TBINPDS ('TABLE.LBL',label,/SILENT)
;
; PROCEDURES USED:
;    Functions: GET_VIABLE, PDSPAR, CLEAN, REMOVE, STR2NUM, POINTPDS
;
; MODIFICATION HISTORY:
;    Adapted by John D. Koch from READFITS by Wayne Landsman, December,1994
;    March 1996, Michael Haken: Remove the prefix 'ASCII_' if part of
;                               data_type keyword in pds label. Tolerate
;                               improper line termination (carriage-return
;                               and/or line feed missing) in table but
;                               inform user of error.
;
;    21 Feb 2003, P. Khetarpal: Rewrote procedure for robustness, and 
;                               included sub-procedures to clean up table
;                               array for proper conversion. POINTPDS is
;                               used to obtain pointer info. Many other
;                               changes have been made. The function now
;                               properly reads all binary table files
;                               as defined in the PDS Standards Reference.
;------------------------------------------------------------------------------

function TBINPDS, fname, label, SILENT=silent
   ON_ERROR, 2

   if N_params() LT 2 then begin
      print, 'Syntax: Result = TBINPDS (filename,label[,/SILENT])'
      return, -1
   endif

   if keyword_set(SILENT) then silent = 1 else silent = 0

   ; obtain viable objects:
   tab_objs = GET_VIABLE (label,'TABLE')
   ser_objs = GET_VIABLE (label,'SERIES')
   pal_objs = GET_VIABLE (label,'PALETTE')
   spe_objs = GET_VIABLE (label,'SPECTRUM')
   con_objs = GET_VIABLE (label,'CONTAINER')
   if tab_objs.count GT 0 then begin
      objarray = tab_objs.array
      objcount = tab_objs.count
      objindex = tab_objs.index
   endif else if ser_objs.count GT 0 then begin
      objarray = [objarray, ser_objs.array]
      objcount = objcount + ser_objs.count
      objindex = [objindex, ser_objs.index]
   endif else if pal_objs.count GT 0 then begin
      objarray = [objarray, pal_objs.array]
      objcount = objcount + pal_objs.count
      objindex = [objindex, pal_objs.index]
   endif else if spe_objs.count GT 0 then begin
      objarray = [objarray, spe_objs.array]
      objcount = objcount + spe_objs.count
      objindex = [objindex, spe_objs.index]
   endif
   if con_objs.count GT 0 then begin
      print, "WARNING: CONTAINER object found. Currently not supported by"+$
             " PDSREAD"
      return, -1
   endif

   ; obtain required keyword parameters:
   interform = PDSPAR (label, 'INTERCHANGE_FORMAT')
   if !ERR EQ -1 then begin
      message, 'Error: missing required INTERCHANGE_FORMAT keyword'
   endif else begin
     interform = interform[0]
     interform = CLEAN(interform, /SPACE)
     interform = REMOVE(interform, '"')
     if interform EQ 'ASCII' then message, $
        'Error: this is a ascii table file; try TASCPDS.'
   endelse

   columns = PDSPAR (label,'COLUMNS')
   if !ERR EQ -1 then begin
      message, 'Error: missing required COLUMNS keyword.'
   endif else $
      cols = fix(STR2NUM(columns[0]))

   X = PDSPAR (label, 'ROW_BYTES')
   if !ERR EQ -1 then begin
      message, 'Error: missing required ROW_BYTES keyword.'
   endif else $
      X = long(X[0])

   Y = PDSPAR (label,'ROWS',INDEX=Y_ind)
   if !ERR EQ -1 then begin
      message, 'Error: missing required ROWS keyword.'
   endif else $
      Y = long(Y[0])

   ; obtain column information:
   name = PDSPAR (label, 'NAME', INDEX=name_ind)
   if !ERR EQ -1 then begin
      message, 'Error: missing required NAME keywords'
   endif else begin
      count = cols
      while name_ind[0] LT Y_ind[0] do begin
         name = name[1:count+1]
         name_ind = name_ind[1:count+1]
      count = count - 1
      endwhile
      columns = strarr(cols+1)
      columns[0] = "columns"
   endelse

   data_type = PDSPAR (label,'DATA_TYPE',COUNT=data_count,INDEX=data_ind)
   if !ERR EQ -1 then message, $
      'Error: missing required DATA_TYPE keywords.'

   length = PDSPAR (label,'BYTES',COUNT=byte_count,INDEX=byte_ind)
   if !ERR EQ -1 then message, $
      'Error: missing required BYTES keywords.'

   start_byte = PDSPAR (label,'START_BYTE',COUNT=strt_count,INDEX=strt_ind)-1
   if !ERR EQ -1 then message, $
      'Error: missing required START_BYTE keywords.'

   scale_flag = 0
   scale = PDSPAR (label,'SCALING_FACTOR',COUNT=scal_count,INDEX=scal_ind)
   if !ERR EQ -1 then !ERR = 0 else begin
      scale_flag = 1
      scalpos = 0
   endelse 

   offset_flag = 0
   offset = PDSPAR (label,'OFFSET_FLAG',COUNT=off_count,INDEX=off_ind)
   if !ERR EQ -1 then !ERR = 0 else begin
      offset_flag = 1
      offpos = 0
   endelse

   ; look for items in Column objects:
   arrays = 0
   items = PDSPAR (label,'ITEMS',COUNT=arrays,INDEX=is_ind)
   if !ERR GT -1 then begin
      item_bytes = PDSPAR (label,'ITEM_BYTES',COUNT=iarrays,INDEX=ib_ind)
      if !ERR GT -1 then begin
         if iarrays NE arrays then message, $
            'ERROR: ITEMS count and ITEM_BYTES count discrepancy'
         length = [temporary(length),item_bytes]
         byte_ind = [temporary(byte_ind),ib_ind]
      endif

      if data_count[0] LT cols then begin
         item_type = PDSPAR (label,'ITEM_TYPE',COUNT=iarrays,INDEX=it_ind)
         if !ERR EQ -1 then message, $
            'ERROR: missing required ITEM_TYPE keyword' else $
         if iarrays NE arrays then message, $
            'ERROR: ITEMS count and ITEM_TYPE count discrepancy'
         data_type = [temporary(data_type),item_type]
         data_ind = [temporary(data_ind),it_ind]
      endif
   endif

   ; clean data_types and names:
   arch = strarr(cols)
   for j = 0, cols-1 do begin
      param = ['"',"'","(",")"]
      name[j] = CLEAN (name[j])
      name[j] = REMOVE (name[j], param)
      data_type[j] = CLEAN (data_type[j], /SPACE)
      data_type[j] = REMOVE (data_type[j], param)
      temp = str_sep(data_type[j], '_')
      if n_elements(temp) GT 1 then begin
         arch[j] = temp[0]
         data_type[j] = ''
         for p = 1, n_elements(temp)-1 do begin
            data_type[j] = data_type[j] + temp[p] + '_'
         endfor
         data_type[j] = strmid(data_type[j],0,strlen(data_type[j])-1)
      endif else arch[j] = data_type[j]
   endfor   

   columns[1:cols] = name

   ; get pointer information
   pointer = POINTPDS (label, fname, objarray[0])
   datafile = pointer.datafile
   skip = pointer.skip

   if silent EQ 0 then begin
     str = cols*Y
     text = strtrim(string(cols),2)+' Columns and '+$
            strtrim(string(Y),2)+' Rows'
     if str GT 0 then begin
        print, 'Now reading table with '+text
     endif else begin
        print, 'Warning: ROWS or COLUMNS = 0. No data read.'  
     endelse
   endif

   ; read data:
   openr, unit, fname, /GET_LUN
   file = assoc(unit, bytarr(X,Y,/NOZERO),skip)
   table = file[0]
   close, unit
   free_lun, unit

   ; conversion of string into structure of appropriate column vectors
   data = CREATE_STRUCT ('column_names',columns)

   for k = 0, cols-1 do begin
      vect = 0
      col_name = 'column'+strtrim(string(k+1),2)
      if k LT cols-1 then begin
         startpos = where(strt_ind GT name_ind[k] AND strt_ind LT name_ind[k+1])
         typepos = where(data_ind GT name_ind[k] AND data_ind LT name_ind[k+1])
         lenpos = where(byte_ind GT name_ind[k] AND byte_ind LT name_ind[k+1],$ 
                  bitenum)
         if arrays[0] GT 0 then $
            it = where(is_ind GT name_ind[k] AND is_ind LT name_ind[k+1])

         if scale_flag then begin
          scalpos = where(scal_ind GT name_ind[k] AND scal_ind LT name_ind[k+1])
          scalpos = scalpos[0]
         endif else scalpos = -1
         if offset_flag then begin
            offpos = where(off_ind GT name_ind[k] AND off_ind LT name_ind[k+1])
            offpos = offpos[0]
         endif else offpos = -1
      endif else begin
         startpos = where(strt_ind GT name_ind[k])
         typepos = where(data_ind GT name_ind[k])
         lenpos = where(byte_ind GT name_ind[k], bitenum)
         if arrays[0] GT 0 then $
            it = where(is_ind GT name_ind[k])

         if scale_flag then begin
            scalpos = where(scal_ind GT name_ind[k])
            scale = scalpos[0]
         endif else scalpos = -1
         if offset_flag then begin
            offpos = where(off_ind GT name_ind[k])
            offset = offpos[0]
         endif else offpos = -1
      endelse
      start = start_byte[startpos]
      start = start[0]

      type = data_type[typepos]
      type = type[0]
      elem = 1
      if arrays[0] GT 0 then if it[0] GT -1 then elem = fix(items[it[0]])

      ;if more than one 'lenpos' then find the one that is smallest
      least = lenpos[0]
      for b = 0, bitenum - 1 do begin
         if STR2NUM(length[lenpos[b]]) LT STR2NUM(length[least]) $ 
            then least = lenpos[b]
      endfor
      lenpos = least[0]
      bytes = length[lenpos]
      bytes = STR2NUM(bytes[0])

      ; determine architecture:
      CASE arch[typepos[0]] OF
               '': arch[typepos[0]] = 'MSB'
            'MSB':
           'IEEE': arch[typepos[0]] = 'MSB'
       'UNSIGNED': begin
                      arch[typepos[0]] = 'MSB'
                      type = 'UNSIGNED_INTEGER'
                   end
            'VAX': arch[typepos[0]] = 'LSB'
           'VAXG': arch[typepos[0]] = 'LSB'
            'LSB': arch[typepos[0]] = 'LSB'
            'MAC': arch[typepos[0]] = 'MSB'
            'SUN': arch[typepos[0]] = 'MSB'
             'PC': if strpos(type,'INTEGER') GT -1 then arch[typepos[0]] = 'LSB'
          'ASCII': begin
                     type = 'CHARACTER'
                     arch[typepos[0]] = 'MSB'
                   end
      'CHARACTER': begin
                     type = 'CHARACTER'
                     arch[typepos[0]] = 'MSB'
                   end
             else: begin
                     print, arch[typepos[0]]+' not a recognized architecture!'+$
                            'MSB assumed.'
                     arch[typepos] = 'MSB'
                   end
      ENDCASE

      vect = BTABVECT(table,start,bytes,type,elem)

      ; perform necessary conversion:
      if arch[typepos] EQ 'MSB' then begin
         ieee_to_host, vect
      endif else if arch[typepos] EQ 'LSB' then begin
         vect = conv_vax_unix(vect)
      endif else if arch[typepos] EQ 'PC' then begin
         print, 'PC_REAL data type not supported by TBINPDS. No conversion'
      endif

      if strpos(type,'UNSIGNED') GT -1 then vect = abs(vect)

      if scale_flag AND scalpos NE -1 then begin
         vect = vect * double(scale[scalpos])
      endif
      if offset_flag AND offpos NE -1 then begin
         vect = vect + double(offset[offpos])
      endif

      data = CREATE_STRUCT(data,col_name,vect)
   endfor

   return, data
end