colour-2.3.6/0000755000175000001440000000000014065123577014115 5ustar00roconnorusers00000000000000colour-2.3.6/Setup.lhs0000644000175000001440000000011714065123577015724 0ustar00roconnorusers00000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain colour-2.3.6/README0000644000175000001440000000117214065123577014776 0ustar00roconnorusers00000000000000I hope for this library to become the standard colour library for Haskell. Most software does not properly blend colours because they fail to gamma-correct the colours before blending. Hopefully by using this library, Haskell programs dealing with colour blending will avoid this problem. There are some optimizing RULES pragmas that could be added to improve preformance. If you are having performace issues with colour, please let me know, and we will test some of these pragmas. Bug reports and any patches are also welcome. Be warned, I haven't extensively tested this library yet. -- Russell O'Connor colour-2.3.6/CHANGELOG0000644000175000001440000000132014065123577015323 0ustar00roconnorusers00000000000000New in version 2.3.6: - Minimum base of 4.13. - Locked down non-colour imports. - Made semigroup instances canonical. - Updated dependencies (for testing). New in version 2.3.5: - Support for MonadFail Proposal. - Documentation updates. New in version 2.3.4: - Support for Semigroup (as superclass of) Monoid Proposal. - Add test-suite to cabal file. New in version 2.3.3: - Support for GHC 7.4 from Eugene Kirpichov. New in version 2.3.2: - Support for GHC 7.4.1 from Brent Yorgey. - Documentation fixes. New in version 2.3.1: - Fixed Data.Colour.Names colour documenation. New in version 2.3: - black exported by Data.Colour - CIELAB conversion functions New in version 2.2.1: - Additional Documenation colour-2.3.6/Data/0000755000175000001440000000000014065123576014765 5ustar00roconnorusers00000000000000colour-2.3.6/Data/Colour/0000755000175000001440000000000014065123577016231 5ustar00roconnorusers00000000000000colour-2.3.6/Data/Colour/Names.hs0000644000175000001440000005147714065123577017646 0ustar00roconnorusers00000000000000{- Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |Names for colours. -- Names taken from SVG 1.1 specification, -- . -- -- 'readColourName' takes a string naming a colour (must be all lowercase) -- and returns the colour. -- Fails if the name is not recognized. module Data.Colour.Names ( readColourName ,aliceblue ,antiquewhite ,aqua ,aquamarine ,azure ,beige ,bisque ,black ,blanchedalmond ,blue ,blueviolet ,brown ,burlywood ,cadetblue ,chartreuse ,chocolate ,coral ,cornflowerblue ,cornsilk ,crimson ,cyan ,darkblue ,darkcyan ,darkgoldenrod ,darkgray ,darkgreen ,darkgrey ,darkkhaki ,darkmagenta ,darkolivegreen ,darkorange ,darkorchid ,darkred ,darksalmon ,darkseagreen ,darkslateblue ,darkslategray ,darkslategrey ,darkturquoise ,darkviolet ,deeppink ,deepskyblue ,dimgray ,dimgrey ,dodgerblue ,firebrick ,floralwhite ,forestgreen ,fuchsia ,gainsboro ,ghostwhite ,gold ,goldenrod ,gray ,grey ,green ,greenyellow ,honeydew ,hotpink ,indianred ,indigo ,ivory ,khaki ,lavender ,lavenderblush ,lawngreen ,lemonchiffon ,lightblue ,lightcoral ,lightcyan ,lightgoldenrodyellow ,lightgray ,lightgreen ,lightgrey ,lightpink ,lightsalmon ,lightseagreen ,lightskyblue ,lightslategray ,lightslategrey ,lightsteelblue ,lightyellow ,lime ,limegreen ,linen ,magenta ,maroon ,mediumaquamarine ,mediumblue ,mediumorchid ,mediumpurple ,mediumseagreen ,mediumslateblue ,mediumspringgreen ,mediumturquoise ,mediumvioletred ,midnightblue ,mintcream ,mistyrose ,moccasin ,navajowhite ,navy ,oldlace ,olive ,olivedrab ,orange ,orangered ,orchid ,palegoldenrod ,palegreen ,paleturquoise ,palevioletred ,papayawhip ,peachpuff ,peru ,pink ,plum ,powderblue ,purple ,red ,rosybrown ,royalblue ,saddlebrown ,salmon ,sandybrown ,seagreen ,seashell ,sienna ,silver ,skyblue ,slateblue ,slategray ,slategrey ,snow ,springgreen ,steelblue ,tan ,teal ,thistle ,tomato ,turquoise ,violet ,wheat ,white ,whitesmoke ,yellow ,yellowgreen ) where import Prelude hiding (tan) import qualified Control.Monad.Fail as Fail import Data.Colour.SRGB import Data.Colour (black) readColourName :: (Fail.MonadFail m, Monad m, Ord a, Floating a) => String -> m (Colour a) readColourName "aliceblue" = return aliceblue readColourName "antiquewhite" = return antiquewhite readColourName "aqua" = return aqua readColourName "aquamarine" = return aquamarine readColourName "azure" = return azure readColourName "beige" = return beige readColourName "bisque" = return bisque readColourName "black" = return black readColourName "blanchedalmond" = return blanchedalmond readColourName "blue" = return blue readColourName "blueviolet" = return blueviolet readColourName "brown" = return brown readColourName "burlywood" = return burlywood readColourName "cadetblue" = return cadetblue readColourName "chartreuse" = return chartreuse readColourName "chocolate" = return chocolate readColourName "coral" = return coral readColourName "cornflowerblue" = return cornflowerblue readColourName "cornsilk" = return cornsilk readColourName "crimson" = return crimson readColourName "cyan" = return cyan readColourName "darkblue" = return darkblue readColourName "darkcyan" = return darkcyan readColourName "darkgoldenrod" = return darkgoldenrod readColourName "darkgray" = return darkgray readColourName "darkgreen" = return darkgreen readColourName "darkgrey" = return darkgrey readColourName "darkkhaki" = return darkkhaki readColourName "darkmagenta" = return darkmagenta readColourName "darkolivegreen" = return darkolivegreen readColourName "darkorange" = return darkorange readColourName "darkorchid" = return darkorchid readColourName "darkred" = return darkred readColourName "darksalmon" = return darksalmon readColourName "darkseagreen" = return darkseagreen readColourName "darkslateblue" = return darkslateblue readColourName "darkslategray" = return darkslategray readColourName "darkslategrey" = return darkslategrey readColourName "darkturquoise" = return darkturquoise readColourName "darkviolet" = return darkviolet readColourName "deeppink" = return deeppink readColourName "deepskyblue" = return deepskyblue readColourName "dimgray" = return dimgray readColourName "dimgrey" = return dimgrey readColourName "dodgerblue" = return dodgerblue readColourName "firebrick" = return firebrick readColourName "floralwhite" = return floralwhite readColourName "forestgreen" = return forestgreen readColourName "fuchsia" = return fuchsia readColourName "gainsboro" = return gainsboro readColourName "ghostwhite" = return ghostwhite readColourName "gold" = return gold readColourName "goldenrod" = return goldenrod readColourName "gray" = return gray readColourName "grey" = return grey readColourName "green" = return green readColourName "greenyellow" = return greenyellow readColourName "honeydew" = return honeydew readColourName "hotpink" = return hotpink readColourName "indianred" = return indianred readColourName "indigo" = return indigo readColourName "ivory" = return ivory readColourName "khaki" = return khaki readColourName "lavender" = return lavender readColourName "lavenderblush" = return lavenderblush readColourName "lawngreen" = return lawngreen readColourName "lemonchiffon" = return lemonchiffon readColourName "lightblue" = return lightblue readColourName "lightcoral" = return lightcoral readColourName "lightcyan" = return lightcyan readColourName "lightgoldenrodyellow" = return lightgoldenrodyellow readColourName "lightgray" = return lightgray readColourName "lightgreen" = return lightgreen readColourName "lightgrey" = return lightgrey readColourName "lightpink" = return lightpink readColourName "lightsalmon" = return lightsalmon readColourName "lightseagreen" = return lightseagreen readColourName "lightskyblue" = return lightskyblue readColourName "lightslategray" = return lightslategray readColourName "lightslategrey" = return lightslategrey readColourName "lightsteelblue" = return lightsteelblue readColourName "lightyellow" = return lightyellow readColourName "lime" = return lime readColourName "limegreen" = return limegreen readColourName "linen" = return linen readColourName "magenta" = return magenta readColourName "maroon" = return maroon readColourName "mediumaquamarine" = return mediumaquamarine readColourName "mediumblue" = return mediumblue readColourName "mediumorchid" = return mediumorchid readColourName "mediumpurple" = return mediumpurple readColourName "mediumseagreen" = return mediumseagreen readColourName "mediumslateblue" = return mediumslateblue readColourName "mediumspringgreen" = return mediumspringgreen readColourName "mediumturquoise" = return mediumturquoise readColourName "mediumvioletred" = return mediumvioletred readColourName "midnightblue" = return midnightblue readColourName "mintcream" = return mintcream readColourName "mistyrose" = return mistyrose readColourName "moccasin" = return moccasin readColourName "navajowhite" = return navajowhite readColourName "navy" = return navy readColourName "oldlace" = return oldlace readColourName "olive" = return olive readColourName "olivedrab" = return olivedrab readColourName "orange" = return orange readColourName "orangered" = return orangered readColourName "orchid" = return orchid readColourName "palegoldenrod" = return palegoldenrod readColourName "palegreen" = return palegreen readColourName "paleturquoise" = return paleturquoise readColourName "palevioletred" = return palevioletred readColourName "papayawhip" = return papayawhip readColourName "peachpuff" = return peachpuff readColourName "peru" = return peru readColourName "pink" = return pink readColourName "plum" = return plum readColourName "powderblue" = return powderblue readColourName "purple" = return purple readColourName "red" = return red readColourName "rosybrown" = return rosybrown readColourName "royalblue" = return royalblue readColourName "saddlebrown" = return saddlebrown readColourName "salmon" = return salmon readColourName "sandybrown" = return sandybrown readColourName "seagreen" = return seagreen readColourName "seashell" = return seashell readColourName "sienna" = return sienna readColourName "silver" = return silver readColourName "skyblue" = return skyblue readColourName "slateblue" = return slateblue readColourName "slategray" = return slategray readColourName "slategrey" = return slategrey readColourName "snow" = return snow readColourName "springgreen" = return springgreen readColourName "steelblue" = return steelblue readColourName "tan" = return tan readColourName "teal" = return teal readColourName "thistle" = return thistle readColourName "tomato" = return tomato readColourName "turquoise" = return turquoise readColourName "violet" = return violet readColourName "wheat" = return wheat readColourName "white" = return white readColourName "whitesmoke" = return whitesmoke readColourName "yellow" = return yellow readColourName "yellowgreen" = return yellowgreen readColourName x = fail $ "Data.Colour.Names.readColourName: Unknown colour name "++show x aliceblue :: (Ord a, Floating a) => Colour a aliceblue = sRGB24 240 248 255 antiquewhite :: (Ord a, Floating a) => Colour a antiquewhite = sRGB24 250 235 215 aqua :: (Ord a, Floating a) => Colour a aqua = sRGB24 0 255 255 aquamarine :: (Ord a, Floating a) => Colour a aquamarine = sRGB24 127 255 212 azure :: (Ord a, Floating a) => Colour a azure = sRGB24 240 255 255 beige :: (Ord a, Floating a) => Colour a beige = sRGB24 245 245 220 bisque :: (Ord a, Floating a) => Colour a bisque = sRGB24 255 228 196 -- black is reexported from Data.Colour blanchedalmond :: (Ord a, Floating a) => Colour a blanchedalmond = sRGB24 255 235 205 blue :: (Ord a, Floating a) => Colour a blue = sRGB24 0 0 255 blueviolet :: (Ord a, Floating a) => Colour a blueviolet = sRGB24 138 43 226 brown :: (Ord a, Floating a) => Colour a brown = sRGB24 165 42 42 burlywood :: (Ord a, Floating a) => Colour a burlywood = sRGB24 222 184 135 cadetblue :: (Ord a, Floating a) => Colour a cadetblue = sRGB24 95 158 160 chartreuse :: (Ord a, Floating a) => Colour a chartreuse = sRGB24 127 255 0 chocolate :: (Ord a, Floating a) => Colour a chocolate = sRGB24 210 105 30 coral :: (Ord a, Floating a) => Colour a coral = sRGB24 255 127 80 cornflowerblue :: (Ord a, Floating a) => Colour a cornflowerblue = sRGB24 100 149 237 cornsilk :: (Ord a, Floating a) => Colour a cornsilk = sRGB24 255 248 220 crimson :: (Ord a, Floating a) => Colour a crimson = sRGB24 220 20 60 cyan :: (Ord a, Floating a) => Colour a cyan = sRGB24 0 255 255 darkblue :: (Ord a, Floating a) => Colour a darkblue = sRGB24 0 0 139 darkcyan :: (Ord a, Floating a) => Colour a darkcyan = sRGB24 0 139 139 darkgoldenrod :: (Ord a, Floating a) => Colour a darkgoldenrod = sRGB24 184 134 11 darkgray :: (Ord a, Floating a) => Colour a darkgray = sRGB24 169 169 169 darkgreen :: (Ord a, Floating a) => Colour a darkgreen = sRGB24 0 100 0 darkgrey :: (Ord a, Floating a) => Colour a darkgrey = sRGB24 169 169 169 darkkhaki :: (Ord a, Floating a) => Colour a darkkhaki = sRGB24 189 183 107 darkmagenta :: (Ord a, Floating a) => Colour a darkmagenta = sRGB24 139 0 139 darkolivegreen :: (Ord a, Floating a) => Colour a darkolivegreen = sRGB24 85 107 47 darkorange :: (Ord a, Floating a) => Colour a darkorange = sRGB24 255 140 0 darkorchid :: (Ord a, Floating a) => Colour a darkorchid = sRGB24 153 50 204 darkred :: (Ord a, Floating a) => Colour a darkred = sRGB24 139 0 0 darksalmon :: (Ord a, Floating a) => Colour a darksalmon = sRGB24 233 150 122 darkseagreen :: (Ord a, Floating a) => Colour a darkseagreen = sRGB24 143 188 143 darkslateblue :: (Ord a, Floating a) => Colour a darkslateblue = sRGB24 72 61 139 darkslategray :: (Ord a, Floating a) => Colour a darkslategray = sRGB24 47 79 79 darkslategrey :: (Ord a, Floating a) => Colour a darkslategrey = sRGB24 47 79 79 darkturquoise :: (Ord a, Floating a) => Colour a darkturquoise = sRGB24 0 206 209 darkviolet :: (Ord a, Floating a) => Colour a darkviolet = sRGB24 148 0 211 deeppink :: (Ord a, Floating a) => Colour a deeppink = sRGB24 255 20 147 deepskyblue :: (Ord a, Floating a) => Colour a deepskyblue = sRGB24 0 191 255 dimgray :: (Ord a, Floating a) => Colour a dimgray = sRGB24 105 105 105 dimgrey :: (Ord a, Floating a) => Colour a dimgrey = sRGB24 105 105 105 dodgerblue :: (Ord a, Floating a) => Colour a dodgerblue = sRGB24 30 144 255 firebrick :: (Ord a, Floating a) => Colour a firebrick = sRGB24 178 34 34 floralwhite :: (Ord a, Floating a) => Colour a floralwhite = sRGB24 255 250 240 forestgreen :: (Ord a, Floating a) => Colour a forestgreen = sRGB24 34 139 34 fuchsia :: (Ord a, Floating a) => Colour a fuchsia = sRGB24 255 0 255 gainsboro :: (Ord a, Floating a) => Colour a gainsboro = sRGB24 220 220 220 ghostwhite :: (Ord a, Floating a) => Colour a ghostwhite = sRGB24 248 248 255 gold :: (Ord a, Floating a) => Colour a gold = sRGB24 255 215 0 goldenrod :: (Ord a, Floating a) => Colour a goldenrod = sRGB24 218 165 32 gray :: (Ord a, Floating a) => Colour a gray = sRGB24 128 128 128 grey :: (Ord a, Floating a) => Colour a grey = sRGB24 128 128 128 green :: (Ord a, Floating a) => Colour a green = sRGB24 0 128 0 greenyellow :: (Ord a, Floating a) => Colour a greenyellow = sRGB24 173 255 47 honeydew :: (Ord a, Floating a) => Colour a honeydew = sRGB24 240 255 240 hotpink :: (Ord a, Floating a) => Colour a hotpink = sRGB24 255 105 180 indianred :: (Ord a, Floating a) => Colour a indianred = sRGB24 205 92 92 indigo :: (Ord a, Floating a) => Colour a indigo = sRGB24 75 0 130 ivory :: (Ord a, Floating a) => Colour a ivory = sRGB24 255 255 240 khaki :: (Ord a, Floating a) => Colour a khaki = sRGB24 240 230 140 lavender :: (Ord a, Floating a) => Colour a lavender = sRGB24 230 230 250 lavenderblush :: (Ord a, Floating a) => Colour a lavenderblush = sRGB24 255 240 245 lawngreen :: (Ord a, Floating a) => Colour a lawngreen = sRGB24 124 252 0 lemonchiffon :: (Ord a, Floating a) => Colour a lemonchiffon = sRGB24 255 250 205 lightblue :: (Ord a, Floating a) => Colour a lightblue = sRGB24 173 216 230 lightcoral :: (Ord a, Floating a) => Colour a lightcoral = sRGB24 240 128 128 lightcyan :: (Ord a, Floating a) => Colour a lightcyan = sRGB24 224 255 255 lightgoldenrodyellow :: (Ord a, Floating a) => Colour a lightgoldenrodyellow = sRGB24 250 250 210 lightgray :: (Ord a, Floating a) => Colour a lightgray = sRGB24 211 211 211 lightgreen :: (Ord a, Floating a) => Colour a lightgreen = sRGB24 144 238 144 lightgrey :: (Ord a, Floating a) => Colour a lightgrey = sRGB24 211 211 211 lightpink :: (Ord a, Floating a) => Colour a lightpink = sRGB24 255 182 193 lightsalmon :: (Ord a, Floating a) => Colour a lightsalmon = sRGB24 255 160 122 lightseagreen :: (Ord a, Floating a) => Colour a lightseagreen = sRGB24 32 178 170 lightskyblue :: (Ord a, Floating a) => Colour a lightskyblue = sRGB24 135 206 250 lightslategray :: (Ord a, Floating a) => Colour a lightslategray = sRGB24 119 136 153 lightslategrey :: (Ord a, Floating a) => Colour a lightslategrey = sRGB24 119 136 153 lightsteelblue :: (Ord a, Floating a) => Colour a lightsteelblue = sRGB24 176 196 222 lightyellow :: (Ord a, Floating a) => Colour a lightyellow = sRGB24 255 255 224 lime :: (Ord a, Floating a) => Colour a lime = sRGB24 0 255 0 limegreen :: (Ord a, Floating a) => Colour a limegreen = sRGB24 50 205 50 linen :: (Ord a, Floating a) => Colour a linen = sRGB24 250 240 230 magenta :: (Ord a, Floating a) => Colour a magenta = sRGB24 255 0 255 maroon :: (Ord a, Floating a) => Colour a maroon = sRGB24 128 0 0 mediumaquamarine :: (Ord a, Floating a) => Colour a mediumaquamarine = sRGB24 102 205 170 mediumblue :: (Ord a, Floating a) => Colour a mediumblue = sRGB24 0 0 205 mediumorchid :: (Ord a, Floating a) => Colour a mediumorchid = sRGB24 186 85 211 mediumpurple :: (Ord a, Floating a) => Colour a mediumpurple = sRGB24 147 112 219 mediumseagreen :: (Ord a, Floating a) => Colour a mediumseagreen = sRGB24 60 179 113 mediumslateblue :: (Ord a, Floating a) => Colour a mediumslateblue = sRGB24 123 104 238 mediumspringgreen :: (Ord a, Floating a) => Colour a mediumspringgreen = sRGB24 0 250 154 mediumturquoise :: (Ord a, Floating a) => Colour a mediumturquoise = sRGB24 72 209 204 mediumvioletred :: (Ord a, Floating a) => Colour a mediumvioletred = sRGB24 199 21 133 midnightblue :: (Ord a, Floating a) => Colour a midnightblue = sRGB24 25 25 112 mintcream :: (Ord a, Floating a) => Colour a mintcream = sRGB24 245 255 250 mistyrose :: (Ord a, Floating a) => Colour a mistyrose = sRGB24 255 228 225 moccasin :: (Ord a, Floating a) => Colour a moccasin = sRGB24 255 228 181 navajowhite :: (Ord a, Floating a) => Colour a navajowhite = sRGB24 255 222 173 navy :: (Ord a, Floating a) => Colour a navy = sRGB24 0 0 128 oldlace :: (Ord a, Floating a) => Colour a oldlace = sRGB24 253 245 230 olive :: (Ord a, Floating a) => Colour a olive = sRGB24 128 128 0 olivedrab :: (Ord a, Floating a) => Colour a olivedrab = sRGB24 107 142 35 orange :: (Ord a, Floating a) => Colour a orange = sRGB24 255 165 0 orangered :: (Ord a, Floating a) => Colour a orangered = sRGB24 255 69 0 orchid :: (Ord a, Floating a) => Colour a orchid = sRGB24 218 112 214 palegoldenrod :: (Ord a, Floating a) => Colour a palegoldenrod = sRGB24 238 232 170 palegreen :: (Ord a, Floating a) => Colour a palegreen = sRGB24 152 251 152 paleturquoise :: (Ord a, Floating a) => Colour a paleturquoise = sRGB24 175 238 238 palevioletred :: (Ord a, Floating a) => Colour a palevioletred = sRGB24 219 112 147 papayawhip :: (Ord a, Floating a) => Colour a papayawhip = sRGB24 255 239 213 peachpuff :: (Ord a, Floating a) => Colour a peachpuff = sRGB24 255 218 185 peru :: (Ord a, Floating a) => Colour a peru = sRGB24 205 133 63 pink :: (Ord a, Floating a) => Colour a pink = sRGB24 255 192 203 plum :: (Ord a, Floating a) => Colour a plum = sRGB24 221 160 221 powderblue :: (Ord a, Floating a) => Colour a powderblue = sRGB24 176 224 230 purple :: (Ord a, Floating a) => Colour a purple = sRGB24 128 0 128 red :: (Ord a, Floating a) => Colour a red = sRGB24 255 0 0 rosybrown :: (Ord a, Floating a) => Colour a rosybrown = sRGB24 188 143 143 royalblue :: (Ord a, Floating a) => Colour a royalblue = sRGB24 65 105 225 saddlebrown :: (Ord a, Floating a) => Colour a saddlebrown = sRGB24 139 69 19 salmon :: (Ord a, Floating a) => Colour a salmon = sRGB24 250 128 114 sandybrown :: (Ord a, Floating a) => Colour a sandybrown = sRGB24 244 164 96 seagreen :: (Ord a, Floating a) => Colour a seagreen = sRGB24 46 139 87 seashell :: (Ord a, Floating a) => Colour a seashell = sRGB24 255 245 238 sienna :: (Ord a, Floating a) => Colour a sienna = sRGB24 160 82 45 silver :: (Ord a, Floating a) => Colour a silver = sRGB24 192 192 192 skyblue :: (Ord a, Floating a) => Colour a skyblue = sRGB24 135 206 235 slateblue :: (Ord a, Floating a) => Colour a slateblue = sRGB24 106 90 205 slategray :: (Ord a, Floating a) => Colour a slategray = sRGB24 112 128 144 slategrey :: (Ord a, Floating a) => Colour a slategrey = sRGB24 112 128 144 snow :: (Ord a, Floating a) => Colour a snow = sRGB24 255 250 250 springgreen :: (Ord a, Floating a) => Colour a springgreen = sRGB24 0 255 127 steelblue :: (Ord a, Floating a) => Colour a steelblue = sRGB24 70 130 180 tan :: (Ord a, Floating a) => Colour a tan = sRGB24 210 180 140 teal :: (Ord a, Floating a) => Colour a teal = sRGB24 0 128 128 thistle :: (Ord a, Floating a) => Colour a thistle = sRGB24 216 191 216 tomato :: (Ord a, Floating a) => Colour a tomato = sRGB24 255 99 71 turquoise :: (Ord a, Floating a) => Colour a turquoise = sRGB24 64 224 208 violet :: (Ord a, Floating a) => Colour a violet = sRGB24 238 130 238 wheat :: (Ord a, Floating a) => Colour a wheat = sRGB24 245 222 179 white :: (Ord a, Floating a) => Colour a white = sRGB24 255 255 255 whitesmoke :: (Ord a, Floating a) => Colour a whitesmoke = sRGB24 245 245 245 yellow :: (Ord a, Floating a) => Colour a yellow = sRGB24 255 255 0 yellowgreen :: (Ord a, Floating a) => Colour a yellowgreen = sRGB24 154 205 50 colour-2.3.6/Data/Colour/RGB.hs0000644000175000001440000001061514065123577017202 0ustar00roconnorusers00000000000000{- Copyright (c) 2008,2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.RGB where import Data.List (elemIndex, transpose) import Data.Colour.Matrix import Data.Colour.CIE.Chromaticity -- |An RGB triple for an unspecified colour space. data RGB a = RGB {channelRed :: !a ,channelGreen :: !a ,channelBlue :: !a } deriving (Eq, Show, Read) instance Functor RGB where fmap f (RGB r g b) = RGB (f r) (f g) (f b) instance Applicative RGB where pure c = RGB c c c (RGB fr fg fb) <*> (RGB r g b) = RGB (fr r) (fg g) (fb b) -- |Uncurries a function expecting three r, g, b parameters. uncurryRGB :: (a -> a -> a -> b) -> RGB a -> b uncurryRGB f (RGB r g b) = f r g b -- |Curries a function expecting one RGB parameter. curryRGB :: (RGB a -> b) -> a -> a -> a -> b curryRGB f r g b = f (RGB r g b) -- |An 'RGBGamut' is a 3-D colour “cube” that contains all the -- colours that can be displayed by a RGB device. -- The “cube” is normalized so that white has -- 'Data.Colour.CIE.luminance' 1. data RGBGamut = RGBGamut {primaries :: !(RGB (Chromaticity Rational)) ,whitePoint :: !(Chromaticity Rational) } deriving (Eq) instance Show RGBGamut where showsPrec d gamut = showParen (d > app_prec) showStr where showStr = showString "mkRGBGamut" . showString " " . (showsPrec (app_prec+1) (primaries gamut)) . showString " " . (showsPrec (app_prec+1) (whitePoint gamut)) instance Read RGBGamut where readsPrec d r = readParen (d > app_prec) (\r -> [(mkRGBGamut p w,t) |("mkRGBGamut",s) <- lex r ,(p,s0) <- readsPrec (app_prec+1) s ,(w,t) <- readsPrec (app_prec+1) s0]) r -- |An RGB gamut is specified by three primary colours (red, green, and -- blue) and a white point (often 'Data.Colour.CIE.Illuminant.d65'). mkRGBGamut :: RGB (Chromaticity Rational) -- ^ The three primaries -> Chromaticity Rational -- ^ The white point -> RGBGamut mkRGBGamut = RGBGamut {- not for export -} primaryMatrix :: (Fractional a) => (RGB (Chromaticity a)) -> [[a]] primaryMatrix p = [[xr, xg, xb] ,[yr, yg, yb] ,[zr, zg, zb]] where RGB (xr, yr, zr) (xg, yg, zg) (xb, yb, zb) = fmap chromaCoords p rgb2xyz :: RGBGamut -> [[Rational]] rgb2xyz space = transpose (zipWith (map . (*)) as (transpose matrix)) where (xn, yn, zn) = chromaCoords (whitePoint space) matrix = primaryMatrix (primaries space) as = mult (inverse matrix) [xn/yn, 1, zn/yn] xyz2rgb :: RGBGamut -> [[Rational]] xyz2rgb = inverse . rgb2xyz hslsv :: (Fractional a, Ord a) => RGB a -> (a,a,a,a,a) hslsv (RGB r g b) | mx == mn = (0,0,mx,0 ,mx) | otherwise = (h,s,l ,s0,mx) where mx = maximum [r,g,b] mn = minimum [r,g,b] l = (mx+mn)/2 s | l <= 0.5 = (mx-mn)/(mx+mn) | otherwise = (mx-mn)/(2-(mx+mn)) s0 = (mx-mn)/mx -- hue calcuation [x,y,z] = take 3 $ dropWhile (/=mx) [r,g,b,r,g] Just o = elemIndex mx [r,g,b] h0 = 60*(y-z)/(mx-mn) + 120*(fromIntegral o) h | h0 < 0 = h0 + 360 | otherwise = h0 -- |The 'hue' coordinate of an 'RGB' value is in degrees. Its value is -- always in the range 0-360. hue :: (Fractional a, Ord a) => RGB a -> a hue rgb = h where (h,_,_,_,_) = hslsv rgb mod1 x | pf < 0 = pf+1 | otherwise = pf where (_,pf) = properFraction x colour-2.3.6/Data/Colour/Matrix.hs0000644000175000001440000000301514065123577020030 0ustar00roconnorusers00000000000000{- Copyright (c) 2008 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.Matrix where import Data.List (transpose) default (Rational) inverse m@[[a,b,c],[d,e,f],[g,h,i]] = [[(e*i-f*h)/det, -(b*i-c*h)/det, (b*f-c*e)/det] ,[-(d*i-f*g)/det, (a*i-c*g)/det, -(a*f-c*d)/det] ,[(d*h-e*g)/det, -(a*h-b*g)/det, (a*e-b*d)/det]] where det = determinant m determinant [[a,b,c],[d,e,f],[g,h,i]] = a*(e*i-f*h) - b*(d*i-f*g) + c*(d*h-e*g) mult l x = map (sum . (zipWith (*) x)) l matrixMult l m = transpose (map (mult l) (transpose m)) colour-2.3.6/Data/Colour/Internal.hs0000644000175000001440000001721314065123577020345 0ustar00roconnorusers00000000000000{- Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.Internal where import Data.List (foldl1') import qualified Data.Colour.Chan as Chan import Data.Colour.Chan (Chan(Chan)) data Red = Red data Green = Green data Blue = Blue -- |This type represents the human preception of colour. -- The @a@ parameter is a numeric type used internally for the -- representation. -- -- The 'Monoid' instance allows one to add colours, but beware that adding -- colours can take you out of gamut. Consider using 'blend' whenever -- possible. -- Internally we store the colour in linear ITU-R BT.709 RGB colour space. data Colour a = RGB !(Chan Red a) !(Chan Green a) !(Chan Blue a) deriving (Eq) -- |Change the type used to represent the colour coordinates. colourConvert :: (Fractional b, Real a) => Colour a -> Colour b colourConvert (RGB r g b) = RGB (Chan.convert r) (Chan.convert g) (Chan.convert b) -- 'black' is the colourless colour. It is the identity colour in -- additive colour spaces. black :: (Num a) => Colour a black = RGB Chan.empty Chan.empty Chan.empty instance (Num a) => Semigroup (Colour a) where (RGB r1 g1 b1) <> (RGB r2 g2 b2) = RGB (r1 `Chan.add` r2) (g1 `Chan.add` g2) (b1 `Chan.add` b2) instance (Num a) => Monoid (Colour a) where mempty = black mconcat l = RGB (Chan.sum lr) (Chan.sum lg) (Chan.sum lb) where (lr,lg,lb) = unzip3 (map toRGB l) toRGB (RGB r g b) = (r,g,b) data Alpha = Alpha -- |This type represents a 'Colour' that may be semi-transparent. -- -- The 'Monoid' instance allows you to composite colours. -- -- >x `mappend` y == x `over` y -- -- To get the (pre-multiplied) colour channel of an 'AlphaColour' @c@, -- simply composite @c@ over black. -- -- >c `over` black -- Internally we use a premultiplied-alpha representation. data AlphaColour a = RGBA !(Colour a) !(Chan Alpha a) deriving (Eq) -- |This 'AlphaColour' is entirely transparent and has no associated -- colour channel. transparent :: (Num a) => AlphaColour a transparent = RGBA (RGB Chan.empty Chan.empty Chan.empty) Chan.empty -- |Change the type used to represent the colour coordinates. alphaColourConvert :: (Fractional b, Real a) => AlphaColour a -> AlphaColour b alphaColourConvert (RGBA c a) = RGBA (colourConvert c) (Chan.convert a) -- |Creates an opaque 'AlphaColour' from a 'Colour'. opaque :: (Num a) => Colour a -> AlphaColour a opaque c = RGBA c Chan.full -- |Returns an 'AlphaColour' more transparent by a factor of @o@. dissolve :: (Num a) => a -> AlphaColour a -> AlphaColour a dissolve o (RGBA c a) = RGBA (darken o c) (Chan.scale o a) -- |Creates an 'AlphaColour' from a 'Colour' with a given opacity. -- -- >c `withOpacity` o == dissolve o (opaque c) withOpacity :: (Num a) => Colour a -> a -> AlphaColour a c `withOpacity` o = RGBA (darken o c) (Chan o) -------------------------------------------------------------------------- -- Blending -------------------------------------------------------------------------- class AffineSpace f where -- |Compute a affine Combination (weighted-average) of points. -- The last parameter will get the remaining weight. -- e.g. -- -- >affineCombo [(0.2,a), (0.3,b)] c == 0.2*a + 0.3*b + 0.5*c -- -- Weights can be negative, or greater than 1.0; however, be aware -- that non-convex combinations may lead to out of gamut colours. affineCombo :: (Num a) => [(a,f a)] -> f a -> f a -- |Compute the weighted average of two points. -- e.g. -- -- >blend 0.4 a b = 0.4*a + 0.6*b -- -- The weight can be negative, or greater than 1.0; however, be aware -- that non-convex combinations may lead to out of gamut colours. blend :: (Num a, AffineSpace f) => a -> f a -> f a -> f a blend weight c1 c2 = affineCombo [(weight,c1)] c2 instance AffineSpace Colour where affineCombo l z = foldl1' mappend [darken w a | (w,a) <- (1-total,z):l] where total = sum $ map fst l instance AffineSpace AlphaColour where affineCombo l z = foldl1' rgbaAdd [dissolve w a | (w,a) <- (1-total,z):l] where total = sum $ map fst l -------------------------------------------------------------------------- -- composite -------------------------------------------------------------------------- class ColourOps f where -- |@c1 \`over\` c2@ returns the 'Colour' created by compositing the -- 'AlphaColour' @c1@ over @c2@, which may be either a 'Colour' or -- 'AlphaColour'. over :: (Num a) => AlphaColour a -> f a -> f a -- |@darken s c@ blends a colour with black without changing it's opacity. -- -- For 'Colour', @darken s c = blend s c mempty@ darken :: (Num a) => a -> f a -> f a instance ColourOps Colour where (RGBA (RGB r0 g0 b0) (Chan a0)) `over` (RGB r1 g1 b1) = RGB (Chan.over r0 a0 r1) (Chan.over g0 a0 g1) (Chan.over b0 a0 b1) darken s (RGB r g b) = RGB (Chan.scale s r) (Chan.scale s g) (Chan.scale s b) instance ColourOps AlphaColour where c0@(RGBA _ a0@(Chan a0')) `over` (RGBA c1 a1) = RGBA (c0 `over` c1) (Chan.over a0 a0' a1) darken s (RGBA c a) = RGBA (darken s c) a -- | 'AlphaColour' forms a monoid with 'over' and 'transparent'. instance (Num a) => Semigroup (AlphaColour a) where (<>) = over instance (Num a) => Monoid (AlphaColour a) where mempty = transparent -- | @c1 \`atop\` c2@ returns the 'AlphaColour' produced by covering -- the portion of @c2@ visible by @c1@. -- The resulting alpha channel is always the same as the alpha channel -- of @c2@. -- -- >c1 `atop` (opaque c2) == c1 `over` (opaque c2) -- >AlphaChannel (c1 `atop` c2) == AlphaChannel c2 atop :: (Fractional a) => AlphaColour a -> AlphaColour a -> AlphaColour a atop (RGBA c0 (Chan a0)) (RGBA c1 (Chan a1)) = RGBA (darken a1 c0 `mappend` darken (1-a0) c1) (Chan a1) -- |'round's and then clamps @x@ between 0 and 'maxBound'. quantize :: (RealFrac a1, Integral a, Bounded a) => a1 -> a quantize x | x <= fromIntegral l = l | fromIntegral h <= x = h | otherwise = round x where l = minBound h = maxBound {- Avoid using -} -- |Returns the opacity of an 'AlphaColour'. alphaChannel :: AlphaColour a -> a alphaChannel (RGBA _ (Chan a)) = a -- |Returns the colour of an 'AlphaColour'. -- @colourChannel transparent@ is undefined and may result in @nan@ or an -- error. -- Its use is discouraged. -- If you are desperate, use -- -- >darken (recip (alphaChannel c)) (c `over` black) colourChannel :: (Fractional a) => AlphaColour a -> Colour a colourChannel (RGBA c (Chan a)) = darken (recip a) c -------------------------------------------------------------------------- -- not for export -------------------------------------------------------------------------- rgbaAdd (RGBA c1 a1) (RGBA c2 a2) = RGBA (c1 `mappend` c2) (a1 `Chan.add` a2) colour-2.3.6/Data/Colour/CIE/0000755000175000001440000000000014065123577016631 5ustar00roconnorusers00000000000000colour-2.3.6/Data/Colour/CIE/Chromaticity.hs0000644000175000001440000000616614065123577021635 0ustar00roconnorusers00000000000000{- Copyright (c) 2008 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.CIE.Chromaticity where data Chromaticity a = Chroma !a !a deriving (Eq) -- |Constructs 'Chromaticity' from the CIE little /x/, little /y/ -- coordinates for the 2° standard (colourimetric) observer. mkChromaticity :: (Fractional a) => a -> a -> Chromaticity a mkChromaticity = Chroma -- |Returns the CIE little /x/, little /y/, little /z/ coordinates -- for the 2° standard (colourimetric) observer. chromaCoords :: (Fractional a) => Chromaticity a -> (a, a, a) chromaCoords (Chroma x y) = (x, y, 1 - x - y) -- |Returns the CIE little /x/ coordinate -- for the 2° standard (colourimetric) observer. chromaX :: (Fractional a) => Chromaticity a -> a chromaX (Chroma x _y) = x -- |Returns the CIE little /y/ coordinate -- for the 2° standard (colourimetric) observer. chromaY :: (Fractional a) => Chromaticity a -> a chromaY (Chroma _x y) = y -- |Returns the CIE little /z/ coordinate -- for the 2° standard (colourimetric) observer. chromaZ :: (Fractional a) => Chromaticity a -> a chromaZ (Chroma x y) = 1 - x - y -- |Change the type used to represent the chromaticity coordinates. chromaConvert :: (Fractional b, Real a) => Chromaticity a -> Chromaticity b chromaConvert (Chroma x y) = Chroma (realToFrac x) (realToFrac y) instance (Fractional a, Show a) => Show (Chromaticity a) where showsPrec d c = showParen (d > app_prec) showStr where showStr = showString "mkChromaticity " . (showsPrec (app_prec+1) x) . showString " " . (showsPrec (app_prec+1) y) (x,y,z) = chromaCoords c instance (Fractional a, Read a) => Read (Chromaticity a) where readsPrec d r = readParen (d > app_prec) (\r -> [(mkChromaticity x y,t) |("mkChromaticity",s) <- lex r ,(x,s0) <- readsPrec (app_prec+1) s ,(y,t) <- readsPrec (app_prec+1) s0]) r -------------------------------------------------------------------------- -- not for export -------------------------------------------------------------------------- app_prec = 10 infix_prec = 9 `asTypeOf` app_prec colour-2.3.6/Data/Colour/CIE/Illuminant.hs0000644000175000001440000000654614065123576021313 0ustar00roconnorusers00000000000000{- Copyright (c) 2008 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |Standard illuminants defined by the International Commission on -- Illumination (CIE). module Data.Colour.CIE.Illuminant where import Data.Colour.CIE.Chromaticity -- |Incandescent \/ Tungsten a :: (Fractional a) => Chromaticity a a = mkChromaticity 0.44757 0.40745 -- |{obsolete} Direct sunlight at noon b :: (Fractional a) => Chromaticity a b = mkChromaticity 0.34842 0.35161 -- |{obsolete} Average \/ North sky Daylight c :: (Fractional a) => Chromaticity a c = mkChromaticity 0.31006 0.31616 -- |Horizon Light. ICC profile PCS d50 :: (Fractional a) => Chromaticity a d50 = mkChromaticity 0.34567 0.35850 -- |Mid-morning \/ Mid-afternoon Daylight d55 :: (Fractional a) => Chromaticity a d55 = mkChromaticity 0.33242 0.34743 -- |Noon Daylight: Television, sRGB color space d65 :: (Fractional a) => Chromaticity a d65 = mkChromaticity 0.31271 0.32902 -- |North sky Daylight d75 :: (Fractional a) => Chromaticity a d75 = mkChromaticity 0.29902 0.31485 -- |Equal energy e :: (Fractional a) => Chromaticity a e = mkChromaticity (1/3) (1/3) -- |Daylight Fluorescent f1 :: (Fractional a) => Chromaticity a f1 = mkChromaticity 0.31310 0.33727 -- |Cool White Fluorescent f2 :: (Fractional a) => Chromaticity a f2 = mkChromaticity 0.37208 0.37529 -- |White Fluorescent f3 :: (Fractional a) => Chromaticity a f3 = mkChromaticity 0.40910 0.39430 -- |Warm White Fluorescent f4 :: (Fractional a) => Chromaticity a f4 = mkChromaticity 0.44018 0.40329 -- |Daylight Fluorescent f5 :: (Fractional a) => Chromaticity a f5 = mkChromaticity 0.31379 0.34531 -- |Lite White Fluorescent f6 :: (Fractional a) => Chromaticity a f6 = mkChromaticity 0.37790 0.38835 -- |D65 simulator, Daylight simulator f7 :: (Fractional a) => Chromaticity a f7 = mkChromaticity 0.31292 0.32933 -- |D50 simulator, Sylvania F40 Design 50 f8 :: (Fractional a) => Chromaticity a f8 = mkChromaticity 0.34588 0.35875 -- |Cool White Deluxe Fluorescent f9 :: (Fractional a) => Chromaticity a f9 = mkChromaticity 0.37417 0.37281 -- |Philips TL85, Ultralume 50 f10 :: (Fractional a) => Chromaticity a f10 = mkChromaticity 0.34609 0.35986 -- |Philips TL84, Ultralume 40 f11 :: (Fractional a) => Chromaticity a f11 = mkChromaticity 0.38052 0.37713 -- |Philips TL83, Ultralume 30 f12 :: (Fractional a) => Chromaticity a f12 = mkChromaticity 0.43695 0.40441 colour-2.3.6/Data/Colour/SRGB/0000755000175000001440000000000014065123576016765 5ustar00roconnorusers00000000000000colour-2.3.6/Data/Colour/SRGB/Linear.hs0000644000175000001440000000413514065123576020536 0ustar00roconnorusers00000000000000{-# OPTIONS_HADDOCK not-home #-} {- Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |Provides a /linear/ colour space with the same gamut as -- "Data.Colour.SRGB". module Data.Colour.SRGB.Linear (Colour, RGB(..) ,rgb, toRGB ,sRGBGamut ) where import qualified Data.Colour.Internal as Internal(Colour(RGB)) import Data.Colour.Internal (Colour) import Data.Colour.Chan import Data.Colour.RGB import Data.Colour.CIE.Chromaticity import Data.Colour.CIE.Illuminant (d65) -- |Constructs a 'Colour' from RGB values using the /linear/ RGB colour -- with the same gamut as sRGB. rgb :: Fractional a => a -> a -> a -> Colour a rgb r g b = Internal.RGB (Chan r) (Chan g) (Chan b) -- |Return RGB values using the /linear/ RGB colour with the same gamut -- as sRGB. toRGB :: Fractional a => Colour a -> RGB a toRGB (Internal.RGB (Chan r) (Chan g) (Chan b)) = RGB r g b -- |This is the gamut for the sRGB colour space. sRGBGamut :: RGBGamut sRGBGamut = RGBGamut (RGB (mkChromaticity 0.64 0.33) (mkChromaticity 0.30 0.60) (mkChromaticity 0.15 0.06)) d65 colour-2.3.6/Data/Colour/RGBSpace.hs0000644000175000001440000001247314065123577020162 0ustar00roconnorusers00000000000000{- Copyright (c) 2008 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |An 'RGBSpace' is characterized by 'Chromaticity' for red, green, and -- blue, the 'Chromaticity' of the white point, and it's -- 'TransferFunction'. module Data.Colour.RGBSpace (Colour -- *RGB Tuple ,RGB(..) ,uncurryRGB, curryRGB -- *RGB Gamut ,RGBGamut ,mkRGBGamut, primaries, whitePoint ,inGamut -- *RGB Space ,TransferFunction(..) ,linearTransferFunction, powerTransferFunction ,inverseTransferFunction ,RGBSpace() ,mkRGBSpace ,gamut, transferFunction ,linearRGBSpace ,rgbUsingSpace ,toRGBUsingSpace ) where import Data.Colour.CIE.Chromaticity import Data.Colour.Matrix import Data.Colour.RGB import Data.Colour.SRGB.Linear -- |Returns 'True' if the given colour lies inside the given gamut. inGamut :: (Ord a, Fractional a) => RGBGamut -> Colour a -> Bool inGamut gamut c = r && g && b where test x = 0 <= x && x <= 1 RGB r g b = fmap test (toRGBUsingGamut gamut c) rtf :: (Fractional b, Real a) => [[a]] -> [[b]] rtf = map (map realToFrac) rgbUsingGamut :: (Fractional a) => RGBGamut -> a -> a -> a -> Colour a rgbUsingGamut gamut r g b = rgb r0 g0 b0 where matrix = rtf $ matrixMult (xyz2rgb sRGBGamut) (rgb2xyz gamut) [r0,g0,b0] = mult matrix [r,g,b] toRGBUsingGamut :: (Fractional a) => RGBGamut -> Colour a -> RGB a toRGBUsingGamut gamut c = RGB r g b where RGB r0 g0 b0 = toRGB c matrix = rtf $ matrixMult (xyz2rgb gamut) (rgb2xyz sRGBGamut) [r,g,b] = mult matrix [r0,g0,b0] -- |A 'transfer' function is a function that typically translates linear -- colour space coordinates into non-linear coordinates. -- The 'transferInverse' function reverses this by translating non-linear -- colour space coordinates into linear coordinates. -- It is required that -- -- > transfer . transferInverse === id === transferInverse . inverse -- -- (or that this law holds up to floating point rounding errors). -- -- We also require that 'transfer' is approximately @(**transferGamma)@ -- (and hence 'transferInverse' is approximately -- @(**(recip transferGamma))@). -- The value 'transferGamma' is for informational purposes only, so there -- is no bound on how good this approximation needs to be. data TransferFunction a = TransferFunction { transfer :: a -> a , transferInverse :: a -> a , transferGamma :: a } -- |This is the identity 'TransferFunction'. linearTransferFunction :: (Num a) => TransferFunction a linearTransferFunction = TransferFunction id id 1 -- |This is the @(**gamma)@ 'TransferFunction'. powerTransferFunction :: (Floating a) => a -> TransferFunction a powerTransferFunction gamma = TransferFunction (**gamma) (**(recip gamma)) gamma -- |This reverses a 'TransferFunction'. inverseTransferFunction :: (Fractional a) => TransferFunction a -> TransferFunction a inverseTransferFunction (TransferFunction for rev g) = TransferFunction rev for (recip g) instance (Num a) => Semigroup (TransferFunction a) where (TransferFunction f0 f1 f) <> (TransferFunction g0 g1 g) = (TransferFunction (f0 . g0) (g1 . f1) (f*g)) instance (Num a) => Monoid (TransferFunction a) where mempty = linearTransferFunction -- |An 'RGBSpace' is a colour coordinate system for colours laying -- 'inGamut' of 'gamut'. -- Linear coordinates are passed through a 'transferFunction' to -- produce non-linear 'RGB' values. data RGBSpace a = RGBSpace { gamut :: RGBGamut, transferFunction :: TransferFunction a } -- |An RGBSpace is specified by an 'RGBGamut' and a 'TransferFunction'. mkRGBSpace :: RGBGamut -> TransferFunction a -> RGBSpace a mkRGBSpace = RGBSpace -- |Produce a linear colour space from an 'RGBGamut'. linearRGBSpace :: (Num a) => RGBGamut -> RGBSpace a linearRGBSpace gamut = RGBSpace gamut mempty -- |Create a 'Colour' from red, green, and blue coordinates given in a -- general 'RGBSpace'. rgbUsingSpace :: (Fractional a) => RGBSpace a -> a -> a -> a -> Colour a rgbUsingSpace space = curryRGB (uncurryRGB (rgbUsingGamut (gamut space)) . fmap tinv) where tinv = transferInverse (transferFunction space) -- |Return the coordinates of a given 'Colour' for a general 'RGBSpace'. toRGBUsingSpace :: (Fractional a) => RGBSpace a -> Colour a -> RGB a toRGBUsingSpace space c = fmap t (toRGBUsingGamut (gamut space) c) where t = transfer (transferFunction space) colour-2.3.6/Data/Colour/RGBSpace/0000755000175000001440000000000014065123577017617 5ustar00roconnorusers00000000000000colour-2.3.6/Data/Colour/RGBSpace/HSV.hs0000644000175000001440000000460314065123577020616 0ustar00roconnorusers00000000000000{- Copyright (c) 2008,2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.RGBSpace.HSV (RGB ,hsvView ,hue, saturation, value ,hsv ) where import Data.Colour.RGB -- |Returns the HSV (hue-saturation-value) coordinates of an 'RGB' triple. -- See 'hue', 'saturation', and 'value'. hsvView :: (Fractional a, Ord a) => RGB a -> (a,a,a) hsvView rgb = (h,s,v) where (h,_,_,s,v) = hslsv rgb -- |Returns the saturation coordinate (range [0,1]) of an 'RGB' triple for the HSV -- (hue-saturation-value) system. -- Note: This is different from 'Data.Colour.RGBSpace.HSL.saturation' for -- the "Data.Colour.RGBSpace.HSL" saturation :: (Fractional a, Ord a) => RGB a -> a saturation rgb = s where (_,_,_,s,_) = hslsv rgb -- |Returns the value coordinate (raonge [0,1]) of an 'RGB' triple for the HSV -- (hue-saturation-value) system. value :: (Fractional a, Ord a) => RGB a -> a value rgb = v where (_,_,_,_,v) = hslsv rgb -- |Convert HSV (hue-saturation-value) coordinates to an 'RGB' value. -- Hue is expected to be measured in degrees [0,360], while saturation and -- value are expected to be in the closed range [0,1]. hsv :: (RealFrac a, Ord a) => a -> a -> a -> RGB a hsv h s v = case hi of 0 -> RGB v t p 1 -> RGB q v p 2 -> RGB p v t 3 -> RGB p q v 4 -> RGB t p v 5 -> RGB v p q where hi = floor (h/60) `mod` 6 f = mod1 (h/60) p = v*(1-s) q = v*(1-f*s) t = v*(1-(1-f)*s) colour-2.3.6/Data/Colour/RGBSpace/HSL.hs0000644000175000001440000000502514065123577020603 0ustar00roconnorusers00000000000000{- Copyright (c) 2008,2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.RGBSpace.HSL (RGB ,hslView ,hue, saturation, lightness ,hsl ) where import Data.Colour.RGB -- |Returns the HSL (hue-saturation-lightness) coordinates of an 'RGB' triple. -- See 'hue', 'saturation', and 'lightness'. hslView :: (Fractional a, Ord a) => RGB a -> (a,a,a) hslView rgb = (h,s,l) where (h,s,l,_,_) = hslsv rgb -- |Returns the saturation coordinate (range [0, 1]) of an 'RGB' triple for the HSL -- (hue-saturation-lightness) system. -- Note: This is different from 'Data.Colour.RGBSpace.HSV.saturation' for -- the "Data.Colour.RGBSpace.HSV" saturation :: (Fractional a, Ord a) => RGB a -> a saturation rgb = s where (_,s,_,_,_) = hslsv rgb -- |Returns the lightness coordinate (range [0, 1]) of an 'RGB' triple for the HSL -- (hue-saturation-lightness) system. lightness :: (Fractional a, Ord a) => RGB a -> a lightness rgb = l where (_,_,l,_,_) = hslsv rgb -- |Convert HSL (hue-saturation-lightness) coordinates to an 'RGB' value. -- Hue is expected to be measured in degrees [0,360], while saturation and -- lightness are expected to be in the closed range [0,1]. hsl :: (RealFrac a, Ord a) => a -> a -> a -> RGB a hsl h s l = fmap component t where hk = h/360 tr = mod1 (hk + 1/3) tg = mod1 hk tb = mod1 (hk - 1/3) t = RGB tr tg tb q | l < 0.5 = l*(1+s) | otherwise = l + s - l*s p = 2*l - q component t | t < 1/6 = p + ((q-p)*6*t) | t < 1/2 = q | t < 2/3 = p + ((q-p)*6*(2/3-t)) | otherwise = p colour-2.3.6/Data/Colour/CIE.hs0000644000175000001440000001315314065123576017167 0ustar00roconnorusers00000000000000{- Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |Colour operations defined by the International Commission on -- Illumination (CIE). module Data.Colour.CIE (Colour ,cieXYZ, cieXYZView, luminance ,toCIEXYZ -- depricated ,Chromaticity ,mkChromaticity, chromaCoords ,chromaX, chromaY, chromaZ ,chromaConvert ,chromaColour ,lightness, cieLABView, cieLAB --cieLuv ) where import Data.List (foldl1') import Data.Colour import Data.Colour.RGB import Data.Colour.SRGB.Linear import Data.Colour.CIE.Chromaticity import Data.Colour.Matrix -- |Construct a 'Colour' from XYZ coordinates for the 2° standard -- (colourimetric) observer. cieXYZ :: (Fractional a) => a -> a -> a -> Colour a cieXYZ x y z = rgb r g b where [r,g,b] = mult matrix [x,y,z] matrix = map (map fromRational) xyz2rgb709 -- |Returns the XYZ colour coordinates for the 2° standard -- (colourimetric) observer. cieXYZView :: (Fractional a) => Colour a -> (a,a,a) cieXYZView c = (x,y,z) where RGB r g b = toRGB c [x,y,z] = mult matrix [r,g,b] matrix = map (map fromRational) rgb7092xyz {-# DEPRECATED toCIEXYZ "`toCIEXYZ' has been renamed `cieXYZView'" #-} toCIEXYZ x = cieXYZView x {- CIE luminance -} -- |Returns the Y colour coordinate (luminance) for the 2° standard -- (colourimetric) observer. luminance :: (Fractional a) => Colour a -> a luminance c = y where (x,y,z) = toCIEXYZ c instance AffineSpace Chromaticity where affineCombo l z = foldl1' chromaAdd [chromaScale w a | (w,a) <- (1-total,z):l] where total = sum $ map fst l (Chroma x0 y0) `chromaAdd` (Chroma x1 y1) = Chroma (x0+x1) (y0+y1) s `chromaScale` (Chroma x y) = Chroma (s*x) (s*y) -- |Constructs a colour from the given 'Chromaticity' and 'luminance'. chromaColour :: (Fractional a) => Chromaticity a -> a -- ^ 'luminance' -> Colour a chromaColour ch y = cieXYZ (s*ch_x) y (s*ch_z) where (ch_x, ch_y, ch_z) = chromaCoords ch s = y/ch_y -- |Returns the lightness of a colour with respect to a given white point. -- Lightness is a perceptually uniform measure. lightness :: (Ord a, Floating a) => Chromaticity a -- ^White point -> Colour a -> a lightness white_ch c | (6/29)^3 < y' = 116*y'**(1/3) - 16 | otherwise = (29/3)^3*y' where white = chromaColour white_ch 1.0 y' = (luminance c/luminance white) -- |Returns the CIELAB coordinates of a colour, which is a -- perceptually uniform colour space. -- The first coordinate is 'lightness'. -- If you don't know what white point to use, use -- 'Data.Colour.CIE.Illuminant.d65'. cieLABView :: (Ord a, Floating a) => Chromaticity a -- ^White point -> Colour a -> (a,a,a) cieLABView white_ch c = (lightness white_ch c, a, b) where white = chromaColour white_ch 1.0 (x,y,z) = toCIEXYZ c (xn,yn,zn) = toCIEXYZ white (fx, fy, fz) = (f (x/xn), f (y/yn), f (z/zn)) a = 500*(fx - fy) b = 200*(fy - fz) f x | (6/29)^3 < x = x**(1/3) | otherwise = 841/108*x + 4/29 -- |Returns the colour for given CIELAB coordinates, which is a -- perceptually uniform colour space. -- If you don't know what white point to use, use -- 'Data.Colour.CIE.Illuminant.d65'. cieLAB :: (Ord a, Floating a) => Chromaticity a -- ^White point -> a -- ^L* coordinate (lightness) -> a -- ^a* coordinate -> a -- ^b* coordinate -> Colour a cieLAB white_ch l a b = cieXYZ (xn*transform fx) (yn*transform fy) (zn*transform fz) where white = chromaColour white_ch 1.0 (xn,yn,zn) = toCIEXYZ white fx = fy + a/500 fy = (l + 16)/116 fz = fy - b/200 delta = 6/29 transform fa | fa > delta = fa^3 | otherwise = (fa - 16/116)*3*delta^2 -- |Returns the CIELUV coordinates of a colour, which is a -- perceptually uniform colour space. -- If you don't know what white point to use, use -- 'Data.Colour.CIE.Illuminant.d65'. cieLuv :: (Ord a, Floating a) => Chromaticity a -- ^White point -> Colour a -> (a,a,a) cieLuv white_ch c = (l, 13*l*(u'-un'), 13*l*(v'-vn')) where white = chromaColour white_ch 1.0 (u', v') = u'v' c (un', vn') = u'v' white l = lightness white_ch c -------------------------------------------------------------------------- {- not for export -} u'v' :: (Ord a, Floating a) => Colour a -> (a,a) u'v' c = (4*x/(x+15*y+3*z), 9*y/(x+15*y+3*z)) where (x,y,z) = toCIEXYZ c rgb7092xyz = (rgb2xyz sRGBGamut) xyz2rgb709 = inverse rgb7092xyz colour-2.3.6/Data/Colour/SRGB.hs0000644000175000001440000001144014065123576017321 0ustar00roconnorusers00000000000000{- Copyright (c) 2008 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |Specifies 'Colour's in accordance with the sRGB standard. module Data.Colour.SRGB (Colour, RGB(..) ,sRGB24, sRGBBounded, sRGB ,toSRGB24, toSRGBBounded, toSRGB ,sRGB24shows, sRGB24show ,sRGB24reads, sRGB24read ,sRGBSpace ) where import Data.Word (Word8) import Numeric (readHex, showHex) import Data.Colour.Internal (quantize) import Data.Colour.SRGB.Linear import Data.Colour.RGBSpace hiding (transferFunction) {- Non-linear colour space -} {- the sRGB transfer function approximates a gamma of about 1/2.2 -} transferFunction lin | lin == 1 = 1 | lin <= 0.0031308 = 12.92*lin | otherwise = (1 + a)*lin**(1/2.4) - a where a = 0.055 invTransferFunction nonLin | nonLin == 1 = 1 | nonLin <= 0.04045 = nonLin/12.92 | otherwise = ((nonLin + a)/(1 + a))**2.4 where a = 0.055 -- |Construct a colour from an sRGB specification. -- Input components are expected to be in the range [0..1]. sRGB :: (Ord b, Floating b) => b -> b -> b -> Colour b sRGB = curryRGB (uncurryRGB rgb . fmap invTransferFunction) -- |Construct a colour from an sRGB specification. -- Input components are expected to be in the range [0..'maxBound']. sRGBBounded :: (Ord b, Floating b, Integral a, Bounded a) => a -> a -> a -> Colour b sRGBBounded r' g' b' = uncurryRGB sRGB (fmap f (RGB r' g' b')) where f x' = (fromIntegral x'/m) m = fromIntegral $ maxBound `asTypeOf` r' -- |Construct a colour from a 24-bit (three 8-bit words) sRGB -- specification. sRGB24 :: (Ord b, Floating b) => Word8 -> Word8 -> Word8 -> Colour b sRGB24 = sRGBBounded -- |Return the sRGB colour components in the range [0..1]. toSRGB :: (Ord b, Floating b) => Colour b -> RGB b toSRGB c = fmap transferFunction (toRGB c) {- Results are clamped and quantized -} -- |Return the approximate sRGB colour components in the range -- [0..'maxBound']. -- Out of range values are clamped. toSRGBBounded :: (RealFrac b, Floating b, Integral a, Bounded a) => Colour b -> RGB a toSRGBBounded c = fmap f (toSRGB c) where f x' = quantize (m*x') m = fromIntegral $ maxBound `asTypeOf` (f undefined) -- |Return the approximate 24-bit sRGB colour components as three 8-bit -- components. -- Out of range values are clamped. toSRGB24 :: (RealFrac b, Floating b) => Colour b -> RGB Word8 toSRGB24 = toSRGBBounded -- |Show a colour in hexadecimal form, e.g. \"#00aaff\" sRGB24shows :: (RealFrac b, Floating b) => Colour b -> ShowS sRGB24shows c = ("#"++) . showHex2 r' . showHex2 g' . showHex2 b' where RGB r' g' b' = toSRGB24 c showHex2 x | x <= 0xf = ("0"++) . showHex x | otherwise = showHex x -- |Show a colour in hexadecimal form, e.g. \"#00aaff\" sRGB24show :: (RealFrac b, Floating b) => Colour b -> String sRGB24show x = sRGB24shows x "" -- |Read a colour in hexadecimal form, e.g. \"#00aaff\" or \"00aaff\" sRGB24reads :: (Ord b, Floating b) => ReadS (Colour b) sRGB24reads "" = [] sRGB24reads x = [(sRGB24 a b c, c0) |(a,a0) <- readPair x', (b,b0) <- readPair a0, (c,c0) <- readPair b0] where x' | head x == '#' = tail x | otherwise = x readPair [] = [] readPair [_] = [] readPair a = [(x,a1)|(x,"") <- readHex a0] where (a0,a1) = splitAt 2 a -- |Read a colour in hexadecimal form, e.g. \"#00aaff\" or \"00aaff\" sRGB24read :: (Ord b, Floating b) => String -> (Colour b) sRGB24read x | length rx /= 1 || not (null (snd (head rx))) = error "Data.Colour.SRGB.sRGB24read: no parse" | otherwise = fst (head rx) where rx = sRGB24reads x -- |The sRGB colour space sRGBSpace :: (Ord a, Floating a) => RGBSpace a sRGBSpace = mkRGBSpace sRGBGamut transfer where transfer = TransferFunction transferFunction invTransferFunction (recip 2.2) colour-2.3.6/Data/Colour/Chan.hs0000644000175000001440000000337714065123577017450 0ustar00roconnorusers00000000000000{- Copyright (c) 2008 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Data.Colour.Chan where {- For internal use only: Not to be exported from the package -} import qualified Data.List (sum) newtype Chan p a = Chan a deriving (Eq) empty :: (Num a) => Chan p a empty = Chan 0 full :: (Num a) => Chan p a full = Chan 1 scale :: (Num a) => a -> Chan p a -> Chan p a scale s (Chan x) = Chan (s*x) add :: (Num a) => Chan p a -> Chan p a -> Chan p a (Chan a) `add` (Chan b) = Chan (a+b) invert :: (Num a) => Chan p a -> Chan p a invert (Chan a) = Chan (1-a) over c0 a c1 = c0 `add` scale (1-a) c1 convert :: (Fractional b, Real a) => Chan p a -> Chan p b convert (Chan x) = Chan (realToFrac x) sum :: (Num a) => [Chan p a] -> Chan p a sum l = Chan (Data.List.sum [x |Chan x <- l])colour-2.3.6/Data/Colour.hs0000644000175000001440000001611414065123576016567 0ustar00roconnorusers00000000000000{- Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} -- |Datatypes for representing the human perception of colour. -- Includes common operations for blending and compositing colours. -- The most common way of creating colours is either by name -- (see "Data.Colour.Names") or by giving an sRGB triple -- (see "Data.Colour.SRGB"). -- -- Methods of specifying Colours can be found in -- -- - "Data.Colour.SRGB" -- -- - "Data.Colour.SRGB.Linear" -- -- - "Data.Colour.CIE" -- -- Colours can be specified in a generic 'Data.Colour.RGBSpace.RGBSpace' -- by using -- -- - "Data.Colour.RGBSpace" --TODO -- - "Data.Colour.HDTV" -- -- - "Data.Colour.SDTV" module Data.Colour ( -- *Interfacing with Other Libraries\' Colour Spaces -- -- |Executive summary: Always use "Data.Colour.SRGB" when interfacing with -- other libraries. -- Use 'Data.Colour.SRGB.toSRGB24' \/ 'Data.Colour.SRGB.sRGB24' when -- interfacing with libraries wanting 'Data.Word.Word8' per channel. -- Use 'Data.Colour.SRGB.toSRGB' \/ 'Data.Colour.SRGB.sRGB' when -- interfacing with libraries wanting 'Double' or 'Float' per channel. -- -- Interfacing with the colour for other libraries, such as cairo -- () and OpenGL -- (), -- can be a challenge because these libraries often do not use colour spaces -- in a consistent way. -- The problem is that these libraries work in a device dependent colour -- space and give no indication what the colour space is. -- For most devices this colours space is implicitly the non-linear sRGB -- space. -- However, to make matters worse, these libraries also do their -- compositing and blending in the device colour space. -- Blending and compositing ought to be done in a linear colour space, -- but since the device space is typically non-linear sRGB, these libraries -- typically produce colour blends that are too dark. -- -- (Note that "Data.Colour" is a device /independent/ colour space, and -- produces correct blends. -- e.g. compare @toSRGB (blend 0.5 lime red)@ with @RGB 0.5 0.5 0@) -- -- Because these other colour libraries can only blend in device colour -- spaces, they are fundamentally broken and there is no \"right\" way -- to interface with them. -- For most libraries, the best one can do is assume they are working -- with an sRGB colour space and doing incorrect blends. -- In these cases use "Data.Colour.SRGB" to convert to and from the -- colour coordinates. This is the best advice for interfacing with cairo. -- -- When using OpenGL, the choice is less clear. -- Again, OpenGL usually does blending in the device colour space. -- However, because blending is an important part of proper shading, one -- may want to consider that OpenGL is working in a linear colour space, -- and the resulting rasters are improperly displayed. -- This is born out by the fact that OpenGL extensions that support -- sRGB do so by converting sRGB input\/output to linear colour coordinates -- for processing by OpenGL. -- -- The best way to use OpenGL, is to use proper sRGB surfaces for textures -- and rendering. -- These surfaces will automatically convert to and from OpenGL's linear -- colour space. -- In this case, use "Data.Colour.SRGB.Linear" to interface OpenGL's linear -- colour space. -- -- If not using proper surfaces with OpenGL, then you have a choice between -- having OpenGL do improper blending or improper display -- If you are using OpenGL for 3D shading, I recommend using -- "Data.Colour.SRGB.Linear" (thus choosing improper OpenGL display). -- If you are not using OpenGL for 3D shading, I recommend using -- "Data.Colour.SRGB" (thus choosing improper OpenGL blending). -- *Colour type Colour ,colourConvert ,black ,AlphaColour ,opaque, withOpacity ,transparent ,alphaColourConvert ,alphaChannel -- *Colour operations -- |These operations allow combine and modify existing colours ,AffineSpace(..), blend ,ColourOps(..) ,dissolve, atop ) where import Data.Char (isAlphaNum, isSpace) import Data.Colour.Internal import qualified Data.Colour.SRGB.Linear import Data.Colour.CIE.Chromaticity (app_prec, infix_prec) instance (Fractional a, Show a) => Show (Colour a) where showsPrec d c = showParen (d > app_prec) showStr where showStr = showString linearConstructorQualifiedName . showString " " . (showsPrec (app_prec+1) r) . showString " " . (showsPrec (app_prec+1) g) . showString " " . (showsPrec (app_prec+1) b) Data.Colour.SRGB.Linear.RGB r g b = Data.Colour.SRGB.Linear.toRGB c instance (Fractional a, Read a) => Read (Colour a) where readsPrec d r = readParen (d > app_prec) (\r -> [(Data.Colour.SRGB.Linear.rgb r0 g0 b0,t) |(name,s) <- mylex r ,name `elem` [linearConstructorName ,linearConstructorQualifiedName] ,(r0,s0) <- readsPrec (app_prec+1) s ,(g0,s1) <- readsPrec (app_prec+1) s0 ,(b0,t) <- readsPrec (app_prec+1) s1]) r where mylex = return . span (\c -> isAlphaNum c || c `elem` "._'") . dropWhile isSpace linearConstructorQualifiedName = "Data.Colour.SRGB.Linear.rgb" linearConstructorName = "rgb" instance (Fractional a, Show a, Eq a) => Show (AlphaColour a) where showsPrec d ac | a == 0 = showString "transparent" | otherwise = showParen (d > infix_prec) showStr where showStr = showsPrec (infix_prec+1) c . showString " `withOpacity` " . showsPrec (infix_prec+1) a a = alphaChannel ac c = colourChannel ac instance (Fractional a, Read a) => Read (AlphaColour a) where readsPrec d r = [(transparent,s)|("transparent",s) <- lex r] ++ readParen (d > infix_prec) (\r -> [(c `withOpacity` o,s) |(c,r0) <- readsPrec (infix_prec+1) r ,("`",r1) <- lex r0 ,("withOpacity",r2) <- lex r1 ,("`",r3) <- lex r2 ,(o,s) <- readsPrec (infix_prec+1) r3]) r colour-2.3.6/LICENSE0000644000175000001440000000205214065123577015121 0ustar00roconnorusers00000000000000Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. colour-2.3.6/colour.cabal0000644000175000001440000000451214065123577016406 0ustar00roconnorusers00000000000000Name: colour Version: 2.3.6 Cabal-Version: >= 1.10 License: MIT License-file: LICENSE Author: Russell O'Connor Maintainer: Russell O'Connor Homepage: http://www.haskell.org/haskellwiki/Colour Build-Type: Simple Category: data, graphics Synopsis: A model for human colour/color perception Description: This package provides a data type for colours and transparency. Colours can be blended and composed. Various colour spaces are supported. A module of colour names ("Data.Colour.Names") is provided. Tested-with: GHC == 8.8.4 data-files: README CHANGELOG Library default-language: Haskell98 Build-Depends: base >= 4.13 && < 5 Exposed-Modules: Data.Colour Data.Colour.SRGB Data.Colour.SRGB.Linear Data.Colour.CIE Data.Colour.CIE.Illuminant Data.Colour.RGBSpace Data.Colour.RGBSpace.HSL Data.Colour.RGBSpace.HSV Data.Colour.Names Other-Modules: Data.Colour.Internal Data.Colour.Chan Data.Colour.RGB Data.Colour.Matrix Data.Colour.CIE.Chromaticity test-suite test-colour default-language: Haskell98 type: exitcode-stdio-1.0 main-is: Tests.hs build-depends: base >= 4.13 && < 5, colour, QuickCheck >= 2.5 && < 2.15, random >= 1.0 && < 1.2, test-framework >= 0.8 && < 0.9, test-framework-quickcheck2 >= 0.3 && < 0.4 Other-Modules: Data.Colour Data.Colour.SRGB Data.Colour.SRGB.Linear Data.Colour.CIE Data.Colour.CIE.Illuminant Data.Colour.RGBSpace Data.Colour.RGBSpace.HSL Data.Colour.RGBSpace.HSV Data.Colour.Names Data.Colour.Internal Data.Colour.Chan Data.Colour.RGB Data.Colour.Matrix Data.Colour.CIE.Chromaticity colour-2.3.6/Tests.hs0000644000175000001440000002667214065123576015567 0ustar00roconnorusers00000000000000{-# LANGUAGE TypeSynonymInstances #-} {- Copyright (c) 2008, 2009 Russell O'Connor Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -} module Main where import Data.Word (Word8) import Control.Monad (liftM, liftM2, liftM3) import Test.QuickCheck ( Arbitrary, CoArbitrary, Gen, Property , (==>), arbitrary, choose, coarbitrary, forAll ) import Test.Framework (defaultMain, defaultMainWithOpts, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Data.Colour.Matrix import Data.Colour import Data.Colour.SRGB import Data.Colour.SRGB.Linear import Data.Colour.CIE import Data.Colour.CIE.Illuminant (d65) import Data.Colour.Names --import Data.Colour.HDTV as HDTV --import qualified Data.Colour.SDTV as SDTV import Data.Colour.RGB import Data.Colour.RGBSpace import Data.Colour.RGBSpace.HSL import Data.Colour.RGBSpace.HSV default (Rational, Double, Float) type RColour = Colour Rational type DColour = Colour Double type FColour = Colour Float type RAlphaColour = AlphaColour Rational type DAlphaColour = AlphaColour Double instance (Real a, Fractional a, Arbitrary a) => Arbitrary (Colour a) where arbitrary = liftM3 mkColour arbitrary arbitrary arbitrary where mkColour r' g' b' = colourConvert (sRGB24 r' g' b'::Colour Double) instance (Real a, Fractional a, CoArbitrary a) => CoArbitrary (Colour a) where coarbitrary c = coarbitrary (r,g,b) where (RGB r g b) = toRGB c instance (Real a, Fractional a, Arbitrary a) => Arbitrary (AlphaColour a) where arbitrary = liftM2 mkAlphaColour arbitrary arbitrary where mkAlphaColour :: (Fractional a) => Colour a -> Word8 -> AlphaColour a mkAlphaColour c a = c `withOpacity` (fromIntegral a/fromIntegral (maxBound `asTypeOf` a)) instance (Real a, Fractional a, CoArbitrary a) => CoArbitrary (AlphaColour a) where coarbitrary ac = coarbitrary a . coarbitrary c where a = alphaChannel ac c = ac `over` black instance (Fractional a, Arbitrary a) => Arbitrary (Chromaticity a) where arbitrary = liftM2 mkChromaticity arbitrary arbitrary instance (Fractional a, CoArbitrary a) => CoArbitrary (Chromaticity a) where coarbitrary c = coarbitrary x . coarbitrary y where (x,y,_) = chromaCoords c instance (Arbitrary a) => Arbitrary (RGB a) where arbitrary = liftM3 RGB arbitrary arbitrary arbitrary instance (CoArbitrary a) => CoArbitrary (RGB a) where coarbitrary (RGB r g b) = coarbitrary (r,g,b) instance Arbitrary RGBGamut where arbitrary = liftM2 RGBGamut arbitrary arbitrary instance CoArbitrary RGBGamut where coarbitrary (RGBGamut p w) = coarbitrary p . coarbitrary w -- generate RGB values with channels between 0 and 1. rgbGen :: Gen (RGB Rational) rgbGen = fmap (\(r,g,b) -> fmap toRational (RGB r g b)) (three zeroOne) zeroOne = choose (0,1::Double) two :: Monad m => m a -> m (a, a) two m = liftM2 (,) m m three :: Monad m => m a -> m (a, a, a) three m = liftM3 (,,) m m m good (RGBGamut p w) = p1 && p2 where p1 = 0 /= determinant (primaryMatrix p) p2 = 0 /= let (x,y,z) = chromaCoords w in y prop_matrixMult (a1,b1,c1) (d1,e1,f1) (g1,h1,i1) (a2,b2,c2) (d2,e2,f2) (g2,h2,i2) (x,y,z) = mult m1 (mult m2 v) == mult (matrixMult m1 m2) v where m1 = [[a1,b1,c1],[d1,e1,f1],[g1,h1,i1]] m2 = [[a2,b2,c2],[d2,e2,f2],[g2,h2,i2]] v :: [Rational] v = [x,y,z] newtype Depth = Depth Int deriving Show instance Arbitrary Depth where arbitrary = liftM Depth $ choose (0,11) instance CoArbitrary Depth where coarbitrary (Depth x) = coarbitrary x prop_toFromRGB :: RColour -> Bool prop_toFromRGB c = uncurryRGB rgb (toRGB c) == c prop_fromToRGB :: Rational -> Rational -> Rational -> Bool prop_fromToRGB r g b = toRGB (rgb r g b) == RGB r g b prop_toFromXYZ :: RColour -> Bool prop_toFromXYZ c = (cieXYZ x y z) == c where (x,y,z) = cieXYZView c prop_fromToXYZ :: Rational -> Rational -> Rational -> Bool prop_fromToXYZ x y z = cieXYZView (cieXYZ x y z) == (x,y,z) -- Uses the fact that an Arbitrary colour is an sRGB24 colour. prop_toFromSRGB :: DColour -> Bool prop_toFromSRGB c = uncurryRGB sRGB24 (toSRGB24 c) == c prop_fromToSRGB :: Word8 -> Word8 -> Word8 -> Bool prop_fromToSRGB r' g' b' = toSRGB24 (sRGB24 r' g' b') == RGB r' g' b' prop_toFromLAB :: Chromaticity Double -> DColour -> Bool prop_toFromLAB wp c = cc (cieLAB wp l a b) == cc c where (l,a,b) = cieLABView wp c cc = toSRGB24 {- prop_fromToY'CbCr709 :: Word8 -> Word8 -> Word8 -> Bool prop_fromToY'CbCr709 y' cb cr = HDTV.toY'CbCr (HDTV.y'CbCr y' cb cr) == (y',cb,cr) prop_fromToY'CbCr601 :: Word8 -> Word8 -> Word8 -> Bool prop_fromToY'CbCr601 y' cb cr = SDTV.toY'CbCr (SDTV.y'CbCr y' cb cr) == (y',cb,cr) -} prop_disolveId :: RAlphaColour -> Bool prop_disolveId c = dissolve 1 c == c prop_disolveTransparent :: RAlphaColour -> Bool prop_disolveTransparent c = dissolve 0 c == transparent prop_transparentOver :: RColour -> Bool prop_transparentOver c = transparent `over` c == c prop_overTransparent :: RAlphaColour -> Bool prop_overTransparent c = c `over` transparent == c prop_opaqueOver :: RColour -> RColour -> Bool prop_opaqueOver c1 c2 = opaque c1 `over` c2 == c1 prop_overOpaque :: RAlphaColour -> RColour -> Bool prop_overOpaque c1 c2 = c1 `over` opaque c2 == opaque (c1 `over` c2) prop_blendOver :: Rational -> RColour -> RColour -> Bool prop_blendOver o c1 c2 = (c1 `withOpacity` o) `over` c2 == blend o c1 c2 prop_blendTransparent :: Rational -> Rational -> RColour -> Bool prop_blendTransparent o a c = blend o (c `withOpacity` a) transparent == c `withOpacity ` (o*a) prop_blendFlip :: Rational -> RColour -> RColour -> Bool prop_blendFlip o c1 c2 = blend (1-o) c2 c1 == blend o c1 c2 prop_darkenBlend :: Rational -> RColour -> Bool prop_darkenBlend w c = blend w c mempty == darken w c prop_darkenBlack :: RAlphaColour -> Bool prop_darkenBlack c = darken 0 c == mempty `withOpacity` (alphaChannel c) prop_darkenId :: RAlphaColour -> Bool prop_darkenId c = darken 1 c == c prop_atopOpaque :: RAlphaColour -> RColour -> Bool prop_atopOpaque c0 c1 = c0 `atop` (opaque c1) == opaque (c0 `over` c1) prop_transparentAtop :: RAlphaColour -> Bool prop_transparentAtop c = transparent `atop` c == c prop_atopTransparent :: RAlphaColour -> Bool prop_atopTransparent c = c `atop` transparent == transparent prop_atopAlpha :: RAlphaColour -> RAlphaColour -> Bool prop_atopAlpha c0 c1 = alphaChannel (c0 `atop` c1) == alphaChannel c1 prop_showReadC :: Depth -> RColour -> Bool prop_showReadC (Depth d) c = readsPrec d (showsPrec d c "") == [(c,"")] prop_showReadAC :: Depth -> RAlphaColour -> Bool prop_showReadAC (Depth d) c = readsPrec d (showsPrec d c "") == [(c,"")] prop_sRGB24showlength :: DColour -> Bool prop_sRGB24showlength c = length (sRGB24show c) == 7 prop_readshowSRGB24 :: DColour -> Bool prop_readshowSRGB24 c = sRGB24show (sRGB24read (sRGB24show c)) == sRGB24show c prop_luminance_white :: RGBGamut -> Property prop_luminance_white space = good space ==> luminance (rgbUsingSpace (linearRGBSpace space) 1 1 1) == 1 prop_rgb :: Rational -> Rational -> Rational -> Bool prop_rgb r g b = rgbUsingSpace (linearRGBSpace sRGBGamut) r g b == rgb r g b prop_toRGB :: RColour -> Bool prop_toRGB c = toRGBUsingSpace (linearRGBSpace sRGBGamut) c == toRGB c prop_sRGB :: Double -> Double -> Double -> Bool prop_sRGB r g b = rgbUsingSpace sRGBSpace r g b == sRGB r g b prop_toSRGB :: DColour -> Bool prop_toSRGB c = toRGBUsingSpace sRGBSpace c == toSRGB c prop_hueRange :: RGB Rational -> Bool prop_hueRange rgb = 0 <= h && h < 360 where h = hue rgb prop_toFromHSL :: Property prop_toFromHSL = forAll rgbGen (\rgb -> hsl' (hslView rgb) == rgb) where hsl' (h,s,l) = hsl h s l prop_fromToHSL :: Rational -> Property prop_fromToHSL h = forAll (two (fmap toRational zeroOne)) (\(s,l) -> checkHSL (hslView (hsl h s l)) (h,s,l)) where checkHSL (h0,s0,l0) (h1,s1,l1) = snd (properFraction ((h0-h1)/360)::(Integer,Rational)) == 0 && s0 == s1 && l0 == l1 prop_toFromHSV :: Property prop_toFromHSV = forAll rgbGen (\rgb -> hsv' (hsvView rgb) == rgb) where hsv' (h,s,v) = hsv h s v prop_fromToHSV :: Rational -> Property prop_fromToHSV h = forAll (two (fmap toRational zeroOne)) (\(s,v) -> checkHSV (hsvView (hsv h s v)) (h,s,v)) where checkHSV (h0,s0,v0) (h1,s1,v1) = snd (properFraction ((h0-h1)/360)::(Integer,Rational)) == 0 && s0 == s1 && v0 == v1 tests = [ testProperty "matrix-mult" prop_matrixMult , testProperty "RGB-to-from" prop_toFromRGB , testProperty "RGB-from-to" prop_fromToRGB , testProperty "XYZ-to-from" prop_toFromXYZ , testProperty "XYZ-from-to" prop_fromToXYZ , testProperty "sRGB-to-from" prop_toFromSRGB , testProperty "sRGB-from-to" prop_fromToSRGB , testProperty "cieLAB-to-from" (prop_toFromLAB d65) -- , testProperty "Y'CbCr-709-from-to" prop_fromToY'CbCr709 -- , testProperty "Y'CbCr-601-from-to" prop_fromToY'CbCr601 , testProperty "dissolve-id" prop_disolveId , testProperty "dissolve-transparent" prop_disolveTransparent , testProperty "transparent-over" prop_transparentOver , testProperty "over-transparent" prop_overTransparent , testProperty "opaque-over" prop_opaqueOver , testProperty "over-opaque" prop_overOpaque , testProperty "blend-over" prop_blendOver , testProperty "blend-transparent" prop_blendTransparent , testProperty "blend-flip" prop_blendFlip , testProperty "darken-blend" prop_darkenBlend , testProperty "darken-black" prop_darkenBlack , testProperty "darken-id" prop_darkenId , testProperty "atop-opaque" prop_atopOpaque , testProperty "transparent-atop" prop_transparentAtop , testProperty "atop-transparent" prop_atopTransparent , testProperty "atop-alpha" prop_atopAlpha , testProperty "colour-show-read" prop_showReadC , testProperty "alphaColour-show-read" prop_showReadAC , testProperty "sRGB24-show-length" prop_sRGB24showlength , testProperty "sRGB24-read-show" prop_readshowSRGB24 , testProperty "luminance-white" prop_luminance_white , testProperty "rgb" prop_rgb , testProperty "toRGB" prop_toRGB , testProperty "sRGB" prop_sRGB , testProperty "toSRGB" prop_toSRGB , testProperty "hueRange" prop_hueRange , testProperty "toFromHSL" prop_toFromHSL , testProperty "fromToHSL" prop_fromToHSL , testProperty "toFromHSV" prop_toFromHSV , testProperty "fromToHSV" prop_fromToHSV ] main = defaultMain tests