source: trunk/SRC/ToBeReviewed/LECTURE/xncdf_lec.pro @ 325

;+
;
; @file_comments
; Reading of a NetCdf file with widgets
;
; @categories
; Widget
;
; @param NAME {in}{optional}{type=string}
; It give the name of the file to be opened. If NAME
; does not contain the separating character of directories ('/' under
; unix for example), the file will be looked for in the current directory.
;
; @keyword IODIR {type=string}
; It contains the directory where to go look for the file to be read.
; If NAME does not contain the separating character of directories ('/' under
; unix for example), the file will be called iodir+nom_fichier.
;
; @keyword COUNT {type=vector}
; An optional vector containing the counts to be used in
; reading Value. COUNT is a 1-based vector with an element for
; each dimension of the data to be written.The default matches
; the size of the variable so that all data is written out.
;
; @keyword GROUP
; The widget ID of the widget that calls XNCDF_LEC. When
; this ID is specified, a death of the caller results in a death
; of XNCDF_LEC.
;
; @keyword OFFSET {type=vector}{default=[0, 0,...]}
; An optional vector containing the starting position
; for the read. The default start position is [0, 0, ...].
;
; @keyword SHIFT {type=vector}{default=[0, 0,...]}
; A vector of integers, specifying for each dimension how much we have to shift it.
; By default, it is [0,0,...]. See the function <proidl>shift</proidl> for more explanations. BEWARE,
; the shift is done on the biggest array before a possible reduction determined
; by OFFSET and COUNT. On the other hand, it is done after the possible extraction
; created by the STRIDE.
;
; @keyword STRIDE {type=vector}{default=[1, 1,...]}
; An optional vector containing the strides, or sampling
; intervals, between accessed values of the netCDF variable. The
; default stride vector is that for a contiguous read, [1, 1,...].
;
; @returns
;  2 different cases:
;       1) None attribute has been selected. In this case, res is the array we
;       wanted to read.
;       2) Some attributes has been selected. In this case, res is a structure
;       whose the first element having the name of the variable is the values
;       array and the other arguments are the select arguments.
;
; @uses
; wididbase, infovariable, resultat, motcle
;
; @examples
; IDL> help, xncdf_lec()
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      24/8/1999
;
; @version
; $Id$
;-
FUNCTION xncdf_lec, name, ATT = att, COUNT = count, GROUP = group, OFFSET = offset, IODIR = iodir, SHIFT = shift,  STRIDE = stride, VAR = var
;
  compile_opt idl2, strictarrsubs
;
   COMMON wididbase, base
   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
   COMMON resultat, res
   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
;------------------------------------------------------------
; Trick for using keywords (we pass by variables declared in a common)
;------------------------------------------------------------
   res = -1
   if keyword_set(att) then mcatt = att ELSE mcatt = 0
   if keyword_set(count) then mccount =count  ELSE mccount = 0
   if keyword_set(offset) then mcoffset = offset ELSE mcoffset = 0
   if keyword_set(shift) then mcshift = shift ELSE mcshift = 0
   if keyword_set(stride) then mcstride = stride ELSE mcstride = 0
   if keyword_set(var) then mcvar = var ELSE mcvar = 0
;------------------------------------------------------------
; choice of the file's name
;------------------------------------------------------------
; What type of machine is used
   thisOS = strupcase(strmid(!version.os_family, 0, 3))
   CASE thisOS of
      'MAC':sep = ':'
      'WIN':sep = '\'
      ELSE: sep = '/'
   ENDCASE
; If IODIR is not defined, we initialize it at the current directory
   if NOT keyword_set(iodir) then cd,  current = iodir
   mciodir = iodir
; We complete IODIR with a separating character if needed.
   IF rstrpos(iodir, sep) NE strlen(iodir)-1 THEN iodir = iodir+sep
   if n_elements(name) EQ 0 then BEGIN ; If NAME is not defined, we find one thanks to the program dialog_pickfile.
      name = dialog_pickfile(filter = iodir+'*.nc')
      if name[0] EQ '' then return,  -1 ;If we do not have find anything, we go out.
