SVG2Q-0.3: Color.hs
module Color where
import Numeric (readHex)
import Debug.Trace (trace)
import Helpers (clean, split, replace)
data Color = Color {
red :: Float
, green :: Float
, blue :: Float
}
deriving (Show, Eq)
-- reads the supplied string and returns the contained color, if there is any.
getColor :: Maybe String -> Maybe Color
getColor Nothing = getColor (Just "")
getColor (Just s) =
case s of
'#':hr:hg:hb:[] -> colorFromHexStrings [hr, hr] [hg, hg] [hb, hb]
'#':hr1:hr2:hg1:hg2:hb1:hb2:[] ->
colorFromHexStrings [hr1, hr2] [hg1, hg2] [hb1, hb2]
"" -> trace "Warning: No valid color supplied where expected.\
\ Falling back to black." rgb 0 0 0
'r':'g':'b':'(':xs -> decrgb xs
_:_ -> colorFromLiteralString s
-- gets 3 strings, representing hex-values of red, green and blue.
-- returns a color, if the values are between 0-255
colorFromHexStrings :: String -> String -> String -> Maybe Color
colorFromHexStrings hr hg hb = let
dr = fst (head (readHex hr))::Float
dg = fst (head (readHex hg))::Float
db = fst (head (readHex hb)):: Float
in
rgb dr dg db
-- strings to Maybe Color.
-- strings recognized: http://www.w3.org/TR/SVG/types.html#ColorKeywords
-- strings are matched in alphabetical order.
-- runtime is probably not that important to optimize
colorFromLiteralString :: String -> Maybe Color
colorFromLiteralString s = case clean s of
"acliceblue" -> rgb 240 248 255
"antiquewhite" -> rgb 250 235 215
"aqua" -> rgb 0 255 255
"aquamarine" -> rgb 127 255 212
"azure" -> rgb 240 255 255
"beige" -> rgb 245 245 220
"bisque" -> rgb 255 228 196
"black" -> rgb 0 0 0
"blancheldalmond" -> rgb 255 235 205
"blue" -> rgb 0 0 255
"blueviolet" -> rgb 138 43 226
"brown" -> rgb 165 42 42
"burlywood" -> rgb 222 184 135
"cadetblue" -> rgb 95 158 160
"charteuse" -> rgb 127 255 0
"chocolate" -> rgb 210 105 30
"coral"-> rgb 255 127 80
"cornflowerblue" -> rgb 100 149 237
"cornsilk" -> rgb 255 248 220
"crimson" -> rgb 220 20 60
"cyan" -> rgb 0 255 255
"darkblue" -> rgb 0 0 139
"darkcyan" -> rgb 0 139 139
"darkgoldenrod" -> rgb 184 134 11
"darkgray" -> rgb 169 169 169
"darkgreen" -> rgb 0 100 0
"darkgrey" -> rgb 169 169 169
"darkkhaki" -> rgb 189 183 107
"darkmagenta" -> rgb 139 0 139
"darkolivegreen" -> rgb 85 107 47
"darkorange" -> rgb 255 140 0
"darkorchid" -> rgb 153 50 204
"darkred" -> rgb 139 0 0
"darksalmin" -> rgb 233 150 122
"darkseagreen" -> rgb 143 188 143
"darkslateblue" -> rgb 72 61 139
"darkslategray" -> rgb 47 79 79
"darkslategrey" -> rgb 47 79 79
"darkturquoise" -> rgb 0 206 209
"darkviolet" -> rgb 148 0 211
"deeppink" -> rgb 255 20 147
"deepskyblue" -> rgb 0 191 255
"dimgray" -> rgb 105 105 105
"dimgrey" -> rgb 105 105 105
"dodgerblue" -> rgb 30 144 255
"firebrick" -> rgb 178 34 34
"floralwhite" -> rgb 255 250 240
"forestgreen" -> rgb 34 139 34
"fuchsia" -> rgb 255 0 255
"gainsboro" -> rgb 220 220 220
"ghostwhite" -> rgb 248 248 255
"gold" -> rgb 255 215 0
"goldenrod" -> rgb 218 165 32
"gray" -> rgb 128 128 128
"grey" -> rgb 128 128 128
"green" -> rgb 0 128 0
"greenyellow" -> rgb 173 255 47
"honeydew" -> rgb 240 255 240
"hotpink" -> rgb 255 105 180
"indianred" -> rgb 205 92 92
"indigo" -> rgb 75 0 130
"ivory" -> rgb 255 255 240
"khaki" -> rgb 240 230 140
"lavender" -> rgb 230 230 250
"lavenderblush" -> rgb 255 240 245
"lawngreen" -> rgb 124 252 0
"lemonchiffon" -> rgb 255 250 205
"lightblue" -> rgb 173 216 230
"lightcoral" -> rgb 240 128 128
"lightcyan" -> rgb 224 255 255
"lightgoldenrodyellow" -> rgb 250 250 210
"lightgray" -> rgb 211 211 211
"lightgreen" -> rgb 144 238 144
"lightgrey" -> rgb 211 211 211
"lightpink" -> rgb 255 182 193
"lightsalmon" -> rgb 255 160 122
"lightseagreen" -> rgb 32 178 170
"lightskyblue" -> rgb 135 206 250
"lightslategray" -> rgb 119 136 153
"lightslategrey" -> rgb 119 136 153
"lightsteelblue" -> rgb 176 196 222
"lightyellow" -> rgb 255 255 224
"lime" -> rgb 0 255 0
"limegreen" -> rgb 50 205 50
"linen" -> rgb 250 240 230
"magenta" -> rgb 255 0 255
"maroon" -> rgb 128 0 0
"mediumaquamarine" -> rgb 102 205 170
"mediumblue" -> rgb 0 0 205
"mediumorchid" -> rgb 186 85 211
"mediumpurple" -> rgb 147 112 219
"mediumseagreen" -> rgb 60 179 113
"mediumslateblue" -> rgb 123 104 238
"mediumspringgreen" -> rgb 0 250 154
"mediumturquoise" -> rgb 72 209 204
"mediumvoiletred" -> rgb 199 21 133
"midnightblue" -> rgb 25 25 112
"mintcream" -> rgb 245 255 250
"mistyrose" -> rgb 255 228 225
"moccasin" -> rgb 255 228 181
"najavowhite" -> rgb 255 222 173
"navy" -> rgb 0 0 128
"oldlace" -> rgb 253 245 230
"olive" -> rgb 128 128 0
"olivedrab" -> rgb 107 142 35
"orange" -> rgb 255 165 0
"orangered" -> rgb 255 69 9
"orchid" -> rgb 218 112 214
"palegoldenrod" -> rgb 238 232 170
"palegreen" -> rgb 152 251 152
"paleturquoise" -> rgb 175 238 238
"palevioletred" -> rgb 219 112 147
"papayawhip" -> rgb 255 239 213
"peachpuff" -> rgb 255 218 185
"peru" -> rgb 205 133 63
"pink" -> rgb 255 192 203
"plum" -> rgb 221 160 221
"powderblue" -> rgb 176 224 230
"purple" -> rgb 128 0 128
"red" -> rgb 255 0 0
"rosybrown" -> rgb 188 143 143
"royalblue" -> rgb 65 105 225
"saddlebrown" -> rgb 139 69 19
"salmon" -> rgb 250 128 114
"sandybrown" -> rgb 244 164 96
"seagreen" -> rgb 46 139 87
"seashell" -> rgb 255 245 238
"sienna" -> rgb 160 82 45
"silver" -> rgb 192 192 192
"skyblue" -> rgb 135 206 235
"slateblue" -> rgb 106 90 205
"slategray" -> rgb 112 128 144
"slategrey" -> rgb 112 128 144
"snow" -> rgb 255 250 250
"springgreen" -> rgb 0 255 127
"steelblue" -> rgb 70 130 180
"tan" -> rgb 210 180 140
"teal" -> rgb 0 128 128
"thistle" -> rgb 216 191 216
"tomato" -> rgb 255 99 71
"turquoise" -> rgb 64 224 208
"violet" -> rgb 238 130 238
"wheat" -> rgb 245 222 179
"white" -> rgb 255 255 255
"whitesmoke" -> rgb 245 245 245
"yellow" -> rgb 255 255 0
"yellowgreen" -> rgb 154 205 50
"none" -> Nothing
_ -> trace ("Warning: couldn't match \
\ color \""++s++"\".\
\ Falling back to black.") rgb 0 0 0
-- creates Just Color from rgb-values in range 0-255, Nothing otherwise.
rgb :: Float -> Float -> Float -> Maybe Color
rgb r g b
| all (`elem` [0 .. 255]) [r, g, b] = Just (Color (r/255) (g/255) (b/255))
| otherwise = getColor (Just "")
decrgb :: String -> Maybe Color
decrgb "" = getColor (Just "")
decrgb s = let xs = map (read.clean)
(split " "
(replace (replace s
","
" ")
")"
""))
in if length xs >= 3
then rgb (head xs) (xs!!1) (xs!!2)
else decrgb ""