;
;.............A bunch of basic/useful procedures..........................
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

;=========================================================================
;..Define procedures for setting up a basic map backgrounds...
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
;...This would be handy, but doesn't work!!............
;...."mapid" has to be defined *coming in* to a procedure.......
;++++++++
;procedure map0(wid,mapid)
; begin
;     mapid = create "Map0" mapPlotClass wid
;     end create
; end
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
;...NOTE ! : the basic map INSTANTIATION must be done outside of a procedure!
;++++++++
procedure map1 (wid,mapid)
  begin
     setvalues mapid
        "mpFillOn" 		: "false"
        "mpAreaMaskingOn" 	: "false"
        "vpYF" 			: 0.9
        "vpHeightF" 		: 0.8
        "vpXF" 			: 0.1
        "vpWidthF" 		: 0.8
     end setvalues
;						     end create
end
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
;++++++++
procedure map2 (wid,mapid)
  begin
     setvalues mapid
        "mpFillOn"               : "true"
        "mpFillDrawOrder" 	: "draw"
        "mpAreaMaskingOn" 	: "false"
        "vpYF" 			: 0.9
        "vpHeightF" 		: 0.8
        "vpXF" 			: 0.1
        "vpWidthF" 		: 0.8
     end setvalues
;						     end create
end
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
;++++++++
procedure map3 (wid,mapid)
  local mask_specs
  begin
    mask_specs = "oceans"
     setvalues mapid
       "mpFillOn"               : "true"
       "mpFillDrawOrder" 	: "postdraw"
       "mpAreaMaskingOn" 	: "true"
        "mpMaskAreaSpecifiers" 	: mask_specs
        "vpYF" 			: 0.9
        "vpHeightF" 		: 0.8
        "vpXF" 			: 0.1
        "vpWidthF" 		: 0.8
     end setvalues
;						     end create
end

;--------------------------------------------------------------------
;...Set up "mpFillColors" for land, water........
;++++++++
procedure mapfill (mapid)
begin
  setvalues mapid
     "mpFillOn" 		: "true"
     "mpOceanFillColor"		: 2
     "mpLandFillColor"		: 3
     "mpInlandWaterFillColor"	: 4
  end setvalues  
end

;====================================================================
;...RESET THE LIMITS OF A MAP.....
;++++++++
procedure set_mplims(mapid, lat1,lat2, lon1,lon2)
;..set the map limits to the limits of the data extracted...
begin
  setvalues mapid	
    "mpLimitMode"  : "latlon"
    "mpMinLatF"    : lat1
    "mpMaxLatF"    : lat2
    "mpMinLonF"    : lon1
    "mpMaxLonF"    : lon2
    "vpYF" 	   : 0.9
    "vpHeightF"    : 0.8
    "vpXF" 	   : 0.1
    "vpWidthF" 	   : 0.8
  end setvalues
;  ...Set up "mpFillColors" for land, water........
  mapfill (mapid)
end

;====================================================================
;...RE-START A MAPID.....>> NO LONGER NEEDED SINCE FOUND "NhlRemoveOverlay"
;++++++++
;procedure restart_mapid(mapid,wid)
;begin
;;   delete (mapid)				; ! ILLEGAL !!!
;   mapid = create "Map0" mapPlotClass wid
;       "vpYF" 			: 0.9
;       "vpHeightF" 		: 0.8
;       "vpXF" 			: 0.1
;       "vpWidthF" 		: 0.8
;   end create
;end

;=========================================================================
;=========================================================================
;=========================================================================

;.......SIMPLE MIN/MAX FINCTIONS.....
;-----------------------
;++++++++
function amin(a,b)
local tmp
begin
  tmp=1.
  if (a.gt.b) then
     tmp=b
  else
     tmp=a
  end if
  return(tmp)
end
;-----------------------
;++++++++
function amax(a,b)
local tmp
begin
  tmp=1.
  if (a.gt.b) then
     tmp=a
  else
     tmp=b
  end if
  return(tmp)
end
;-----------------------
;++++++++
;procedure getfield(fileid,fvarnam,nvarnam)
;begin
;  nvarnam = fileid->fvarnam
;end