;We complete NAME by IODIR if NAME does not contain any directory separating character.
   ENDIF ELSE if strpos(name, sep) EQ -1 then name = iodir+name
   test = findfile(name)         ; Does the name looked for correspond to a file?
   while test[0] EQ '' OR n_elements(test) GT 1 do BEGIN ; We look for one as long as it correspond to nothing!
      test = test[0]
      name = dialog_pickfile(filter = iodir+'*.nc')
      if name EQ '' then return,  -1
      test = findfile(name)
   endwhile
;------------------------------------------------------------
; Opening of the file name.
;------------------------------------------------------------
   cdfid=ncdf_open(name)
   contient=ncdf_inquire(cdfid)
;------------------------------------------------------------
; What does this file contain??
;------------------------------------------------------------
; Opening of the base window as columns
   if n_elements(group) EQ 0 then base = widget_base(/column, title='Fichier: '+name, /align_left) $
   ELSE base = widget_base(/column, title='Fichier: '+name, /align_left, GROUP_LEADER = group)
; Opening of base sub-windows ;
;------------------------------------------------------------
; base 1 title having the file's name
;------------------------------------------------------------
   base1 = widget_base(base, /column, /align_center)
   rien = widget_label(base1, value = 'NetCdf filename', /align_center)
   rien = widget_text(base1, value = name, /align_center, uvalue=1, /editable) ;File's name we can change
   rien = widget_label(base1, value = ' ') ; We jump a line
;------------------------------------------------------------
; base 2 General informations on the file
;------------------------------------------------------------
   base2 = widget_base(base, /column)
;------------------------------------------------------------
; Informations on global attributes
;------------------------------------------------------------
   if contient.ngatts NE -1 then begin
      rien = widget_label(base2, value = 'Nombre de attributs globaux: '+ strtrim(contient.ngatts,1), /align_left)
      for attiq=0,contient.ngatts-1 do BEGIN ; Loop on  the number of global attributes
         name=ncdf_attname(cdfid,attiq,/global) ;Attribute's name
         ncdf_attget,cdfid,name,value,/global ;Attribute's value
         rien = widget_text(base2, value = name+': '+strtrim(string(value),1), xsize = 60, /scroll, /wrap, /align_right)
      endfor
      rien = widget_label(base2, value = ' ')
   endif
;------------------------------------------------------------
;  Informations on dimensions
;------------------------------------------------------------
   rien = widget_label(base2, value = 'Nombre de dimensions: '+strtrim(contient.ndims,1), /align_left)
   if contient.recdim NE -1 then begin ;  Loop on  the number of global attributes
      ncdf_diminq,cdfid,contient.recdim,name,value ; Name and value of the dimension
      rien = widget_label(base2, value = 'name de la dimension infinie: '+name, /align_left)
   endif
;
   nomdim   =strarr(contient.ndims) ; Vector containing dimensions's name
   tailledim=lonarr(contient.ndims) ; Vector containing dimensions's value
   for dimiq=0,contient.ndims-1 do begin ; Loop on the number of dimensions
      ncdf_diminq,cdfid,dimiq,name,value ; Name and value of the dimension
      nomdim[dimiq]=name
      tailledim[dimiq]=value
      rien = widget_label(base2, value = name+' de taille: '+strtrim(value,1), /align_right)
   ENDFOR
   rien = widget_label(base2, value = ' ') ; We jump a line
;------------------------------------------------------------
; base 3 choice of the variable
;------------------------------------------------------------
   base3 = widget_base(base, /column)
   rien = widget_label(base3, value = 'Nombre de variables: '+strtrim(contient.nvars,1), /align_left)
   base31 = widget_base(base3, /row, /align_center)
