Here, finally, is the direct analog of newVisibleSpectrum
from this answerthis answer, which can be used to replace ColorData["BlackBodySpectrum"]
.
ChromaticityPlot; (* pre-load internals *)
newBlackBodySpectrum[t_?NumericQ] :=
With[{planck = 1/((Exp[1.43877696*^7/(# t)] - 1) #^5) &},
XYZColor @@ ({{1.0478112, 0.022886602, -0.050126976}, (* Bradford D65 -> D50 *)
{0.029542398, 0.9904844, -0.017049096},
{-0.0092344897, 0.015043617, 0.75213163}} .
Normalize[planck[Image`ColorOperationsDump`$wavelengths] .
Image`ColorOperationsDump`tris, #[[2]] &])]
The Bradford chromatic adaptation matrix was needed here since Mathematica assumes a D50 whitepoint for XYZColor[]
(see the docs for ColorConvert[]
).
Now, 6500 K corresponds to white, as it is supposed to be for D65:
ColorConvert[newBlackBodySpectrum[6500], RGBColor]
Graphics[{newBlackBodySpectrum[6500], Disk[]}]
Compare:
GraphicsColumn[{DensityPlot[x, {x, 1000, 10000}, {y, 0, 1500},
AspectRatio -> Automatic, PlotPoints -> {200, 3},
ColorFunction -> "BlackBodySpectrum",
ColorFunctionScaling -> False,
PlotLabel -> "BlackBodySpectrum"],
DensityPlot[x, {x, 1000, 10000}, {y, 0, 1500},
AspectRatio -> Automatic, PlotPoints -> {200, 3},
ColorFunction -> newBlackBodySpectrum,
ColorFunctionScaling -> False,
PlotLabel -> "newBlackBodySpectrum"]}]