source: trunk/SRC/ToBeReviewed/PLOTS/DESSINE/pltbase.pro @ 419

;+
;
; @file_comments
; Overlayer contour to trace a field which can be mask.
; Elementary brick of <pro>plt</pro>, <pro>pltz</pro> and <pro>pltt</pro>.
;
; @categories
; Graphics
;
; @param Z2D {in}{required}
; The table to trace
;
; @param X {in}{required}
; Axis. Vector or array of the same size that z2d. This is the coordinate of z2d on x.
;
; @param Y {in}{required}
; Axis. Vector or array of the same size that z2d. This is the coordinate of z2d on y.
;
; @param MASK {in}{required}{type=array}
; It is the array who mask z2d (with 0s on points we want to mask and 1s on others).
; If z2d is not masked, put this argument equal to 1.
;
; @param XM {in}{required}
; Axis of the mask. Vector or array of the same size that mask.
; This is the coordinate of mask on x.
;
; @param YM {in}{required}
; Axis of the mask. Vector or array of the same size that mask.
; This is the coordinate of mask on y.
;
; @param LEVELS {in}{optional}{type=vector}
; Vectors which contain levels needed at the contour.
; If it is not given, we take 20 levels between the min and the max.
;
; @param COLORS {in}{optional}{type=vector}
; Vectors which contain colors needed at the contour.
; If it is not given, we take 20 levels between the min and the max.
;
; @keyword COLORTRICHAMP
; The color we want to use to draw the triangulation which is used to make contours of the field.
;
; @keyword COLORTRIMASK
; The color we want to use to draw the triangulation which is used to make contours of the mask.
;
; @keyword COLOR_C
; To draw the contour in color instead of in black
; with filling in color
;
; @keyword CONT_NOFILL
; Activate it not to fill the point mask to let them transparent!
; Comment: Nevertheless, we trace mask's contour.
;
; @keyword CONT_COLOR {default= (!d.n_colors - 1) < 255 =>white}
; The color of the continent.
;
; @keyword DESSTRICHAMP
; To draw the triangulation which is used to make field's contours.
;
; @keyword DESSTRIMASK
; To draw the triangulation which is used to make mask's contours.
;
; @keyword FORPLT
; To activate if we want that the drawing of coast be realized by <pro>tracecote</pro> rather than <pro>tracemask</pro>.
;
; @keyword I_COLORS {type=vector}
; It is a vector specifying the colors to use to trace contours.
; It is the same thing that c_colors which act on contours.
;
; @keyword MORE {default=10}
; Number to give to avoid style's bugs:
;  % Out of range subscript encountered: <LONG      Array[38911]>.
;  % Execution halted at:  PLTBASE           151
;             If the bug still exist, increase the value of more!
; (The explanation and the justification of this method do not have scientific bases yet...).
;
; @keyword NOFILL
; To make just isolines with no filling
;
; @keyword NOCONTOUR
; To make just colors.
;
; @keyword CONTSTRIDE {type=integer} {default=1}
; To trace one isoline every contstride.
;
; @keyword UNSUR2
; Obsolete. use CONTSTRIDE = 2
;
; @keyword UNLABSUR {type=integer}
; I specify we only label one contour on two.
;
; @keyword CONTOUR
; To be used since <pro>plt</pro>, <pro>pltz</pro> or <pro>pltt</pro>. (Have a look on these routines).
;
; @keyword _EXTRA
; Used to pass keywords
;
; @uses
; <pro>common</pro>
;
; @restrictions
; In the case of z2d, x and y are arrays of same size, we have to put them as vectors: z2d[*], x[*], y[*].
;
; @history
;  Sebastien Masson (smasson\@lodyc.jussieu.fr)
; ????
; 8/2/2000 check if the tri array is not equal to
; -1. allow contour without using a triangulation.
;
; @version
; $Id$
;
; @todo seb L.172 à 173
;
;-
PRO pltbase, z2d, x, y, mask, xm, ym, levels, colors $
           , UNSUR2=unsur2, CONTSTRIDE = contstride, CONTOUR=contour $
           , NOCONTOUR=nocontour, NOFILL=nofill $
           , TRICHAMP=trichamp, TRIMSK=trimsk $
           , REALCONT=realcont, NAN=nan, USETRI=usetri $
           , COLORTRICHAMP=colortrichamp, COLORTRIMASK=colortrimask $
           , COLORTRINAN=colortrinan $
           , COLORPOINTS=colorpoints, DRAWPOINTS=drawpoints $
           , TH_TRICHAMP=th_trichamp, TH_TRIMASK=th_trimask $
           , DESSTRICHAMP=desstrichamp, DESSTRIMASK=desstrimask $
           , DESSTRINAN=desstrinan, COLOR_C=color_c $
           , I_COLORS=i_colors,  CONT_COLOR=CONT_COLOR $
           , CONT_NOFILL=cont_nofill, UNLABSUR=unlabsur $
           , COINMONTEMASK=coinmontemask, COINDESCENDMASK=coindescendmask $
           , COINMONTENAN=coinmontenan, COINDESCENDNAN=coindescendnan $
           , INDICEZOOMMASK=indicezoommask, INDICEZOOMNAN=indicezoomnan $
           , MASKORG=maskorg, MASKNAN=masknan, TRINAN=trinan $
           , FORPLT=forplt, REALSECTION=realsection $
           , MORE=more, EXCHANGE_XY=exchange_xy $
           , _EXTRA=ex
;
  compile_opt idl2, strictarrsubs
;
@cm_4mesh
  IF NOT keyword_set(key_forgetold) THEN BEGIN
@updatenew
@updatekwd
  ENDIF
;---------------------------------------------------------
;
; Explanation concerning contour. This keyword is activated when we trace a
; colored contour different from the one with black trait.
; If it is activated (case n_elements(contour) NE 0), we pass 2 time in pltbase:
;   1) We trace colors then we leave, it is the case:
;         n_elements(contour) NE 0 AND n_elements(contour) NE 4)
;   2) We trace contours in traits then continents, it is the case:
;         n_elements(contour) NE 0 AND n_elements(contour) EQ 4)
;
;------------------------------------------------------------
  tempsun = systime(1)          ; To key_performance
  if n_elements(mask) EQ 0 then mask = 1b
  if n_elements(masknan) EQ 0 then masknan = 1b
  IF total(mask) EQ n_elements(z2d) THEN mask = 1b
;----------------------------------------------------------------------
; If levels and colors aren't given
;----------------------------------------------------------------------
  if n_params() EQ 4 then $
    label, 0, min(z2d*mask), max(z2d*mask), ncontour, levels, colors
; attention bidouille inexplicable pour que tout se passe bien avec les
; postcript ds pltz!!!
  if n_elements(contour) LE 4 AND !x.type EQ 0 THEN $
    plot, [0], [0], xstyle = 5, ystyle = 5, /nodata, /noerase, title = '', subtitle = ''
;----------------------------------------------------------------------
; Is cell_fill is a part of _extra, we desactive it if it is nt equal to 2
;----------------------------------------------------------------------
  IF chkstru(ex, 'CELL_FILL') THEN BEGIN
    cell_fill = ex.CELL_FILL
    if ex.CELL_FILL NE 2 then ex.CELL_FILL = 0
  ENDIF ELSE cell_fill = 0      ;
;----------------------------------------------------------------------
; I) Filling contours with colors
;----------------------------------------------------------------------
  if NOT keyword_set(more) then more = 10
  if NOT keyword_set(nofill) AND NOT keyword_set(color_c) then begin
    if n_elements(contour) NE 4 THEN BEGIN
      if usetri EQ 2 then BEGIN
        IF size(x, /n_dimensions) EQ 1 THEN x = x#replicate(1, (size(z2d))[2])
        IF size(y, /n_dimensions) EQ 1 THEN y = replicate(1, (size(z2d))[1])#y
        contour, [z2d[*], fltarr(more)], [x[*], fltarr(more)] $
          , [y[*], fltarr(more)], levels = levels, c_color = colors $
          , /noerase, /fill, TRIANGULATION = trichamp, _extra = ex
        ENDIF ELSE BEGIN
        IF size(x, /n_dimensions) EQ 2 THEN x = x[*, 0]
        IF size(y, /n_dimensions) EQ 2 THEN y = reform(y[0, *])
        contour, z2d, x, y, levels = levels, c_color = colors, /noerase $
          , /fill, _extra = ex
      ENDELSE
    ENDIF
  ENDIF
  if n_elements(contour) NE 0 AND n_elements(contour) NE 4 THEN GOTO, fini
  IF chkstru(ex, 'C_ORIENTATION') THEN ex = extractstru(ex, 'C_ORIENTATION')
  IF chkstru(ex, 'C_SPACING') THEN ex = extractstru(ex, 'C_SPACING')
  IF chkstru(ex, 'C_COLORS') THEN ex = extractstru(ex, 'C_COLORS')
;------------------------------------------------------------
; II) Drawing contours with lines
;------------------------------------------------------------
  if n_elements(contour) EQ 4 OR n_elements(contour) EQ 0 THEN BEGIN
;
; we put the masked values to NaN
;
    IF (n_elements(mask) GT 1 OR n_elements(masknan) GT 1) $
      AND NOT keyword_set(cont_nofill) THEN BEGIN
      IF keyword_set(maskorg) THEN tonan = maskorg*masknan ELSE tonan = mask*masknan
      tonan = where(remplit(tonan, nite = 1, mask = tonan $
                            , /basique, fillval = 0 $
                            , fillxdir = keyword_set(realsection)) EQ 0, count)
      IF count NE 0 THEN z2d[temporary(tonan)] = !values.f_nan
    ENDIF
;
; We do not pass if we have to make differents contours...
; In the case of unsur2 is activated, we reduce levels
    if NOT keyword_set(nocontour) then begin
      IF keyword_set(unsur2) THEN levels = levels[where(zeroun(n_elements(levels) ) eq 1)]
      IF keyword_set(contstride) THEN levels = levels[where((indgen(n_elements(levels)) MOD contstride) eq 0)]
; Is unlabsur activated?  Does C_LABEL passed via _EXTRA?
      if keyword_set(unlabsur) THEN IF chkstru(ex, 'C_LABELS') THEN $
        ex.C_LABELS = 1-((indgen(n_elements(ex.C_LABELS)) MOD unlabsur) < 1)
;
; Not to fill when cell_fill is imposed...
      IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = 0
;
      CASE 1 OF
        keyword_set(color_c):c_colors = colors
        keyword_set(i_colors):c_colors = i_colors
        ELSE:
      ENDCASE
;
      IF usetri EQ 2 THEN BEGIN
        IF size(x, /n_dimensions) EQ 1 THEN x = x#replicate(1, (size(z2d))[2])
        IF size(y, /n_dimensions) EQ 1 THEN y = replicate(1, (size(z2d))[1])#y
        contour, [z2d[*], fltarr(more)], [x[*], fltarr(more)] $
          , [y[*], fltarr(more)], levels = levels $
          , overplot = 1-keyword_set(nofill), noerase = keyword_set(nofill) $
          , c_colors = c_colors, TRIANGULATION = trichamp, _extra = ex
      ENDIF ELSE BEGIN
        IF size(x, /n_dimensions) EQ 2 THEN x = x[*, 0]
        IF size(y, /n_dimensions) EQ 2 THEN y = reform(y[0, *])
        contour, z2d, x, y, levels = levels $
          , overplot = 1-keyword_set(nofill), noerase = keyword_set(nofill) $
          , c_colors = c_colors, _extra = ex
      ENDELSE
    ENDIF
;----------------------------------------------------------------------
; III) Filling continents with color
;----------------------------------------------------------------------
    IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = cell_fill < 1
    IF chkstru(ex, 'LEVELS') THEN ex = extractstru(ex, 'LEVELS')
    IF chkstru(ex, 'NODATA') THEN ex = extractstru(ex, 'NODATA')
    IF NOT keyword_set(cont_color) THEN cont_color = (!d.n_colors-1) <  255