;Creation of a listename containing the name of all file's variables
   listename = strarr(contient.nvars)
   for varid=0,contient.nvars-1 do begin
      varcontient=ncdf_varinq(cdfid,varid) ; that the variable contain
      listename[varid] = varcontient.name
   endfor
   rien= widget_label(base31, value = 'variable')
; Creation of a button with a pop-up menu.
   base311=widget_droplist(base31,value=listename, uvalue=2)
   rien = widget_label(base3, value = '')
;------------------------------------------------------------
; base 4 button done
;------------------------------------------------------------
   base4 = widget_base(base, /row)
   base42=widget_button(base4,value='done', uvalue=3, /align_right)
;Execution of the base window and of sub-windows
   widget_control,base,/realize
;------------------------------------------------------------
   xmanager,'xncdf_lec',base
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
   return, res
end
;
; La lecture de ce programme se fait de bas en haut:
;   1) xncdf_lec
;    -->2) xncdf_lec_event
;       |--> 3) wid_var
;            --> wid_var_event
;
;+
;
; @file_comments
; Procedure called by xmanager when we press on a button of a second widget created by wid_var.
;
; @param EVENT {in}{required}
; A structure characterizing the type of event which arrive to a widget number1 2
;
; @uses
; wididbase,resultat,infovariable,indicewid,motcle
;
; @version
; $Id$
;-
PRO wid_var_event,  event
;
  compile_opt idl2, strictarrsubs
;
   COMMON wididbase, base
   COMMON resultat, res
   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
   COMMON indicewid_var, widbase1, widbase2111, widbase212, widbase213, selectatt
   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
;
; What is the type of event?
   widget_control, event.id, get_uvalue=uval
   tailledimvar = tailledim[varcontient.dim]
   if n_elements(uval) EQ 0 then return
; case on the type of event.
   case uval OF
      1:BEGIN                   ; We change values in the array
; We check that values put in the array are not totally false.
         widget_control, widbase1, get_value = table
; Is it the good type of argument?
; If the type is wrong, we automatically change it by default values.
         if event.x GT (size(table))[1] then return
         if event.y GT (size(table))[2] then return
         if size(table[event.x, event.y], /type) GE 6 $
          OR size(table[event.x, event.y], /type) EQ 0 then BEGIN
            if event.x EQ 1 then $
             widget_control, widbase1, use_table_select = [1, event.y,1, event.y] $
             , set_value = tailledimvar[event.y] $
            ELSE widget_control, widbase1 $
             , use_table_select = [event.x, event.y, event.x, event.y], set_value = 0
         endif
; Argument with a wrong name value?
         table = fix(table)
         case event.x of
            0:BEGIN             ; We touched the offset
               if table[0, event.y] LT 0 then BEGIN
                  table[0, event.y] = 0
                  widget_control, widbase1, use_table_select = [0, event.y, 0, event.y] $
                   , set_value = 0
              endif
; If it exceed the dimension of the array, we put it at the max and the cont at 1.
               if table[0, event.y] GT tailledimvar[event.y]/table[3, event.y] then begin
                  widget_control, widbase1, use_table_select = [0, event.y,1, event.y] $
                   , set_value = [tailledimvar[event.y]/table[3, event.y], 1]
              ENDIF ELSE BEGIN
; If, with the new offset, the cont is too big, we reduce it  until it goes well!
                  if table[1, event.y] GT $
                   (tailledimvar[event.y]/table[3, event.y])-table[0, event.y] then begin
                     widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
                      , set_value = (tailledimvar[event.y]/table[3, event.y])-table[0, event.y]
                  endif
               ENDELSE
            END
            1:BEGIN             ;We touched the cont.
               if table[1, event.y] LT 1 then BEGIN
                  table[1, event.y] = 1
                  widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
                   , set_value = 1
               endif