;=========================================================================
;=========================================================================
;=========================================================================
;...adjust colormap to have 10 elements at start for ocean, land, etc.
;....(see "mpFillColors")....
;++++++++
procedure adjust_colormap(wid)
local cmap1,cmap2,lencmap,tmp1,i,j,fillindices
begin
  getvalues wid
     "wkColorMapLen" : lencmap
  end getvalues
  lennewcmap=lencmap+8
  cmap1=new((/lencmap,3/), float)
  cmap2=new((/lennewcmap,3/), float)
  cmap2(0:1,:)=cmap1(0:1,:)
  do i=2,lencmap-1
     cmap2(i+8,:)=cmap1(i,:)
  end do
  cmap2(2,:)=(/.80,.90,.91/)	; ocean
  cmap2(3,:)=(/.90,.80,.75/)	; land
  cmap2(4,:)=(/.80,.85,.93/)	; inland water
  cmap2(5,:)=(/.90,.90,.90/)	; 
  cmap2(6,:)=(/.80,.80,.80/)
  cmap2(6,:)=(/.70,.70,.70/)
  cmap2(7,:)=(/.60,.60,.60/)
  cmap2(8,:)=(/.50,.50,.50/)
  cmap2(9,:)=(/.40,.40,.40/)
  setvalues wid
      "wkColorMap" : cmap2
  end setvalues
end

;  clear(wid)
;  draw(mapid)

;--------------------------------------------------------------------
;.......SELECT COLORS FROM COLORMAP FOR CONTOUR FILL.....
;...Note: skip first 10 element (fg,bg,ocean,land,water,reserved)...
;++++++++
procedure set_cnfill(wid, cnid)
local nclev,lencmap,tmp1,i,j,fillindices
begin
  getvalues wid
     "wkColorMapLen" : lencmap
  end getvalues
  getvalues cnid
     "cnLevelCount" : nclev
  end getvalues
  fillindices = new (nclev+1, integer)
  lencmapm=lencmap-10
  tmp1=new(1,float)
  j=new(1,integer)
  do i=1,nclev+1
     tmp1=i
     frac=tmp1/(nclev+1)
     j=floattoint(floor(frac*lencmapm))
     if (j.gt.lencmap) then
        j=j-lencmap
     end if
     fillindices(i-1) = j+9
  end do
  setvalues cnid
     "cnFillOn"		: "true"
     "cnFillColors"	: fillindices
     "cnLineColors"	: fillindices
  end setvalues
end

;---------------------------------------------------------------------
;....FORCE BLACK LETTERS ON WHITE BKGRD.........
;++++++++
procedure black_on_white (wid)
begin
  setvalues wid
         "wkBackgroundColor"	:  (/1.0, 1.0, 1.0/)
         "wkForegroundColor"	:  (/ 0., 0.,  0./)
  end setvalues
end

;---------------------------------------------------------------------
;....FORCE WHITE LETTERS ON BLACK BKGRD.........
;++++++++
procedure white_on_black (wid)
begin
  setvalues wid
         "wkBackgroundColor"	:  (/ 0., 0.,  0./)
         "wkForegroundColor"	:  (/1.0, 1.0, 1.0/)
  end setvalues
end

;=========================================================================
;=========================================================================
;=========================================================================
;....Set a bunch of contour label specs....
;++++++++
procedure cnlabels(cnid)
begin
  setvalues cnid
;     "cnLineLabelBackgroundColor" : 0	; (background)
;     "cnHighLabelBackgroundColor" : 0	; appears to control Low labels, too
     "cnLineLabelBackgroundColor" : -1
     "cnHighLabelBackgroundColor" : -1	; appears to control Low labels, too
     "cnLineLabelFont" 		: 21
     "cnHighLabelFont" 		: 21
     "cnLowLabelFont" 		: 21
     "cnLineLabelPerimSpaceF" 	: .1
     "cnHighLabelPerimSpaceF" 	: .1
     "cnLowLabelPerimSpaceF" 	: .1
     "cnLineLabelFontHeightF" 	: .013
     "cnHighLabelFontHeightF" 	: .016	; appears to control Low labels, too
     "cnLowLabelFontHeightF" 	: .016
     "cnLineLabelAngleF" : 0
  end setvalues
end

;---------------------------------------------------------------------
;....CONTOUR A DATA ARRAY....
;+++++++++
procedure contour(appid,wid,cnid,dataid, ARRAY[*][*],lat1,lat2,lon1,lon2)
begin
;  delete (dataid)
;  dataid = create "data_1" scalarFieldClass appid
   setvalues dataid
      "sfDataArray" 	: ARRAY
      "sfXCStartV" 	: lon1
      "sfXCEndV" 	: lon2
      "sfYCStartV" 	: lat1
      "sfYCEndV" 	: lat2
  end setvalues
;  end create
  setvalues cnid
     "cnScalarFieldData" : dataid
     "cnLabelDrawOrder"  : "postdraw"		;puts labels on last
     "cnLineLabelFont" 	 : 21
  end setvalues
;  ...Set a bunch of contour label specs....
  cnlabels(cnid)
