colour-accelerate 0.2.0.0 → 0.3.0.0
raw patch · 8 files changed
+217/−119 lines, 8 filesdep ~acceleratedep ~base
Dependency ranges changed: accelerate, base
Files
- CHANGELOG.md +6/−0
- Data/Array/Accelerate/Data/Colour/HSL.hs +6/−4
- Data/Array/Accelerate/Data/Colour/HSV.hs +6/−4
- Data/Array/Accelerate/Data/Colour/RGB.hs +96/−49
- Data/Array/Accelerate/Data/Colour/RGBA.hs +94/−56
- Data/Array/Accelerate/Data/Colour/SRGB.hs +1/−1
- README.md +2/−0
- colour-accelerate.cabal +6/−5
CHANGELOG.md view
@@ -6,6 +6,11 @@ project adheres to the [Haskell Package Versioning Policy (PVP)](https://pvp.haskell.org) +## [0.3.0.0] - 2018-04-03+### Changed+ * update to accelerate-1.2+ * RGB and RGBA colours with Word8 components are stored in packed array-of-struct representation+ ## [0.2.0.0] - 2017-09-21 * update for accelerate-1.1.* @@ -13,6 +18,7 @@ * initial release +[0.3.0.0]: https://github.com/tmcdonell/colour-accelerate/compare/0.2.0.0...0.3.0.0 [0.2.0.0]: https://github.com/tmcdonell/colour-accelerate/compare/0.1.0.0...0.2.0.0 [0.1.0.0]: https://github.com/tmcdonell/colour-accelerate/compare/6b2dc2e55bc0503aa4c94b883f6b608aaa734101...0.1.0.0
Data/Array/Accelerate/Data/Colour/HSL.hs view
@@ -25,6 +25,8 @@ -- Colours in the HSL (hue-saturation-lightness) cylindrical-coordinate -- representation of points in the RGB colour space. --+-- <https://en.wikipedia.org/wiki/HSL_and_HSV>+-- module Data.Array.Accelerate.Data.Colour.HSL ( @@ -189,7 +191,7 @@ = HSL (signum h1) (signum s1) (signum v1) fromInteger i- = let f = fromInteger i+ = let f = P.fromInteger i in HSL f f f instance (P.Num a, P.Fractional a) => P.Fractional (HSL a) where@@ -200,7 +202,7 @@ = HSL (recip h1) (recip s1) (recip l1) fromRational r- = let f = fromRational r+ = let f = P.fromRational r in HSL f f f @@ -210,13 +212,13 @@ (*) = lift2 ((*) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) abs = lift1 (abs :: HSL (Exp a) -> HSL (Exp a)) signum = lift1 (signum :: HSL (Exp a) -> HSL (Exp a))- fromInteger i = let f = fromInteger i :: Exp a+ fromInteger i = let f = P.fromInteger i :: Exp a in lift $ HSL f f f instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (HSL a)) where (/) = lift2 ((/) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) recip = lift1 (recip :: HSL (Exp a) -> HSL (Exp a))- fromRational r = let f = fromRational r :: Exp a+ fromRational r = let f = P.fromRational r :: Exp a in lift $ HSL f f f
Data/Array/Accelerate/Data/Colour/HSV.hs view
@@ -25,6 +25,8 @@ -- Colours in the HSV (hue-saturation-value) cylindrical-coordinate -- representation of points in the RGB colour space. --+-- <https://en.wikipedia.org/wiki/HSL_and_HSV>+-- module Data.Array.Accelerate.Data.Colour.HSV ( @@ -189,7 +191,7 @@ = HSV (signum h1) (signum s1) (signum v1) fromInteger i- = let f = fromInteger i+ = let f = P.fromInteger i in HSV f f f instance (P.Num a, P.Fractional a) => P.Fractional (HSV a) where@@ -200,7 +202,7 @@ = HSV (recip h1) (recip s1) (recip v1) fromRational r- = let f = fromRational r+ = let f = P.fromRational r in HSV f f f @@ -210,13 +212,13 @@ (*) = lift2 ((*) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) abs = lift1 (abs :: HSV (Exp a) -> HSV (Exp a)) signum = lift1 (signum :: HSV (Exp a) -> HSV (Exp a))- fromInteger i = let f = fromInteger i :: Exp a+ fromInteger i = let f = P.fromInteger i :: Exp a in lift $ HSV f f f instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (HSV a)) where (/) = lift2 ((/) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) recip = lift1 (recip :: HSV (Exp a) -> HSV (Exp a))- fromRational r = let f = fromRational r :: Exp a+ fromRational r = let f = P.fromRational r :: Exp a in lift $ HSV f f f
Data/Array/Accelerate/Data/Colour/RGB.hs view
@@ -41,18 +41,20 @@ ) where import Data.Array.Accelerate as A hiding ( clamp )-import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) ) import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) )+import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) )+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Type import Data.Array.Accelerate.Data.Colour.Names-import Data.Array.Accelerate.Data.Colour.Internal.Pack+import Data.Array.Accelerate.Data.Colour.RGBA ( RGBA(..) )+import Data.Array.Accelerate.Data.Colour.Internal.Pack ( word8OfFloat ) import Data.Typeable import Prelude as P --- | An RGB colour value+-- | An RGB colour value, in an unspecified colour space. -- type Colour = RGB Float @@ -76,7 +78,7 @@ -> Exp Colour rgb8 r g b = lift- $ RGB (A.fromIntegral r / 255)+ $ RGB (A.fromIntegral r / 255 :: Exp Float) (A.fromIntegral g / 255) (A.fromIntegral b / 255) @@ -139,78 +141,122 @@ -- | Convert a Colour into a packed-word RGBA representation -- packRGB :: Exp Colour -> Exp Word32-packRGB (unlift -> RGB r g b) = pack8 (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) 0xFF+packRGB (unlift -> RGB r g b)+ = bitcast+ . lift+ $ RGBA (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) 0xFF -- | Convert a colour into a packed-word ABGR representation -- packBGR :: Exp Colour -> Exp Word32-packBGR (unlift -> RGB r g b) = pack8 0xFF (word8OfFloat b) (word8OfFloat g) (word8OfFloat r)+packBGR (unlift -> RGB r g b)+ = bitcast+ . lift+ $ RGBA 0xFF (word8OfFloat b) (word8OfFloat g) (word8OfFloat r) packRGB8 :: Exp (RGB Word8) -> Exp Word32-packRGB8 (unlift -> RGB r g b) = pack8 r g b 0xFF+packRGB8 (unlift -> RGB r g b :: RGB (Exp Word8))+ = bitcast+ . lift+ $ RGBA r g b 0xFF packBGR8 :: Exp (RGB Word8) -> Exp Word32-packBGR8 (unlift -> RGB r g b) = pack8 0xff b g r+packBGR8 (unlift -> RGB r g b :: RGB (Exp Word8))+ = bitcast+ . lift+ $ RGBA 0xff b g r -- | Convert a colour from a packed-word RGBA representation -- unpackRGB :: Exp Word32 -> Exp Colour-unpackRGB w =- let (r,g,b::Exp Word8,_::Exp Word8) = unlift (unpack8 w)- in rgb8 r g b+unpackRGB (unlift . bitcast -> RGBA r g b _ :: RGBA (Exp Word8)) = rgb8 r g b -- | Convert a colour from a packed-word ABGR representation -- unpackBGR :: Exp Word32 -> Exp Colour-unpackBGR w =- let (_::Exp Word8,b::Exp Word8,g,r) = unlift (unpack8 w)- in rgb8 r g b+unpackBGR (unlift . bitcast -> RGBA _ b g r :: RGBA (Exp Word8)) = rgb8 r g b unpackRGB8 :: Exp Word32 -> Exp (RGB Word8)-unpackRGB8 w =- let (r,g,b::Exp Word8,_::Exp Word8) = unlift (unpack8 w)- in lift $ RGB r g b+unpackRGB8 (unlift . bitcast -> RGBA r g b _ :: RGBA (Exp Word8)) = lift (RGB r g b) unpackBGR8 :: Exp Word32 -> Exp (RGB Word8)-unpackBGR8 w =- let (_::Exp Word8,b::Exp Word8,g,r) = unlift (unpack8 w)- in lift $ RGB r g b+unpackBGR8 (unlift . bitcast -> RGBA _ b g r :: RGBA (Exp Word8)) = lift (RGB r g b) -- Accelerate bits -- --------------- --- RGB colour space+-- | An RGB colour value to hold the colour components. All components lie in+-- the range [0..1] for floating point values, or [0..255] for byte values. --+-- Colours in the floating point representation are stored in the usual unzipped+-- struct-of-array representation. Colours with Word8 components are stored in+-- a packed array-of-struct representation, which is typically more convenient+-- when exporting the data (e.g. as a 24-bit BMP image).+-- data RGB a = RGB a a a deriving (Show, P.Eq, Functor, Typeable) --- Represent colours in Accelerate as a 3-tuple----type instance EltRepr (RGB a) = EltRepr (a, a, a)+type instance EltRepr (RGB Float) = EltRepr (Float, Float, Float)+type instance EltRepr (RGB Word8) = V3 Word8 -instance Elt a => Elt (RGB a) where- eltType (_ :: RGB a) = eltType (undefined :: (a,a,a))- toElt c = let (r,g,b) = toElt c in RGB r g b- fromElt (RGB r g b) = fromElt (r,g,b)+instance Elt (RGB Float) where+ eltType _ = eltType (undefined::(Float,Float,Float))+ toElt t = let (r,g,b) = toElt t in RGB r g b+ fromElt (RGB r g b) = fromElt (r,g,b) -instance Elt a => IsProduct Elt (RGB a) where- type ProdRepr (RGB a) = ((((),a), a), a)- fromProd _ (RGB r g b) = ((((), r), g), b)- toProd _ ((((),r),g),b) = RGB r g b- prod cst _ = prod cst (undefined :: (a,a,a))+instance Elt (RGB Word8) where+ eltType _ = TypeRscalar scalarType+ toElt (V3 r g b) = RGB r g b+ fromElt (RGB r g b) = V3 r g b -instance (Lift Exp a, Elt (Plain a)) => Lift Exp (RGB a) where- type Plain (RGB a) = RGB (Plain a)- lift (RGB r g b) = Exp . Tuple $ NilTup `SnocTup` lift r `SnocTup` lift g `SnocTup` lift b+instance IsProduct Elt (RGB Float) where+ type ProdRepr (RGB Float) = ProdRepr (Float,Float,Float)+ fromProd cst (RGB r g b) = fromProd cst (r,g,b)+ toProd cst p = let (r,g,b) = toProd cst p in RGB r g b+ prod cst _ = prod cst (undefined :: (Float,Float,Float)) -instance Elt a => Unlift Exp (RGB (Exp a)) where- unlift c = let r = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c- g = Exp $ SuccTupIdx ZeroTupIdx `Prj` c- b = Exp $ ZeroTupIdx `Prj` c- in RGB r g b+instance IsProduct Elt (RGB Word8) where+ type ProdRepr (RGB Word8) = ProdRepr (V3 Word8)+ fromProd cst (RGB r g b) = fromProd cst (V3 r g b)+ toProd cst p = let V3 r g b = toProd cst p in RGB r g b+ prod cst _ = prod cst (undefined :: V3 Word8) +instance Lift Exp (RGB Float) where+ type Plain (RGB Float) = RGB Float+ lift = constant++instance Lift Exp (RGB Word8) where+ type Plain (RGB Word8) = RGB Word8+ lift = constant++instance Lift Exp (RGB (Exp Float)) where+ type Plain (RGB (Exp Float)) = RGB Float+ lift (RGB r g b) = Exp . Tuple $ NilTup `SnocTup` r `SnocTup` g `SnocTup` b++instance Lift Exp (RGB (Exp Word8)) where+ type Plain (RGB (Exp Word8)) = RGB Word8+ lift (RGB r g b) = Exp . Tuple $ NilTup `SnocTup` r `SnocTup` g `SnocTup` b++instance Unlift Exp (RGB (Exp Float)) where+ unlift c =+ let+ r = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c+ g = Exp $ SuccTupIdx ZeroTupIdx `Prj` c+ b = Exp $ ZeroTupIdx `Prj` c+ in+ RGB r g b++instance Unlift Exp (RGB (Exp Word8)) where+ unlift c =+ let r = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c+ g = Exp $ SuccTupIdx ZeroTupIdx `Prj` c+ b = Exp $ ZeroTupIdx `Prj` c+ in+ RGB r g b++ instance P.Num a => P.Num (RGB a) where (+) (RGB r1 g1 b1 ) (RGB r2 g2 b2) = RGB (r1 + r2) (g1 + g2) (b1 + b2)@@ -228,7 +274,7 @@ = RGB (signum r1) (signum g1) (signum b1) fromInteger i- = let f = fromInteger i+ = let f = P.fromInteger i in RGB f f f instance (P.Num a, P.Fractional a) => P.Fractional (RGB a) where@@ -239,23 +285,24 @@ = RGB (recip r1) (recip g1) (recip b1) fromRational r- = let f = fromRational r+ = let f = P.fromRational r in RGB f f f --instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (RGB a)) where+instance (A.Num a, Unlift Exp (RGB (Exp a)), Plain (RGB (Exp a)) ~ RGB a)+ => P.Num (Exp (RGB a)) where (+) = lift2 ((+) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) (-) = lift2 ((-) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) (*) = lift2 ((*) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) abs = lift1 (abs :: RGB (Exp a) -> RGB (Exp a)) signum = lift1 (signum :: RGB (Exp a) -> RGB (Exp a))- fromInteger i = let f = fromInteger i :: Exp a+ fromInteger i = let f = P.fromInteger i :: Exp a in lift $ RGB f f f -instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (RGB a)) where+instance (A.Fractional a, Unlift Exp (RGB (Exp a)), Plain (RGB (Exp a)) ~ RGB a)+ => P.Fractional (Exp (RGB a)) where (/) = lift2 ((/) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) recip = lift1 (recip :: RGB (Exp a) -> RGB (Exp a))- fromRational r = let f = fromRational r :: Exp a+ fromRational r = let f = P.fromRational r :: Exp a in lift $ RGB f f f
Data/Array/Accelerate/Data/Colour/RGBA.hs view
@@ -42,18 +42,20 @@ ) where import Data.Array.Accelerate as A hiding ( clamp )-import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) ) import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) )+import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) )+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Type import Data.Array.Accelerate.Data.Colour.Names-import Data.Array.Accelerate.Data.Colour.Internal.Pack+import Data.Array.Accelerate.Data.Colour.Internal.Pack ( word8OfFloat ) import Data.Typeable+import GHC.TypeLits ( ) -- ghc-8.0 bug?? import Prelude as P --- | An RGBA colour value.+-- | An RGBA colour value, in an unspecified colour space. -- type Colour = RGBA Float @@ -81,7 +83,7 @@ -> Exp Colour rgba8 r g b a = lift- $ RGBA (A.fromIntegral r / 255)+ $ RGBA (A.fromIntegral r / 255 :: Exp Float) (A.fromIntegral g / 255) (A.fromIntegral b / 255) (A.fromIntegral a / 255)@@ -163,86 +165,120 @@ -- | Convert a Colour into a packed-word RGBA representation -- packRGBA :: Exp Colour -> Exp Word32-packRGBA (unlift -> RGBA r g b a) =- pack8 (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) (word8OfFloat a)+packRGBA (unlift -> RGBA r g b a)+ = bitcast+ . lift+ $ RGBA (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) (word8OfFloat a) -- | Convert a colour into a packed-word ABGR representation -- packABGR :: Exp Colour -> Exp Word32-packABGR (unlift -> RGBA r g b a) =- pack8 (word8OfFloat a) (word8OfFloat b) (word8OfFloat g) (word8OfFloat r)+packABGR (unlift -> RGBA r g b a)+ = bitcast+ . lift+ $ RGBA (word8OfFloat a) (word8OfFloat b) (word8OfFloat g) (word8OfFloat r) packRGBA8 :: Exp (RGBA Word8) -> Exp Word32-packRGBA8 (unlift -> RGBA r g b a) = pack8 r g b a+packRGBA8 = bitcast packABGR8 :: Exp (RGBA Word8) -> Exp Word32-packABGR8 (unlift -> RGBA r g b a) = pack8 a b g r+packABGR8 (unlift -> RGBA r g b a :: RGBA (Exp Word8))+ = bitcast+ $ lift (RGBA a b g r) -- | Convert a colour from a packed-word RGBA representation -- unpackRGBA :: Exp Word32 -> Exp Colour-unpackRGBA w =- let (r,g,b,a::Exp Word8) = unlift (unpack8 w)- in rgba8 r g b a+unpackRGBA (unlift . bitcast -> RGBA r g b a) = rgba8 r g b a -- | Convert a colour from a packed-word ABGR representation -- unpackABGR :: Exp Word32 -> Exp Colour-unpackABGR w =- let (a,b,g,r::Exp Word8) = unlift (unpack8 w)- in rgba8 r g b a+unpackABGR (unlift . bitcast -> RGBA a b g r) = rgba8 r g b a unpackRGBA8 :: Exp Word32 -> Exp (RGBA Word8)-unpackRGBA8 w =- let (r,g,b,a::Exp Word8) = unlift (unpack8 w)- in lift $ RGBA r g b a+unpackRGBA8 = bitcast unpackABGR8 :: Exp Word32 -> Exp (RGBA Word8)-unpackABGR8 w =- let (a,b,g,r::Exp Word8) = unlift (unpack8 w)- in lift $ RGBA r g b a+unpackABGR8 (unlift . bitcast -> RGBA a b g r :: RGBA (Exp Word8)) =+ lift (RGBA r g b a) -- Accelerate bits -- --------------- -- | An RGBA colour value to hold the colour components. All components lie in--- the range [0..1).+-- the range [0..1] for floating point values, or [0..255] for byte values. ----- We need to parameterise by a type so that we can have both Exp (RGBA a) and--- RGBA (Exp a).+-- Colours in the floating-point representation are stored in the usual unzipped+-- struct-of-array representation. Colours with Word8 components are stored in+-- a packed array-of-struct representation, which is typically more convenient+-- when exporting the data (e.g. as a 32-bit BMP image) -- data RGBA a = RGBA a a a a deriving (Show, P.Eq, Functor, Typeable) --- Represent colours in Accelerate as a 4-tuple----type instance EltRepr (RGBA a) = EltRepr (a, a, a, a)+type instance EltRepr (RGBA Float) = EltRepr (Float,Float,Float,Float)+type instance EltRepr (RGBA Word8) = V4 Word8 -instance Elt a => Elt (RGBA a) where- eltType (_ :: RGBA a) = eltType (undefined :: (a,a,a,a))- toElt c = let (r,g,b,a) = toElt c in RGBA r g b a- fromElt (RGBA r g b a) = fromElt (r,g,b,a)+instance Elt (RGBA Float) where+ eltType _ = eltType (undefined::(Float,Float,Float,Float))+ toElt t = let (r,g,b,a) = toElt t in RGBA r g b a+ fromElt (RGBA r g b a) = fromElt (r,g,b,a) -instance Elt a => IsProduct Elt (RGBA a) where- type ProdRepr (RGBA a) = (((((),a), a), a), a)- fromProd _ (RGBA r g b a) = (((((), r), g), b), a)- toProd _ (((((),r),g),b),a) = RGBA r g b a- prod cst _ = prod cst (undefined :: (a,a,a,a))+instance Elt (RGBA Word8) where+ eltType _ = TypeRscalar scalarType+ toElt (V4 r g b a) = RGBA r g b a+ fromElt (RGBA r g b a) = V4 r g b a -instance (Lift Exp a, Elt (Plain a)) => Lift Exp (RGBA a) where- type Plain (RGBA a) = RGBA (Plain a)- lift (RGBA r g b a) = Exp . Tuple $ NilTup `SnocTup` lift r `SnocTup` lift g- `SnocTup` lift b `SnocTup` lift a+instance IsProduct Elt (RGBA Float) where+ type ProdRepr (RGBA Float) = ProdRepr (Float,Float,Float,Float)+ fromProd cst (RGBA r g b a) = fromProd cst (r,g,b,a)+ toProd cst p = let (r,g,b,a) = toProd cst p in RGBA r g b a+ prod cst _ = prod cst (undefined :: (Float,Float,Float,Float)) -instance Elt a => Unlift Exp (RGBA (Exp a)) where- unlift c = let r = Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` c- g = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c- b = Exp $ SuccTupIdx ZeroTupIdx `Prj` c- a = Exp $ ZeroTupIdx `Prj` c- in RGBA r g b a+instance IsProduct Elt (RGBA Word8) where+ type ProdRepr (RGBA Word8) = ProdRepr (V4 Word8)+ fromProd cst (RGBA r g b a) = fromProd cst (V4 r g b a)+ toProd cst p = let V4 r g b a = toProd cst p in RGBA r g b a+ prod cst _ = prod cst (undefined :: V4 Word8) +instance Lift Exp (RGBA Float) where+ type Plain (RGBA Float) = RGBA Float+ lift = constant++instance Lift Exp (RGBA Word8) where+ type Plain (RGBA Word8) = RGBA Word8+ lift = constant++instance Lift Exp (RGBA (Exp Float)) where+ type Plain (RGBA (Exp Float)) = RGBA Float+ lift (RGBA r g b a) = Exp . Tuple $ NilTup `SnocTup` r `SnocTup` g `SnocTup` b `SnocTup` a++instance Lift Exp (RGBA (Exp Word8)) where+ type Plain (RGBA (Exp Word8)) = RGBA Word8+ lift (RGBA r g b a) = Exp . Tuple $ NilTup `SnocTup` r `SnocTup` g `SnocTup` b `SnocTup` a++instance Unlift Exp (RGBA (Exp Float)) where+ unlift c =+ let r = Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` c+ g = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c+ b = Exp $ SuccTupIdx ZeroTupIdx `Prj` c+ a = Exp $ ZeroTupIdx `Prj` c+ in+ RGBA r g b a++instance Unlift Exp (RGBA (Exp Word8)) where+ unlift c =+ let r = Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` c+ g = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c+ b = Exp $ SuccTupIdx ZeroTupIdx `Prj` c+ a = Exp $ ZeroTupIdx `Prj` c+ in+ RGBA r g b a++ instance P.Num a => P.Num (RGBA a) where (+) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _) = RGBA (r1 + r2) (g1 + g2) (b1 + b2) 1@@ -260,7 +296,7 @@ = RGBA (signum r1) (signum g1) (signum b1) 1 fromInteger i- = let f = fromInteger i+ = let f = P.fromInteger i in RGBA f f f 1 instance (P.Num a, P.Fractional a) => P.Fractional (RGBA a) where@@ -271,24 +307,26 @@ = RGBA (recip r1) (recip g1) (recip b1) 1 fromRational r- = let f = fromRational r+ = let f = P.fromRational r in RGBA f f f 1 -instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (RGBA a)) where+instance (A.Num a, Unlift Exp (RGBA (Exp a)), Plain (RGBA (Exp a)) ~ RGBA a)+ => P.Num (Exp (RGBA a)) where (+) = lift2 ((+) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) (-) = lift2 ((-) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) (*) = lift2 ((*) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) abs = lift1 (abs :: RGBA (Exp a) -> RGBA (Exp a)) signum = lift1 (signum :: RGBA (Exp a) -> RGBA (Exp a))- fromInteger i = let f = fromInteger i- a = fromInteger 1 :: Exp a+ fromInteger i = let f = P.fromInteger i+ a = P.fromInteger 1 :: Exp a in lift $ RGBA f f f a -instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (RGBA a)) where+instance (A.Fractional a, Unlift Exp (RGBA (Exp a)), Plain (RGBA (Exp a)) ~ RGBA a)+ => P.Fractional (Exp (RGBA a)) where (/) = lift2 ((/) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) recip = lift1 (recip :: RGBA (Exp a) -> RGBA (Exp a))- fromRational r = let f = fromRational r- a = fromRational 1 :: Exp a+ fromRational r = let f = P.fromRational r+ a = P.fromRational 1 :: Exp a in lift $ RGBA f f f a
Data/Array/Accelerate/Data/Colour/SRGB.hs view
@@ -57,7 +57,7 @@ -> Exp Colour srgb8 r g b = lift- $ RGB (fromIntegral r / 255)+ $ RGB (fromIntegral r / 255 :: Exp Float) (fromIntegral g / 255) (fromIntegral b / 255)
README.md view
@@ -2,6 +2,8 @@ ================= [](https://travis-ci.org/tmcdonell/colour-accelerate)+[](https://stackage.org/lts/package/colour-accelerate)+[](https://stackage.org/nightly/package/colour-accelerate) [](https://hackage.haskell.org/package/colour-accelerate) This package provides data types and operations for dealing with colours in
colour-accelerate.cabal view
@@ -1,5 +1,5 @@ name: colour-accelerate-version: 0.2.0.0+version: 0.3.0.0 synopsis: Working with colours in Accelerate description: This package provides data types for colours and transparency for use with@@ -30,10 +30,11 @@ library default-language: Haskell2010 build-depends:- base >= 4.7 && < 4.11- , accelerate >= 1.1+ base >= 4.7 && < 4.12+ , accelerate >= 1.2 - ghc-options: -Wall+ ghc-options:+ -Wall exposed-modules: Data.Array.Accelerate.Data.Colour.HSL@@ -53,7 +54,7 @@ source-repository this type: git- tag: 0.2.0.0+ tag: 0.3.0.0 location: https://github.com/tmcdonell/colour-accelerate -- vim: nospell