; If it is too big, we reduce it  until it goes well!
               if table[1, event.y] GT $
                (tailledimvar[event.y]/table[3, event.y])-table[0, event.y] then BEGIN
                  widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
                   , set_value = (tailledimvar[event.y]/table[3, event.y])-table[0, event.y]
               endif
            END
            2:BEGIN             ;We touched the shift.
               widget_control, widbase1, use_table_select = [2, event.y, 2, event.y] $
                , set_value = table[2, event.y] MOD (tailledimvar[event.y]/table[3, event.y])
            END
            3:BEGIN             ;We touched the stride.
               if table[3, event.y] LT 1 then BEGIN
                  table[3, event.y] = 1
                  widget_control, widbase1, use_table_select = [3, event.y, 3, event.y] $
                   , set_value = 1
               endif
               if table[3, event.y] EQ 0 then $ ;It must not be null.
                widget_control, widbase1, use_table_select = [3, event.y, 3, event.y] $
                , set_value = 1
; It must not be too big.
               if table[3, event.y] GT tailledimvar[event.y] then $
                widget_control, widbase1, use_table_select = [0, event.y,3, event.y] $
                , set_value = [0, 1, 0, tailledimvar[event.y]] $
               ELSE BEGIN
                  if table[1, event.y] GT $
                   (tailledimvar[event.y]/table[3, event.y])-table[0, event.y] then begin
                     widget_control, widbase1, use_table_select = [1, event.y, 1, event.y] $
                      , set_value = (tailledimvar[event.y]/table[3, event.y])-table[0, event.y]
                  endif
               ENDELSE
            END
            ELSE:
         endcase
      END
      2111:BEGIN                ;We touched buttons yes/no
; We update the vector selectatt at 0 or 1 for the concerned attribute (number event.id).
         selectatt[where(widbase2111 EQ event.id)] = event.select
      end
      31:BEGIN                  ;We pressed on 'get'
         widget_control, widbase1, get_value = table
         table = fix(table)
         mcshift = where(table[2, *] NE 0)
         mcoffset = table[0, *]
         mccount = table[1, *]
         mcstride = table[3, *]
         if mcshift[0] NE -1 then BEGIN ; There are some shifts.
; We read the wholeness of dimensions for which ones there is a shift.
            mcoffset[mcshift] = 0
            mccount[mcshift] = tailledimvar[mcshift]
; We do not activate stride when there is no need because it makes write something weird on the screen.
            if total(mcstride) EQ n_elements(mcstride) then $
             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount $
            ELSE $
             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount, STRIDE = mcstride
; To do the shift
            mcshift = table[2, *]
            mcoffset = table[0, *]
            mccount = table[1, *]
; We define the command allowing to do a shift.
            commande = 'res=shift(res'
            for dim = 0, varcontient.ndims-1 do commande = commande+','+string(table[2,dim])
            commande = commande+')'
            rien = execute(commande)
; We redefine the command allowing to cut dimensions which has not been cut yet (ones we shift).
            commande = 'res=res[' ; initialization of the command
            for dim = 0, varcontient.ndims-1 do BEGIN
               if mcshift[dim] EQ 0 then commande = commande+'*,' $
               ELSE commande=commande+string(mcoffset[dim])+':'+string(mccount[dim]+mcoffset[dim]-1)+','
            ENDFOR
            commande = strmid(commande, 0, strlen(commande)-1)+']'
            rien = execute(commande)
; Case without shift, we read directly the good part of the array.
         ENDIF ELSE BEGIN
            if total(mcstride) EQ n_elements(mcstride) then $
             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount $
            ELSE $
             ncdf_varget, cdfid, varid, res, OFFSET = mcoffset, COUNT = mccount, STRIDE = mcstride
         ENDELSE