;
; If there is points at NaN
; We trace points in white at NaN before drawing coasts with a trait.
;
    if keyword_set(trinan) AND NOT keyword_set(nofill) THEN BEGIN
      IF size(x, /n_dimensions) EQ 1 THEN x = x#replicate(1, (size(masknan))[2])
      IF size(y, /n_dimensions) EQ 1 THEN y = replicate(1, (size(masknan))[1])#y
      contour, [1b-masknan[*], fltarr(more)], [x[*], fltarr(more)] $
        , [y[*], fltarr(more)], levels = 0.5, /overplot, /fill $
        , c_colors = cont_color, TRIANGULATION = trinan, _extra = ex
      IF keyword_set(forplt) THEN $
        completecointerre, COINMONTE = coinmontenan $
        , COINDESCEND = coindescendnan, INDICEZOOM = indicezoomnan $
        , CONT_COLOR = cont_color, _EXTRA = ex $
      ELSE fillcornermask, x[*, 0], y[0, *], COINMONTE = coinmontenan $
        , COINDESCEND = coindescendnan, CONT_COLOR = cont_color, _extra = ex
    ENDIF
;
; Filling continents
;
    if keyword_set(realcont) then if realcont EQ 1 then mask = 1b
    if n_elements(mask) NE 1 then BEGIN ; If mask=1 we gap it.
;
      if NOT keyword_set(cont_nofill) then BEGIN
;
; mask filling
;
        case 1 of
          keyword_set(realsection):drawsectionbottom, mask, xm, ym $
            , CONT_NOFILL = cont_nofill, CONT_COLOR = cont_color, _EXTRA = ex
          usetri GE 1:BEGIN
            if n_elements(trimsk) eq 0 then trimsk = trichamp
            IF size(xm, /N_DIMENSIONS) EQ 1 THEN xm = xm#replicate(1, (size(mask))[2])
            IF size(ym, /N_DIMENSIONS) EQ 1 THEN ym = replicate(1, (size(mask))[1])#ym
            contour, [1b-mask[*], fltarr(more)], [xm[*], fltarr(more)] $
              , [ym[*], fltarr(more)], LEVELS = 0.5, /OVERPLOT, /FILL $
              , C_COLORS = cont_color, TRIANGULATION = trimsk, _extra = ex
            IF keyword_set(forplt) THEN $
              completecointerre, COINMONTE = coinmontemask $
              , COINDESCEND = coindescendmask, INDICEZOOM = indicezoommask $
              , CONT_COLOR = cont_color, _EXTRA = ex $
            ELSE fillcornermask, xm[*, 0], ym[0, *], COINMONTE = coinmontemask $
              , COINDESCEND = coindescendmask, CONT_COLOR = cont_color, _extra = ex
          END
          ELSE:BEGIN
            IF size(xm, /n_dimensions) EQ 2 THEN xm = xm[*, 0]
            IF size(ym, /n_dimensions) EQ 2 THEN ym = reform(ym[0, *])
            contour, 1b-mask, xm, ym, LEVELS = 0.5, /OVERPLOT $
              , /FILL, C_COLORS = cont_color, _EXTRA = ex
          END
        ENDCASE
      ENDIF                     ; NOT keyword_set(cont_nofill)
;------------------------------------------------------------
; IV) Trace coast with line
;------------------------------------------------------------
      case 1 of
        keyword_set(realsection) AND NOT keyword_set(cont_nofill):
        keyword_set(realsection) AND keyword_set(cont_nofill): $
          drawsectionbottom, mask, xm, ym $
          , CONT_NOFILL = cont_nofill, _extra = ex
        (keyword_set(forplt) AND (!map.projection GT 0 OR key_irregular)) $
          OR keyword_set(nan):tracecote, _extra = ex
        ELSE:tracemask, mask, xm, ym, _extra = ex
      endcase                   ;
    ENDIF                       ; n_elements(mask) NE 1
  ENDIF
;------------------------------------------------------------
; draw the triangulations
;------------------------------------------------------------
  if keyword_set(desstrichamp) then $
    dessinetri, trichamp, x, y, color = colortrichamp, thick = th_trichamp
  if keyword_set(desstrimask) then $
    dessinetri, trimsk, xm, ym, color = colortrimask, thick = th_trimask
  if keyword_set(desstrinan) then $
    dessinetri, trinan, x, y, color = colortrinan
  if keyword_set(drawpoints) then $
    tracegrille, x, y, color = colorpoints
;------------------------------------------------------------
;
fini:
  IF keyword_set(key_performance) THEN print, 'temps pltbase', systime(1)-tempsun

  return
end