;  ...Pick colorfill colors from the wid colormap...
  set_cnfill(wid, cnid)
end

;====================================================================
;====================================================================
;====================================================================
; Define a procedure for creating a 64-element colormap....
;++++++++
procedure gen_colormap_64(cmap)
begin
        ;This procedure explicitly sets the red, green, and blue
        ;intensities for each element in a 64-element colormap array.

   ; Create a 64x3 array for the colormap (the first dimension is arbitrary).
   ; The second dimension represents each component of an RGB triple.
;   cmap = new ((/64,3/), float)

        ; Set the color map
        cmap( 63,:) = (/1.00,.000,.000/)
        cmap( 62,:) = (/1.00,.000,.000/)
        cmap( 61,:) = (/.990,.000,.000/)
        cmap( 60,:) = (/.950,.010,.000/)
        cmap( 59,:) = (/.900,.030,.000/)
        cmap( 58,:) = (/.870,.050,.000/)
        cmap( 57,:) = (/.830,.070,.000/)
        cmap( 56,:) = (/.800,.090,.000/)
        cmap( 55,:) = (/.750,.090,.000/)
        cmap( 54,:) = (/.700,.090,.000/)
        cmap( 53,:) = (/.700,.100,.000/)
        cmap( 52,:) = (/.700,.120,.000/)
        cmap( 51,:) = (/.700,.130,.000/)
        cmap( 50,:) = (/.700,.180,.000/)
        cmap( 49,:) = (/.700,.240,.000/)
        cmap( 48,:) = (/.700,.260,.000/)
        cmap( 47,:) = (/.700,.270,.000/)
        cmap( 46,:) = (/.700,.285,.000/)
        cmap( 45,:) = (/.690,.300,.000/)
        cmap( 44,:) = (/.680,.330,.000/)
        cmap( 43,:) = (/.675,.375,.000/)
        cmap( 42,:) = (/.570,.420,.000/)
        cmap( 41,:) = (/.565,.485,.000/)
        cmap( 40,:) = (/.560,.530,.000/)
        cmap( 39,:) = (/.555,.545,.000/)
        cmap( 38,:) = (/.550,.550,.000/)
        cmap( 37,:) = (/.160,.565,.000/)
        cmap( 36,:) = (/.130,.570,.000/)
        cmap( 35,:) = (/.100,.575,.000/)
        cmap( 34,:) = (/.060,.680,.000/)
        cmap( 33,:) = (/.030,.685,.000/)
        cmap( 32,:) = (/.000,.690,.000/)
        cmap( 31,:) = (/.000,.725,.000/)
        cmap( 30,:) = (/.000,.700,.100/)
        cmap( 29,:) = (/.000,.650,.200/)
        cmap( 28,:) = (/.000,.600,.300/)
        cmap( 27,:) = (/.000,.550,.400/)
        cmap( 26,:) = (/.000,.500,.500/)
        cmap( 25,:) = (/.000,.450,.600/)
        cmap( 24,:) = (/.000,.400,.700/)
        cmap( 23,:) = (/.000,.350,.700/)
        cmap( 22,:) = (/.000,.300,.700/)
        cmap( 21,:) = (/.000,.250,.700/)
        cmap( 20,:) = (/.000,.200,.700/)
        cmap( 19,:) = (/.000,.150,.700/)
        cmap( 18,:) = (/.000,.100,.700/)
        cmap( 17,:) = (/.000,.050,.700/)
        cmap( 16,:) = (/.000,.000,.700/)
        cmap( 15,:) = (/.050,.050,.700/)
        cmap( 14,:) = (/.100,.100,.700/)
        cmap( 13,:) = (/.150,.150,.700/)
        cmap( 12,:) = (/.200,.200,.700/)
        cmap( 11,:) = (/.250,.250,.700/)
        cmap( 10,:) = (/.300,.300,.700/)
        cmap(  9,:) = (/.350,.350,.700/)
        cmap(  8,:) = (/.420,.400,.700/)
        cmap(  7,:) = (/.450,.450,.700/)
        cmap(  6,:) = (/.560,.500,.700/)
        cmap(  5,:) = (/.550,.550,.700/)
        cmap(  4,:) = (/.610,.600,.700/)
        cmap(  3,:) = (/.650,.650,.700/)
        cmap(  2,:) = (/.700,.700,.700/)
        ; Entry 1 is the foreground color.
        ; The continental outlines in the map object use this color 
        ; as a default.
        cmap(  1,:) = (/.999,.999,.999/)		;JPS: this doesn't work!
        ; Entry 0 is the background color.
        cmap(  0,:) = (/.000,.000,.000/)
end