; Do we have to constitute a structure with selected attributes.
         if total(selectatt) NE 0 then BEGIN ; There are selected attributes
            res = create_struct(varcontient.name, res) ; We create the structure
            selectatt = where(selectatt EQ 1) ; We find selected attributes
            for attid = 0,  n_elements(selectatt)-1 do BEGIN ; for which we take
               widget_control, widbase212[selectatt[attid]], get_value = attname ; the name
               widget_control, widbase213[selectatt[attid]], get_value = attvalue ; the value
              res = create_struct(res, attname[0], attvalue[0]) ; We concatenate the structure
            endfor
         endif
         widget_control, event.top, /destroy ;We shut the second widget.
         widget_control, base, /destroy ;We shut the first widget.
         ncdf_close,cdfid
      END
      32:                       ;Case of the display of a held (with xdisplayfile)
      33:widget_control, event.top, /destroy ;We shut the second widget.
      ELSE:
   endcase
   return
end
;
;+
;
; @file_comments
; This procedure manage the second created widget when we call xncdf_lec.
; This widget concern the reading of the variable.
;
; @param WIDID_PERE {type=scalar}{in}{required}
; It contains the identity of the father widget which was
; created by xncdf_lec and which has allowed to select the variable to be read.
;
; @results
; indirectement res (le tableau ou la structure resultat)
;
; @uses
; resultat,infovariable,indicewid_var,motcle
;
; @version
; $Id$
;-
PRO wid_var, widid_pere
;
  compile_opt idl2, strictarrsubs
;
   COMMON resultat, res
   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
   COMMON indicewid_var, widbase1, widbase2111, widbase212, widbase213, selectatt
   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
   res = -1
;------------------------------------------------------------
; Opening of the base window as columns.
   widbase = widget_base(/column, title='variable: '+varcontient.name, /align_center, group_leader = widid_pere)
;------------------------------------------------------------
; Opening of the base subwindow
;------------------------------------------------------------
; widbase1 array of offsets
;------------------------------------------------------------
   rien = widget_label(widbase, value = ' ') ; We jump a line
; Definition of labels of lines of the array
   rowlab = string(tailledim[varcontient.dim])
   for i = 0,  n_elements(rowlab)-1 do rowlab[i] = strtrim(rowlab[i], 1)
   rowlab = nomdim[varcontient.dim]+replicate(': ', n_elements(varcontient.dim))+rowlab
; Definition of array's initial values
   valinit = lonarr(4, n_elements(varcontient.dim))
; column 0 : offsets
   if keyword_set(mcoffset) AND n_elements(mcoffset) EQ varcontient.ndims THEN $
    valinit[0,*]=mcoffset ELSE valinit[0, *] = 0
; colomn 1 : counts
   if keyword_set(mccount) AND n_elements(mccount) EQ varcontient.ndims THEN  $
    valinit[1,*]=mccount ELSE valinit[1, *] = tailledim[varcontient.dim]
; column 2 : shifts
   if keyword_set(mcshift) AND n_elements(mcshift) EQ varcontient.ndims THEN $
    valinit[2,*]=mcshift ELSE valinit[2, *] = 0
; column 3 : strides
   if keyword_set(mcstride) AND n_elements(mcstride) EQ varcontient.ndims THEN $
    valinit[3,*]=mcstride ELSE valinit[3, *] = 1
; test of initial values of the array
   valinit = fix(valinit)
   valinit[3, *] = 1 > valinit[3, *] < tailledim[varcontient.dim] ; test of strides
   valinit[0, *] = 0 > valinit[0, *] < tailledim[varcontient.dim] ; test of offsets
; test of counts
   valinit[1, *] = 1 > valinit[1, *] < ((tailledim[varcontient.dim]/valinit[3, *])-valinit[0, *])
   valinit[2, *] = valinit[2, *] MOD (tailledim[varcontient.dim]/valinit[3, *]) ; test of shifts
; declaration of the array
   widbase1 = widget_table(widbase, row_labels = rowlab, value = valinit, /editable $
                           , column_labels = ['Offset', 'Count', 'Shift', 'Stride'], uvalue = 1)
