Created
March 13, 2013 02:20
-
-
Save eiel/5148886 to your computer and use it in GitHub Desktop.
CIELCH 色空間 をHTML で確認するスクリプト。 標本数をいじりたいなら hues chromas lightnesses あたりをいじる。
validRGB でぶっとんだ RGB値のものを省いてるけど、はぶかなくても面白い。
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| import Data.Colour.CIE | |
| import Data.Colour.SRGB | |
| import Data.Colour.CIE.Illuminant | |
| import Data.Colour.SRGB.Linear | |
| cieLCH :: (Ord a, Floating a) => Chromaticity a -> a -> a -> a -> Colour a | |
| cieLCH white_ch l c h = cieLAB white_ch l a b | |
| where | |
| radius = pi * h / 180 | |
| a = cos radius * c | |
| b = sin radius * c | |
| validRGB :: (Fractional a, Ord a) => RGB a -> Bool | |
| validRGB (RGB r g b) = if sum >= 0 && sum <= 3.1 && | |
| r > low && r < high && | |
| g > low && g < high && | |
| b > low && b < high | |
| then True | |
| else False | |
| where | |
| sum = r + g + b | |
| low = -0.1 | |
| high = 1.2 | |
| toRGBColor :: (Fractional a, Ord a) => Colour a -> Maybe (Colour a) | |
| toRGBColor colour = if validRGB rgb | |
| then Just colour | |
| else Nothing | |
| where | |
| rgb = Data.Colour.SRGB.Linear.toRGB colour | |
| type ColorName = (Maybe (Colour Double), Double, Double) | |
| type ColorTable = [[ColorName]] | |
| colorTabletoHTML :: ColorTable -> String | |
| colorTabletoHTML table = "<table style=\"display: inline;\">" | |
| ++ (unlines $ map makeRow table) ++ "</table>" | |
| where | |
| makeRow :: [ColorName] -> String | |
| makeRow cols = "<tr>" ++ (unlines $ map makeCol cols) ++ "</tr>" | |
| makeCol :: ColorName -> String | |
| makeCol (color, l, c) = "<td style=\"background-color: " ++ | |
| rgbString color ++ "; \"> </td>" | |
| rgbString Nothing = "" | |
| rgbString (Just color) = sRGB24show color | |
| colorTable lightnesses chromas h = | |
| [[(makeColor l c h, l,c) | c <- chromas] | |
| | l <- lightnesses] | |
| where | |
| makeColor l c h = Main.toRGBColor $ cieLCH d65 l c h | |
| hues = [0,18..342] | |
| chromas = [100,80..0] | |
| lightnesses = [100,80..0] | |
| main = do | |
| putStrLn "<body style=\"background-color: #2c2c2c\">" | |
| mapM_ putStrLn $ map (colorTabletoHTML . colorTable lightnesses chromas) hues | |
| putStrLn "</body>" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment