# R/soiltexture.R In soiltexture: Functions for Soil Texture Plot, Classification and Transformation

```#'@importFrom sp point.in.polygon
NULL

# Environment for storing, hiding and protecting internal variables and functions.
#' TT env
#'
#' Environment for storing, hiding and protecting internal variables and
#' functions
#'
#'
#' @docType data
#' @noRd

NULL
TT.env <- new.env()

# assign(
#     x       = "TT.env",
#     value   = new.env()
# )   #

# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# | LIST: TT.par                        |
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# [ TT.par :: A list of default parameters, contained in a list, stored in the TT.env environment (~ invisible)
assign(
envir   = TT.env,
x       = "TT.par",
value   = list(
# +-------------------------------------------------------------------------+
# | SCRIPT PARAMETERS SPECIFICATION:                                        |
# +-------------------------------------------------------------------------+
#
# +---------------------------------+
# | TRIANGLE GEOMETRY               |
# +---------------------------------+
#
# Geometry of the texture triangle, in cases where no specific texture triangle
#   is used. Be aware that some of these default parameters will be overwritten
#   by triangle specific parameters.
blr.clock       = rep(T,3), # clockwise axes (T) ? or counterclock ? (F)
#   clock wise mean bottom axis is oriented from right to left,
#   left axis is oriented bottom to top and right axis is
#   oriented from top to bottom.
#   Can also be c(F,T,NA) or c(T,NA,F) or c(NA,F,T)
# Top, Left and Right ANGLES of the triangle, in DEGREES
tlr.an          = c(60,60,60),
#   For nicer triangle, higher angle must be on the LEFT in the case
#   of a clock orientation, and higher angle must be on the RIGHT
#   in the case of a counter-clock orientation
# Bottom, Left and Right TEXTURES of the triangles
#
# NB: in the default options, coordinates are always expressed as a "fraction" (0 to 1 values)
#
# Limits of the triangle to be drawn (get rid of this???)
base.frame      = data.frame(
# Rows (here vertical)      = triangle submits
# Coulmns (here horizontal) = coordinates of the submits for bootom, left and right variables
"b" = c( 1, 0, 0 ),
"l" = c( 0, 1, 0 ),
"r" = c( 0, 0, 1 )
),  #
#
# Limits (min,max values) of the different variables
b.lim           = c(0,1),   # Bootom variable
l.lim           = c(0,1),   # Left   variable
r.lim           = c(0,1),   # Right  variable
#
# Limits "tolerance", as a fraction of the triangle maximum range (0 to 1)
lim.tol         = 0.1,
#
# +---------------------------------+
# | TRIANGLE BASE CONTENT           |
# +---------------------------------+
#
# Bottom, Left and Right TeXtures (= which texture
#   displaying on B, L, R axis). MUST belong to CLAY SILT
#   and SAND (the order is free).
blr.tx          = c("SAND","CLAY","SILT"),
#
# Clay, Silt and Sand (columns) NAMES in the input soil
#   texture data table (tri.data).
#   example: c("ARGILE","LIMON","SABLE")
css.names       = c("CLAY","SILT","SAND"),
#
# A vector of 3 character strings, or expressions, for the
#   LABELS of Clay, Silt and Sand, respectively. If
#   non-null, will overwrite any default label (in any lang).
css.lab         = NULL,
#
#blr.lab         = NULL,     # a vector of 3 character strings
#                           # or expressions, with the labels
#                           # of bottom, left and right axis.
#
lang            = "en",
#
# blr.psize.lim = data.frame(
#   "SAND"  = c(50,2000),
#   "CLAY"  = c(0,2),
#   "SILT"  = c(2,50)
# ),    #
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
# Input data:
text.sum        = 100,      # Value of the SUM OF CLAY SILT SAND TEXTURE: either 1 or 100 (or fancy)
text.tol        = 1/1000,   # Error tolerance on the sum of the 3 particle size classes
tri.sum.tst     = TRUE,     # Perform a sum test on the tri-variable data (sums == text.sum) ??
tri.pos.tst     = TRUE,     # Test if all tri-variable data are positive ??
#
# +---------------------------------+
# | INTERNATIONALISATION            |
# +---------------------------------+
lang.par    = data.frame(
"lang"  = c(    "en",                           "fr",                       "it",
"es",                           "de",                       "nl",
"se",                           "fl",                       "ro" ),
#
"CLAY"  = c(    "\"Clay\"",                     "\"Argile\"",               "\"Argilla\"",
"\"Arcilla\"",                  "\"Ton\"",                  "\"Lutum\"",
"\"Ler\"",                      "\"Klei\"",                 "\"Argila\"" ),
#
"SILT"  = c(    "\"Silt\"",                     "\"Limon\"",                "\"Limo\"",
"\"Limo\"",                     "\"Schluff\"",              "\"Silt\"",
"\"Silt\"",                     "\"Leem\"",                 "\"Praf\"" ),
#
"SAND"  = c(    "\"Sand\"",                     "\"Sable\"",                "\"Sabbia\"",
"\"Arena\"",                    "\"Sand\"",                 "\"Zand\"",
"\"Sand\"",                     "\"Zand\"",                 "\"Nisip\"" ),
#
"TT"    = c(    "\"Texture triangle\"",         "\"Triangle de texture\"",  "\"Triangolo della tessitura\"",
"\"Triangulo de textura\"",     "\"Bodenartendiagramm\"",   "\"Textuurdriehoek\"",
"\"Texturtriangel\"",           "\"Textuurdriehoek\"",      "\"Diagrama triunghiulara a texturii\"" ),

# NOTE: accents removed!

stringsAsFactors    = FALSE
),  #
# Acknowledgments: Rosca Bogdan, from the Romanian Academy, Iasi Branch, Geography team, provided the Romanian translation (thanks!).
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# | TRIANGLE CUSTOMISATION          |
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# | General graphical parameters
#
# FONTS:
font            = NULL,     # for plotted points and text
font.axis       = 2,        # for ticks labels
font.lab        = 2,        # for axis labels (arrows) and texture classes labels
font.main       = 2,        # main title
#
# COLORS:
bg              = NULL,     # plot and plotted points background
fg              = NULL,     # for plotted points and text (foreground)
col             = NULL,     # for plotted points and text
col.axis        = NULL,     # for ticks, triangle "axis/frame" (but not texture classes or grid)
col.lab         = NULL,     # for axis labels and arrows (but not texture classes labels)
col.main        = NULL,     # main title
# NOTICE: grid lines and "frame" background colors are set with other options (non generic)
#
# CEX:
cex             = 1.5,      # for plotted points and text
cex.axis        = 1.5,      # for ticks labels
cex.lab         = 1.5,      # for axis labels and texture classes labels
cex.main        = 1.5,      # main title
#
# LWD:
lwd             = 3,        # for plotted lines (not implemented yet?)
#
#
#
# warning. belw, not in par()
lwd.axis        = 3,        # for ticks, triangle "axis/frame" and grid
lwd.lab         = 3,        # for axis arrows and texture classes polygons
#
# FAMILY:
family.op       = NULL,
#
# graph margins (as in par("mar")):
new.mar         = NULL,
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# | Specific graphical parameters
#
# TRIANGLE FRAME parameters:
frame.bg.col    = NULL,             # triangle frame background color
#
# Texture values _at_ which starting grid or thicks points (values between 0 and 1!!!)
at              = seq(from=.1,to=.9,by=.1),
#
# CLASSES SYSTEM (polygons / Texture Triangle) used by default:
class.sys       = "HYPRES.TT",
class.lab.col   = NULL,             # Color of classes names (abreviation)
class.p.bg.col  = FALSE,            # Fill classes polygon with color gradient ???
class.p.bg.hue  = 0.04,             # Hue (unique) of the classes polygon color gradient
class.line.col  = NULL,             # Classes lines (foreground) color
#                                   # 0.04 is salmon-pink, 0.21 is olive green, 0.57 is sky blue, 0.72 a nice purple-blue
class.lty       = NULL,
class.lab.show  = "abr",            # Show
#
# GRID LINES parameters:
grid.show       = TRUE,
grid.col        = NULL,             # grid line colors (fg) # default in fact gray(.5)
grid.lty        = 1,                # Grid line type
#
# TICKS MARK parameters:
ticks.shift         = 02.5/100,     # Value of the ticks shift from the border of the triangle: ]0;1[ (but 1 extra big)
ticks.lab.shift     = 05.0/100,     # Value of the ticks label shift from the border of the triangle: ]0;1[ (but 1 extra big)
#
# ARROWS parameters:
arrows.show         = TRUE,
arrows.lims         = c(0.150,0.450),
arrows.head.shift   = 05.0/100,     # Distance between the arrow head and the triangle frame
arrows.base.shift   = 11.0/100,     # Distance between the arrow base and the triangle frame
arrows.text.shift   = 11.0/100,     # Distance between the arrow label/text and the triangle frame
arrows.text.shift2  = 10.0/100,     # Distance between the arrow "turn" and the text (parallel to axis)
arrows.lty          = 1,
#
# POINTS-DATA parameters:
points.type         = "p",
pch                 = NULL,  # Added 20090617
#
# TEXT DATA parameters:
pos             = NULL,
offset          = 0,
#
# +---------------------------------+
# | TT.points.in.classes parameters |
# +---------------------------------+
PiC.type            = c("n","l","t")[1],
#                                   # Type of output for TT.points.in.classes
#                                   # "n" stands for numeric (0 = out, 1 = in, 3 = border)
#                                   # "l" stands for logical (F = out, T = in)
#                                   # "t" stands for text (concatenated texture class symbol)
#
# +---------------------------------+
# | z: the 4th variable             |
# +---------------------------------+
# [ z may be plotted as a bubble chart or as an interpolated map
z.type              = c("bubble","map")[1],
z.col.hue           = 0.21,
z.cex.range         = c(1.00,4.00),
# z.cex.min         = 0.50,
z.pch               = c(16,1),  # Respectively for color fill and border
#
# +---------------------------------+
# | Texture particle size           |
# | transformation:                 |
# +---------------------------------+
# Base (plot, geometry, reference) Clay Silt Sand
#   particle size limits (in micro-meters), in the form of
#   c(clay min,clay max = silt min, silt max = sand min, sand.max)
#   If plotted texture triangles or soil point data have
#   a different css.ps.lim, and if transformation is allowed,
#   then all Clay Silt Sand data will be coverted TO that
#   system.
base.css.ps.lim = c(0,2,50,2000),
#
# Same, but for the plotted texture triangle
#   particle size limits (in micro-meters) (see above)
tri.css.ps.lim  = NULL,
#
# Same, but for the plotted soil point data (tri.data)
#   particle size limits (in micro-meters) (see above)
dat.css.ps.lim  = NULL,
#
# Should any texture triangle or soil point data, with
#   different Clay Silt Sand particle size limits from the
#   base plot, be transformed into the base plot system?
css.transf      = FALSE,
#
# Default function to be used when transforming soil
#   texture data or triangles (particle sizes)
#   alternatives functions should either have the same
#   options (even if some are not used), or a "..." option
#   that will be used as a "dump" for unused otions.
text.transf.fun     = "TT.text.transf",  # CHARACTER vector
#
# In case an alternative to "TT.text.transf" is used in
#   text.transf.fun, it is possible to provide 2 additional
#   options to that new functions (free), unused in
#   "TT.text.transf".
#
# +-------------------------------------------------+
# | HYPRES TEXTURE TRIANGLE -- ORIGINAL, WRONG NAME |
# +-------------------------------------------------+
#
FAO50.TT  = list( # FAO TRIANGLE PARAMETERS :

#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  =-P01-   P02    P03    P04    P05    P06    P07    P08   -P09-   P10    P11   -P12-
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.600, 0.600, 0.350, 0.350, 0.350, 0.180, 0.180, 0.000, 0.000, 0.000, 0.000),
"SILT"      = c( 0.000, 0.000, 0.400, 0.000, 0.500, 0.650, 0.000, 0.170, 0.000, 0.350, 0.850, 1.000),
"SAND"      = c( 0.000, 0.400, 0.000, 0.650, 0.150, 0.000, 0.820, 0.650, 1.000, 0.650, 0.150, 0.000)
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"VF"        = list( "name" = "Very fine",       "points" = c(02,01,03)          ),
"F"         = list( "name" = "Fine",            "points" = c(04,02,03,06)       ),
"M"         = list( "name" = "Medium",          "points" = c(07,04,05,11,10,08) ),
"MF"        = list( "name" = "Medium fine",     "points" = c(11,05,06,12)       ),
"C"         = list( "name" = "Coarse",          "points" = c(09,07,08,10)       )
),  #
#
# Traingle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
#
# In fact it is the FAO soil texture classes: Info from SysCan
# http://sis.agr.gc.ca/cansis/nsdb/lpdb/faotext.html
# FAO Soil Texture
# Texture is the relative proportion of sand, silt and clay of the dominant
# soil for each soil map polygon. Texture classes are:
#
# Coarse texture: sands, loamy sand and sandy loams with less than 18 % clay,
# and more than 65 % sand.
#
# Medium texture: sandy loams, loams, sandy clay loams, silt loams with less
# than 35 % clay and less than 65 % sand; the sand fractions may be as high as 82 % if a minimum of 18 % clay is present.
#
# Fine texture: clays, silty clays, sandy clays, clay loams and silty clay loams
# with more than 35 % clay.
#
# Where two or three texture names appear, this means that all named textures
# are present in the map unit.
#
# Texture Codeset
# COARSE
# FINE
# FINE-COARSE
# FINE-MED-CRS
# FINE-MEDIUM
# MEDIUM
# MEDIUM-COARSE
#
),  #

# +----------------------------------+
# | HYPRES TEXTURE TRIANGLE, RENAMED |
# +----------------------------------+

HYPRES.TT  = list( # EU SOIL MAP TRIANGLE PARAMETERS :

main            = "HYPRES / European Soil Map",

#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  =-P01-   P02    P03    P04    P05    P06    P07    P08   -P09-   P10    P11   -P12-
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.600, 0.600, 0.350, 0.350, 0.350, 0.180, 0.180, 0.000, 0.000, 0.000, 0.000),
"SILT"      = c( 0.000, 0.000, 0.400, 0.000, 0.500, 0.650, 0.000, 0.170, 0.000, 0.350, 0.850, 1.000),
"SAND"      = c( 0.000, 0.400, 0.000, 0.650, 0.150, 0.000, 0.820, 0.650, 1.000, 0.650, 0.150, 0.000)
),  #

#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"VF"        = list( "name" = "Very fine",       "points" = c(02,01,03)          ),
"F"         = list( "name" = "Fine",            "points" = c(04,02,03,06)       ),
"M"         = list( "name" = "Medium",          "points" = c(07,04,05,11,10,08) ),
"MF"        = list( "name" = "Medium fine",     "points" = c(11,05,06,12)       ),
"C"         = list( "name" = "Coarse",          "points" = c(09,07,08,10)       )
),  #

# Traingle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
#
# In fact it is the FAO soil texture classes: Info from SysCan
# http://sis.agr.gc.ca/cansis/nsdb/lpdb/faotext.html
# FAO Soil Texture
# Texture is the relative proportion of sand, silt and clay of the dominant
# soil for each soil map polygon. Texture classes are:
#
# Coarse texture: sands, loamy sand and sandy loams with less than 18 % clay,
# and more than 65 % sand.
#
# Medium texture: sandy loams, loams, sandy clay loams, silt loams with less
# than 35 % clay and less than 65 % sand; the sand fractions may be as high as 82 % if a minimum of 18 % clay is present.
#
# Fine texture: clays, silty clays, sandy clays, clay loams and silty clay loams
# with more than 35 % clay.
#
# Where two or three texture names appear, this means that all named textures
# are present in the map unit.
#
# Texture Codeset
# COARSE
# FINE
# FINE-COARSE
# FINE-MED-CRS
# FINE-MEDIUM
# MEDIUM
# MEDIUM-COARSE
#
),  #

# +-----------------+
# | OTHER TRIANGLES |
# +-----------------+

USDA.TT = list(  #  USDA Triangle parameters
#
main            = "USDA",
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
#                  = P13    P14    P15    P16    P17    P18    P19    P20    P21    P22    P23
#                  = P24    P25    P26 (submits)
"tt.points"     = data.frame(
"CLAY"      = c( 0.550, 0.600, 0.350, 0.350, 0.400, 0.400, 0.400, 0.200, 0.200, 0.275, 0.275, 0.275,
0.275, 0.150, 0.100, 0.075, 0.075, 0.125, 0.125, 0.000, 0.000, 0.000, 0.000,
1.000, 0.000, 0.000  ),
#
"SILT"      = c( 0.000, 0.400, 0.000, 0.200, 0.150, 0.400, 0.600, 0.000, 0.275, 0.275, 0.500, 0.525,
0.725, 0.000, 0.000, 0.400, 0.500, 0.800, 0.875, 0.150, 0.300, 0.500, 0.800,
0.000, 0.000, 1.000  ),
#
"SAND"      = c( 0.450, 0.000, 0.650, 0.450, 0.450, 0.200, 0.000, 0.800, 0.525, 0.450, 0.225, 0.200,
0.000, 0.850, 0.900, 0.525, 0.425, 0.075, 0.000, 0.850, 0.700, 0.500, 0.200,
0.000, 1.000, 0.000  )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"Cl"        = list( "name" = "clay",            "points" = c(24,01,05,06,02)            ),
"SiCl"      = list( "name" = "silty clay",      "points" = c(02,06,07)                  ),
"SaCl"      = list( "name" = "sandy clay",      "points" = c(01,03,04,05)               ),
"ClLo"      = list( "name" = "clay loam",       "points" = c(05,04,10,11,12,06)         ),
"SiClLo"    = list( "name" = "silty clay loam", "points" = c(06,12,13,07)               ),
"SaClLo"    = list( "name" = "sandy clay loam", "points" = c(03,08,09,10,04)            ),
"Lo"        = list( "name" = "loam",            "points" = c(10,09,16,17,11)            ),
"SiLo"      = list( "name" = "silty loam",      "points" = c(11,17,22,23,18,19,13,12)   ),
"SaLo"      = list( "name" = "sandy loam",      "points" = c(08,14,21,22,17,16,09)      ),
"Si"        = list( "name" = "silt",            "points" = c(18,23,26,19)               ),
"LoSa"      = list( "name" = "loamy sand",      "points" = c(14,15,20,21)               ),
"Sa"        = list( "name" = "sand",            "points" = c(15,25,20)                  )
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #

"USDA-NCSS.TT" = list(  #  USDA Triangle parameters with NCSS class-labels

main            = "USDA (NCSS)",
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
#                  = P13    P14    P15    P16    P17    P18    P19    P20    P21    P22    P23
#                  = P24    P25    P26 (submits)
"tt.points"     = data.frame(
"CLAY"      = c( 0.550, 0.600, 0.350, 0.350, 0.400, 0.400, 0.400, 0.200, 0.200, 0.275, 0.275, 0.275,
0.275, 0.150, 0.100, 0.075, 0.075, 0.125, 0.125, 0.000, 0.000, 0.000, 0.000,
1.000, 0.000, 0.000  ),
#
"SILT"      = c( 0.000, 0.400, 0.000, 0.200, 0.150, 0.400, 0.600, 0.000, 0.275, 0.275, 0.500, 0.525,
0.725, 0.000, 0.000, 0.400, 0.500, 0.800, 0.875, 0.150, 0.300, 0.500, 0.800,
0.000, 0.000, 1.000  ),
#
"SAND"      = c( 0.450, 0.000, 0.650, 0.450, 0.450, 0.200, 0.000, 0.800, 0.525, 0.450, 0.225, 0.200,
0.000, 0.850, 0.900, 0.525, 0.425, 0.075, 0.000, 0.850, 0.700, 0.500, 0.200,
0.000, 1.000, 0.000  )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"C"     = list( "name" = "clay",            "points" = c(24,01,05,06,02)            ), # "Cl"
"SIC"   = list( "name" = "silty clay",      "points" = c(02,06,07)                  ), # "SiCl"
"SC"    = list( "name" = "sandy clay",      "points" = c(01,03,04,05)               ), # "SaCl"
"CL"    = list( "name" = "clay loam",       "points" = c(05,04,10,11,12,06)         ), # "ClLo"
"SICL"  = list( "name" = "silty clay loam", "points" = c(06,12,13,07)               ), # "SiClLo"
"SCL"   = list( "name" = "sandy clay loam", "points" = c(03,08,09,10,04)            ), # "SaClLo"
"L"     = list( "name" = "loam",            "points" = c(10,09,16,17,11)            ), # "Lo"
"SIL"   = list( "name" = "silty loam",      "points" = c(11,17,22,23,18,19,13,12)   ), # "SiLo"
"SL"    = list( "name" = "sandy loam",      "points" = c(08,14,21,22,17,16,09)      ), # "SaLo"
"SI"    = list( "name" = "silt",            "points" = c(18,23,26,19)               ), # "Si"
"LS"    = list( "name" = "loamy sand",      "points" = c(14,15,20,21)               ), # "LoSa"
"S"     = list( "name" = "sand",            "points" = c(15,25,20)                  )  # "Sa"
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#

FR.AISNE.TT = list( # AISNE/FRENCH TRIANGLE PARAMETERS :
#
main            = "Aisne (FR)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11
#                    P12    P13    P14    P15    P16    P17    P18   -P19-   P20    P21    P22
#                    P23    P24    P25    P26   -P27-  -P28-   P29
"tt.points"     = data.frame(
"CLAY"      = c( 0.450, 0.450, 0.450, 0.450, 0.250, 0.250, 0.300, 0.300, 0.300, 0.300, 0.100,
0.100, 0.125, 0.125, 0.175, 0.175, 0.175, 0.175, 0.000, 0.000, 0.075, 0.075,
0.075, 0.075, 0.000, 0.000, 0.000, 1.000, 0.300  ),
"SILT"      = c( 0.000, 0.100, 0.350, 0.550, 0.000, 0.200, 0.250, 0.350, 0.500, 0.700, 0.000,
0.100, 0.100, 0.325, 0.275, 0.475, 0.675, 0.825, 0.000, 0.200, 0.375, 0.575,
0.775, 0.925, 0.450, 0.850, 1.000, 0.000, 0.550  ),
"SAND"      = c( 0.550, 0.450, 0.200, 0.000, 0.750, 0.550, 0.450, 0.350, 0.200, 0.000, 0.900,
0.800, 0.775, 0.550, 0.550, 0.350, 0.150, 0.000, 1.000, 0.800, 0.550, 0.350,
0.150, 0.000, 0.550, 0.150, 0.000, 0.000, 0.150  )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"ALO"       = list( "name" = "Argile lourde",           "points" = c(28, 01, 04                 ) ),
"A"         = list( "name" = "Argile",                  "points" = c(02, 07, 09, 03             ) ),
"AL"        = list( "name" = "Argile limoneuse",        "points" = c(03, 09, 10, 04             ) ),
"AS"        = list( "name" = "Argile sableuse",         "points" = c(01, 05, 06, 07, 02         ) ),
"LA"        = list( "name" = "Limon argileux",          "points" = c(29, 17, 18, 10             ) ),
"LAS"       = list( "name" = "Limon argilo-sableux",    "points" = c(08, 16, 17, 29, 09         ) ),
"LSA"       = list( "name" = "Limon sablo-argileux",    "points" = c(07, 06, 15, 16, 08         ) ),
"SA"        = list( "name" = "Sable argileux",          "points" = c(05, 11, 12, 13, 14, 15, 06 ) ),
"LM"        = list( "name" = "Limon moyen",             "points" = c(17, 23, 24, 18             ) ),
"LMS"       = list( "name" = "Limon moyen sableux",     "points" = c(16, 22, 23, 17             ) ),
"LS"        = list( "name" = "Limon sableux",           "points" = c(15, 14, 21, 22, 16         ) ),
"SL"        = list( "name" = "Sable limoneux",          "points" = c(13, 12, 20, 25, 21, 14     ) ),
"S"         = list( "name" = "Sable",                   "points" = c(11, 19, 20, 12             ) ),
"LL"        = list( "name" = "Limon leger",             "points" = c(23, 26, 27, 24             ) ),
"LLS"       = list( "name" = "Limon leger sableux",     "points" = c(21, 25, 26, 23, 22         ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
FR.GEPPA.TT = list( # GEPPA/FRENCH TRIANGLE PARAMETERS :
#
main            = "GEPPA (FR)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  P01          P02          P03          P04          P05          P06          P07
#                  P08          P09          P10          P11          P12          P13          P14
#                  P15          P16          P17          P18          P19          P20          P21
#                  P22          P23          P24          P25          P26          P27          P28
"tt.points"     = data.frame(
"CLAY"  =   c( 1.000000000, 0.600000000, 0.550000000, 0.450000000, 0.426000000, 0.394160600, 0.375000000,
0.325000000, 0.307758600, 0.287600800, 0.275000000, 0.225000000, 0.209848500, 0.203698200,
0.187764100, 0.175000000, 0.125000000, 0.111486500, 0.103378400, 0.087890630, 0.075000000,
0.075000000, 0.033333330, 0.000000000, 0.000000000, 0.000000000, 0.000000000, 0.000000000),
"SILT"  =   c( 0.000000000, 0.000000000, 0.450000000, 0.000000000, 0.200000000, 0.465328500, 0.625000000,
0.000000000, 0.250000000, 0.542288300, 0.725000000, 0.000000000, 0.250000000, 0.351479300,
0.614392600, 0.825000000, 0.000000000, 0.250000000, 0.400000000, 0.686523440, 0.925000000,
0.000000000, 0.250000000, 0.000000000, 0.250000000, 0.450000000, 0.750000000, 1.000000000),
"SAND"  =   c( 0.000000000, 0.400000000, 0.000000000, 0.550000000, 0.374000000, 0.140510900, 0.000000000,
0.675000000, 0.442241400, 0.170110900, 0.000000000, 0.775000000, 0.540151500, 0.444822500,
0.197843300, 0.000000000, 0.875000000, 0.638513500, 0.496621600, 0.225585930, 0.000000000,
0.925000000, 0.716666670, 1.000000000, 0.750000000, 0.550000000, 0.250000000, 0.000000000)
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"AA"    = list( "name" = "Argile lourde",           "points" = c(01, 02, 03             ) ),
"A"     = list( "name" = "Argileux",                "points" = c(02, 04, 05, 06, 07, 03 ) ),
"As"    = list( "name" = "Argile sableuse",         "points" = c(04, 08, 09, 05         ) ),
"Als"   = list( "name" = "Argile limono-sableuse",  "points" = c(05, 09, 10, 06         ) ),
"Al"    = list( "name" = "Argile limoneuse",        "points" = c(06, 10, 11, 07         ) ),
"AS"    = list( "name" = "Argilo-sableux",          "points" = c(08, 12, 13, 09         ) ),
"LAS"   = list( "name" = "Limon argilo-sableux",    "points" = c(09, 13, 14, 15, 10     ) ),
"La"    = list( "name" = "Limon argileux",          "points" = c(10, 15, 16, 11         ) ),
"Sa"    = list( "name" = "Sable argileux",          "points" = c(12, 17, 18, 13         ) ),
"Sal"   = list( "name" = "Sable argilo-limoneux",   "points" = c(13, 18, 19, 14         ) ),
"Lsa"   = list( "name" = "Limon sablo-argileux",    "points" = c(14, 19, 20, 15         ) ),
"L"     = list( "name" = "Limon",                   "points" = c(15, 20, 21, 16         ) ),
"S"     = list( "name" = "Sableux",                 "points" = c(17, 22, 23, 18         ) ),
"SS"    = list( "name" = "Sable",                   "points" = c(22, 24, 25, 23         ) ),
"Sl"    = list( "name" = "Sable limoneux",          "points" = c(18, 23, 25, 26, 19     ) ),
"Ls"    = list( "name" = "Limon sableux",           "points" = c(19, 26, 27, 20         ) ),
"LL"    = list( "name" = "Limon pur",               "points" = c(20, 27, 28, 21         ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("SILT","CLAY","SAND"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
DE.BK94.TT  = list( # GERMAN TRIANGLE PARAMETERS :
#
main            = "Bodenkundliche Kartieranleitung 1994 (DE)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12    P13
#                  P14    P15    P16    P17    P18    P19    P20    P21    P22    P23    P24    P25    P26
#                  P27    P28    P29    P30    P31    P32    P33    P34    P35    P36    P37    P38    P39
#                  P40    P41    P42    P43    P44    P45    P46    P47    P48    P49    P50    P51    P52
#                  P53
"tt.points"     = data.frame(
"CLAY"  =   c( 0.000, 0.080, 0.120, 0.170, 0.000, 0.080, 0.250, 0.080, 0.120, 0.170, 0.250, 0.300, 0.350,
0.450, 0.000, 0.080, 0.170, 0.250, 0.300, 0.350, 0.450, 0.000, 0.080, 0.120, 0.170, 0.250,
0.650, 0.170, 0.250, 0.350, 0.450, 0.650, 0.000, 0.050, 0.080, 0.170, 0.250, 0.350, 0.450,
0.650, 0.000, 0.050, 0.080, 0.120, 0.170, 0.000, 0.050, 0.170, 0.250, 0.350, 0.450, 0.650,
1.000),
"SILT"  =   c( 1.000, 0.920, 0.880, 0.830, 0.800, 0.800, 0.750, 0.650, 0.650, 0.650, 0.650, 0.650, 0.650,
0.550, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500, 0.400, 0.400, 0.400, 0.400, 0.400,
0.350, 0.300, 0.300, 0.300, 0.300, 0.300, 0.250, 0.250, 0.250, 0.150, 0.150, 0.150, 0.150,
0.150, 0.100, 0.100, 0.100, 0.100, 0.100, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,
0.000),
"SAND"  =   c( 0.000, 0.000, 0.000, 0.000, 0.200, 0.120, 0.000, 0.270, 0.230, 0.180, 0.100, 0.050, 0.000,
0.000, 0.500, 0.420, 0.330, 0.250, 0.200, 0.150, 0.050, 0.600, 0.520, 0.480, 0.430, 0.350,
0.000, 0.530, 0.450, 0.350, 0.250, 0.050, 0.750, 0.700, 0.670, 0.680, 0.600, 0.500, 0.400,
0.200, 0.900, 0.850, 0.820, 0.780, 0.730, 1.000, 0.950, 0.830, 0.750, 0.650, 0.550, 0.350,
0.000)
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"Ss"    = list( "name" = "reiner Sand",             "points" = c(41, 46, 47, 42         ) ),
"Su2"   = list( "name" = "Schwach schluffiger Sand","points" = c(33, 41, 42, 34         ) ),
"Sl2"   = list( "name" = "Schwach lehmiger Sand",   "points" = c(34, 42, 43, 35         ) ),
"Sl3"   = list( "name" = "Mittel lehmiger Sand",    "points" = c(23, 35, 43, 44, 24     ) ),
"St2"   = list( "name" = "Schwach toniger Sand",    "points" = c(42, 47, 48, 45, 44, 43 ) ),
"Su3"   = list( "name" = "Mittel schluffiger Sand", "points" = c(22, 33, 34, 35, 23     ) ),
"Su4"   = list( "name" = "Stark schluffiger Sand",  "points" = c(15, 22, 23, 16         ) ),
"Slu"   = list( "name" = "Schluffig-lehmiger Sand", "points" = c(16, 23, 24, 25, 17     ) ),
"Sl4"   = list( "name" = "Stark lehmiger Sand",     "points" = c(24, 44, 45, 36, 28, 25 ) ),
"St3"   = list( "name" = "Mittel toniger Sand",     "points" = c(36, 45, 48, 49, 37     ) ),
"Ls2"   = list( "name" = "Schwach sandiger Lehm",   "points" = c(17, 25, 26, 18         ) ),
"Ls3"   = list( "name" = "Mittel sandiger Lehm",    "points" = c(25, 28, 29, 26         ) ),
"Ls4"   = list( "name" = "Stark sandiger Lehm",     "points" = c(28, 36, 37, 29         ) ),
"Lt2"   = list( "name" = "Schwach toniger Lehm",    "points" = c(18, 26, 29, 30, 20, 19 ) ),
"Lts"   = list( "name" = "Sandig-toniger Lehm",     "points" = c(29, 37, 38, 39, 31, 30 ) ),
"Ts4"   = list( "name" = "Stark sandiger Ton",      "points" = c(37, 49, 50, 38         ) ),
"Ts3"   = list( "name" = "Mittel sandiger Ton",     "points" = c(38, 50, 51, 39         ) ),
"Uu"    = list( "name" = "Reiner Schluff",          "points" = c(01, 05, 06, 02         ) ),
"Us"    = list( "name" = "Sandiger Schluff",        "points" = c(05, 15, 16, 08, 06     ) ),
"Ut2"   = list( "name" = "Schwach toniger Schluff", "points" = c(02, 06, 08, 09, 03     ) ),
"Ut3"   = list( "name" = "Mittel toniger Schluff",  "points" = c(03, 09, 10, 04         ) ),
"Uls"   = list( "name" = "Sandig-lehmiger Schluff", "points" = c(08, 16, 17, 10, 09     ) ),
"Ut4"   = list( "name" = "Stark toniger Schluff",   "points" = c(04, 10, 11, 07         ) ),
"Lu"    = list( "name" = "Schluffiger Lehm",        "points" = c(10, 17, 18, 19, 12, 11 ) ),
"Lt3"   = list( "name" = "Mittel toniger Lehm",     "points" = c(20, 30, 31, 21         ) ),
"Tu3"   = list( "name" = "Mittel schluffiger Ton",  "points" = c(12, 19, 20, 21, 14, 13 ) ),
"Tu4"   = list( "name" = "Stark schluffiger Ton",   "points" = c(07, 11, 12, 13         ) ),
"Ts2"   = list( "name" = "Schwach sandiger Ton",    "points" = c(39, 51, 52, 40         ) ),
"Tl"    = list( "name" = "Lehmiger Ton",            "points" = c(31, 39, 40, 32         ) ),
"Tu2"   = list( "name" = "Schwach schluffiger Ton", "points" = c(14, 21, 31, 32, 27     ) ),
"Tt"    = list( "name" = "Reiner Ton",              "points" = c(27, 32, 40, 52, 53     ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("CLAY","SILT","SAND"),
#
base.css.ps.lim = c(0,2,63,2000),
tri.css.ps.lim  = c(0,2,63,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
UK.SSEW.TT  = list( # SSEW-DEFRA TRIANGLE PARAMETERS :
#
main            = "Soil Survey of England and Wales (UK)",
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01   P02   P03   P04   P05   P06   P07   P08   P09   P10   P11
#                    P12   P13   P14   P15   P16   P17   P18   P19   P20
"tt.points"     = data.frame(
"CLAY"      = c( 1.00, 0.55, 0.55, 0.35, 0.35, 0.35, 0.30, 0.30, 0.18, 0.18, 0.18,
0.18, 0.15, 0.10, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 ),
#
"SILT"      = c( 0.00, 0.00, 0.45, 0.20, 0.45, 0.65, 0.00, 0.20, 0.00, 0.32, 0.62,
0.82, 0.00, 0.00, 0.00, 0.15, 0.30, 0.50, 0.80, 1.00 ),
#
"SAND"      = c( 0.00, 0.45, 0.00, 0.45, 0.20, 0.00, 0.70, 0.50, 0.82, 0.50, 0.20,
0.00, 0.85, 0.90, 1.00, 0.85, 0.70, 0.50, 0.20, 0.00 )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"Cl"        = list( "name" = "Clay",            "points" = c(01,02,04,05,03)    ),
"SaCl"      = list( "name" = "Sandy clay",      "points" = c(02,07,08,04)       ),
"SiCl"      = list( "name" = "Silty clay",      "points" = c(03,05,06)          ),
"ClLo"      = list( "name" = "Clay loam",       "points" = c(04,08,10,11,05)    ),
"SiClLo"    = list( "name" = "Silty clay loam", "points" = c(05,11,12,06)       ),
"SaClLo"    = list( "name" = "Sandy clay loam", "points" = c(07,09,10,08)       ),
"SaLo"      = list( "name" = "Sandy loam",      "points" = c(09,13,17,18,10)    ),
"SaSiLo"    = list( "name" = "Sandy silt loam", "points" = c(10,18,19,11)       ),
"SiLo"      = list( "name" = "Silt loam",       "points" = c(11,19,20,12)       ),
"LoSa"      = list( "name" = "Loamy sand",      "points" = c(13,14,16,17)       ),
"Sa"        = list( "name" = "Sand",            "points" = c(14,15,16)          )
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,60,2000),
tri.css.ps.lim  = c(0,2,60,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
"AU.TT" = list( # Australian TRIANGLE PARAMETERS :
#
main            = "Autralia (AU)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  P01  P02  P03  P04  P05  P06  P07
#                  P08  P09  P10  P11  P12  P13  P14
#                  P15  P16  P17  P18  P19  P20  P21
#                  P22
"tt.points"     = data.frame(
"CLAY"  =   c( 1.00,  0.74,  0.40,  0.26,  0.00,  0.40,
0.26,  0.50,  0.12,  0.30,  0.205, 0.00,
0.265, 0.105, 0.17,  0.09,  0.00,  0.085,
0.00 ),
"SILT"  =   c( 0.00,  0.26,  0.60,  0.74,  1.00,  0.26,
0.26,  0.00,  0.26,  0.07,  0.10,  0.26,
0.00,  0.1325,0.00,  0.04,  0.08,  0.00,
0.00 ),
"SAND"  =   c( 0.00,  0.00,  0.00,  0.00,  0.00,  0.34,
0.48,  0.50,  0.62,  0.63,  0.695, 0.74,
0.735, 0.7625,0.83,  0.87,  0.92, 0.915,
1.00 )
),  #
#
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"Cl"        = list( "name" = "Clay",            "points" = c(01, 02, 06, 10, 08) ),
"SiCl"      = list( "name" = "Silty clay",      "points" = c(02, 03, 06) ),
"SiClLo"    = list( "name" = "Silt clay loam",  "points" = c(03, 04, 07, 06) ),
"SiLo"      = list( "name" = "Silty loam",      "points" = c(04, 05, 12, 09, 07) ),
"ClLo"      = list( "name" = "Clay loam",       "points" = c(06, 07, 11, 10) ),
"Lo"        = list( "name" = "Loam",            "points" = c(07, 09, 14, 11) ),
"LoSa"      = list( "name" = "Loamy sand",      "points" = c(09, 12, 17, 19, 18, 16, 14) ),
"SaCl"      = list( "name" = "Sandy clay",      "points" = c(08, 10, 13) ),
"SaClLo"    = list( "name" = "Sandy clay loam", "points" = c(10, 11, 15, 13) ),
"SaLo"      = list( "name" = "Sandy loam",      "points" = c(11, 14, 16, 18, 15) ),
"Sa"        = list( "name" = "Sand",            "points" = c(16, 17, 19, 18) )
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,20,2000),
tri.css.ps.lim  = c(0,2,20,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
"AU2.TT" = list( # Australian TRIANGLE PARAMETERS :
main            = "Autralia (AU)",
#
# The coordinates of this triangle were kindly provided by Budiman Minasni
#    as a replacement for the original implementation of the Australian
#    texture triangle.
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  P01    P02    P03    P04    P05    P06    P07
#                  P08    P09    P10    P11    P12    P13    P14
#                  P15    P16    P17    P18    P19
"tt.points"     = data.frame(
"CLAY"  =   c( 0.510, 0.300, 0.400, 0.750, 1.000, 0.400, 0.260,
0.260, 0.000, 0.000, 0.120, 0.085, 0.000, 0.000,
0.080, 0.100, 0.210, 0.170, 0.260 ),
"SILT"  =   c( 0.000, 0.070, 0.250, 0.250, 0.000, 0.600, 0.740,
0.250, 0.250, 1.000, 0.250, 0.040, 0.075, 0.000,
0.000, 0.130, 0.100, 0.000, 0.000 ),
"SAND"  =   c( 0.490, 0.630, 0.350, 0.000, 0.000, 0.000, 0.000,
0.490, 0.750, 0.000, 0.630, 0.875, 0.925, 1.000,
0.920, 0.770, 0.690, 0.830, 0.740 )
),  #
#
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"C"   = list( "name" = "Clay",            "points" = c(01, 02, 03, 04, 05, 01) ),
"ZC"  = list( "name" = "Silty clay",      "points" = c(03, 06, 04, 03) ),
"ZCL" = list( "name" = "Silty clay loam", "points" = c(08, 07, 06, 03, 08) ),
"ZL"  = list( "name" = "Silty loam",      "points" = c(09, 10, 07, 08, 11, 09) ),
"LS"  = list( "name" = "Loamy sand",      "points" = c(13, 09, 11, 12) ),
"S"   = list( "name" = "Sand",            "points" = c(14, 13, 12, 15, 14) ),
"SL"  = list( "name" = "Sandy loam",      "points" = c(15, 16, 17, 18, 15) ),
"L"   = list( "name" = "Loam",            "points" = c(16, 11, 08, 17, 16) ),
"SCL" = list( "name" = "Sandy clay loam", "points" = c(18, 17, 02, 19, 18) ),
"CL"  = list( "name" = "Clay loam",       "points" = c(17, 08, 03, 02) ),
"SC"  = list( "name" = "Sandy clay",      "points" = c(19, 02, 01, 19) )
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,20,2000),
tri.css.ps.lim  = c(0,2,20,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
"BE.TT" = list( # Belgian TRIANGLE PARAMETERS :
#
main            = "Belgium (BE)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  =-P01-   P02    P03    P04    P05    P06    P07    P08      P09     P10    P11
#                    P12    P13    P14    P15   -P16-   P17    P18    P19      P20   -P21-
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.450, 0.350, 0.350, 0.175, 0.175, 0.175, 0.18125, 0.200, 0.225, 0.300,
0.0875,0.0875,0.1125,0.1125,0.000, 0.000, 0.000, 0.000,   0.000, 0.000 ),
"SILT"      = c( 0.000, 0.550, 0.000, 0.550, 0.000, 0.150, 0.525, 0.56875, 0.600, 0.625, 0.700,
0.000, 0.0875,0.2125,0.3875,0.000, 0.175, 0.325, 0.500,   0.850, 1.000 ),
"SAND"      = c( 0.000, 0.000, 0.650, 0.100, 0.825, 0.675, 0.300, 0.250,   0.200, 0.150, 0.000,
0.9125,0.825, 0.675, 0.500, 1.000, 0.825, 0.675, 0.500,   0.150, 0.000 )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"U" = list( "name" = "Argile lourde | Zware klei",              "points" = c(01, 03, 04, 02                     ) ),
"E" = list( "name" = "Argile | Klei",                           "points" = c(03, 04, 02, 11, 10, 09, 08, 07, 05 ) ),
"A" = list( "name" = "Limon | Leem",                            "points" = c(10, 11, 21, 20                     ) ),
"L" = list( "name" = "Limon sableux | Zandleem",                "points" = c(06, 07, 08, 09, 10, 20, 19, 15, 14 ) ),
"P" = list( "name" = "Limon sableux leger | Licht zandleem",    "points" = c(14, 15, 19, 18                     ) ),
"S" = list( "name" = "Sable limoneux | Lemig zand",             "points" = c(05, 06, 14, 18, 17, 13, 12         ) ),
"Z" = list( "name" = "Sable | Zand",                            "points" = c(12, 13, 17, 16                     ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(F,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SILT","SAND","CLAY"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
#
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  =-P01-   P02    P03    P04    P05    P06    P07    P08    P09    P10    P11
#                    P12    P13    P14    P15    P16    P17    P18    P19    P20    P21   -P22-
#                    P23    P24    P25    P26   -P27-
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.600, 0.600, 0.550, 0.400, 0.400, 0.400, 0.350, 0.350, 0.270, 0.270,
0.270, 0.270, 0.200, 0.200, 0.120, 0.120, 0.150, 0.100, 0.070, 0.070, 0.000,
0.000, 0.000, 0.000, 0.000, 0.000 ),
"SILT"      = c( 0.000, 0.400, 0.000, 0.000, 0.600, 0.400, 0.150, 0.200, 0.000, 0.730, 0.530,
0.500, 0.280, 0.280, 0.000, 0.880, 0.800, 0.000, 0.000, 0.500, 0.410, 1.000,
0.800, 0.500, 0.300, 0.150, 0.000 ),
"SAND"      = c( 0.000, 0.000, 0.400, 0.450, 0.000, 0.200, 0.450, 0.450, 0.650, 0.000, 0.200,
0.230, 0.450, 0.520, 0.800, 0.000, 0.080, 0.850, 0.900, 0.430, 0.520, 0.000,
0.200, 0.500, 0.700, 0.850, 1.000 )
#                http://sis.agr.gc.ca/cansis/glossary/texture,_soil.html
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"ALo"  = list( "name" = "Argile lourde",         "points" = c( 01, 02, 03 ) ),
"ALi"  = list( "name" = "Argile limoneuse",      "points" = c( 02, 05, 06 ) ),
"A"    = list( "name" = "Argile",                "points" = c( 02, 03, 04, 07, 06 ) ),
"AS"   = list( "name" = "Argile sableuse",       "points" = c( 04, 07, 08, 09 ) ),
"LLiA" = list( "name" = "Loam limono-argileux",  "points" = c( 05, 06, 11, 10 ) ),
"LA"   = list( "name" = "Loam argileux",         "points" = c( 06, 07, 08, 13, 12, 11 ) ),
"LSA"  = list( "name" = "Loam sablo-argileux",   "points" = c( 08, 09, 15, 14, 13 ) ),
"LLi"  = list( "name" = "Loam limoneux",         "points" = c( 10, 11, 12, 20, 24, 23, 17, 16 ) ),
"L"    = list( "name" = "Loam",                  "points" = c( 12, 13, 14, 21, 20 ) ),
"LS"   = list( "name" = "Loam sableux",          "points" = c( 14, 15, 18, 25, 24, 20, 21 ) ),
"SL"   = list( "name" = "Sable loameux",         "points" = c( 18, 19, 26, 25 ) ),
"Li"   = list( "name" = "Limon",                 "points" = c( 16, 17, 23, 22 ) ),
"S"    = list( "name" = "Sable",                 "points" = c( 19, 27, 26 ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000), # http://sis.agr.gc.ca/cansis/glossary/separates,_soil.html
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
#
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  =-P01-   P02    P03    P04    P05    P06    P07    P08    P09    P10    P11
#                    P12    P13    P14    P15    P16    P17    P18    P19    P20    P21   -P22-
#                    P23    P24    P25    P26   -P27-
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.600, 0.600, 0.550, 0.400, 0.400, 0.400, 0.350, 0.350, 0.270, 0.270,
0.270, 0.270, 0.200, 0.200, 0.120, 0.120, 0.150, 0.100, 0.070, 0.070, 0.000,
0.000, 0.000, 0.000, 0.000, 0.000 ),
"SILT"      = c( 0.000, 0.400, 0.000, 0.000, 0.600, 0.400, 0.150, 0.200, 0.000, 0.730, 0.530,
0.500, 0.280, 0.280, 0.000, 0.880, 0.800, 0.000, 0.000, 0.500, 0.410, 1.000,
0.800, 0.500, 0.300, 0.150, 0.000 ),
"SAND"      = c( 0.000, 0.000, 0.400, 0.450, 0.000, 0.200, 0.450, 0.450, 0.650, 0.000, 0.200,
0.230, 0.450, 0.520, 0.800, 0.000, 0.080, 0.850, 0.900, 0.430, 0.520, 0.000,
0.200, 0.500, 0.700, 0.850, 1.000 )
#                http://sis.agr.gc.ca/cansis/glossary/texture,_soil.html
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"HCl"    = list( "name" = "Heavy clay",       "points" = c( 01, 02, 03 ) ),
"SiCl"   = list( "name" = "Silty clay",       "points" = c( 02, 05, 06 ) ),
"Cl"     = list( "name" = "Clay",             "points" = c( 02, 03, 04, 07, 06 ) ),
"SaCl"   = list( "name" = "Sandy clay",       "points" = c( 04, 07, 08, 09 ) ),
"SiClLo" = list( "name" = "Silty clay loam",  "points" = c( 05, 06, 11, 10 ) ),
"ClLo"   = list( "name" = "Clay loam",        "points" = c( 06, 07, 08, 13, 12, 11 ) ),
"SaClLo" = list( "name" = "Sandy clay loam",  "points" = c( 08, 09, 15, 14, 13 ) ),
"SiLo"   = list( "name" = "Silty loam",       "points" = c( 10, 11, 12, 20, 24, 23, 17, 16 ) ),
"L"      = list( "name" = "Loam",             "points" = c( 12, 13, 14, 21, 20 ) ),
"SaLo"   = list( "name" = "Sandy loam",       "points" = c( 14, 15, 18, 25, 24, 20, 21 ) ),
"LoSa"   = list( "name" = "Loamy sand",       "points" = c( 18, 19, 26, 25 ) ),
"Si"     = list( "name" = "Silt",             "points" = c( 16, 17, 23, 22 ) ),
"Sa"     = list( "name" = "Sand",             "points" = c( 19, 27, 26 ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000), # http://sis.agr.gc.ca/cansis/glossary/separates,_soil.html
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
#               # Variant with official class-labels prepared for the
#               # Ontario Ministry of Agriculture, Food and Rural Affairs,
#               # Environmental Management Branch
#
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  =-P01-   P02    P03    P04    P05    P06    P07    P08    P09    P10    P11
#                    P12    P13    P14    P15    P16    P17    P18    P19    P20    P21   -P22-
#                    P23    P24    P25    P26   -P27-
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.600, 0.600, 0.550, 0.400, 0.400, 0.400, 0.350, 0.350, 0.270, 0.270,
0.270, 0.270, 0.200, 0.200, 0.120, 0.120, 0.150, 0.100, 0.070, 0.070, 0.000,
0.000, 0.000, 0.000, 0.000, 0.000 ),
"SILT"      = c( 0.000, 0.400, 0.000, 0.000, 0.600, 0.400, 0.150, 0.200, 0.000, 0.730, 0.530,
0.500, 0.280, 0.280, 0.000, 0.880, 0.800, 0.000, 0.000, 0.500, 0.410, 1.000,
0.800, 0.500, 0.300, 0.150, 0.000 ),
"SAND"      = c( 0.000, 0.000, 0.400, 0.450, 0.000, 0.200, 0.450, 0.450, 0.650, 0.000, 0.200,
0.230, 0.450, 0.520, 0.800, 0.000, 0.080, 0.850, 0.900, 0.430, 0.520, 0.000,
0.200, 0.500, 0.700, 0.850, 1.000 )
#                http://sis.agr.gc.ca/cansis/glossary/texture,_soil.html
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"HC"     = list( "name" = "Heavy clay",       "points" = c( 01, 02, 03 ) ),
"SiC"    = list( "name" = "Silty clay",       "points" = c( 02, 05, 06 ) ),
"C"      = list( "name" = "Clay",             "points" = c( 02, 03, 04, 07, 06 ) ),
"SC"     = list( "name" = "Sandy clay",       "points" = c( 04, 07, 08, 09 ) ),
"SiCL"   = list( "name" = "Silty clay loam",  "points" = c( 05, 06, 11, 10 ) ),
"CL"     = list( "name" = "Clay loam",        "points" = c( 06, 07, 08, 13, 12, 11 ) ),
"SCL"    = list( "name" = "Sandy clay loam",  "points" = c( 08, 09, 15, 14, 13 ) ),
"SiL"    = list( "name" = "Silty loam",       "points" = c( 10, 11, 12, 20, 24, 23, 17, 16 ) ),
"L"      = list( "name" = "Loam",             "points" = c( 12, 13, 14, 21, 20 ) ),
"SL"     = list( "name" = "Sandy loam",       "points" = c( 14, 15, 18, 25, 24, 20, 21 ) ),
"LS"     = list( "name" = "Loamy sand",       "points" = c( 18, 19, 26, 25 ) ),
"Si"     = list( "name" = "Silt",             "points" = c( 16, 17, 23, 22 ) ),
"S"      = list( "name" = "Sand",             "points" = c( 19, 27, 26 ) )                  #
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000), # http://sis.agr.gc.ca/cansis/glossary/separates,_soil.html
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
"ISSS.TT" = list(  #  ISSS Triangle parameters
#                 by Wei Shangguan, School of geography, Beijing normal university
#                 and after Verheye, W., and J. Ameryckx. 1984. Mineral fractions
#                 and classificaton of soil texture. Pedologie, 2, 215-225.
main            = "ISSS",
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
#                  = P13    P14    P15    P16    P17    P18
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.450, 0.450, 0.450, 0.250, 0.250, 0.250, 0.250, 0.150, 0.150, 0.150, 0.150,
0.050, 0.000, 0.000, 0.000, 0.000, 0.000),
#
"SILT"      = c( 0.000, 0.000, 0.450, 0.550, 0.000, 0.200, 0.450, 0.750, 0.000, 0.200, 0.450, 0.850,
0.000, 0.000, 0.150, 0.350, 0.450, 1.000),
#
"SAND"      = c( 0.000, 0.550, 0.100, 0.000, 0.750, 0.550, 0.300, 0.000, 0.850, 0.650, 0.400, 0.000,
0.950, 1.000, 0.850, 0.650, 0.550, 0.000)
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"HCl"        = list( "name" = "heavy clay",      "points" = c(01,02,03,04)        ),
"SaCl"       = list( "name" = "sandy clay",      "points" = c(02,05,06)           ),
"LCl"        = list( "name" = "light clay",      "points" = c(02,06,07,03)        ),
"SiCl"       = list( "name" = "silty clay",      "points" = c(03,07,08,04)        ),
"SaClLo"     = list( "name" = "sandy clay loam", "points" = c(05,09,10,06)        ),
"ClLo"       = list( "name" = "clay loam",       "points" = c(06,10,11,07)        ),
"SiClLo"     = list( "name" = "silty clay loam", "points" = c(07,11,12,08)        ),
"LoSa"       = list( "name" = "loamy sand",      "points" = c(09,13,15)           ),
"Sa"         = list( "name" = "sand",            "points" = c(13,14,15)           ),
"SaLo"       = list( "name" = "sandy loam",      "points" = c(09,15,16,10)        ),
"Lo"         = list( "name" = "loam",            "points" = c(10,16,17,11)        ),
"SiLo"       = list( "name" = "silt loam",       "points" = c(11,17,18,12)        )
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,20,2000),
tri.css.ps.lim  = c(0,2,20,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
"ROM.TT" = list(# ROM TRIANGLE PARAMETERS: Added 2010/06/07
#                  by Rosca Bogdan, Romanian Academy
#                  Iasi Branch, Geography team
#
main = "SRTS 2003",
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
#                  = P13    P14    P15    P16    P17    P18    P19    P20    P21    P22    P23
#                  = P24    P25    P26    P27 (submits)
"tt.points"     = data.frame(
"CLAY"      = c( 0.700, 0.700, 0.600, 0.600, 0.600, 0.450, 0.450, 0.450, 0.450, 0.330, 0.330, 0.330,
0.330, 0.200, 0.200, 0.200, 0.200, 0.200, 0.120, 0.120, 0.050, 0.050, 0.000,
0.000, 1.000, 0.000, 0.000 ),
#
"SILT"      = c( 0.000, 0.300, 0.000, 0.330, 0.400, 0.000, 0.140, 0.330, 0.550, 0.000, 0.140, 0.330,
0.670, 0.000, 0.140, 0.330, 0.500, 0.800, 0.000, 0.330, 0.000, 0.330, 0.330,
0.500, 0.000, 0.000, 1.000 ),
#
"SAND"      = c( 0.300, 0.000, 0.400, 0.070, 0.000, 0.550, 0.410, 0.220, 0.000, 0.670, 0.530, 0.340,
0.000, 0.800, 0.660, 0.470, 0.300, 0.000, 0.880, 0.550, 0.950, 0.620, 0.670,
0.500, 0.000, 1.000, 0.000 )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"AF"        = list( "name" = "argila fina",          "points" = c(01,25,02                 ) ),
"AA"        = list( "name" = "argila medie",         "points" = c(01,03,04,05,02           ) ),
"AP"        = list( "name" = "argila prafoasa",      "points" = c(04,08,09,05              ) ),
"AL"        = list( "name" = "argila lutoasa",       "points" = c(03,06,07,08,04           ) ),
"TP"        = list( "name" = "lut argilo-prafos",    "points" = c(08,12,13,09              ) ),
"TT"        = list( "name" = "lut argilos mediu",    "points" = c(07,11,12,08              ) ),
"TN"        = list( "name" = "argila nisipoasa",     "points" = c(06,10,11,07              ) ),
"LP"        = list( "name" = "lut prafos",           "points" = c(12,16,17,18,13           ) ),
"LL"        = list( "name" = "lut mediu",            "points" = c(11,15,16,12              ) ),
"LN"        = list( "name" = "lut nisipo-argilos",   "points" = c(10,14,15,11              ) ),
"SP"        = list( "name" = "praf",                 "points" = c(17,24,27,18              ) ),
"SS"        = list( "name" = "lut nisipos prafos",   "points" = c(16,20,22,23,24,17        ) ),
"SG+SM+SF"  = list( "name" = "lut nisipos",          "points" = c(14,19,20,16,15           ) ),
"UG+UM+UF"  = list( "name" = "nisip lutos",          "points" = c(19,21,22,20              ) ),
"NG+NM+NF"  = list( "name" = "nisip",                "points" = c(21,26,23,22              ) )
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,20,2000),
tri.css.ps.lim  = c(0,2,20,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #
#
"DE.SEA74.TT"  = list( # GDR Forest soils TRIANGLE PARAMETERS :
#
main            = "Standortserkundungsanweisung SEA 1974 (DE)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes. The clay definition of points 08, 09, 10 closely follows the
#                   triangle, plotted in SEA 1974, conforms to the GDR standard (TGL 24300-05:1985-06), but
#                   is 1 Percent larger than the actual German texture triangle in DE.BK94.TT :
#                  P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12    P13
#                  P14    P15    P16    P17    P18    P19    P20    P21    P22    P23    P24    P25    P26
"tt.points"     = data.frame(
"CLAY"  =   c( 1.000, 0.450, 0.450, 0.300, 0.300, 0.300, 0.300, 0.180, 0.180, 0.180, 0.150, 0.120, 0.050,
0.000, 0.000, 0.000, 0.000, 0.050, 0.100, 0.025, 0.050, 0.080, 0.080, 0.000, 0.000, 0.450 ),
"SILT"  =   c( 0.000, 0.550, 0.000, 0.700, 0.550, 0.150, 0.000, 0.820, 0.550, 0.150, 0.000, 0.150, 0.550,
0.550, 0.200, 0.100, 0.000, 0.000, 0.000, 0.075, 0.150, 0.800, 0.920, 1.000, 0.800, 0.400 ),
"SAND"  =   c( 0.000, 0.000, 0.550, 0.000, 0.150, 0.550, 0.700, 0.000, 0.270, 0.670, 0.850, 0.730, 0.400,
0.450, 0.800, 0.900, 1.000, 0.950, 0.900, 0.900, 0.800, 0.120, 0.000, 0.000, 0.200, 0.150 )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"L"   = list( "name" = "Lehm",                "points" = c(10, 06, 05, 09 ) ),
"stL" = list( "name" = "sandig-toniger Lehm", "points" = c(11, 07, 06, 10, 12 ) ),
"sL"  = list( "name" = "sandiger Lehm",       "points" = c(12, 10, 09, 13 ) ),
"S"   = list( "name" = "Sand",                "points" = c(17, 18, 20, 16 ) ),
"alS" = list( "name" = "anlehmiger Sand",     "points" = c(18, 19, 21, 15, 16, 20 ) ),
"lS"  = list( "name" = "lehmiger Sand",       "points" = c(19, 11, 12, 13, 14, 15, 21 ) ),
"T"   = list( "name" = "Ton",                 "points" = c(03, 01, 02 ) ),
"uT"  = list( "name" = "schluffiger Ton",     "points" = c(05, 26, 02, 04 ) ),
"lT"  = list( "name" = "lehmiger Ton",        "points" = c(03, 26, 05, 06 ) ),
"sT"  = list( "name" = "sandiger Ton",        "points" = c(07, 03, 06 ) ),
"U"   = list( "name" = "Schluff",             "points" = c(25, 22, 23, 24 ) ),
"UL"  = list( "name" = "Schlufflehm",         "points" = c(09, 05, 04, 08 ) ),
"lU"  = list( "name" = "lehmiger Schluff",    "points" = c(14, 13, 09, 08, 23, 22, 25 ) )
#
),  #

# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),

blr.tx      = c("CLAY","SILT","SAND"),

base.css.ps.lim = c(0,2,63,2000),
tri.css.ps.lim  = c(0,2,63,2000),

unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),

text.sum        = 100
),  #
#
"DE.TGL85.TT" = list( # GDR Arable soils TRIANGLE PARAMETERS :
#
main = "TGL 24300-05, landwirtschaftliche Boeden (DE)",
#
#                 The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes. Definitions follow the GDR Standard for arable soils
#                   (TGL 24300-05:1985-06; Aufnahme landwirtschaftlich genutzter Standorte):
#                  P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12    P13
#                  P14    P15    P16    P17    P18    P19    P20    P21    P22    P23    P24    P25    P26
"tt.points" = data.frame(
"CLAY"  =   c( 1.000, 0.500, 0.500, 0.500, 0.300, 0.300, 0.300, 0.300, 0.180, 0.180, 0.180, 0.080, 0.080,
0.000, 0.000, 0.140, 0.110, 0.080, 0.050, 0.000, 0.000, 0.000, 0.050, 0.085, 0.000, 0.050),
"SILT"  =   c( 0.000, 0.500, 0.300, 0.000, 0.700, 0.500, 0.200, 0.000, 0.820, 0.500, 0.000, 0.920, 0.720,
0.800, 1.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.150, 0.300, 0.300, 0.300, 0.500, 0.500),
"SAND"  =   c( 0.000, 0.000, 0.200, 0.500, 0.000, 0.200, 0.500, 0.700, 0.000, 0.320, 0.820, 0.000, 0.200,
0.200, 0.000, 0.860, 0.890, 0.920, 0.950, 1.000, 0.850, 0.700, 0.650, 0.615, 0.500, 0.450)
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"rS"    = list( "name" = "reiner Sand",                "points" = c(19, 20, 21 ) ),
"l''S"  = list( "name" = "sehr schwach lehmiger Sand", "points" = c(18, 19, 21, 22 ) ),
"l'S"   = list( "name" = "schwach lehmiger Sand",      "points" = c(17, 18, 22, 23 ) ),
#"lS"   = list( "name" = "stark lehmiger Sand",        "points" = c(17, 18, 20, 16 ) ),
"lS"    = list( "name" = "stark lehmiger Sand",        "points" = c(16, 17, 23, 24 ) ),
"uS"    = list( "name" = "schluffiger Sand",           "points" = c(24, 23, 22, 25, 26 ) ),
"U"     = list( "name" = "Schluff",                    "points" = c(13, 14, 15, 12 ) ),
"lU"    = list( "name" = "lehmiger Schluff",           "points" = c(10, 26, 25, 14, 13, 12, 09 ) ),
"sL"    = list( "name" = "sandiger Lehm",              "points" = c(11, 16, 24, 26,  10 ) ),
"L"     = list( "name" = "Lehm",                       "points" = c(08, 11, 10, 06, 07 ) ),
"UL"    = list( "name" = "Schlufflehm",                "points" = c(06, 10, 09, 05 ) ),
"uT"    = list( "name" = "schluffiger Ton",            "points" = c(03, 06, 05, 02 ) ),
"lT"    = list( "name" = "lehmiger Ton",               "points" = c(04, 07, 06, 03 ) ),
"sT"    = list( "name" = "sandiger Ton",               "points" = c(04, 08, 07 ) ),
"T"     = list( "name" = "Ton",                        "points" = c(01, 04, 03, 02 ) )
#
),  #
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = c(F,T,NA),
tlr.an          = c(45,90,45),
#
blr.tx          = c("CLAY","SILT","SAND"),
#
base.css.ps.lim = c(0,2,63,2000),
tri.css.ps.lim  = c(0,2,63,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),

"USDA1911" = list(
# USDA 1911 (M. Whitney, 1911)
# Courtesy of Nic Jelinski University of Minnesota, USA
# 2014-04-23

"main"  = "USDA 1911 (M. Whitney, 1911) - Ternary Plot",

text = "CLAY SILT SAND
0.0  0.0  1.0       # 1
0.2  0.0  0.8       # 2
0.0  0.2  0.8       # 3
0.5  0.0  0.5       # 4
0.3  0.2  0.5       # 5
0.2  0.3  0.5       # 6
0.0  0.5  0.5       # 7
0.2  0.5  0.3       # 8
0.3  0.5  0.2       # 9
0.3  0.7  0.0       # 10
0.2  0.8  0.0       # 11
0.0  1.0  0.0       # 12
1.0  0.0  0.0" ),   # 13

"tt.polygons"   = list(
"C" = list(
"name"      = "Clay",
"points"    = c( 4, 13, 10,  5 )
),
"SaC" = list(   # INSTEAD OF SC (can be mistaken for Silty Clay)
"name"      = "Sandy Clay",
"points"    = c( 2, 4, 5 )
),
"CL" = list(
"name"      = "Clay Loam",
"points"    = c( 5, 9, 8, 6 )
),
"SaCL" = list(  # INSTEAD OF SiCL
"name"      = "Sandy Clay Loam",
"points"    = c( 8, 9, 10, 11 )
),
"L" = list(
"name"      = "Loam",
"points"    = c( 7, 6, 8 )
),
"SiL" = list(
"name"      = "Silt Loam",
"points"    = c( 7, 8, 11, 12 )
),
"SaL" = list(   # INSTEAD OF SL (can be mistaken for Silty Loam)
"name"      = "Sandy Loam",
"points"    = c( 3, 2, 5, 7 )
),
"Sa" = list(    # INSTEAD OF S (Can be mistaken for Silt)
"name"      = "Sand",
"points"    = c( 1, 2, 3 )
)
),
"blr.clock"         = c( FALSE, TRUE, NA ),
"tlr.an"            = c( 45, 90, 45 ),
"blr.tx"            = c( "SILT", "CLAY", "SAND" ),
"base.css.ps.lim"   = c( 0, 5, 50, 2000 ),
"tri.css.ps.lim"    = c( 0, 5, 50, 2000 ),
"unit.ps"           = quote( bold( mu ) * bold( "m" ) ),
"unit.tx"           = quote( bold( "%" ) ),
"text.sum"          = 100
),

BRASIL.TT = list(  #  Brazilian Triangle parameters (Lemos and Santos 1996)
# Lemos, R. C. & Santos, R. D. Manual de descricao e
# coleta de solo no campo. 3a ed. Campinas, Sociedade
# Brasileira de Ciencia do solo, 1996.

# Information is a courtesy of Rodolfo Marcondes Silva
# Souza, UFPE, Brasil (base-triangle is USDA triangle,
# modified for Brasil)

main            = "Brasil - Lemos & Santos (1996)",
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
#                  = P13    P14    P15    P16    P17    P18    P19    P20    P21    P22    P23
#                  = P24    P25    P26    P27 (submits)
"tt.points"     = data.frame(
"CLAY"      = c( 0.550, 0.600, 0.350, 0.350, 0.400, 0.400, 0.400, 0.200, 0.200, 0.275, 0.275, 0.275,
0.275, 0.150, 0.100, 0.075, 0.075, 0.125, 0.125, 0.000, 0.000, 0.000, 0.000,
1.000, 0.000, 0.000, 0.600 ),
#
"SILT"      = c( 0.000, 0.400, 0.000, 0.200, 0.150, 0.400, 0.600, 0.000, 0.275, 0.275, 0.500, 0.525,
0.725, 0.000, 0.000, 0.400, 0.500, 0.800, 0.875, 0.150, 0.300, 0.500, 0.800,
0.000, 0.000, 1.000, 0.000 ),
#
"SAND"      = c( 0.450, 0.000, 0.650, 0.450, 0.450, 0.200, 0.000, 0.800, 0.525, 0.450, 0.225, 0.200,
0.000, 0.850, 0.900, 0.525, 0.425, 0.075, 0.000, 0.850, 0.700, 0.500, 0.200,
0.000, 1.000, 0.000, 0.400 )
),  #
#
#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"   = list(
"MA"        = list( "name" = "muito argilosa",        "points" = c(02,24,27)                  ),
"A"         = list( "name" = "argila",                "points" = c(27,01,05,06,02)            ),
"As"        = list( "name" = "argila siltosa",        "points" = c(02,06,07)                  ),
"AAr"       = list( "name" = "argila arenosa",        "points" = c(01,03,04,05)               ),
"FA"        = list( "name" = "franco argiloso",       "points" = c(05,04,10,11,12,06)         ),
"FAS"       = list( "name" = "franco argilo siltoso", "points" = c(06,12,13,07)               ),
"FAAr"      = list( "name" = "franco argilo arenoso", "points" = c(03,08,09,10,04)            ),
"F"         = list( "name" = "franco",                "points" = c(10,09,16,17,11)            ),
"FS"        = list( "name" = "franco siltoso",        "points" = c(11,17,22,23,18,19,13,12)   ),
"FAr"       = list( "name" = "franco arenoso",        "points" = c(08,14,21,22,17,16,09)      ),
"S"         = list( "name" = "silte",                 "points" = c(18,23,26,19)               ),
"ArF"       = list( "name" = "areia franca",          "points" = c(14,15,20,21)               ),
"Ar"        = list( "name" = "areia",                 "points" = c(15,25,20)                  )
),
#
# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),
#
blr.tx      = c("SAND","CLAY","SILT"),
#
base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),
#
unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),
#
text.sum        = 100
),  #

"SiBCS13.TT" = list(
# Subagrupamento Textural SiBCS 2013 parameters (Embrapa 2013)
#   Embrapa. Sistema Brasileiro de Classificacao de Solos /
#   Humberto Golcalves dos Santos ... [et al.]. 3a ed. rev. ampl.
#   Brasilia, DF: Embrapa, 2013.

# Information is a courtesy of Jose Lucas Safanelli and
# Alexandre ten Caten, UFSC Curitibanos, Brasil.

# main            = "Subagrupamento textural SiBCS 2013 - Embrapa 2013",
main            = "SiBCS 2013 (Embrapa)", # Shorter title and more international?
#
#                The list below specify the CSS coordinates of the different POINTS
#                   that are used to draw soil texture classes. One points can be
#                   used by several classes :
#                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
#                  = P13    P14    P15    P16    P17    P18    (submits)
"tt.points"     = data.frame(
"CLAY"      = c( 1.000, 0.600, 0.600, 0.350, 0.350, 0.350, 0.350, 0.200, 0.200, 0.250, 0.150, 0.100,
0.000, 0.000, 0.000, 0.000, 0.000, 0.000 ),
#
"SILT"      = c( 0.000, 0.000, 0.400, 0.000, 0.175, 0.500, 0.650, 0.000, 0.250, 0.275, 0.000, 0.000,
0.000, 0.150, 0.300, 0.475, 0.850, 1.000 ),
#
"SAND"      = c( 0.000, 0.400, 0.000, 0.650, 0.475, 0.150, 0.000, 0.800, 0.550, 0.475, 0.850, 0.900,
1.000, 0.850, 0.700, 0.525, 0.150, 0.000 )
),  #

#   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
"tt.polygons"  = list(
"MA"       = list( "name" = "muito argilosa", "points" = c(01,02,03)          ),
"A"        = list( "name" = "argilosa",       "points" = c(02,03,07,06,05,04) ),
"S"        = list( "name" = "siltosa",        "points" = c(06,07,18,17)       ),
"MeS"      = list( "name" = "media siltosa",  "points" = c(05,06,17,16,09,10) ),
"MeA"      = list( "name" = "media argilosa", "points" = c(04,05,10,09,08)    ),
"MeAr"     = list( "name" = "media arenosa",  "points" = c(08,09,16,15,11)    ),
"ArMe"     = list( "name" = "arenosa media",  "points" = c(11,15,14,12)       ),
"MAr"      = list( "name" = "muito arenosa",  "points" = c(12,14,13)          )
),

# Triangle specific parameters for triangle geometry / appearance
#   See general parameters above for detailed description of them
blr.clock       = rep(T,3),
tlr.an          = c(60,60,60),

blr.tx          = c("SAND","CLAY","SILT"),

base.css.ps.lim = c(0,2,50,2000),
tri.css.ps.lim  = c(0,2,50,2000),

unit.ps         = quote(bold(mu) * bold('m')),
unit.tx         = quote(bold('%')),

text.sum        = 100,

#   New parameter
class.lab.cex   = 2/3
)

# "Polish_BN_1978.TT" = list(  #  Polish_BN_1978 Triangle parameters
# #
# #   Courtsesy of Michal Stepien, Warsaw University of Life Sciences
# #
# main            = "Polish_BN_1978",
# #
# #                The list below specify the CSS coordinates of the different POINTS
# #                   that are used to draw soil texture classes. One points can be
# #                   used by several classes :
# #                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
# #                  = P13    P14    P15    P16    P17    P18    P19    P20    P21    P22    P23    P24
# #                  = P25    P26    P27    P28    P29    P30    P31    P32    P33    P34    P35    P36(submits)
# "tt.points"     = data.frame(
# "CLAY"      = c( 1.000, 0.900, 0.750, 0.750, 0.750, 0.650, 0.500, 0.500, 0.500, 0.500, 0.350, 0.350,
# 0.350, 0.350, 0.250, 0.250, 0.250, 0.200, 0.200, 0.200, 0.200, 0.200, 0.150, 0.150,
# 0.150, 0.100, 0.100, 0.100, 0.050, 0.050, 0.050, 0.000, 0.000, 0.000, 0.000, 0.000  ),
# #
# "SILT"      = c( 0.000, 0.000, 0.000, 0.150, 0.250, 0.250, 0.000, 0.250, 0.400, 0.500, 0.000, 0.250,
# 0.400, 0.650, 0.000, 0.250, 0.400, 0.000, 0.250, 0.400, 0.550, 0.800, 0.000, 0.250,
# 0.400, 0.000, 0.250, 0.400, 0.000, 0.250, 0.400, 0.000, 0.250, 0.400, 0.750, 1.000  ),
# #
# "SAND"      = c( 0.000, 0.100, 0.250, 0.100, 0.000, 0.100, 0.500, 0.250, 0.100, 0.000, 0.650, 0.400,
# 0.250, 0.000, 0.750, 0.500, 0.350, 0.800, 0.550, 0.400, 0.250, 0.000, 0.850, 0.600,
# 0.450, 0.900, 0.650, 0.500, 0.950, 0.700, 0.550, 1.000, 0.750, 0.600, 0.250, 0.000  )
# ),  #
# #
# #   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
# "tt.polygons"   = list(
# "pl"        = list( "name" = "piasek luzny",                    "points" = c(29,30,33,32)     ),
# "plp"       = list( "name" = "piasek luzny pylasty",            "points" = c(30,31,34,33)     ),
# "ps"        = list( "name" = "piasek slabogliniasty",           "points" = c(26,27,30,29)     ),
# "psp"       = list( "name" = "piasek slabogliniasty pylasty",   "points" = c(27,28,31,30)     ),
# "pgl"       = list( "name" = "piasek gliniasty lekki",          "points" = c(23,24,27,26)     ),
# "pglp"      = list( "name" = "piasek gliniasty lekki pylasty",  "points" = c(24,25,28,27)     ),
# "pgm"       = list( "name" = "piasek gliniasty mocny",          "points" = c(18,19,24,23)     ),
# "pgmp"      = list( "name" = "piasek gliniasty mocny pylasty",  "points" = c(19,20,25,24)     ),
# "gp"        = list( "name" = "glina piaszczysta",               "points" = c(15,16,19,18)     ),
# "gpp"       = list( "name" = "glina piaszczysta pylasta",       "points" = c(16,17,20,19)     ),
# "gl"        = list( "name" = "glina lekka",                     "points" = c(11,12,16,15)     ),
# "glp"       = list( "name" = "glina lekka pylasta",             "points" = c(12,13,17,16)     ),
# "gs"        = list( "name" = "glina srednia",                   "points" = c(07,08,12,11)     ),
# "gsp"       = list( "name" = "glina srednia pylasta",           "points" =c(08,09,13,12)      ),
# "gc"        = list( "name" = "glina ciezka",                    "points" = c(03,04,06,08,07)  ),
# "gcp"       = list( "name" = "glina ciezka pylasta",            "points" =c(06,09,08)         ),
# "gbc"       = list( "name" = "glina bardzo ciezka",             "points" =c(02,04,03)         ),
# "i"         = list( "name" = "il",                              "points" = c(01,05,06,04,02)  ),
# "ip"        = list( "name" = "il pylasty",                      "points" = c(05,10,09,06)     ),
# "pyi"       = list( "name" = "pyl ilasty",                      "points" = c(09,10,14,13)     ),
# "pyg"       = list( "name" = "pyl gliniasty",                   "points" = c(13,14,22,21,20)  ),
# "pyp"       = list( "name" = "pyl piaszczysty",                 "points" = c(20,21,35,34)     ),
# "pyz"       = list( "name" = "pyl zwykly",                      "points" = c(21,22,36,35)     )
# ),  #
# #
# # Triangle specific parameters for triangle geometry / appearance
# #   See general parameters above for detailed description of them
# blr.clock       = rep(F,3),
# tlr.an          = c(60,60,60),
# #
# blr.tx      = c("SILT","SAND","CLAY"),
# #
# base.css.ps.lim = c(0,20,100,1000),
# tri.css.ps.lim  = c(0,20,100,1000),
# #
# unit.ps         = quote(bold(mu) * bold('m')),
# unit.tx         = quote(bold('%')),
# #
# text.sum        = 100
# ),  #

# Polish_PTG_1956_Musierowicz.TT = list(  #  Polish_PTG_1956_Musierowicz Triangle parameters
# #
# main            = "Polish_PTG_1956_Musierowicz",
# #
# #                The list below specify the CSS coordinates of the different POINTS
# #                   that are used to draw soil texture classes. One points can be
# #                   used by several classes :
# #                  = P01    P02    P03    P04    P05    P06    P07    P08    P09    P10    P11    P12
# #                  = P13    P14    P15    P16    P17    P18    P19    P20    P21    P22    P23    P24
# #                  = P25    P26    P27    P28    (submits)
# "tt.points"     = data.frame(
# "CLAY"      = c( 1.000, 0.900, 0.750, 0.650, 0.500, 0.500, 0.500, 0.500, 0.350, 0.350, 0.350, 0.350,
# 0.200, 0.200, 0.200, 0.150, 0.150, 0.150, 0.100, 0.100, 0.100, 0.050, 0.050, 0.050,
# 0.000, 0.000, 0.000, 0.000  ),
# #
# "SILT"      = c( 0.000, 0.000, 0.250, 0.250, 0.000, 0.250, 0.400, 0.500, 0.000, 0.250, 0.400, 0.650,
# 0.000, 0.250, 0.400, 0.000, 0.250, 0.400, 0.000, 0.250, 0.400, 0.000, 0.250, 0.400,
# 0.000, 0.250, 0.400, 1.000  ),
# #
# "SAND"      = c( 0.000, 0.100, 0.000, 0.100, 0.500, 0.250, 0.100, 0.000, 0.650, 0.400, 0.250, 0.000,
# 0.800, 0.550, 0.400, 0.850, 0.600, 0.450, 0.900, 0.650, 0.500, 0.950, 0.700, 0.550,
# 1.000, 0.750, 0.600, 0.000 )
# ),  #
# #
# #   Abreviations;       Names of the texture cl;    Points marking the class limits (points specified above)
# "tt.polygons"   = list(
# "pl"        = list( "name" = "piasek luzny",                   "points" = c(22,23,26,25)             ),
# "plp"       = list( "name" = "piasek luzny pylasty",           "points" = c(23,24,27,26)             ),
# "ps"        = list( "name" = "piasek slabogliniasty",          "points" = c(19,20,23,22)             ),
# "psp"       = list( "name" = "piasek slabogliniasty pylasty",  "points" = c(20,21,24,23)             ),
# "pgl"       = list( "name" = "piasek gliniasty lekki",         "points" = c(16,17,20,19)             ),
# "pglp"      = list( "name" = "piasek gliniasty lekki pylasty", "points" = c(17,18,21,20)             ),
# "pgm"       = list( "name" = "piasek gliniasty mocny",         "points" = c(13,14,17,16)             ),
# "pgmp"      = list( "name" = "piasek gliniasty mocny pylasty", "points" = c(14,15,18,17)             ),
# "gl"        = list( "name" = "glina lekka",                    "points" = c(09,10,14,13)             ),
# "glp"       = list( "name" = "glina lekka pylasta",            "points" = c(10,11,15,14)             ),
# "gs"        = list( "name" = "glina srednia",                  "points" = c(05,06,10,09)             ),
# "gsp"       = list( "name" = "glina srednia pylasta",          "points" = c(06,07,11,10)             ),
# "gc"        = list( "name" = "glina ciezka",                   "points" = c(02,04,06,05)             ),
# "gcp"       = list( "name" = "glina ciezka pylasta",           "points" = c(04,07,06)                ),
# "i"         = list( "name" = "il",                             "points" = c(01,03,04,02)             ),
# "ip"        = list( "name" = "il pylasty",                     "points" = c(03,08,07,04)             ),
# "pyz"       = list( "name" = "pyl zwykly",                     "points" = c(11,12,28,27,24,21,18,15) ),
# "pyi"       = list( "name" = "pyl ilasty",                     "points" = c(07,08,12,11)             )
# ),  #
# #
# # Triangle specific parameters for triangle geometry / appearance
# #   See general parameters above for detailed description of them
# blr.clock       = rep(F,3),
# tlr.an          = c(60,60,60),
# #
# blr.tx      = c("SILT","SAND","CLAY"),
# #
# base.css.ps.lim = c(0,20,100,1000),
# tri.css.ps.lim  = c(0,20,100,1000),
# #
# unit.ps         = quote(bold(mu) * bold('m')),
# unit.tx         = quote(bold('%')),
# #
# text.sum        = 100
# )   #

# Code for polish triangles can be found in
# \prepare\specialCharacters\triangles.R

# +-------------------------------------------------------------------------+
# | END(SCRIPT PARAMETERS SPECIFICATION)                                    |
# +-------------------------------------------------------------------------+

)   #
)   #

# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# | LIST:   TT.par.bkp                  |
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# [ TT.par.bkp :: A backup of "TT.par" parameter list, used for resetting "TT.par"
assign(
envir   = TT.env,
x       = "TT.par.bkp",
value   = get( x = "TT.par",  envir = TT.env )
)   #
#   get( "TT.par.bkp", envir = TT.env )

#' Function to change / set the default package parameters.
#'
#' Function to change / set the default package parameters as they are stored
#' in the list TT.par in the environment TT.env. Use this function to change
#' some deafult parameters for all the current R cession. Many functions of
#' soiltexture take some of their parameter values in TT.par.
#'
#'
#' @param \dots List of parameters and value in the form "par.name1" =
#' par.value1, "par.name2" = par.value2... List of parameters to change.
#' @param reset Single logical. If set to TRUE the parameter list is reset to
#' default
#' @param par.list Single character. Name of the list containing the parameters
#' @param bkp.par.list Single character. Name of the backuped list containing
#' the default parameters
#' @param par.env An R environment. Name of the environment containing the
#' parameter lists (no quotes)
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.set <- function(# Function to change / set the default package parameters.
### Function to change / set the default package parameters as they
### are stored in the list TT.par in the environment TT.env. Use
### this function to change some deafult parameters for all the
### current R cession. Many functions of soiltexture take some of
### their parameter values in TT.par.

...,
### List of parameters and value in the form "par.name1" = par.value1,
### "par.name2" = par.value2... List of parameters to change.

reset=FALSE,
### Single logical. If set to TRUE the parameter list is reset to default

par.list="TT.par",
### Single character. Name of the list containing the parameters

bkp.par.list="TT.par.bkp",
### Single character. Name of the backuped list containing the default parameters

par.env=TT.env
### An R environment. Name of the environment containing the parameter lists (no quotes)

){  #
argz <- list(...)
#
# Basic checkup:
if( !reset & (length(argz) == 0) )
{   stop("No argument specified!")  }
#
if( reset & (length(argz) != 0) )
{   stop("'reset' is not compatible with other parameters specification")   }
#
argz.nm <- names(argz)
#
if( (length(argz) != 0) & any(is.null(argz.nm)) )
{   stop("parameterS should not be text names of variables: use TT.get() to get variables") }
#
# Reset option:
if( reset )
{   #
assign(
envir   = par.env,
x       = par.list,
value   = get( x = bkp.par.list,  envir = par.env )
)   #
}else{  # Non reset options:
# Import the environment variables (function internal)
argz.list   <- get( x = par.list,  envir = par.env )
#
# Basic check:
if(   any(  !( names(argz) %in% names(argz.list) )  )   )
{   stop("At least one specified parameter doesn't exist!") }
#
# SETTING the parameters value:
for( i in 1:length(argz) )
{   #
if( is.null( argz[[i]] ) )
{   #
argz.list[  names(argz)[i]  ] <- list( argz[[i]] )
}else{
argz.list[[ names(argz)[i] ]] <- argz[[i]]
}   #
}   #
# Re-export the environment variables
assign(
envir   = par.env,
x       = par.list,
value   = argz.list
)   #
#
return( invisible( argz.list ) )
}   #
}   #

#' Function to retrieve / get the default package parameters.
#'
#' Function to retrieve / get the default package parameters.
#'
#'
#' @param \dots Vector of character strings. Name of arguments for which default value is to be retrieved.
#' @param par.list Name of the list containing the parameters
#' @param bkp.par.list Name of the backuped list containing the default parameters
#' @param par.env name of the environment containing the parameter lists
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.get <- function(# Function to retrieve / get the default package parameters.
### Function to retrieve / get the default package parameters.

...,                            # List of parameters to change
par.list        = "TT.par",     # Name of the list containing the parameters
bkp.par.list    = "TT.par.bkp", # Name of the backuped list containing the default parameters
par.env         = TT.env        # name of the environment containing the parameter lists
){  #
argz <- list(...)
#
# Import the environment variables (function internal)
argz.list   <- get( x = par.list,  envir = par.env )
#
# Basic checkup:
if( length(argz) == 0 )
{   #
res <- argz.list
}else{
#
argz.nm <- names(argz)
#
if( any(!is.null(argz.nm)) )
{  stop("parameterS should be text names of variables: use TT.set() to set variables")  }
#
# Flattern argument list (to text vector)
argz <- unlist(argz)
#
# Basic check:
if(  any( !(argz %in% names(argz.list)) )  )
{   stop("At least one specified parameter doesn't exist!") }
#
# RETRIEVING the parameters value (in the order they were asked)
res <- lapply(X=argz,FUN=function(X,dat){dat[[X]]},dat=argz.list)
# res <- argz.list[ argz ]
if( length(res) == 1 )
{   res <- res[[1]] }
}   #
return( res )
}   #

#' Function to add a new default package parameters.
#'
#' Function to add a new default package parameters. Mostly used to add a new
#' texture triangle definition.
#'
#'
#' @param \dots parameters to be changed in format: "parameter_name1" = new_value1, "parameter_name2" = new_value2
#' @param par.list Name of the list containing the parameters
#' @param bkp.par.list Name of the backuped list containing the default parameters
#' @param par.env name of the environment containing the parameter lists
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
### Function to add a new default package parameters. Mostly used
### to add a new texture triangle definition.

...,                            # List of parameters to change
par.list        = "TT.par",     # Name of the list containing the parameters
bkp.par.list    = "TT.par.bkp", # Name of the backuped list containing the default parameters
par.env         = TT.env        # name of the environment containing the parameter lists
){  #
argz    <- list(...)
argz.nm <- names(argz)
#
# Import the environment variables (function internal)
argz.list       <- get( x = par.list,  envir = par.env )
argz.list.nm    <- names( argz.list )
#
# Basic checkup:
if( length(argz) == 0 )
{   #
stop(
"TT.add must have at least one '...' option specified (named list). Now zero length"
)   #
}   #
#
if( is.null( argz.nm ) | any( argz.nm == "" ) )
{   #
stop(
paste(
sep = "",
"TT.add ... option must be a named list (eventually length 1),\n",
"with _names_ different from ''.\n",
"Now names(...) = ", paste(argz.nm,collapse=" ")
)   #
)   #
}   #
#
if( any( duplicated( argz.nm ) ) )
{   #
stop(
paste(
sep = "",
"TT.add ... option must be a named list (eventually length 1),\n",
"with unique (non duplicated) names.\n",
"Now names(...) = ", paste(names(argz),collapse=" ")
)   #
)   #
}   #
#
if( any( argz.nm %in% argz.list.nm ) )
{   #
stop(
paste(
sep = "",
"TT.add ... option must be a named list (eventually length 1),\n",
"with names that are not already in the default argument list (TT.par).\n",
"Now names(...) = ", paste(names(argz),collapse=" "), "\n",
"If you want to replace/change an existing argument, use TT.set() instead"
)   #
)   #
}   #
#
argz.list   <- c(argz.list,argz)
sel.vec     <- (length(argz.list)-length(argz)+1):length(argz.list)
names( argz.list )[ sel.vec ]   <- argz.nm
#
assign(
envir   = par.env,
x       = par.list,
value   = argz.list
)   #
}   #

#' Stretch or reshape the range of value of some data set.
#'
#' Function to 'stretch' or reshape the range of value of some data set.
#' Usefull for cex parameter in plot.
#'
#'
#' @param x Vector of numeric values.
#' @param str.min Minimun value after stretching.
#' @param str.max Maximun value after stretching.
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.str <- function(# Stretch or reshape the range of value of some data set.
### Function to 'stretch' or reshape the range of value of some data set. Usefull for cex parameter in plot.
##keywords<< internal

x,
str.min = 0,
str.max = 1
){  #
aa <- (str.min - str.max)/( min(x) - max(x) )
bb <- str.min - aa*min(x)
aa*x + bb
}   #
#   TT.str(50:100,1,0)

# # TT.nightC <- function(# Internal. Inverse RGB values of a vector of colors.
# # ### Inverse RGB values of a vector of colors.

# #     cl,         # vector of colors, html stype "#808080"
# #     ic  = TRUE  # Really inverse colors ?
# # ){  #
# #     if( ic )
# #     {   #
# #         cl <- col2rgb(
# #             col     = cl,
# #             alpha   = FALSE
# #         )   #
# #         #
# #         cl <- apply(
# #             X       = cl,
# #             MARGIN  = 2,
# #             FUN     = function(X){
# #                 rep(255,3) - X
# #             }   #
# #         )   #
# #         #
# #         cl <- cl/255
# #         #
# #         rgb(
# #             red     = cl["red",],
# #             green   = cl["green",],
# #             blue    = cl["blue",],
# #         )   #
# #     }else{
# #         cl
# #     }   #
# # }   #

#' Internal. Retrieve and set default values from options.
#'
#' Retrieve and set default values from options (that do _not_ superseed
#' par()).
#'
#'
#' @param param
#' @param assign.op
#' @param p.env
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd

TT.gen.op.set  <- function(# Internal. Retrieve and set default values from options.
### Retrieve and set default values from options (that do _not_ superseed par()).
##keywords<< internal

param,
assign.op   = TRUE,
p.env       = parent.frame()
){  #
# Get the parameter values:
param.val   <- lapply(
X   = param,
FUN = function(X){
get(X,envir=p.env)
}   #
)   #
names(param.val)    <- param
#
# Find null parameters values:
null.param  <- unlist(  lapply(
X   = param.val,
FUN = function(X){
any( is.null( X ) )
}   #
)   )   #
#
if( any(null.param) )
{   #
# Get the default value in the options list:
param.val[ null.param ] <- lapply(
X   = param[ null.param ],
FUN = function(X){
TT.get(X)
}   #
)   #
#
# Assign the values in the higher level function
if( assign.op )
{   #
silent  <- lapply(
X   = 1:length(param[ null.param ]),
FUN = function(X){
assign(
x       = param[ null.param ][X],
value   = param.val[ null.param ][[X]],
envir   = p.env
)   #
}   #
)   #
}   #
}   #
return( invisible( param.val ) )
}   #

#   test.fun1   <- function(
#       cex         = NULL,
#       cex.lab     = 2,
#       col.axis    = "blue",
#       font.axis   = NULL
#   ){  #
#       invres <- TT.gen.op.set(c("cex","cex.lab","col.axis","font.axis"))
#       #
#       list("cex"=cex,"cex.lab"=cex.lab,"col.axis"=col.axis,"font.axis"=font.axis,invres)
#   }   #
#   test.fun1()

#' Internal. Retrieve and set default values from options with default in
#' "par()".
#'
#' Retrieve and set default values from options with default in "par()"
#'
#'
#' @param param
#' @param assign.op
#' @param p.env
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom graphics par
TT.par.op.set  <- function(# Internal. Retrieve and set default values from options with default in "par()".
### Retrieve and set default values from options with default in "par()"
##keywords<< internal

param,
assign.op   = TRUE,
p.env       = parent.frame()
){  #
param.val   <- TT.gen.op.set(
param       = param,
assign.op   = assign.op,
p.env       = p.env
)   #
#
# Find null parameters values:
null.param  <- unlist(  lapply(
X   = param.val,
FUN = function(X){
any( is.null( X ) )
}   #
)   )   #
#
if( any(null.param) )
{   #
# Get the default value in par()
param[ param == "family.op" ]       <- "family" # for compatibility with family()
param.val[ null.param ]             <- graphics::par(param[ null.param ])
param[ param == "family" ]          <- "family.op"
#
# Assign the values in the higher level function
if( assign.op )
{   #
silent  <- lapply(
X   = 1:length(param[ null.param ]),
FUN = function(X){
assign(
x       = param[ null.param ][X],
value   = param.val[ null.param ][[X]],
envir   = p.env
)   #
}   #
)   #
}   #
}   #
return( invisible( param.val ) )
}   #

#   test.fun    <- function(
#       cex         = NULL,
#       cex.lab     = 2,
#       col.axis    = "blue",
#       font.axis   = NULL,
#       family.op   = NULL
#   ){  #
#       invres <- TT.par.op.set(c("cex","cex.lab","col.axis","font.axis","family.op"))
#       #
#       list("cex"=cex,"cex.lab"=cex.lab,"col.axis"=col.axis,"font.axis"=font.axis,"family.op"=family.op,invres)
#   }   #
#   test.fun()

#' Internal. Retrieve and set default values for parameters (par() or not),
#' when NULL.
#'
#' Retrieve and set default values for parameters (par() or not), when NULL.
#'
#'
#' @param fun
#' @param assign.op
#' @param p.env
#' @param set.par If TRUE parameters are set automatically to their defualt value
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom graphics par
TT.auto.set    <- function(# Internal. Retrieve and set default values for parameters (par() or not), when NULL.
### Retrieve and set default values for parameters (par() or not), when NULL.
##keywords<< internal

fun         = sys.function(which=-1),
assign.op   = TRUE,
p.env       = parent.frame(),
set.par     = TRUE
){  #
param   <- names( formals(fun) )
#
if( set.par )
{   #
sel.par <- (param %in% names(graphics::par()))
#
l1  <- TT.par.op.set(
param       = param[ sel.par ],
assign.op   = assign.op,
p.env       = p.env
)   #
}else{
sel.par <- rep(FALSE,length(param))
#
l1  <- vector()
}   #
#
sel.TT  <- ((param %in% names(TT.get())) & !sel.par)
#
l2  <- TT.gen.op.set(
param       = param[ sel.TT ],
assign.op   = assign.op,
p.env       = p.env
)   #
#
return( invisible( c(l1,l2) ) )
}   #

#   test.fun    <- function(
#       cex         = NULL,
#       cex.lab     = 2,
#       col.axis    = "blue",
#       font.axis   = NULL,
#       blr.clock   = NULL,
#       tlr.an      = c(50,60,70)
#   ){  #
#       invres <- TT.auto.set(set.par=TRUE)
#       #
#       list(
#           invres,
#           lapply(
#               X   = names(formals(test.fun)),
#               FUN = function(X){
#                   get(X)
#               }   #
#           )   #
#       )   #
#   }   #
#   test.fun()

# # TT.inv.par <- function(# Internal. Same as the par() function, but reverse colors.
# # ### Same as the par() function, but reverse colors.

# #     ic      = TRUE, # Really inverse colors ? To be used for autonated shift
# #     par.opt = c("bg","col","col.axis","col.lab","col.main","col.sub","fg"),
# #     ...
# # ){  #
# #     #
# #     dots    <- list(...)
# #     #
# #     par.opt <- par.opt[ !(par.opt %in% names(dots)) ]
# #     #
# #     if( ic )
# #     {   #
# #         cl          <- TT.nightC( cl = old.par[ par.opt ], ic = ic )
# #         cl          <- as.list( cl )
# #         names( cl ) <- par.opt
# #         cl          <- c(dots,cl)
# #     }else{ cl <- dots }
# #     #
# #     do.call( what = "par", args = cl )
# #     #
# #     return( invisible( old.par ) )
# # }   #

#' Internal. A function to obtaine a weight average 'mix' of different colors!
#'
#' A function to obtaine a weight average 'mix' of different colors!
#'
#'
#' @param cl
#' @param w
#' @param gray.l
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom grDevices col2rgb
#' @importFrom grDevices rgb
#' @importFrom stats weighted.mean
TT.DJ.col <- function(# Internal. A function to obtaine a weight average 'mix' of different colors!
### A function to obtaine a weight average 'mix' of different colors!
##keywords<< internal

cl,             # vector of colors, html stype "#808080"
w,              # vector of weight corresponding to the colors
gray.l  = FALSE # if TRUE Produce a gray level color, instead of a 'colored' color
){  #
cl  <- grDevices::col2rgb( cl, alpha = FALSE )
#
m.cl    <- apply(
X       = cl,
MARGIN  = 1,
FUN     = function(X){
stats::weighted.mean(x=X,w=w)
}   #
)   #
#
if( gray.l ){ m.cl[] <- rep(mean(m.cl),3) }     # 1:3 stands here in case of alpha value...
#
grDevices::rgb(
red           = m.cl["red"],
green         = m.cl["green"],
blue          = m.cl["blue"],
maxColorValue = 255
)   #
}   #

#' Internal. Convert any colors to hsv.
#'
#' Convert any colors to hsv. Wrapper around rgb2hsv() and col2rgb().
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom grDevices rgb2hsv
#' @importFrom grDevices col2rgb
TT.col2hsv  <- function(# Internal. Convert any colors to hsv.
### Convert any colors to hsv. Wrapper around rgb2hsv() and col2rgb().
##keywords<< internal

col
){  #
t(  #
grDevices::rgb2hsv(
grDevices::col2rgb(
col     = col,
alpha   = FALSE
),  #
#gamma          = 1,
maxColorValue   = 255
)   #
)   #
}   #

#' Internal. Check the consistency between blr.tx and css.names.
#'
#' Check the consistency between blr.tx and css.names. All values in blr.tx
#' should be found in css.names and vice-versa.
#'
#'
#' @param css.names
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.blr.tx.check <- function(# Internal. Check the consistency between blr.tx and css.names.
### Check the consistency between blr.tx and css.names. All values
### in blr.tx should be found in css.names and vice-versa.
##keywords<< internal

blr.tx,
css.names
){  #
css <- TT.get("css.names")
#
names(css.names)    <- css
#
if( !all( blr.tx %in% css ) | !all( css %in% blr.tx ) )
{   #
stop(
paste(
sep = "",
"Every blr.tx (", paste(blr.tx,collapse=", "), ")\n",
"\t should be one of ", paste(css,collapse=", "), "\n",
"\t and vice-versa."
)   #
)   #
}   #
#
blr.tx.nm       <- blr.tx
blr.tx          <- css.names[ blr.tx ]
names(blr.tx)   <- blr.tx.nm
#
return( blr.tx )
}   #

#     TT.blr.tx.check(c("SAND","CLAY","SILT"),c("ARGILE","LIMON","SABLE"))
#     TT.blr.tx.check(c("SAND","CLAY","SILT"),c("CLAY","SILT","SAND"))

#' Internal. Create a tabular version of clay silt sand particle size limits.
#'
#' Create a tabular version of clay silt sand particle size limits.
#'
#'
#' @param css.ps.lim
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.blr.ps.lim <- function(# Internal. Create a tabular version of clay silt sand particle size limits.
### Create a tabular version of clay silt sand particle size limits.
##keywords<< internal

blr.tx,
css.ps.lim
){  #
css.ps.lim  <- do.call(
what    = "cbind",
args    = lapply(
X   = 1:3,
FUN = function(X){
c(css.ps.lim[X],css.ps.lim[X+1])
}   #
)   #
)   #
#
colnames(css.ps.lim)    <- TT.get("css.names")
rownames(css.ps.lim)    <- c("ps.min","ps.max")
#
css.ps.lim              <- css.ps.lim[, blr.tx ]
#
colnames(css.ps.lim)    <- c("B","L","R")
#
return( css.ps.lim )
}   #

#     TT.blr.ps.lim( blr.tx = c("CLAY","SILT","SAND"), css.ps.lim = c(0,2,50,2000) )
#     TT.blr.ps.lim( blr.tx = c("SAND","CLAY","SILT"), css.ps.lim = c(0,2,50,2000) )

#' Internal. Takes "geo" values and assign them individually in the parent
#' function.
#'
#' Takes "geo" values and assign them individually in the parent function.
#'
#'
#' @param p.env
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.geo.set  <- function(# Internal. Takes "geo" values and assign them individually in the parent function.
### Takes "geo" values and assign them individually in the parent function.
##keywords<< internal

geo,
p.env   = parent.frame()
){  #
silent  <- lapply(
X   = names(geo),
FUN = function(X){
assign(
x       = X,
value   = geo[[X]],
envir   = p.env
)   #
}   #
)   #
}   #

#   rm("blr.clock","tlr.an","blr.tx","text.sum","blr.psize.lim")
#   test.fun    <- function(
#       geo = list(
#           "blr.clock"     = rep(T,3),
#           "tlr.an"        = rep(60,3),
#           "blr.tx"        = c("CLAY","SILT","SAND"),
#           "text.sum"      = 100,
#           "blr.psize.lim" = 50
#       )   #
#   ){  #
#       TT.geo.set(
#           geo     = geo
#           #p.env  = parent.frame()
#       )   #
#       #
#       return( list(
#           "blr.clock"     = blr.clock,
#           "tlr.an"        = tlr.an,
#           "blr.tx"        = blr.tx,
#           "text.sum"      = text.sum,
#           "blr.psize.lim" = blr.psize.lim
#       )   )   #
#   }   #
#   test.fun() ; blr.clock

#   rm("blr.clock","tlr.an","blr.tx","text.sum","blr.psize.lim")
#   test.fun    <- function(
#       geo = list(
#           "blr.clock"     = rep(T,3),
#           "tlr.an"        = rep(60,3),
#           "blr.tx"        = c("CLAY","SILT","SAND"),
#           "text.sum"      = 100,
#           "blr.psize.lim" = 50
#       )   #
#   ){  #
#       TT.geo.set(
#           geo     = geo
#           #p.env  = environment()
#       )   #
#       #
#       return( list(
#           "blr.clock"     = blr.clock,
#           "tlr.an"        = tlr.an,
#           "blr.tx"        = blr.tx,
#           "text.sum"      = text.sum,
#           "blr.psize.lim" = blr.psize.lim
#       )   )   #
#   }   #
#   test.fun() ; blr.clock

#   rm("blr.clock","tlr.an","blr.tx","text.sum","blr.psize.lim")
#   test.fun    <- function(
#       geo = list(
#           "blr.clock"     = rep(T,3),
#           "tlr.an"        = rep(60,3),
#           "blr.tx"        = c("CLAY","SILT","SAND"),
#           "text.sum"      = 100,
#           "blr.psize.lim" = 50
#       )   #
#   ){  #
#       TT.geo.set(
#           geo     = geo
#       )   #
#       #
#       return( list(
#           "blr.clock"     = blr.clock,
#           "tlr.an"        = tlr.an,
#           "blr.tx"        = blr.tx,
#           "text.sum"      = text.sum,
#           "blr.psize.lim" = blr.psize.lim
#       )   )   #
#   }   #
#   test.fun() ; blr.clock

#   test.fun    <- function( p.env = environment() ){ p.env }
#   test.fun2   <- function(){ test.fun() }
#   test.fun2()

#' Retrieve and return the geometrical parameters from a list of
#' parameter values (NULL or not).
#'
#' Retrieve and return the geometrical parameters from a list of parameter
#' values (NULL or not).
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.geo.get  <- function(# Internal. Retrieve and return the geometrical parameters from a list of parameter values (NULL or not).
### Retrieve and return the geometrical parameters from a list of parameter values (NULL or not).
##keywords<< internal

class.sys       = NULL,
blr.clock       = NULL,
tlr.an          = NULL,
blr.tx          = NULL,
text.sum        = NULL,
base.css.ps.lim = NULL
){  #
if( is.null(class.sys) ){ class.sys <- TT.get("class.sys") }

if( class.sys == "FAO50.TT" ){
warning( "class.sys = 'FAO50.TT' must be replaced by class.sys = 'HYPRES.TT'. See the package vignette." )
}

geo.par         <- c("blr.clock","tlr.an","blr.tx","text.sum","base.css.ps.lim")
#
p.env           <- environment()
#
null.geo.par    <- unlist(  lapply(
X   = geo.par,
FUN = function(X){
is.null( get(x=X,envir=p.env) )
}   #
)   )   #

# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Attributes either classes-system or default values
# to triangle geometry parameters (and others)

if( any( null.geo.par ) )
{   #
geo.par <- geo.par[ null.geo.par ]
#
if( class.sys != "none" )
{   #
# Retrieve classes-system (texture triangle) parameters:
TT.data <- TT.get(class.sys)
#
silent  <- lapply(
X   = geo.par,
FUN = function(X){
assign(x=X,value=TT.data[[X]],envir=p.env)
}   #
)   #
}else{
silent  <- lapply(
X   = geo.par,
FUN = function(X){
assign(x=X,value=TT.get(X),envir=p.env)
}   #
)   #
}   #
}   #
#
return( list(
"blr.clock"         = blr.clock,
"tlr.an"            = tlr.an,
"blr.tx"            = blr.tx,
"text.sum"          = text.sum,
"base.css.ps.lim"   = base.css.ps.lim
#"blr.psize.lim"    = blr.psize.lim
)   )   #
}   #

#' Test the validity of some soil texture data table (3 particle size classes).
#'
#' Test the validity of some soil texture data table. (1) Test that it is a
#' data.frame or matrix, (2) Test that column names contains 'css.names', (3)
#' Test that there are no missing values, (4) that all values are >= 0, (5)
#' That the sum of the 3 particle size classes is >= 'text.sum'*(1-'text.tol')
#' or <= 'text.sum'*(1+'text.tol').  'tri.data' may contain other variables
#' than the 3 textuer classes (ignored).
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.data.test <- function(# Test the validity of some soil texture data table (3 particle size classes).
### Test the validity of some soil texture data table. (1) Test that
### it is a data.frame or matrix, (2) Test that column names contains
### 'css.names', (3) Test that there are no missing values, (4) that
### all values are >= 0, (5) That the sum of the 3 particle size classes
### is >= 'text.sum'*(1-'text.tol') or <= 'text.sum'*(1+'text.tol').
### 'tri.data' may contain other variables than the 3 textuer classes
### (ignored).

tri.data,
css.names   = NULL,
text.sum    = NULL,
text.tol    = NULL,
#
tri.sum.tst = NULL,
tri.pos.tst = NULL
){  #
# Set rest of variables:
TT.auto.set(set.par=FALSE)
#
# 1. Check if tri.data is a matrix or a data.frame:
if( !is.data.frame(tri.data) & !is.matrix(tri.data) )
{   #
stop("tri.data MUST be a data.frame, a matrix, or NULL")
}   #
#
# 2. Check if columns names correspond to the list provided by css.names
if( !all( css.names %in% colnames(tri.data) ) )
{   #
stop(   paste(
sep = "",
"tri.data column names (",
paste(colnames(tri.data),collapse=", "),
") don't correspond to ",
paste(css.names,collapse=", ")
)   )   #
}   #
#
# 3. Sub-select only the interest variables
tri.data <- tri.data[,css.names]
#
# 3b. Test the presence of missing values (error)
if( tri.pos.tst )
{   #
row.na <- apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X){ any( is.na( X ) ) }
)   #
#
if(  any( row.na )  )
{   #
print( tri.data[row.na,] )
cat("\n")
stop( "No missing values are allowed in tri.data: check the data" )
}   #
}   #
#
# 4. Test the presence of negative values (error)
if( tri.pos.tst )
{   #
row.neg <- apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X){ any(X < 0) }
)   #
#
if(  any( row.neg )  )
{   #
print( tri.data[row.neg,] )
cat("\n")
stop( "Each of the 3 plotted variables should be >= 0: check the data" )
}   #
}   #
#
if( tri.sum.tst )
{   #
# 5. Check if all row sum of variable triplets correspond to total value provided by text.sum
# -  Compute the sum
row.sums <- apply(
X       = tri.data,
MARGIN  = 1,
FUN     = sum
)   #
# -  Check if sum results are ok (+/- tolerance)
sums.bad <- (row.sums < text.sum*(1-text.tol)) | (row.sums > text.sum*(1+text.tol))
#
{   #
cat("\n")
stop(
paste(
sep="",
"The sum of the 3 plotted variables should be around ",
text.sum,
": check the data, or change 'text.tol' parameter."
)   #
)   #
}   #
}   #
}   #

#' Test the validity of some soil texture data table (X particle size classes).
#'
#' Test the validity of some soil texture data table. (1) Test that it is a
#' data.frame or matrix, (3) Test that there are no missing values, (4) that
#' all values are >= 0, (5) That the sum of the X particle size class is >=
#' 'text.sum'*(1-'text.tol') or <= 'text.sum'*(1+'text.tol'). Contrary to
#' TT.data.test() no test are performed for the particle size classes and
#' columns names, so 'tri.data' should only contains texture data, and nothing
#' else.
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.data.test.X <- function(# Test the validity of some soil texture data table (X particle size classes).
### Test the validity of some soil texture data table. (1) Test that
### it is a data.frame or matrix, (3) Test that there are no missing
### values, (4) that all values are >= 0, (5) That the sum of the
### X particle size class is >= 'text.sum'*(1-'text.tol') or <=
### 'text.sum'*(1+'text.tol'). Contrary to TT.data.test() no test
### are performed for the particle size classes and columns names, so
### 'tri.data' should only contains texture data, and nothing else.

tri.data,   # Only texture data here. No additionnal variables
text.sum    = NULL,
text.tol    = NULL,
#
tri.sum.tst = NULL,
tri.pos.tst = NULL
){  #
# Set rest of variables:
TT.auto.set( set.par = FALSE )
#
# 1. Check if tri.data is a matrix or a data.frame:
if( !is.data.frame(tri.data) & !is.matrix(tri.data) )
{   #
stop("tri.data MUST be a data.frame, a matrix, or NULL")
}   #
#
# 2. Test the presence of negative values (error)
if( tri.pos.tst )
{   #
row.neg <- apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X){ any(X < 0) }
)   #
#
if(  any( row.neg )  )
{   #
print( tri.data[row.neg,] )
cat("\n")
stop( "Each of the n particle size classes must be >= 0: check the data" )
}   #
}   #
#
if( tri.sum.tst )
{   #
# 3. Check if all row sum of variable triplets correspond to total value provided by text.sum
# -  Compute the sum
row.sums <- apply(
X       = tri.data,
MARGIN  = 1,
FUN     = sum
)   #
# -  Check if sum results are ok (+/- tolerance)
sums.bad <- (row.sums < text.sum*(1-text.tol)) | (row.sums > text.sum*(1+text.tol))
#
{   #
cat("\n")
stop(
paste(
sep="",
"The sum of the n particle size classes should be around ",
text.sum,
": check the data, or change 'text.tol' parameter."
)   #
)   #
}   #
}   #
}   #

#' Convert a soil particle diameter dia [micro-meters] into phi =
#' -log2(dia/1000)
#'
#' Convert a soil particle diameter dia [micro-meters] into phi = -log2(dia).
#'
#'
#' @param dia Particle size diameter in micro-meters (will be converted in
#' milli-meters)
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @export
TT.dia2phi <- function(# Internal. Convert a soil particle diameter dia [micro-meters] into phi = -log2(dia/1000)
### Convert a soil particle diameter dia [micro-meters] into
##keywords<< internal

dia
### Particle size diameter in micro-meters (will be converted in milli-meters)

){  #
return( -logb(dia/1000,base=2) )
}   #

#' Internal. Convert a soil particle phi value into diameter dia
#' [micro-meters].
#'
#' Convert a soil particle phi value into diameter dia [micro-meters].  See
#' also TT.dia2phi(). dia = (2^-phi)*1000. Not used by the package.
#'
#'
#' @param phi
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.phi2dia <- function(# Internal. Convert a soil particle phi value into diameter dia [micro-meters].
### Convert a soil particle phi value into diameter dia [micro-meters].
### See also TT.dia2phi(). dia = (2^-phi)*1000. Not used by the package.
##keywords<< internal

phi

){  #
return( (2^-phi)*1000 )
}   #

#' Internal. Check the consistency between 'base.ps.lim' and 'dat.ps.lim'.
#'
#' Check the consistency between 'base.ps.lim' and 'dat.ps.lim'.  5 tests
#' performed.
#'
#'
#' @param base.ps.lim
#' @param dat.ps.lim
#' @param ps.lim.length vector of 2 integers. Number of particle size classes +
#' 1. c(base,dat)
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.check.ps.lim <- function(# Internal. Check the consistency between 'base.ps.lim' and 'dat.ps.lim'.
### Check the consistency between 'base.ps.lim' and 'dat.ps.lim'.
### 5 tests performed.
##keywords<< internal

base.ps.lim,
dat.ps.lim,
ps.lim.length=c(4,4)
### vector of 2 integers. Number of particle size classes + 1. c(base,dat)

){  #
# if( length( base.ps.lim ) != length( dat.ps.lim ) )
# {   #
#     stop( paste(
#         sep="",
#         "The length of the 'base' particle size classes limits must be equal to\n",
#         "the length of the 'dat' particle size classes limits.\n",
#         "Either check the 'base' particle size classes limits vector,\n",
#         "or check number of column in tri.data.\n"
#     ) )   #
# }   #
#
if( length( base.ps.lim ) != ps.lim.length[1] )
{   #
stop( paste(
sep="",
"The length of the 'base' particle size classes limits must be equal to\n",
ps.lim.length[1], " (number of particle size classes+1; from ps min to ps.max)\n",
"Actual value: ", length( base.ps.lim ), ".\n",
"Either check the 'base' particle size classes limits,\n",
"or check number of column in tri.data.\n"
) )   #
}   #
#
if( length( dat.ps.lim ) != ps.lim.length[2] )
{   #
stop( paste(
sep="",
"The length of the 'dat' particle size classes limits must be equal to\n",
ps.lim.length[2], " (number of particle size classes +1; from ps min to ps.max)\n",
"Actual value: ", length( dat.ps.lim ), ".\n",
"Either check the 'dat' particle size classes limits,\n",
"or check number of column in tri.data.\n"
) )   #
}   #
#
if( base.ps.lim[1] != dat.ps.lim[1] )
{   #
stop( paste(
sep="",
"The first value of the 'dat' particle size classes limits must be equal to\n",
"the first value of the 'base' particle size classes limits.\n",
"Actual value, base: ", base.ps.lim[1], ", dat: ", dat.ps.lim[1]
) )   #
}   #
#
if( base.ps.lim[ps.lim.length[1]] != dat.ps.lim[ps.lim.length[2]] )
{   #
stop( paste(
sep="",
"The last value of the 'dat' particle size classes limits must be equal to\n",
"the last value of the 'base' particle size classes limits.\n",
"Actual value, base: ", base.ps.lim[ps.lim.length[1]], ", dat: ", dat.ps.lim[ps.lim.length[2]]
) )   #
}   #
#
if( base.ps.lim[1] == 0 )
{   #
if( base.ps.lim[2] < dat.ps.lim[2] )
stop( paste(
sep="",
"When the 1st value of 'dat' and 'base' particle size classes limits is 0\n",
"The 2nd value of the 'base' particle size classes limits must higher or equal to\n",
"the 2nd value of the 'dat' particle size classes limits.\n"
) )   #
}   #
}   #

#' Log-linear transformation of a soil texture data table between 2 particle
#' size systems (3 classes).
#'
#' Log-linear transformation of a soil texture data table ('tri.data') from one
#' particle size system ('dat.css.ps.lim') into another ('base.css.ps.lim').
#' Only 3 particle size classes allowed. See TT.text.transf.X for
#' transformation involving more than 3 particle classes. 'tri.data' may
#' contain other variables (not in 'css.names'). They are returned unchanged
#' with the transformed texture data.
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @importFrom stats approx
#' @export
TT.text.transf <- function(# Log-linear transformation of a soil texture data table between 2 particle size systems (3 classes).
### Log-linear transformation of a soil texture data table
### ('tri.data') from one
### particle size system ('dat.css.ps.lim') into another
### ('base.css.ps.lim'). Only 3 particle size classes allowed. See
### TT.text.transf.X for transformation involving more than 3
### particle classes. 'tri.data' may contain other variables
### (not in 'css.names'). They are returned unchanged with the
### transformed texture data.

tri.data,
base.css.ps.lim,
dat.css.ps.lim,
css.names       = NULL,
blr.tx          = NULL,
text.sum        = NULL,
text.tol        = NULL,
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
trsf.add.opt1   = NULL,   # unused here (but required)
trsf.add.opt2   = NULL    # unused here (but required)
){  #
#
TT.auto.set( set.par = FALSE )
#
TT.data.test(
tri.data    = tri.data,
css.names   = css.names,
text.sum    = text.sum,
text.tol    = text.tol,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst
)   #
#
blr.tx <- TT.blr.tx.check(
blr.tx      = blr.tx,
css.names   = css.names
)   #
#
# Saving the other columns of the data.frame:
old.col.nm  <- colnames(tri.data)
other.data  <- as.data.frame(
tri.data[,!(old.col.nm %in% css.names)]
)   #
colnames(other.data)    <- old.col.nm[!(old.col.nm %in% css.names)]
#
# Taking only texture data:
colnames(tri.data[,blr.tx]) <- names(blr.tx)
#
# Giving them international names:
tri.data <- tri.data[,css.names]
#
tri.data <- t(  apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X){
cumsum(X)
}   #
)   )   #
#
TT.check.ps.lim(
base.ps.lim     = base.css.ps.lim,
dat.ps.lim      = dat.css.ps.lim,
ps.lim.length   = c(4,4)
)   #
#
if( base.css.ps.lim[1] != 0 )
{   #
tri.data <- cbind(
"ZERO" = rep(0,dim(tri.data)[1]),
tri.data
)   #
#
ps.start <- 1
}else{
ps.start <- 2
}   #
#
base.css.ps.lim2 <- TT.dia2phi(base.css.ps.lim)
dat.css.ps.lim2  <- TT.dia2phi(dat.css.ps.lim)
#
tri.data <- t(  apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X,base.css.ps.lim2,dat.css.ps.lim2){
c( X[1], diff( stats::approx(
x       = dat.css.ps.lim2[ ps.start:4 ],
y       = X,
xout    = base.css.ps.lim2[ ps.start:4 ],
method  = "linear",
rule    = 1,
ties    = function(...){
stop("error in TT.text.transf: Unexpected ties in text.cum = f(phi)")
}   #
)\$"y"   )   )   #
},  #
base.css.ps.lim2,
dat.css.ps.lim2
)   )   #
#
if( base.css.ps.lim[1] != 0 )
{   #
tri.data <- tri.data[,-1]
}   #
#
tri.data            <- as.data.frame(tri.data)
colnames(tri.data)  <- c("CLAY","SILT","SAND")
tri.data            <- tri.data[,names(blr.tx)]
colnames(tri.data)  <- blr.tx
tri.data            <- cbind(
tri.data,
other.data
)   #
tri.data            <- tri.data[,old.col.nm]
#
return( tri.data )
}   #

#     my.text <- data.frame(
#         "CLAY"  = c(05,60,15,05,25,05,25,45,65,75,13,47),
#         "SILT"  = c(05,08,15,25,55,85,65,45,15,15,17,43),
#         "SAND"  = c(90,32,70,70,20,10,10,10,20,10,70,10),
#         "OC"    = c(20,14,15,05,12,15,07,21,25,30,05,28)
#     )   #
#     my.text
#     TT.text.transf(
#       tri.data        = my.text,
#       base.css.ps.lim = c(0,2,50,2000),
#       dat.css.ps.lim  = c(0,2,50,2000)
#     )   #
#     TT.text.transf(
#       tri.data        = my.text,
#       base.css.ps.lim = c(0,2,50,2000),
#       dat.css.ps.lim  = c(0,2,60,2000)
#     )   #
#     tmp <- TT.text.transf(
#       tri.data        = my.text,
#       base.css.ps.lim = c(1,2,50,2000),
#       dat.css.ps.lim  = c(1,1.5,60,2000)
#     )   #
#     tmp ; all( rowSums(tmp[,1:3]) == 100 )

#     my.text2 <- my.text

#     my.text2 <- do.call(
#         what    = "rbind",
#         args    = lapply(
#             X   = 1:8500,
#             FUN = function(X){
#                 my.text
#             }   #
#         )   #
#     )   #

#     dim(my.text2)

#     system.time(
#         TT.text.transf(
#             tri.data        = my.text2,
#             base.css.ps.lim = c(0,2,50,2000),
#             dat.css.ps.lim  = c(0,2,60,2000)
#         )   #
#     )   #
#     # 4450 texture transformed per second

#' Log-linear transformation of a soil texture data table between 2 particle
#' size systems (X classes).
#'
#' Log-linear transformation of a soil texture data table ('tri.data') from one
#' particle size system ('dat.css.ps.lim') into another ('base.css.ps.lim'). No
#' limit in the number of partile size classes in the inputed and outputed
#' texture tables. See TT.text.transf for transformation involving only 3
#' particle classes. 'tri.data' can only contain texture data.
#'
#'
#' @param base.ps.lim Vector of numeric value. Particle size limits of the system tri.data should be converted into.
#' @param dat.ps.lim Vector of numeric value. Particle size limits of tri.data.
#' @param text.tol See See \code{\link[soiltexture]{TT.plot}}
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @importFrom stats approx
#' @export
TT.text.transf.X <- function(# Log-linear transformation of a soil texture data table between 2 particle size systems (X classes).
### Log-linear transformation of a soil texture data table
### ('tri.data') from one
### particle size system ('dat.css.ps.lim') into another
### ('base.css.ps.lim'). No limit in the number of partile size classes
### in the inputed and outputed texture tables. See TT.text.transf
### for transformation involving only 3 particle classes. 'tri.data'
### can only contain texture data.

tri.data,
base.ps.lim,
dat.ps.lim,
text.sum        = NULL,
text.tol        = NULL,
tri.sum.tst     = NULL,
tri.pos.tst     = NULL
){  #
TT.auto.set( set.par = FALSE )
#
TT.data.test.X(
tri.data    = tri.data,
text.sum    = text.sum,
text.tol    = text.tol,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst
)   #
#
tri.data <- t(  apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X){
cumsum(X)
}   #
)   )   #
#
ps.end   <- dim( tri.data )[2] + 1
#
TT.check.ps.lim(
base.ps.lim     = base.ps.lim,
dat.ps.lim      = dat.ps.lim,
ps.lim.length   = c(length(base.ps.lim),ps.end)
)   #
#
if( base.ps.lim[1] != 0 )
{   #
tri.data <- cbind(
"ZERO" = rep(0,dim(tri.data)[1]),
tri.data
)   #
#
ps.start    <- 1
}else{
ps.start    <- 2
}   #
#
base.ps.lim2 <- TT.dia2phi(base.ps.lim)
dat.ps.lim2  <- TT.dia2phi(dat.ps.lim)
#
old.col.nm   <- colnames( tri.data )
#
tri.data <- t(  apply(
X       = tri.data,
MARGIN  = 1,
FUN     = function(X,base.ps.lim2,dat.ps.lim2){
c( X[1], diff( stats::approx(
x       = dat.ps.lim2[ ps.start:ps.end ],
y       = X,
xout    = base.ps.lim2[ ps.start:length(base.ps.lim) ],
method  = "linear",
rule    = 1,
ties    = function(...){
stop("error in TT.text.transf: Unexpected ties in text.cum = f(phi)")
}   #
)\$"y"   )   )   #
},  #
base.ps.lim2,
dat.ps.lim2
)   )   #
#
if( base.ps.lim[1] != 0 )
{   #
tri.data <- tri.data[,-1]
}   #
#
tri.data            <- as.data.frame(tri.data)
colnames(tri.data)  <- paste(sep="","C",1:dim(tri.data)[2])
#
return( tri.data )
}   #

#     my.text4 <- data.frame(
#         "CLAY"  = c(05,60,15,05,25,05,25,45,65,75,13,47),
#         "FSILT" = c(02,04,10,15,25,40,35,20,10,05,10,20),
#         "CSILT" = c(03,04,05,10,30,45,30,25,05,10,07,23),
#         "SAND"  = c(90,32,70,70,20,10,10,10,20,10,70,10)
#     )   #
#     my.text4
#     TT.text.transf.X(
#       tri.data    = my.text4,
#       base.ps.lim = c(0,2,20,50,2000),
#       dat.ps.lim  = c(0,2,20,50,2000)
#     )   #
#     TT.text.transf.X(
#       tri.data    = my.text4,
#       base.ps.lim = c(0,2,20,50,2000),
#       dat.ps.lim  = c(0,2,30,60,2000)
#     )   #
#     tmp <- TT.text.transf.X(
#       tri.data    = my.text4,
#       base.ps.lim = c(0,2,50,2000),
#       dat.ps.lim  = c(0,2,30,60,2000)
#     )   #
#     tmp ; all( rowSums( tmp ) == 100 )

#' Internal. Function to convert angle in degree to angle in radian.
#'
#' Function to convert angle in degree to angle in radian.
#'
#'
#' @param A Angle in Degrees
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.deg2rad <- function(# Internal. Function to convert angle in degree to angle in radian.
### Function to convert angle in degree to angle in radian.
##keywords<< internal

A
### Angle in Degrees

){  #
(pi/180)*A
}   #

#' Internal. Flexible version of ifelse.
#'
#' Flexible version of ifelse.
#'
#'
#' @param test
#' @param yes
#' @param no
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.ifelse <- function(# Internal. Flexible version of ifelse.
### Flexible version of ifelse.
##keywords<< internal

test,
yes,
no

){  #
if(test){ res <- yes }else{ res <- no }
return(res)
}   #

#' Internal. Used in the plot axis drawings.
#'
#' Used in the plot axis drawings.
#'
#'
#' @param c1
#' @param c2
#' @param c3
#' @param c4
#' @param blr.order
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.switch <- function(# Internal. Used in the plot axis drawings.
### Used in the plot axis drawings.
##keywords<< internal

blr.clock   = TT.get("blr.clock"),
c1          = NA,
c2          = NA,
c3          = NA,
c4          = NA,
blr.order   = c(1,3,2)
){  #
TT.ifelse(
"test"  = blr.clock[ blr.order[1] ],
"yes"   = TT.ifelse(
"test"  = blr.clock[ blr.order[2] ],
"yes"   = c1,   # Side 1 == clock and Side 2 == clock
"no"    = c2    # Side 1 == clock and Side 2 == Aclock
),  #
"no"    = TT.ifelse(
"test"  = blr.clock[ blr.order[3] ],
"yes"   = c3,   # Side 1 == Aclock and Side 3 == clock
"no"    = c4    # Side 1 == Aclock and Side 3 == Aclock
)   #
)   #
}   #

#' Internal. Converts texture data (3 classes) into x-y coordinates.
#'
#' Converts texture data (3 classes) into x-y coordinates. This function is the
#' 'heart' of most soiltexture plot functions.
#'
#'
#' @param set.par If TRUE parameters are set automatically to their defualt value
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.css2xy <- function(# Internal. Converts texture data (3 classes) into x-y coordinates.
### Converts texture data (3 classes) into x-y coordinates. This
### function is the 'heart' of most soiltexture plot functions.
##keywords<< internal

tri.data,
geo,
css.names       = NULL,
#
text.tol        = NULL,
#
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
set.par         = FALSE,
text.sum        = NULL,
blr.clock       = NULL
){  #
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
# Set rest of variables:
TT.auto.set(set.par=set.par)
#
blr.tx <- TT.blr.tx.check(
blr.tx      = blr.tx,
css.names   = css.names
)   #
#
# Check for tlr.an: data type
if( any( is.null(tlr.an) | is.na(tlr.an) ) | !is.numeric(tlr.an) | (length(tlr.an) != 3) )
{   #
stop( paste(
sep = "",
"tlr.an (=",
paste(tlr.an,collapse=";"),
") must be a numeric, non-null, non-na vector of length 3"
)   )
}   #
#
# Check for tlr.an: angle sum must be 180 degrees
if( sum(tlr.an) != 180 )
{   #
stop( paste(
sep = "",
"sum(tlr.an) (=",
paste(tlr.an,collapse=";"),
") must be 180 (degrees)"
)   )
}   #
#
# Test the data provided:
TT.data.test(
tri.data    = tri.data,
css.names   = css.names,
text.sum    = text.sum,
text.tol    = text.tol,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst
#set.par     = set.par
)   #
#
# Test (anti)clock settings
ok.clock <- list(
#       #    Bottom Left    Right
"TTT"   = c( TRUE,  TRUE,   TRUE    ),
"TXF"   = c( TRUE,  NA,     FALSE   ),
"FTX"   = c( FALSE, TRUE,   NA      ),
"FFF"   = c( FALSE, FALSE,  FALSE   )
)   #
#
ok.clock <- unlist( lapply(
X           = ok.clock,
FUN         = function(X,blr.clock){
identical(blr.clock,X)
},  #
blr.clock   = blr.clock
)   )   #
#
if( !any(ok.clock) )
{   #
stop( paste(
sep = "",
"blr.clock (=",
paste(as.character(blr.clock),collapse=";"),
") MUST be one of: ",
paste(names(ok.clock),collapse=";"),
"; [with X == NA]. consider revising"
)   )   #
}   #
#
# Angle transformation: degree to radian
#
# # "reverse" the bottom and right orientation to fit x and y orientation
rev.dt <- function(
i,
blr.c   = blr.clock,
tri.d   = tri.data,
blr.t   = blr.tx,
text.s  = text.sum
){  #
val <- tri.d[  , blr.t[i] ]
if( !is.na(blr.c[i]) )  # Do not reverse NA sides
{   #
if( (blr.c[i] & (i != 2)) | (!blr.c[i] & (i == 2)) )
{   #
val <- ( text.s - val )
}   #
}   #
val
}   #
#
for( j in 1:3 ){ tri.data[,blr.tx[j]] <- rev.dt("i"=j) }
#
# The x,y coordnates calculation is 1st separated depending on blr.clock[2]
if( !is.na(blr.clock[2]) ){ cond2 <- blr.clock[2] }else{ cond2 <- FALSE }
#
if( cond2 )
{   #
ypos    <- tri.data[  , blr.tx[2] ] * sin(tlr.an[2])
}else{
ypos    <- tri.data[  , blr.tx[3] ] * sin(tlr.an[3])
}   #
#
if( blr.clock[1] )
{   # if cond2 this is the TTT case, else (!cond2) this is the TXF case.
xpos    <- tri.data[  , blr.tx[1] ] - ypos/tan(tlr.an[3])
}else{
# if cond2 this is the FTX case, else (cond2) this is the FFF case.
xpos    <- tri.data[  , blr.tx[1] ] + ypos/tan(tlr.an[2])
}   #
#
return( data.frame( "xpos" = xpos , "ypos" = ypos ) )
}   #

#' Plot a soil texture data table as points on an existing texture plot.
#'
#' Plot a soil texture data table as points on an existing texture plot.
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @importFrom grDevices hsv
#' @importFrom grDevices dev.cur
#' @importFrom graphics points
#' @export
TT.points <- function(# Plot a soil texture data table as points on an existing texture plot.
### Plot a soil texture data table as points on an existing texture plot.

tri.data,
geo,
css.names       = NULL,
z.name          = NULL,
base.css.ps.lim = NULL,
dat.css.ps.lim  = NULL,
css.transf      = NULL,
text.transf.fun = NULL,
text.tol        = NULL,
#
pch             = NULL,
fg              = NULL,
col             = NULL,
bg              = NULL,
cex             = NULL,
lwd             = NULL,
points.type     = NULL,
#
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
#
z.type          = NULL,
z.col.hue       = NULL,
z.cex.range     = NULL,
z.pch           = NULL,
text.sum        = NULL,
blr.clock       = NULL,
blr.tx          = NULL
){  #
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
if( any( is.null(dat.css.ps.lim) ) )
{   #
dat.css.ps.lim  <- base.css.ps.lim
}   #
#
# Set the rest of parameters
TT.auto.set()
#
# Basic checks
if( grDevices::dev.cur() == 1 )
{   #
stop("Cannot add points unless the TT.plot has been drawn")
}   #
#
if( css.transf )
{   #
text.transf.fun <- get( text.transf.fun )
#
tri.data <- text.transf.fun(
tri.data        = tri.data,
base.css.ps.lim = base.css.ps.lim,
dat.css.ps.lim  = dat.css.ps.lim,
css.names       = css.names,
blr.tx          = blr.tx,
text.sum        = text.sum,
text.tol        = text.tol,
tri.sum.tst     = tri.sum.tst,
tri.pos.tst     = tri.pos.tst,
)   #
}   #
#
xy.coord <- TT.css2xy(
tri.data    = tri.data,
css.names   = css.names,
geo         = geo,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
set.par     = FALSE,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
if( !is.null(z.name) & z.type == "bubble" )
{   #
z           <- order( tri.data[,z.name], decreasing = TRUE )
#
xy.coord    <- xy.coord[ z ,  ]
#
z           <- tri.data[ z , z.name ]
#
old.fg.col  <- col
#
night.cols  <-  TT.col2hsv(bg)[,"v"] < 0.5
#
if( night.cols )
{   #
points.sat <- TT.str(z,0.25,1.00)
points.val <- TT.str(z,0.25,1.00)
}else{
points.sat <- TT.str(z,1.00,0.25)
points.val <- TT.str(z,1.00,0.25)
}   #
#
col <- grDevices::hsv(
h   = z.col.hue,
s   = points.sat,
v   = points.val
)   #
#
cex <- TT.str(z,z.cex.range[1],z.cex.range[2])
#
pch1    <- z.pch[1] # Added 20090617
pch2    <- z.pch[2] # Added 20090617
}else{
pch1    <- pch
pch2    <- pch
}   #
#
nobs <- dim(xy.coord)[1]
#
graphics::points(
x       = xy.coord\$"xpos",
y       = xy.coord\$"ypos",
pch     = pch1, # Added 20090617
col     = col,
bg      = bg,
type    = points.type,
cex     = cex,
lwd     = lwd  # Added 20090617
)   #
#
if( !is.null(z.name) & z.type == "bubble" )
{   #
graphics::points(
x       = xy.coord\$"xpos",
y       = xy.coord\$"ypos",
pch     = pch2,
col     = old.fg.col,
bg      = bg,
type    = points.type,
cex     = cex,
lwd     = lwd  # Added 20090617
)   #
}   #
#
invisible( xy.coord )
}   #

#' Plot text labels for each values of a soil texture data table on an existing
#' texture plot.
#'
#' Plot text labels for each values of a soil texture data table on an existing
#' texture plot.
#'
#'
#' @param labels Vector of character strings. Label to be plotted, for each point in 'tri.data'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @importFrom grDevices dev.cur
#' @importFrom graphics text
#' @export
TT.text <- function(# Plot text labels for each values of a soil texture data table on an existing texture plot.
### Plot text labels for each values of a soil texture data table on an existing texture plot.

tri.data,
geo,
labels          = NULL,
css.names       = NULL,
base.css.ps.lim = NULL,
dat.css.ps.lim  = NULL,
css.transf      = NULL,
text.transf.fun = NULL,
text.tol        = NULL,
text.sum        = NULL,
blr.clock       = NULL,
#
fg              = NULL,
col             = NULL,
cex             = NULL,
font            = NULL,
family.op       = NULL,
pos             = NULL,
offset          = NULL,
#
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
blr.tx          = NULL
){  #
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
if( any( is.null(dat.css.ps.lim) ) )
{   #
dat.css.ps.lim  <- base.css.ps.lim
}   #
#
if( any( is.null(labels) ) )
{   #
labels <- 1:dim(tri.data)[1]
}   #
#
# Set the rest of parameters
TT.auto.set()
#
# Basic checks
if( grDevices::dev.cur() == 1 )
{   #
stop("Cannot add points unless the TT.plot has been drawn")
}   #
#
if( css.transf )
{   #
text.transf.fun <- get( text.transf.fun )
#
tri.data <- text.transf.fun(
tri.data        = tri.data,
base.css.ps.lim = base.css.ps.lim,
dat.css.ps.lim  = dat.css.ps.lim,
css.names       = css.names,
blr.tx          = blr.tx,
text.sum        = text.sum,
text.tol        = text.tol,
tri.sum.tst     = tri.sum.tst,
tri.pos.tst     = tri.pos.tst,
)   #
}   #
#
xy.coord <- TT.css2xy(
tri.data    = tri.data,
css.names   = css.names,
geo         = geo,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
set.par     = FALSE,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
nobs <- dim(xy.coord)[1]
#
graphics::text(
x       = xy.coord\$"xpos",
y       = xy.coord\$"ypos",
labels  = labels,
col     = col,
#type   = points.type,
cex     = cex,
font    = font,
family  = family.op,
pos     = pos,
offset  = offset
)   #
#
invisible( xy.coord )
}   #

#' Internal. Create an empty plot scene for a texture triangle.
#'
#' Create an empty plot where a texture triangle can be drawn with other
#' secondary functions (frame, axis, ...). Also return the 'geo' parameters
#' needed by these secondary functions.
#'
#'
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @importFrom graphics plot
#' @export
TT.baseplot <- function(# Internal. Create an empty plot scene for a texture triangle.
### Create an empty plot where a texture triangle can be drawn with
### other secondary functions (frame, axis, ...). Also return the
### 'geo' parameters needed by these secondary functions.
##keywords<< internal

geo             = NULL,
class.sys       = "none",
#
# "GEO" parameters
blr.clock       = NULL,
tlr.an          = NULL,
blr.tx          = NULL,
text.sum        = NULL,
base.css.ps.lim = NULL,
#
# DATA TESTS:
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
#
text.tol        = NULL,
unit.ps         = NULL,
unit.tx         = NULL,
#
b.lim           = NULL,   # default c(0,1)
l.lim           = NULL,   # default c(0,1)
#
main            = NULL,
#
new.mar         = NULL,
#
bg              = NULL,
fg              = NULL,
col             = NULL,
cex.main        = NULL,
#
lang            = NULL
){  #
css.names   <- c("CLAY","SILT","SAND")
#
if( is.null(geo) )
{   #
geo <- TT.geo.get(
class.sys       = class.sys,
blr.clock       = blr.clock,
tlr.an          = tlr.an,
blr.tx          = blr.tx,
text.sum        = text.sum,
base.css.ps.lim = base.css.ps.lim
)   #
}   #
#
# Set geographical parameters:
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Retrieve classes-system (texture triangle) parameters:
if( class.sys != "none" )
{   #
TT.data <- TT.get(class.sys)
}   #
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Fix the plot limits:
if( any(is.null(b.lim)) ){ b.lim <- TT.get("b.lim") * text.sum }
if( any(is.null(l.lim)) ){ l.lim <- TT.get("l.lim") * text.sum }
r.lim <- text.sum - c( b.lim[1] + l.lim[2], b.lim[1] + l.lim[1] )
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Create a "base frame", with coordinates expressed in CLAY SILT SAND
base.frame  <- data.frame(
#   #   S1                          S2                          S3
"b" = c(b.lim[1],                   b.lim[2],                   b.lim[1] ),
"l" = c(l.lim[2],                   l.lim[1],                   l.lim[1] ),
"r" = c(text.sum-b.lim[1]-l.lim[2], text.sum-b.lim[2]-l.lim[1], text.sum-b.lim[1]-l.lim[1] )
)   #
colnames(base.frame)    <- blr.tx
#
if( is.null(main) )
{   #
lang.par    <- TT.get("lang.par")
#
if( is.null(lang) ){ lang <- TT.get("lang") }
#
main        <- lang.par[ lang.par\$"lang" == lang , "TT" ]
main        <- parse(text=main)[[1]]    # Added 2009/06/27
#
if( class.sys != "none" )
{   #
main <- paste(
sep = "",
main,
": ",
TT.data\$"main"
)   #
}   #
}   #
#
# Auto-set parameters that are not in par()
TT.auto.set(set.par=FALSE)
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Convert CLAY SILT SAND coordinates into xy coordinates
ghost.TT    <- TT.css2xy(
tri.data    = base.frame,
geo         = geo,
css.names   = css.names,
text.tol    = text.tol,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
set.par     = FALSE,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Setup new graph margins:
#
# # default c(5, 2, 4, 2)
# # c(bottom, left, top, right)
if( is.null(new.mar) )
{   #
#              c(bottom, left, top, right)
new.mar     <- c(5.0, 3.5, 3.0, 3.5)+0.1
#
if( if(is.null(main)){FALSE}else{is.na(as.character(main))} )
{   #
new.mar[3]  <- 0.1
}   #
if( tlr.an[2] > tlr.an[3] )
{   #
new.mar[4] <- 0.1
}else{
if( tlr.an[2] < tlr.an[3] )
{   #
new.mar[2] <- 0.1
}else{  # Equality case
new.mar[c(2,4)] <- 0.1
}   #
}   #
}   #
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Setup other graphical parameters:
par.list    <- list(
"mar"   = new.mar,
"pty"   = "s",
"xpd"   = TRUE,
"bg"    = bg,
"fg"    = fg
#"col"  = col
)   #
#
par.list    <- par.list[ unlist(lapply(X=par.list,FUN=function(X){!is.null(X)})) ]
#
# Sets new par() values
do.call( what = "par", args = par.list )
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# | Ghost plot to set the limits of |
# | the graph                       |
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
graphics::plot(
x           = ghost.TT\$"xpos",
y           = ghost.TT\$"ypos",
type        = "n",
axes        = FALSE,
xlim        = range(ghost.TT\$"xpos"),
ylim        = min(ghost.TT\$"ypos")+c(0,diff(range(ghost.TT\$"xpos"))),
main        = main,
cex.main    = cex.main,
xlab        = "",
ylab        = ""
)   #
#
# Return the geo(metrical) specifications of the plot
return( invisible( geo ) )
}   #

#   TT.baseplot()

#' Internal. Plot the edges (bare axis) of a soil texture triangle.
#'
#' Plot the edges (bare axis) of a soil texture triangle. This is not a primary
#' plot function, TT.baseplot() must have been called before (usually inside
#' TT.plot()).
#'
#'
#' @param plot.axis If TRUE the 3 axes are plotted.
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom graphics polygon
TT.edges <- function(# Internal. Plot the edges (bare axis) of a soil texture triangle.
### Plot the edges (bare axis) of a soil texture triangle. This
### is not a primary plot function, TT.baseplot() must have been
### called before (usually inside TT.plot()).
##keywords<< internal

geo,
#
text.tol        = NULL,
text.sum        = NULL,
blr.clock       = NULL,
#
col.axis        = NULL,
plot.axis       = TRUE,     # plot the axis (not only background)
frame.bg.col    = NULL,
lwd.axis        = NULL,
#
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
bg              = NULL
){  #
css.names   <- c("CLAY","SILT","SAND")
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic sets remaining NULL varaibles
TT.auto.set()
#
blr.tx <- TT.blr.tx.check(
blr.tx      = blr.tx,
css.names   = css.names
)   #
#
# Set the base frame
base.frame <- TT.get("base.frame") * text.sum
colnames(base.frame)    <- blr.tx
# # base.frame is not in the options so has not been called at
# # this stage...
#
if( is.null(frame.bg.col) )
{   #
frame.bg.col    <- TT.DJ.col(
cl      = c(bg,col.axis),
w       = c(0.9,0.1),
gray.l  = FALSE
)   #
}   #
#
tri.TT <- TT.css2xy(
tri.data    = base.frame,
geo         = geo,
css.names   = css.names,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
set.par     = FALSE,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
xpos    <- tri.TT\$"xpos"
ypos    <- tri.TT\$"ypos"
#
if( !plot.axis ){ col.axis <- NA }
#
graphics::polygon(
x       = tri.TT\$"xpos",
y       = tri.TT\$"ypos",
border  = col.axis,
col     = frame.bg.col,
lwd     = lwd.axis
)   #
}   #

#' Internal. Used to plot line elements of a texture plot axis, ticks, arrows,
#' etc.
#'
#' Used to plot line elements of a texture plot axis, ticks, arrows, etc.
#'
#'
#' @param at.1.s
#' @param at.2.s
#' @param at.3.s
#' @param at.1.e
#' @param at.2.e
#' @param at.3.e
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
TT.lines <- function(# Internal. Used to plot line elements of a texture plot axis, ticks, arrows, etc.
### Used to plot line elements of a texture plot axis, ticks, arrows, etc.

geo         = geo,
#
at.1.s      = TT.get("at"),         # Start values of lines on each side of the triangle
at.2.s      = 1 - TT.get("at"),     # (Start values) For grid lines: reverse value, for ticks, at + ticks.shift
at.3.s      = 0,                    # (Start values) For grid lines: 0 value, for ticks, 0 - ticks.shift
at.1.e      = TT.get("at"),         # End values of lines on each side of the triangle
at.2.e      = 0,                    # at.2.e: (End values) logically equal to at.3.s
at.3.e      = 1 - TT.get("at"),     # at.3.e: (End values) logically equal to at.2.s
#
text.tol    = NULL,
text.sum    = NULL,
blr.clock   = NULL,
#
tri.sum.tst = NULL,
tri.pos.tst = NULL
){  #
css.names   <- c("CLAY","SILT","SAND")
#
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
TT.auto.set()
#
blr.tx <- TT.blr.tx.check(
blr.tx      = blr.tx,
css.names   = css.names
)   #
#
# If one of the parameter has length one, expand it to at.1.s length:
# + adapt the scale to text.sum
for( j in c("at.1.s","at.2.s","at.3.s","at.1.e","at.2.e","at.3.e") )
{   #
if(  (length(get(j)) == 1) & (length(at.1.s) != 1)  )
{   #
assign(
x       = j,
value   = rep(get(j),length(at.1.s))
)   #
}   #
assign(
x       = j,
value   = text.sum * get(j)
)   #
}   #
#
# NEW NEW NEW NEW
grid.lns <- list(
"B" = list( # Dataframe of BLR coordinates for grid lines starting from the bottom of the triangle:
"start" = data.frame(   # BLR (or CSS) values of the segments starts
#     #                     # TTT   # TXF   # FTX   # FFF
"B" = at.1.s,
"L" = TT.switch( blr.clock, at.3.s, at.2.s, at.3.s, at.2.s ),
"R" = TT.switch( blr.clock, at.2.s, at.3.s, at.2.s, at.3.s )
),  #
"end"   = data.frame(   # BLR (or CSS) values of the segments ends
"B" = at.1.e,
"L" = TT.switch( blr.clock, at.3.e, at.2.e, at.3.e, at.2.e ),
"R" = TT.switch( blr.clock, at.2.e, at.3.e, at.2.e, at.3.e )
)   #
),  #
"L" = list( # Dataframe of BLR coordinates for grid lines starting from the left of the triangle:
"start" = data.frame(   # BLR (or CSS) values of the segments starts
#     #                     # TTT   # TXF   # FTX   # FFF
"B" = TT.switch( blr.clock, at.2.s, at.2.s, at.3.s, at.3.s ),
"L" = at.1.s,
"R" = TT.switch( blr.clock, at.3.s, at.3.s, at.2.s, at.2.s )
),  #
"end"   = data.frame(   # BLR (or CSS) values of the segments ends
"B" = TT.switch( blr.clock, at.2.e, at.2.e, at.3.e, at.3.e ),
"L" = at.1.e,
"R" = TT.switch( blr.clock, at.3.e, at.3.e, at.2.e, at.2.e )
)   #
),  #
"R" = list( # Dataframe of BLR coordinates for grid lines starting from the right of the triangle:
"start" = data.frame(   # BLR (or CSS) values of the segments starts
#     #                     # TTT   # TXF   # FTX   # FFF
"B" = TT.switch( blr.clock, at.3.s, at.3.s, at.2.s, at.2.s ),
"L" = TT.switch( blr.clock, at.2.s, at.2.s, at.3.s, at.3.s ),
"R" = at.1.s
),  #
"end"   = data.frame(   # BLR (or CSS) values of the segments ends
"B" = TT.switch( blr.clock, at.3.e, at.3.e, at.2.e, at.2.e ),
"L" = TT.switch( blr.clock, at.2.e, at.2.e, at.3.e, at.3.e ),
"R" = at.1.e
)   #
)   #
)   #
#
grid.lns <- lapply(
X   = grid.lns,
FUN = function(X){
assign("x",X)
lapply(
X   = x,
FUN = function(X){
colnames(X) <- blr.tx
TT.css2xy(
tri.data    = X,
geo         = geo,
css.names   = css.names,
text.tol    = text.tol,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
set.par     = FALSE,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
}   #
)   #
}   #
)   #
#
return( grid.lns )
}   #

#' Plot a grid at regular texture intervals inside an existing soil texture
#' triangle.
#'
#' Plot a grid at regular texture intervals inside an existing soil texture
#' triangle.
#'
#'
#' @param at Vector of numeric values.
#' @param grid.col Passed to argument 'col' of \code{\link[graphics]{segments}}
#' @param grid.lty Passed to argument 'lty' of \code{\link[graphics]{segments}}
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @importFrom grDevices rgb
#' @importFrom grDevices hsv
#' @importFrom graphics segments
#' @export
TT.grid <- function(# Plot a grid at regular texture intervals inside an existing soil texture triangle.
### Plot a grid at regular texture intervals inside an existing soil texture triangle.

geo             = geo,
at              = NULL,
#
text.tol        = NULL,
text.sum        = NULL,
blr.clock       = NULL,
#
grid.col        = NULL,
grid.lty        = NULL,
lwd.axis        = NULL,
#
tri.sum.tst     = NULL,
tri.pos.tst     = NULL,
#
# Parameters for auto adaptation of the grid color
# to the class polygon background colors
class.p.bg.col  = NULL,     # added 2009/05/18
class.p.bg.hue  = NULL,     # added 2009/05/18
frame.bg.col    = NULL,     # added 2009/05/19
bg              = NULL,     # added 2009/05/22
col.axis        = NULL      # added 2009/05/22
){  #
TT.auto.set()
#
# 1. Setting the colors
if( is.null(grid.col) )
{   #
class.p.bg.col.test <- is.logical( class.p.bg.col )
if( class.p.bg.col.test )
{   #
class.p.bg.col.test <- class.p.bg.col
}else{
class.p.bg.col.test <- TRUE
}   #
#
# There is a color gradient in the texture classes polygons?
if( class.p.bg.col.test )
{   # Check "darkness" of the background:
night.cols  <-  TT.col2hsv(bg)[,"v"] < 0.5
#
grid.col    <- grDevices::hsv(
h   = class.p.bg.hue,
# Below, check with class polygon color: consitency:
s   = ifelse(night.cols,0.45,0.45), # a little less than the min saturation (night or day)
v   = ifelse(night.cols,0.20,0.80)  # equal the min value night or max value day
)   #
}else{
# Frame backgound color is NULL (so default = light gray)
if( is.null(frame.bg.col) )
# Step that will "remove" transparency:
bg.hsv      <- grDevices::col2rgb( bg, alpha = FALSE )[,1]/255
#
grid.col    <- grDevices::rgb(
red   = bg.hsv["red"],
green = bg.hsv["green"],
blue  = bg.hsv["blue"]
)   #
# Frame backgound color is not NULL
}else{
# gid color as a mix of frame background and frame line colors
grid.col    <- TT.DJ.col(
cl      = as.character( c(frame.bg.col,col.axis) ),
w       = c(0.9,0.1),
gray.l  = FALSE
)   #
}   #
}   #
}   #
#
at.r    <- 1 - at
at.0    <- 0
#
grid.lns <- TT.lines(
geo         = geo,
at.1.s      = at,
at.2.s      = at.r,
at.3.s      = at.0,
at.1.e      = at,
at.2.e      = at.0,
at.3.e      = at.r,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
invisible( lapply(
X   = grid.lns,
FUN = function(X){
graphics::segments(
x0      = X\$"start"\$"xpos",
y0      = X\$"start"\$"ypos",
x1      = X\$"end"\$"xpos",
y1      = X\$"end"\$"ypos",
col     = grid.col,
lty     = grid.lty,
lwd     = lwd.axis
)   #
}   #
)   )   #
#
return( invisible( grid.lns ) )
}   #

#' Internal. Plot the axis' ticks of a texture triangle plot.
#'
#' Plot the axis' ticks of a texture triangle plot.
#'
#'
#' @param at
#' @param tk.s
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom graphics segments
TT.ticks <- function(# Internal. Plot the axis' ticks of a texture triangle plot.
### Plot the axis' ticks of a texture triangle plot.
##keywords<< internal

geo,
at          = NULL,
#
text.tol    = NULL,
text.sum    = NULL,
blr.clock   = NULL,
#
tk.s        = NULL,
#
tri.sum.tst = NULL,
tri.pos.tst = FALSE,    # Ticks are outside the triangle
lwd.axis    = NULL,
col.axis    = NULL
){  #
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
TT.auto.set()
#
at.2.s  <- 1 - at
at.3.s  <- 0
at.2.e  <- at.2.s + tk.s
at.3.e  <- at.3.s - tk.s
#
grid.lns <- TT.lines(
geo         = geo,
at.1.s      = at,
at.2.s      = at.2.s,
at.3.s      = at.3.s,
at.1.e      = at,
at.2.e      = at.2.e,
at.3.e      = at.3.e,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
# NEW NEW NEW
plot.TF <- c(
#     #                     # TTT  # TXF  # FTX  # FFF
"B" = TT.switch( blr.clock, TRUE,  TRUE,  TRUE,  TRUE ),
"L" = TT.switch( blr.clock, TRUE,  FALSE, TRUE,  TRUE ),
"R" = TT.switch( blr.clock, TRUE,  TRUE,  FALSE, TRUE )
)   #
# #
# if( is.null(col.axis) ){ col.axis <- col }
#
invisible( lapply(
X   = names(grid.lns),
FUN = function(X){
if( plot.TF[X] )
{   #
graphics::segments(
x0      = grid.lns[[X]]\$"start"\$"xpos",
y0      = grid.lns[[X]]\$"start"\$"ypos",
x1      = grid.lns[[X]]\$"end"\$"xpos",
y1      = grid.lns[[X]]\$"end"\$"ypos",
col     = col.axis,
lty     = 1,
lwd     = lwd.axis
)   #
}   #
}   #
)   )   #
}   #

#' Internal. Plot the axis ticks' labels of a texture triangle plot.
#'
#' Plot the axis ticks' labels of a texture triangle plot.
#'
#'
#' @param at
#' @param tk.ls
#' @param font.axis
#' @param cex.axis
#' @author Julien Moeys [aut, cre], Wei Shangguan [ctb], Rainer Petzold [ctb],
#' Budiman Minasny [ctb], Bogdan Rosca [ctb], Nic Jelinski [ctb], Wiktor
#' Zelazny [ctb], Rodolfo Marcondes Silva Souza [ctb], Jose Lucas Safanelli
#' [ctb], Alexandre ten Caten [ctb]
#' @noRd
#' @importFrom graphics text
TT.ticks.lab <- function(# Internal. Plot the axis ticks' labels of a texture triangle plot.
### Plot the axis ticks' labels of a texture triangle plot.
##keywords<< internal

geo,
at          = NULL,
#
text.tol    = NULL,
text.sum    = NULL,
blr.clock   = NULL,
tlr.an      = NULL,
#
tk.ls       = NULL,
#
tri.sum.tst = NULL,
tri.pos.tst = FALSE,    # Ticks are outside the triangle
#
col.axis    = NULL,
font.axis   = NULL,
cex.axis    = NULL,
family.op   = NULL
){  #
# +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
# Automatic takes the values in geo and
# attributes them to same name variables
TT.geo.set(
geo     = geo
#p.env  = environment()
)   #
#
TT.auto.set()
#
at.2.s  <- 1 - at
at.3.s  <- 0
at.2.e  <- at.2.s + tk.ls
at.3.e  <- at.3.s - tk.ls
#
grid.lns <- TT.lines(
geo         = geo,
at.1.s      = at,
at.2.s      = at.2.s,
at.3.s      = at.3.s,
at.1.e      = at,
at.2.e      = at.2.e,
at.3.e      = at.3.e,
tri.sum.tst = tri.sum.tst,
tri.pos.tst = tri.pos.tst,
text.sum    = text.sum,
blr.clock   = blr.clock
)   #
#
# NEW NEW NEW
angle   <- c(
#     #                     # TTT       # TXF   # FTX   # FFF
"B" = TT.switch( blr.clock, -tlr.an[3], +90,    -90,    +tlr.an[2]  ),
"L" = TT.switch( blr.clock, +00,        NA,     +00,    -tlr.an[3]  ),
"R" = TT.switch( blr.clock, +tlr.an[2], +00,     NA,    +00         )
)   #
#
# NEW NEW NEW
plot.TF <- c(
#     #                     # TTT  # TXF  # FTX  # FFF
"B" = TT.switch( blr.clock, TRUE,  TRUE,  TRUE,  TRUE ),
"L" = TT.switch( blr.clock, TRUE,  FALSE, TRUE,  TRUE ),
"R" = TT.switch( blr.clock, TRUE,  TRUE,  FALSE, TRUE )
)   #
#
invisible( lapply(
X   = names(grid.lns),
FUN = function(X){
if( plot.TF[X] )
{   #
graphics::text(
x           = grid.lns[[X]]\$"end"\$"xpos",
y           = grid.lns[[X]]\$"end"\$"ypos",
labels      = at * text.sum,
col         = col.axis,
srt         = angle[X],
font        = font.axis,
cex         = cex.axis,
family      = family.op
)   #
}   #
}   #
)   )   #
}   #

#' Internal. Plot the axis' arrows of a texture triangle plot.
#'
#' Plot the axis' arrows of a texture triangle plot.
#'
#'
#' @param css.lab
#' @param a.l
#' @param a.h.s
#' @param a.t.s
#' @param a.t.s2
#' @param a.b.s