/
pickColors.R
130 lines (125 loc) · 4.17 KB
/
pickColors.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
#' Pick colors up
#'
#' Generate an interactive interface to pick a set of colors up.
#'
#' @param n The number of colors to be selected (9 by default).
#' @param ramp A vector of colors used as tone palette.
#' @param nb_shades Number of shades to be displayed once a tone is selected.
#'
#' @keywords color, palette, interactive
#'
#' @export
#'
#' @return
#' A character vector including the colors selected.
#'
#' @details
#' This function generates a graphical window split into 6 panels. The top
#' panel serves to select one tone. The panel right below presents `nb_shades`
#' of the selected tones. The bottom right panel displays the current selection
#' that can be stored by clicking on the bottom left panel _Keep it_.
#' The bottom center panel shows the characteristic of the selected color.
#' Finally, in order to abort before completing the selection of colors, the
#' user can simply click on the _Stop_ panel (on the left).
pickColors <- function(n = 9, ramp = grDevices::rainbow(1024), nb_shades = 512) {
opar <- par(no.readonly = TRUE)
# output
colSlc <- rep(NA_character_, n)
#
nb_ramp <- length(ramp)
# initial values
col_foc <- col_ini <- ramp[floor(nb_ramp * 0.5) + 1]
# getLayout
mat <- getMatrix(n)
tmp <- howManyRC(n)
# remove margins
i <- 0
k <- 0
while (i == 0 && k < n) {
#
layout(mat, widths = c(1, 2, rep(1 / (tmp[2L]), tmp[2L])),
heights = c(1, 1, rep(2 / tmp[1L], tmp[1L])))
par(mar = c(0, 0, 0, 0), xaxs = "i", yaxs = "i")
shades <- (grDevices::colorRampPalette(c("white", col_ini, "black")))(nb_shades)
drawSelector2(
ramp, col_ini, col_foc, shades, nb_shades, nb_ramp, prod(tmp),
colSlc
)
#
par(new = TRUE, fig = c(0, 1, 0, 1))
plot0(c(0, 1), c(0, 1))
loc <- locator(1L)
#
if (loc$y > 0.5) {
if (loc$y > 0.75) {
col_ini <- ramp[floor(nb_ramp * loc$x) + 1]
shades <- (grDevices::colorRampPalette(c("white", col_ini, "black")))(nb_shades)
col_foc <- shades[floor(nb_shades * 0.5) + 1]
} else {
col_foc <- shades[floor(nb_shades * loc$x) + 1]
}
} else {
if (loc$x < 0.25) {
if (loc$y > 0.25) {
k <- k + 1
colSlc[k] <- col_foc
} else {
i <- 1
}
}
}
}
#
par(opar)
grDevices::dev.off()
#
colSlc[!is.na(colSlc)]
}
getMatrix <- function(n) {
## -- rows and columns
tmp <- howManyRC(n)
mat <- rbind(1, 2, cbind(3, 4, matrix(4 + (1:prod(tmp)), tmp[1L], tmp[2L],
byrow = TRUE)))
mat
}
## -------------
drawSelector2 <- function(ramp, col_ini, col_foc, shades, nb_shades, nb_ramp, nbpanels,
colSlc) {
#
image(matrix(1L:nb_ramp), col = ramp, axes = FALSE, ann = FALSE)
points(rep(which(ramp == col_ini)[1L] / nb_ramp, 2), c(0, 0), col = c(
"white",
1
), pch = c(19, 20))
box(lwd = 3, col = "white")
#
image(matrix(1:nb_shades), col = shades, axes = FALSE, ann = FALSE)
points(rep(which(shades == col_foc)[1L] / nb_shades, 2), c(0, 0), col = c(
"white",
1
), pch = c(19, 20))
box(lwd = 3, col = "white")
#
plot0(fill = "grey80")
text(0, 0.5, label = "Keep it", cex = 2, col = "grey20")
abline(h = 0, lwd = 2, col = "white")
text(0, -0.5, label = "Stop", cex = 2, col = "grey20")
#
plot0(fill = col_foc)
code_rgb <- col2rgb(col_foc)
# print(sum(code_rgb) < 255)
if (sum(code_rgb) < 255) {
txt_col <- "grey80"
} else {
txt_col <- "grey20"
}
text(0, 0.7, label = as.character(col_foc), cex = 2.5, col = txt_col)
text(0, 0, label = paste0("Red :", code_rgb[1L]), cex = 2, col = txt_col)
text(0, -0.3, label = paste0("Green:", code_rgb[2L]), cex = 2,
col = txt_col)
text(0, -0.6, label = paste0("Blue :", code_rgb[3L]), cex = 2,
col = txt_col)
# box(lwd = 3, col = 'white') --
for (i in 4 + seq_len(nbpanels)) plot0(fill = colSlc[i - 4])
invisible(NULL)
}