;+
;PROCEDURE: printdat,x, [name]
;PURPOSE:
;   Displays information and contents of a data variable.
;   This routine is most useful for displaying contents of complex
;   data structures.
;   If printdat is called without arguments then information on all variables
;   within the calling routine are displayed.
;
;Keywords:
;   WIDTH:   Width of screen.
;   MAX:     Maximum number of array elements to print.  (default is 5)
;   NSTRMAX  Maximum number of structure (or pointer) elements to print.
;            (default is 3)
;   OUTSTRING=outstring :  named variable in which the output is dumped.
;
;Written by Davin Larson, May 1997.
;-
pro printdat,data,name,level=level,  $
   options=opts,ptrs=ptrs, $  ; for recursion only!
   values_only=values_only, $
   pgmtrace = pgmtrace, $
   namewidth=namewidth, $
   max=max,outstring=outstring,nstrmax=nstrmax,nptrmax=nptrmax,width=width

;tname=['Undef','Byte','Int','Long','Flt','Dbl', $
;   'Cmplx','String','Struct','Dcmplx','Pointer','Object','Uint','Ulong','Long64']

if not keyword_set(level) then level = ''

if keyword_set(pgmtrace) then  level = ptrace(/sublevel) + level

if n_params() eq 0 then begin
   vars=scope_varname(count=c,level=-1)
   for i=0,c-1 do begin
      print
      printdat,scope_varfetch(vars[i],level=-1),vars[i]
   endfor
   return
endif

if not keyword_set(name) then begin
   name = scope_varname(data,level=-1)
   if not keyword_set(name) then name='<Expr>'
endif

if not keyword_set(opts) then begin
  opts={ $
      width: keyword_set(width) ? width : 80, $
      max:   keyword_set(max)   ? max   : 29, $
      values_only: keyword_set(values_only), $
      nstrmax: keyword_set(nstrmax)  ? nstrmax : 3, $
      nptrmax: keyword_set(nptrmax)  ? nptrmax : 3, $
      outs:   arg_present(outstring)  }
  outstring=''
  ptrs = ptr_new()     ; array to detect recursion
endif


dt = size(/type,data)
n =  size(/n_elements,data)
;tnam = tname[dt]
tnam = size(/tname,data)
dim = dimen(data)
ndim = ndimen(data)
nm = (n < opts.max)
if dt eq 8 and n eq 1 then ndim=0   ;fix of IDL bug

if ndim ge 1 then dimstr = '['+string(dim,format="(8(i0.0,:,','))")+']' $
else dimstr=''

case dt of
 0:    valstr = 'Undefined'                                    ;Undefined
 1:    valstr = strcompress(fix(data[0:nm-1]),/remove_all)     ;bytes
 7:    valstr = "'"+data[0:nm-1]+"'"                           ;strings
 8:    valstr = tag_names(data,/struct)+'---->'                ;structures
 10:   begin                                                   ;pointers
        valstr = strarr(nm)
        for i=0,nm-1 do valstr[i] = string(/print,data[i])
       end
 11:   begin                                                   ;objects
        valstr = strarr(nm)
        for i=0,nm-1 do valstr[i] = string(/print,data[i])
       end
 else: valstr = strcompress(data[0:nm-1],/remove_all)
endcase

ls = strlen(valstr)
;print,width,ls
if dt ne 8 and ndim ge 1 then begin
   w = 20
   for i=0,nm-1 do begin
      w = w+ls[i]+2
      if w gt opts.width then goto,break1
   endfor
   break1:
   i = i > 1
   if i lt n then valstr[i-1] = ' ...'
   valstr = '['+string(/print,valstr[0:i-1],format="(30(a,:,', '))")+']'
endif

;s1='              '
;strput,s1,name
if keyword_set(namewidth) then begin
   s1 = string(replicate(32b,namewidth+1))
   strput,s1,name
endif else s1 = name+' '
s2='              '
strput,s2,tnam+dimstr
if opts.values_only then $
  s = string(level,s1,valstr,format="(a,a,'= ',a)") $
else $
  s = string(level,s1,s2,valstr,format="(a,a,'= ',a,'= ',a)")

if opts.outs then   append_array,outstring,s   $
else print,s

;help,ptrs
if dt eq 8 then begin        ;structure
   for j=0l,n-1 do begin
     if j ge opts.nstrmax then begin
        s3 = level+'Array truncated ...'
        if opts.outs then  append_array,outstring,s3 $
        else print,s3
        goto,break2
     endif
     tags = tag_names(data)
     nwdth = max(strlen(tags))
     if ndim ge 1 then begin
         s3 = level+name+'['+strtrim(j,2)+']'
         if opts.outs then  append_array,outstring,s3 $
         else print,s3
     endif
     for i=0,n_elements(tags)-1 do begin
       printdat,data(j).(i),tags(i),level=level+'   ',namewidth=nwdth,  $
          outstring=outstring,options=opts,ptrs=ptrs
     endfor
   endfor
   break2:
endif

if dt eq   10  then begin      ; pointers
   for j=0,n-1 do begin
     if opts.nptrmax eq 0 then goto,break3
     if j ge opts.nptrmax then begin
        s3 = level+'Array truncated ...'
        if opts.outs then  append_array,outstring,s3 $
        else print,s3
        goto,break3
     endif
     if ptr_valid(data[j]) then begin   ; pointer is defined
        if keyword_set(ptrs) and total(data[j] eq ptrs) gt 0 then begin  ;recursive
           s3="recursive pointer detected!"
           if opts.outs then  append_array,outstring,s3 $
           else print,s3
        endif else begin
           s3 = '*'+name
           if ndim ge 1 then s3 = s3+'['+strtrim(j,2)+']'
           printdat,*data[j],level=level,s3,outstring=outstring, $
              options=opts,ptrs= keyword_set(ptrs) ? [ptrs,data[j]] : data[j]
        endelse
     endif
   endfor
   break3:
endif


end