PlotEquiMap.R 44.5 KB
Newer Older
      } else if (box[1] < 0 && box[3] > 0) {
        #segments south
        segments(box[1], box[2], 0, box[2], col = boxcol[counter], lwd = boxlwd[counter])
        segments(0, box[2], box[3], box[2], col = boxcol[counter], lwd = boxlwd[counter]) 
        #segments north
        segments(box[1], box[4], 0, box[4], col = boxcol[counter], lwd = boxlwd[counter])
        segments(0, box[4], box[3], box[4], col = boxcol[counter], lwd = boxlwd[counter]) 
        #segments west
        segments(box[1], box[2], box[1], box[4], col = boxcol[counter], 
                 lwd = boxlwd[counter])  
        #segments est
        segments(box[3], box[2], box[3],box[4], col = boxcol[counter], 
                 lwd = boxlwd[counter])          
      } else {
        rect(box[1], box[2], box[3], box[4], border = boxcol[counter], col = NULL, 
             lwd = boxlwd[counter], lty = 'solid')
      }
      counter <- counter + 1
    }
  }
  #
  #  PlotWind
  # ~~~~~~~~~~
  #
  if (!is.null(varu) && !is.null(varv)) {
    # Create a two dimention array of longitude and latitude
    lontab <- InsertDim(lonb$x, 2, length(latb$x), name = 'lat')
    lattab <- InsertDim(latb$x, 1, length(lonb$x), name = 'lon')
    varplotu <- varu[lonb$ix, latb$ix]
    varplotv <- varv[lonb$ix, latb$ix]

    # Select a subsample af the points to an arrow
    #for each "subsample" grid point
    sublon <- seq(1,length(lon), arr_subsamp)
    sublat <- seq(1,length(lat), arr_subsamp)

    uaux <- lontab[sublon, sublat] + varplotu[sublon, sublat] * 0.5 * arr_scale
    vaux <- lattab[sublon, sublat] + varplotv[sublon, sublat] * 0.5 * arr_scale

    lenshaft <- 0.18 * arr_scale * arr_scale_shaft
    angleshaft <- 12 * arr_scale_shaft_angle
    # Plot Wind
    arrows(lontab[sublon, sublat], lattab[sublon, sublat],
           uaux, vaux,
           angle = angleshaft,
           length = lenshaft)
    
    # Plotting an arrow at the bottom of the plot for the legend
    posarlon <- lonb$x[1] + (lonmax - lonmin) * 0.1
    posarlat <- latmin - ((latmax - latmin) + 1) / par('pin')[2] * 
                         (spaceticklab + 0.2 + cex_axes_labels + 0.6 * units_scale) * par('csi')

    arrows(posarlon, posarlat,
           posarlon + 0.5 * arr_scale * arr_ref_len, posarlat,
           length = lenshaft, angle = angleshaft,
           xpd = TRUE)
    #save the parameter value
    xpdsave <- par('xpd')
    #desactivate xpd to be able to plot in margen
    par(xpd = NA)
    #plot text
    mtext(paste(as.character(arr_ref_len), arr_units, sep = ""),
          line = spaceticklab + 0.2 + cex_axes_labels + 1.2 * units_scale, side = 1,
          at = posarlon + (0.5 * arr_scale * arr_ref_len) / 2,
          cex = units_scale)
    #come back to the previous xpd value
    par(xpd = xpdsave)
  }
  #
  #  Colorbar
  # ~~~~~~~~~~
  #
  if (drawleg) {
    ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, 
             triangle_ends, col_inf = col_inf, col_sup = col_sup, 
             extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks,
             draw_separators = draw_separators, title = units, 
             title_scale = units_scale, triangle_ends_scale = triangle_ends_scale, 
             label_scale = bar_label_scale, tick_scale = bar_tick_scale,
             extra_margin = bar_extra_margin, label_digits = bar_label_digits)
  }

  # If the graphic was saved to file, close the connection with the device
  if (!is.null(fileout)) dev.off()

  invisible(list(brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup))
}