1### ------ hcl() explorations
2
3hcl.wheel <-
4    function(chroma = 35, lums = 0:100, hues = 1:360, asp = 1,
5             p.cex = 0.6, do.label = FALSE, rev.lum = FALSE,
6             fixup = TRUE)
7{
8    ## Purpose: show chroma "sections" of hcl() color space; see  ?hcl
9    ## ----------------------------------------------------------------------
10    ## Arguments: chroma: can be vector -> multiple plots are done,
11    ##            lums, hues, fixup : all corresponding to hcl()'s args
12    ##            rev.lum: logical indicating if luminance
13    ## 			should go from outer to inner
14    ## ----------------------------------------------------------------------
15    ## Author: Martin Maechler, Date: 24 Jun 2005
16
17    require("graphics")
18    stopifnot(is.numeric(lums), lums >= 0, lums <= 100,
19              is.numeric(hues), hues >= 0, hues <= 360,
20              is.numeric(chroma), chroma >= 0, (nch <- length(chroma)) >= 1)
21    if(is.unsorted(hues)) hues <- sort(hues)
22    if(nch > 1) {
23        op <- par(mfrow= n2mfrow(nch), mar = c(0,0,0,0), xpd = TRUE)
24        on.exit(par(op))
25    }
26    for(i.c in 1:nch) {
27        plot(-1:1,-1:1, type="n", axes = FALSE, xlab="",ylab="", asp = asp)
28        ## main = sprintf("hcl(h = <angle>, c = %g)", chroma[i.c]),
29        text(0.4, 0.99, paste("chroma =", format(chroma[i.c])),
30             adj = 0, font = 4)
31        l.s <- (if(rev.lum) rev(lums) else lums) / max(lums) # <= 1
32        for(ang in hues) { # could do all this using outer() instead of for()...
33            a. <- ang * pi/180
34            z.a <- exp(1i * a.)
35            cols <- hcl(ang, c = chroma[i.c], l = lums, fixup = fixup)
36            points(l.s * z.a, pch = 16, col = cols, cex = p.cex)
37            ##if(do."text") : draw the 0,45,90,... angle "lines"
38            if(do.label)
39                text(z.a*1.05, labels = ang, col = cols[length(cols)/2],
40                     srt = ang)
41        }
42        if(!fixup) ## show the outline
43            lines(exp(1i * hues * pi/180))
44   }
45   invisible()
46}
47
48## and now a few interesting calls :
49
50hcl.wheel() # and watch it redraw when you fiddle with the graphic window
51hcl.wheel(rev.lum= TRUE) # ditto
52hcl.wheel(do.label = TRUE) # ditto
53
54
55## Now watch:
56hcl.wheel(chroma = c(25,35,45,55))
57
58hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.4)
59hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, fixup = FALSE)
60hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE)
61if(dev.interactive()) # new "graphics window" -- to compare with previous :
62    dev.new()
63hcl.wheel(chroma = seq(10, 90, by = 10), p.cex = 0.3, rev.lum = TRUE, fixup=FALSE)
64