; un petit blabla
   rien = widget_label(widbase, value = 'ATTENTION: Faire des ''return'' pour que les valeurs', /align_center)
   rien = widget_label(widbase, value = 'du tableau ou des textes soient bien prises en compte', /align_center)
;------------------------------------------------------------
; widbase2 choice of attributes
;------------------------------------------------------------
   rien = widget_label(widbase, value = ' ') ; We jump a line
   widbase2 = widget_base(widbase, /column)
; To each attribute, we created a widget (widbase21) containing in line a button
; yes/no (widbase211), and two widget text (widbase212, widbase213) comprising the
; name and the value of the attribute.
   widbase21 = lonarr(varcontient.natts)
   widbase211 = lonarr(varcontient.natts)
   widbase2111 = lonarr(varcontient.natts)
; Vector which will serve to know which yes/no are selected. see. wid_var_event
   selectatt = lonarr(varcontient.natts)
   selectatt[*] = 0
   widbase212 = lonarr(varcontient.natts)
   widbase213 = lonarr(varcontient.natts)
   for attid = 0, varcontient.natts-1 do BEGIN ;Loop on the number of attribute.
      widbase21[attid] = widget_base(widbase2, /row)
      name=ncdf_attname(cdfid,varid,attid)
      ncdf_attget,cdfid,varid,name,value
      widbase211[attid] = widget_base(widbase21[attid], /nonexclusive)
      widbase2111[attid]  = widget_button(widbase211[attid], value = ' ', uvalue = 2111)
      widbase212[attid] = widget_text(widbase21[attid], value = name, /editable)
      widbase213[attid] = widget_text(widbase21[attid], value=strtrim(string(value),1), /editable)
   endfor
;------------------------------------------------------------
; widbase3 buttons of the bottom.
;------------------------------------------------------------
   widbase3 = widget_base(widbase, /row,/align_center)
   widbase31=widget_button(widbase3,value='GET', uvalue=31)
   widbase32=widget_button(widbase3,value='Help', uvalue=32)
   widbase33=widget_button(widbase3,value='DONE', uvalue=33)
;------------------------------------------------------------
;execution of the base window and of sub-window.
;------------------------------------------------------------
   widget_control,widbase,/realize
;------------------------------------------------------------
   xmanager,'wid_var',widbase
   return
end
;
;+
;
; @file_comments
; Procedure called by xmanager when we press a button of the first widget
; created by par xncdf_lec
;
; @param EVENT
; A structure characterising the event type which arrive at the widget number 1.
;
; @uses
; resultat, infovariable, motcle
;
; @version
; $Id$
;-
PRO xncdf_lec_event, event
;
  compile_opt idl2, strictarrsubs
;
   COMMON resultat, res
   COMMON infovariable, cdfid, listename, contient, nomdim, tailledim, varid, varcontient
   COMMON motcle, mcatt, mccount, mcoffset, mciodir, mcshift, mcstride, mcvar
; What is the type of event?
   widget_control, event.id, get_uvalue=uval
; case on the type of event.
   case uval of
      1:BEGIN                   ; We want to read an other file
         widget_control, event.id, get_value = nom ; We recuperate the name.
         widget_control, event.top, /destroy ;We shut the widget.
         ncdf_close,cdfid       ;We shut the wrong file which has been opened.
;We call back xncdf_lec
         res = xncdf_lec(nom[0], ATT = mcatt, COUNT = mccount, OFFSET = mcoffset, IODIR = mciodir $
                         , SHIFT = mcshift,  STRIDE = mcstride, VAR = mcvar)
         return
      END
      2:BEGIN                   ; A variable is selected.
         varid = event.index    ; We recuperat its number in the file Netcdf
         varcontient = ncdf_varinq(cdfid,varid)
         wid_var, event.top     ; We call the program which launch the second widget. See sooner.
      END
      3:BEGIN                   ; button done
         widget_control, event.top, /destroy ; We delete the widget
         ncdf_close,cdfid       ; We shut the file.
      END
      ELSE:
   endcase
   return
end