colour-accelerate 0.3.0.0 → 0.4.0.0
raw patch · 11 files changed
+253/−279 lines, 11 filesdep ~acceleratedep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: accelerate, base
API changes (from Hackage documentation)
- Data.Array.Accelerate.Data.Colour.HSL: instance (Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp a, Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Lift.Plain a)) => Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL a)
- Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Array.Sugar.Elt a => Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.HSL.HSL a)
- Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Array.Sugar.Elt a => Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp a))
- Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Array.Sugar.Elt a => Data.Array.Accelerate.Product.IsProduct Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.HSL.HSL a)
- Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Classes.Fractional.Fractional a => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL a))
- Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Classes.Num.Num a => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL a))
- Data.Array.Accelerate.Data.Colour.HSV: instance (Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp a, Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Lift.Plain a)) => Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV a)
- Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Array.Sugar.Elt a => Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.HSV.HSV a)
- Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Array.Sugar.Elt a => Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp a))
- Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Array.Sugar.Elt a => Data.Array.Accelerate.Product.IsProduct Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.HSV.HSV a)
- Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Classes.Fractional.Fractional a => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV a))
- Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Classes.Num.Num a => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV a))
- Data.Array.Accelerate.Data.Colour.Names: instance (Data.Array.Accelerate.Array.Sugar.Elt c, Data.Array.Accelerate.Data.Colour.Names.NamedColour c) => Data.Array.Accelerate.Data.Colour.Names.NamedColour (Data.Array.Accelerate.Smart.Exp c)
- Data.Array.Accelerate.Data.Colour.RGB: instance (Data.Array.Accelerate.Classes.Fractional.Fractional a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)) ~ Data.Array.Accelerate.Data.Colour.RGB.RGB a) => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB a))
- Data.Array.Accelerate.Data.Colour.RGB: instance (Data.Array.Accelerate.Classes.Num.Num a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)) ~ Data.Array.Accelerate.Data.Colour.RGB.RGB a) => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB a))
- Data.Array.Accelerate.Data.Colour.RGB: instance Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGB.RGB GHC.Types.Float)
- Data.Array.Accelerate.Data.Colour.RGB: instance Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGB.RGB GHC.Word.Word8)
- Data.Array.Accelerate.Data.Colour.RGB: instance Data.Array.Accelerate.Product.IsProduct Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGB.RGB GHC.Types.Float)
- Data.Array.Accelerate.Data.Colour.RGB: instance Data.Array.Accelerate.Product.IsProduct Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGB.RGB GHC.Word.Word8)
- Data.Array.Accelerate.Data.Colour.RGBA: instance (Data.Array.Accelerate.Classes.Fractional.Fractional a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)) ~ Data.Array.Accelerate.Data.Colour.RGBA.RGBA a) => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA a))
- Data.Array.Accelerate.Data.Colour.RGBA: instance (Data.Array.Accelerate.Classes.Num.Num a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)) ~ Data.Array.Accelerate.Data.Colour.RGBA.RGBA a) => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA a))
- Data.Array.Accelerate.Data.Colour.RGBA: instance Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGBA.RGBA GHC.Types.Float)
- Data.Array.Accelerate.Data.Colour.RGBA: instance Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGBA.RGBA GHC.Word.Word8)
- Data.Array.Accelerate.Data.Colour.RGBA: instance Data.Array.Accelerate.Product.IsProduct Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGBA.RGBA GHC.Types.Float)
- Data.Array.Accelerate.Data.Colour.RGBA: instance Data.Array.Accelerate.Product.IsProduct Data.Array.Accelerate.Array.Sugar.Elt (Data.Array.Accelerate.Data.Colour.RGBA.RGBA GHC.Word.Word8)
+ Data.Array.Accelerate.Data.Colour.HSL: instance (Data.Array.Accelerate.Classes.Fractional.Fractional a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.HSL.HSL a) => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL a))
+ Data.Array.Accelerate.Data.Colour.HSL: instance (Data.Array.Accelerate.Classes.Num.Num a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.HSL.HSL a) => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL a))
+ Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp GHC.Types.Float))
+ Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSL.HSL (Data.Array.Accelerate.Smart.Exp GHC.Types.Float))
+ Data.Array.Accelerate.Data.Colour.HSL: instance Data.Array.Accelerate.Sugar.Elt.Elt (Data.Array.Accelerate.Data.Colour.HSL.HSL GHC.Types.Float)
+ Data.Array.Accelerate.Data.Colour.HSL: instance GHC.Generics.Generic (Data.Array.Accelerate.Data.Colour.HSL.HSL a)
+ Data.Array.Accelerate.Data.Colour.HSL: pattern HSL_ :: (Elt (HSL a), Elt a, VecElt a, EltR (HSL a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (HSL a)
+ Data.Array.Accelerate.Data.Colour.HSV: instance (Data.Array.Accelerate.Classes.Fractional.Fractional a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.HSV.HSV a) => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV a))
+ Data.Array.Accelerate.Data.Colour.HSV: instance (Data.Array.Accelerate.Classes.Num.Num a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.HSV.HSV a) => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV a))
+ Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp GHC.Types.Float))
+ Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Lift.Lift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV GHC.Types.Float)
+ Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.HSV.HSV (Data.Array.Accelerate.Smart.Exp GHC.Types.Float))
+ Data.Array.Accelerate.Data.Colour.HSV: instance Data.Array.Accelerate.Sugar.Elt.Elt (Data.Array.Accelerate.Data.Colour.HSV.HSV GHC.Types.Float)
+ Data.Array.Accelerate.Data.Colour.HSV: instance GHC.Generics.Generic (Data.Array.Accelerate.Data.Colour.HSV.HSV a)
+ Data.Array.Accelerate.Data.Colour.HSV: pattern HSV_ :: (Elt (HSV a), Elt a, VecElt a, EltR (HSV a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (HSV a)
+ Data.Array.Accelerate.Data.Colour.Names: instance (Data.Array.Accelerate.Sugar.Elt.Elt c, Data.Array.Accelerate.Data.Colour.Names.NamedColour c) => Data.Array.Accelerate.Data.Colour.Names.NamedColour (Data.Array.Accelerate.Smart.Exp c)
+ Data.Array.Accelerate.Data.Colour.RGB: instance (Data.Array.Accelerate.Classes.Fractional.Fractional a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.RGB.RGB a) => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB a))
+ Data.Array.Accelerate.Data.Colour.RGB: instance (Data.Array.Accelerate.Classes.Num.Num a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGB.RGB (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.RGB.RGB a) => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGB.RGB a))
+ Data.Array.Accelerate.Data.Colour.RGB: instance Data.Array.Accelerate.Sugar.Elt.Elt (Data.Array.Accelerate.Data.Colour.RGB.RGB GHC.Types.Float)
+ Data.Array.Accelerate.Data.Colour.RGB: instance Data.Array.Accelerate.Sugar.Elt.Elt (Data.Array.Accelerate.Data.Colour.RGB.RGB GHC.Word.Word8)
+ Data.Array.Accelerate.Data.Colour.RGB: instance GHC.Generics.Generic (Data.Array.Accelerate.Data.Colour.RGB.RGB a)
+ Data.Array.Accelerate.Data.Colour.RGB: pattern RGB_ :: (Elt (RGB a), Elt a, VecElt a, EltR (RGB a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (RGB a)
+ Data.Array.Accelerate.Data.Colour.RGBA: instance (Data.Array.Accelerate.Classes.Fractional.Fractional a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.RGBA.RGBA a) => GHC.Real.Fractional (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA a))
+ Data.Array.Accelerate.Data.Colour.RGBA: instance (Data.Array.Accelerate.Classes.Num.Num a, Data.Array.Accelerate.Lift.Unlift Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)), Data.Array.Accelerate.Lift.Plain (Data.Array.Accelerate.Data.Colour.RGBA.RGBA (Data.Array.Accelerate.Smart.Exp a)) Data.Type.Equality.~ Data.Array.Accelerate.Data.Colour.RGBA.RGBA a) => GHC.Num.Num (Data.Array.Accelerate.Smart.Exp (Data.Array.Accelerate.Data.Colour.RGBA.RGBA a))
+ Data.Array.Accelerate.Data.Colour.RGBA: instance Data.Array.Accelerate.Sugar.Elt.Elt (Data.Array.Accelerate.Data.Colour.RGBA.RGBA GHC.Types.Float)
+ Data.Array.Accelerate.Data.Colour.RGBA: instance Data.Array.Accelerate.Sugar.Elt.Elt (Data.Array.Accelerate.Data.Colour.RGBA.RGBA GHC.Word.Word8)
+ Data.Array.Accelerate.Data.Colour.RGBA: instance GHC.Generics.Generic (Data.Array.Accelerate.Data.Colour.RGBA.RGBA a)
+ Data.Array.Accelerate.Data.Colour.RGBA: pattern RGBA_ :: (Elt (RGBA a), Elt a, VecElt a, EltR (RGBA a) ~ Vec4 a) => Exp a -> Exp a -> Exp a -> Exp a -> Exp (RGBA a)
Files
- CHANGELOG.md +9/−0
- Data/Array/Accelerate/Data/Colour/HSL.hs +32/−38
- Data/Array/Accelerate/Data/Colour/HSV.hs +56/−53
- Data/Array/Accelerate/Data/Colour/Internal/Pack.hs +2/−2
- Data/Array/Accelerate/Data/Colour/Names.hs +2/−2
- Data/Array/Accelerate/Data/Colour/RGB.hs +58/−77
- Data/Array/Accelerate/Data/Colour/RGBA.hs +54/−75
- Data/Array/Accelerate/Data/Colour/SRGB.hs +16/−18
- LICENSE +1/−1
- README.md +16/−4
- colour-accelerate.cabal +7/−9
CHANGELOG.md view
@@ -6,6 +6,14 @@ project adheres to the [Haskell Package Versioning Policy (PVP)](https://pvp.haskell.org) +## [0.4.0.0] - 2020-08-26+### Changed+ * update for accelerate-1.3+ * data types are stored in AoS style++### Added+ * pattern synonyms for unpacking colour components+ ## [0.3.0.0] - 2018-04-03 ### Changed * update to accelerate-1.2@@ -18,6 +26,7 @@ * initial release +[0.4.0.0]: https://github.com/tmcdonell/colour-accelerate/compare/0.3.0.0...v0.4.0.0 [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
@@ -1,24 +1,24 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}-#if __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif -- | -- Module : Data.Array.Accelerate.Data.Colour.HSL--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -32,6 +32,7 @@ Colour, HSL(..),+ pattern HSL_, hsl, clamp,@@ -43,16 +44,14 @@ ) 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.Sugar.Elt+import Data.Primitive.Vec import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) ) import Data.Array.Accelerate.Data.Colour.Names as C import Data.Functor import Data.Typeable-import Prelude ( fromInteger ) -- ghc < 8 bug import qualified Prelude as P @@ -147,32 +146,25 @@ -- HSL colour space -- data HSL a = HSL a a a- deriving (P.Show, P.Eq, Functor, Typeable)---- Represent colours in Accelerate as a 3-tuple----type instance EltRepr (HSL a) = EltRepr (a, a, a)+ deriving (P.Show, P.Eq, Functor, Typeable, Generic) -instance Elt a => Elt (HSL a) where- eltType (_ :: HSL a) = eltType (undefined :: (a,a,a))- toElt c = let (h,s,l) = toElt c in HSL h s l- fromElt (HSL h s l) = fromElt (h,s,l)+pattern HSL_ :: (Elt (HSL a), Elt a, VecElt a, EltR (HSL a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (HSL a)+pattern HSL_ h s l = V3 h s l+{-# COMPLETE HSL_ #-} -instance Elt a => IsProduct Elt (HSL a) where- type ProdRepr (HSL a) = ((((),a), a), a)- fromProd _ (HSL h s l) = ((((), h), s), l)- toProd _ ((((),h),s),l) = HSL h s l- prod cst _ = prod cst (undefined :: (a,a,a))+instance Elt (HSL Float) where+ type EltR (HSL Float) = Vec3 Float+ eltR = eltR @(Vec3 Float)+ tagsR = tagsR @(Vec3 Float)+ toElt (Vec3 r g b) = HSL r g b+ fromElt (HSL r g b) = Vec3 r g b -instance (Lift Exp a, Elt (Plain a)) => Lift Exp (HSL a) where- type Plain (HSL a) = HSL (Plain a)- lift (HSL h s l) = Exp . Tuple $ NilTup `SnocTup` lift h `SnocTup` lift s `SnocTup` lift l+instance Lift Exp (HSL (Exp Float)) where+ type Plain (HSL (Exp Float)) = HSL Float+ lift (HSL h s l) = HSL_ h s l -instance Elt a => Unlift Exp (HSL (Exp a)) where- unlift c = let h = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c- s = Exp $ SuccTupIdx ZeroTupIdx `Prj` c- l = Exp $ ZeroTupIdx `Prj` c- in HSL h s l+instance Unlift Exp (HSL (Exp Float)) where+ unlift (HSL_ h s l) = HSL h s l instance P.Num a => P.Num (HSL a) where (+) (HSL h1 s1 v1 ) (HSL h2 s2 v2)@@ -192,7 +184,7 @@ fromInteger i = let f = P.fromInteger i- in HSL f f f+ in HSL f f f instance (P.Num a, P.Fractional a) => P.Fractional (HSL a) where (/) (HSL h1 s1 l1) (HSL h2 s2 l2)@@ -203,23 +195,25 @@ fromRational r = let f = P.fromRational r- in HSL f f f+ in HSL f f f -instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (HSL a)) where+instance (A.Num a, Unlift Exp (HSL (Exp a)), Plain (HSL (Exp a)) ~ HSL a)+ => P.Num (Exp (HSL a)) where (+) = lift2 ((+) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) (-) = lift2 ((-) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) (*) = 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 = P.fromInteger i :: Exp a- in lift $ HSL f f f+ in lift $ HSL f f f -instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (HSL a)) where+instance (A.Fractional a, Unlift Exp (HSL (Exp a)), Plain (HSL (Exp a)) ~ HSL 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 = P.fromRational r :: Exp a- in lift $ HSL f f f+ in lift $ HSL f f f -- Named colours
Data/Array/Accelerate/Data/Colour/HSV.hs view
@@ -1,24 +1,24 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}-#if __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif -- | -- Module : Data.Array.Accelerate.Data.Colour.HSV--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -32,6 +32,7 @@ Colour, HSV(..),+ pattern HSV_, hsv, clamp,@@ -43,16 +44,14 @@ ) 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.Sugar.Elt+import Data.Primitive.Vec -import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) )+import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..), pattern RGB_ ) import Data.Array.Accelerate.Data.Colour.Names as C import Data.Functor import Data.Typeable-import Prelude ( fromInteger ) -- ghc < 8 bug import qualified Prelude as P @@ -70,13 +69,12 @@ -> Exp Colour hsv h s v = clamp- $ lift (HSV h s v)+ $ HSV_ h s v clamp :: Exp Colour -> Exp Colour-clamp (unlift -> HSV h s v)- = lift- $ HSV (fmod h 360) (c s) (c v)+clamp (HSV_ h s v)+ = HSV_ (fmod h 360) (c s) (c v) where c x = 0 `max` x `min` 1 @@ -88,7 +86,7 @@ -- | Convert a HSV colour to an RGB colour-space value -- toRGB :: Exp (HSV Float) -> Exp (RGB Float)-toRGB (unlift -> HSV h s v) = rgb+toRGB (HSV_ h s v) = rgb where c = v * s h' = h / 60@@ -98,18 +96,18 @@ c' = c + m x' = x + m --- rgb = h' < 1 ? ( lift (RGB c' x' m)- , h' < 2 ? ( lift (RGB x' c' m)- , h' < 3 ? ( lift (RGB m c' x')- , h' < 4 ? ( lift (RGB m x' c')- , h' < 5 ? ( lift (RGB x' m c')- , ( lift (RGB c' m x') ))))))+ rgb = h' < 1 ? ( RGB_ c' x' m+ , h' < 2 ? ( RGB_ x' c' m+ , h' < 3 ? ( RGB_ m c' x'+ , h' < 4 ? ( RGB_ m x' c'+ , h' < 5 ? ( RGB_ x' m c'+ , ( RGB_ c' m x' )))))) -- | Convert a point in the RGB colour-space to a point in the HSV colour-space. -- fromRGB :: Exp (RGB Float) -> Exp (HSV Float)-fromRGB (unlift -> RGB r g b) = lift (HSV h s v)+fromRGB (RGB_ r g b) = HSV_ h s v where mx = P.maximum [r,g,b] mn = P.minimum [r,g,b]@@ -128,17 +126,23 @@ -- | Return the HSV-hue of an RGB colour -- hue :: Exp (RGB Float) -> Exp Float-hue (unlift . fromRGB -> HSV h _ _) = h+hue c =+ let HSV_ h _ _ = fromRGB c+ in h -- | Return the HSV-saturation of an RGB colour -- saturation :: Exp (RGB Float) -> Exp Float-saturation (unlift . fromRGB -> HSV _ s _) = s+saturation c =+ let HSV_ _ s _ = fromRGB c+ in s -- | Return the HSV-value of an RGB colour -- value :: Exp (RGB Float) -> Exp Float-value (unlift . fromRGB -> HSV _ _ v) = v+value c =+ let HSV_ _ _ v = fromRGB c+ in v -- Accelerate bits@@ -147,32 +151,29 @@ -- HSV colour space -- data HSV a = HSV a a a- deriving (P.Show, P.Eq, Functor, Typeable)+ deriving (P.Show, P.Eq, Functor, Typeable, Generic) --- Represent colours in Accelerate as a 3-tuple----type instance EltRepr (HSV a) = EltRepr (a, a, a)+pattern HSV_ :: (Elt (HSV a), Elt a, VecElt a, EltR (HSV a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (HSV a)+pattern HSV_ h s v = V3 h s v+{-# COMPLETE HSV_ #-} -instance Elt a => Elt (HSV a) where- eltType (_ :: HSV a) = eltType (undefined :: (a,a,a))- toElt c = let (h,s,v) = toElt c in HSV h s v- fromElt (HSV h s v) = fromElt (h,s,v)+instance Elt (HSV Float) where+ type EltR (HSV Float) = Vec3 Float+ eltR = eltR @(Vec3 Float)+ tagsR = tagsR @(Vec3 Float)+ toElt (Vec3 r g b) = HSV r g b+ fromElt (HSV r g b) = Vec3 r g b -instance Elt a => IsProduct Elt (HSV a) where- type ProdRepr (HSV a) = ((((),a), a), a)- fromProd _ (HSV h s v) = ((((), h), s), v)- toProd _ ((((),h),s),v) = HSV h s v- prod cst _ = prod cst (undefined :: (a,a,a))+instance Lift Exp (HSV Float) where+ type Plain (HSV Float) = HSV Float+ lift = constant -instance (Lift Exp a, Elt (Plain a)) => Lift Exp (HSV a) where- type Plain (HSV a) = HSV (Plain a)- lift (HSV h s v) = Exp . Tuple $ NilTup `SnocTup` lift h `SnocTup` lift s `SnocTup` lift v+instance Lift Exp (HSV (Exp Float)) where+ type Plain (HSV (Exp Float)) = HSV Float+ lift (HSV h s v) = HSV_ h s v -instance Elt a => Unlift Exp (HSV (Exp a)) where- unlift c = let h = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c- s = Exp $ SuccTupIdx ZeroTupIdx `Prj` c- v = Exp $ ZeroTupIdx `Prj` c- in HSV h s v+instance Unlift Exp (HSV (Exp Float)) where+ unlift (HSV_ h s v) = HSV h s v instance P.Num a => P.Num (HSV a) where (+) (HSV h1 s1 v1 ) (HSV h2 s2 v2)@@ -192,7 +193,7 @@ fromInteger i = let f = P.fromInteger i- in HSV f f f+ in HSV f f f instance (P.Num a, P.Fractional a) => P.Fractional (HSV a) where (/) (HSV h1 s1 v1) (HSV h2 s2 v2)@@ -203,23 +204,25 @@ fromRational r = let f = P.fromRational r- in HSV f f f+ in HSV f f f -instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (HSV a)) where+instance (A.Num a, Unlift Exp (HSV (Exp a)), Plain (HSV (Exp a)) ~ HSV a)+ => P.Num (Exp (HSV a)) where (+) = lift2 ((+) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) (-) = lift2 ((-) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) (*) = 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 = P.fromInteger i :: Exp a- in lift $ HSV f f f+ in lift $ HSV f f f -instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (HSV a)) where+instance (A.Fractional a, Unlift Exp (HSV (Exp a)), Plain (HSV (Exp a)) ~ HSV 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 = P.fromRational r :: Exp a- in lift $ HSV f f f+ in lift $ HSV f f f -- Named colours
Data/Array/Accelerate/Data/Colour/Internal/Pack.hs view
@@ -1,9 +1,9 @@ -- | -- Module : Data.Array.Accelerate.Data.Colour.Internal.Pack--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
Data/Array/Accelerate/Data/Colour/Names.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE NoImplicitPrelude #-} -- | -- Module : Data.Array.Accelerate.Data.Colour.Names--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --
Data/Array/Accelerate/Data/Colour/RGB.hs view
@@ -1,24 +1,24 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}-#if __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif -- | -- Module : Data.Array.Accelerate.Data.Colour.RGB--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -29,6 +29,7 @@ Colour, RGB(..),+ pattern RGB_, rgb, rgb8, clamp,@@ -41,13 +42,11 @@ ) where import Data.Array.Accelerate as A hiding ( clamp )-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.Sugar.Elt+import Data.Primitive.Vec import Data.Array.Accelerate.Data.Colour.Names-import Data.Array.Accelerate.Data.Colour.RGBA ( RGBA(..) )+import Data.Array.Accelerate.Data.Colour.RGBA ( pattern RGBA_ ) import Data.Array.Accelerate.Data.Colour.Internal.Pack ( word8OfFloat ) import Data.Typeable@@ -67,7 +66,7 @@ -> Exp Colour rgb r g b = clamp- $ lift (RGB r g b)+ $ RGB_ r g b -- | Construct a colour from 8-bit-per-channel colour components.@@ -77,10 +76,9 @@ -> Exp Word8 -- ^ blue component -> Exp Colour rgb8 r g b- = lift- $ RGB (A.fromIntegral r / 255 :: Exp Float)- (A.fromIntegral g / 255)- (A.fromIntegral b / 255)+ = RGB_ (A.fromIntegral r / 255 :: Exp Float)+ (A.fromIntegral g / 255)+ (A.fromIntegral b / 255) -- | Clamp each component of a colour to the range [0..1].@@ -108,11 +106,8 @@ -> Exp Colour -- ^ First colour -> Exp Colour -- ^ Second colour -> Exp Colour -- ^ Resulting colour-blend m1 m2 c1 c2 =+blend m1 m2 (RGB_ r1 g1 b1) (RGB_ r2 g2 b2) = let- RGB r1 g1 b1 = unlift c1- RGB r2 g2 b2 = unlift c2- -- Normalise mixing proportions to ratios. m12 = m1 + m2 m1' = m1 / m12@@ -132,7 +127,7 @@ -- | Luminance of an RGB colour (Y component of a YUV colour). -- luminance :: Exp Colour -> Exp Float-luminance (unlift -> RGB r g b) = 0.299*r + 0.587*g + 0.114*b+luminance (RGB_ r g b) = 0.299*r + 0.587*g + 0.114*b -- Packed representation@@ -141,47 +136,51 @@ -- | Convert a Colour into a packed-word RGBA representation -- packRGB :: Exp Colour -> Exp Word32-packRGB (unlift -> RGB r g b)+packRGB (RGB_ r g b) = bitcast- . lift- $ RGBA (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) 0xFF+ $ 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)+packBGR (RGB_ r g b) = bitcast- . lift- $ RGBA 0xFF (word8OfFloat b) (word8OfFloat g) (word8OfFloat r)+ $ RGBA_ 0xFF (word8OfFloat b) (word8OfFloat g) (word8OfFloat r) packRGB8 :: Exp (RGB Word8) -> Exp Word32-packRGB8 (unlift -> RGB r g b :: RGB (Exp Word8))+packRGB8 (RGB_ r g b) = bitcast- . lift- $ RGBA r g b 0xFF+ $ RGBA_ r g b 0xFF packBGR8 :: Exp (RGB Word8) -> Exp Word32-packBGR8 (unlift -> RGB r g b :: RGB (Exp Word8))+packBGR8 (RGB_ r g b) = bitcast- . lift- $ RGBA 0xff b g r+ $ RGBA_ 0xff b g r -- | Convert a colour from a packed-word RGBA representation -- unpackRGB :: Exp Word32 -> Exp Colour-unpackRGB (unlift . bitcast -> RGBA r g b _ :: RGBA (Exp Word8)) = rgb8 r g b+unpackRGB w =+ let RGBA_ r g b _ = bitcast w+ in rgb8 r g b -- | Convert a colour from a packed-word ABGR representation -- unpackBGR :: Exp Word32 -> Exp Colour-unpackBGR (unlift . bitcast -> RGBA _ b g r :: RGBA (Exp Word8)) = rgb8 r g b+unpackBGR w =+ let RGBA_ _ b g r = bitcast w+ in rgb8 r g b unpackRGB8 :: Exp Word32 -> Exp (RGB Word8)-unpackRGB8 (unlift . bitcast -> RGBA r g b _ :: RGBA (Exp Word8)) = lift (RGB r g b)+unpackRGB8 w =+ let RGBA_ r g b _ = bitcast w+ in RGB_ r g b unpackBGR8 :: Exp Word32 -> Exp (RGB Word8)-unpackBGR8 (unlift . bitcast -> RGBA _ b g r :: RGBA (Exp Word8)) = lift (RGB r g b)+unpackBGR8 w =+ let RGBA_ _ b g r = bitcast w+ in RGB_ r g b -- Accelerate bits@@ -196,32 +195,25 @@ -- 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)+ deriving (Show, P.Eq, Functor, Typeable, Generic) -type instance EltRepr (RGB Float) = EltRepr (Float, Float, Float)-type instance EltRepr (RGB Word8) = V3 Word8+pattern RGB_ :: (Elt (RGB a), Elt a, VecElt a, EltR (RGB a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (RGB a)+pattern RGB_ r g b = V3 r g b+{-# COMPLETE RGB_ #-} 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)+ type EltR (RGB Float) = Vec3 Float+ eltR = eltR @(Vec3 Float)+ tagsR = tagsR @(Vec3 Float)+ toElt (Vec3 r g b) = RGB r g b+ fromElt (RGB r g b) = Vec3 r g b 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 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 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)+ type EltR (RGB Word8) = Vec3 Word8+ eltR = eltR @(Vec3 Word8)+ tagsR = tagsR @(Vec3 Word8)+ toElt (Vec3 r g b) = RGB r g b+ fromElt (RGB r g b) = Vec3 r g b instance Lift Exp (RGB Float) where type Plain (RGB Float) = RGB Float@@ -233,28 +225,17 @@ 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+ lift (RGB r g b) = RGB_ r g 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+ lift (RGB r g b) = RGB_ r g 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+ unlift (RGB_ r g b) = 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+ unlift (RGB_ r g b) = RGB r g b instance P.Num a => P.Num (RGB a) where@@ -275,7 +256,7 @@ fromInteger i = let f = P.fromInteger i- in RGB f f f+ in RGB f f f instance (P.Num a, P.Fractional a) => P.Fractional (RGB a) where (/) (RGB r1 g1 b1) (RGB r2 g2 b2)@@ -286,7 +267,7 @@ fromRational r = let f = P.fromRational r- in RGB f f f+ in RGB f f f instance (A.Num a, Unlift Exp (RGB (Exp a)), Plain (RGB (Exp a)) ~ RGB a) => P.Num (Exp (RGB a)) where@@ -296,14 +277,14 @@ abs = lift1 (abs :: RGB (Exp a) -> RGB (Exp a)) signum = lift1 (signum :: RGB (Exp a) -> RGB (Exp a)) fromInteger i = let f = P.fromInteger i :: Exp a- in lift $ RGB f f f+ in lift $ RGB f f f 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 = P.fromRational r :: Exp a- in lift $ RGB f f f+ in lift $ RGB f f f -- Named colours
Data/Array/Accelerate/Data/Colour/RGBA.hs view
@@ -1,24 +1,24 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}-#if __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE OverlappingInstances #-}-{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}-#endif -- | -- Module : Data.Array.Accelerate.Data.Colour.RGBA--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -29,6 +29,7 @@ Colour, RGBA(..),+ pattern RGBA_, rgba, rgba8, clamp,@@ -42,10 +43,8 @@ ) where import Data.Array.Accelerate as A hiding ( clamp )-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.Sugar.Elt+import Data.Primitive.Vec import Data.Array.Accelerate.Data.Colour.Names import Data.Array.Accelerate.Data.Colour.Internal.Pack ( word8OfFloat )@@ -70,7 +69,7 @@ -> Exp Colour rgba r g b a = clamp- $ lift (RGBA r g b a)+ $ RGBA_ r g b a -- | Construct a colour from 8-bits-per-channel colour components.@@ -82,11 +81,10 @@ -> Exp Word8 -- ^ alpha component -> Exp Colour rgba8 r g b a- = lift- $ RGBA (A.fromIntegral r / 255 :: Exp Float)- (A.fromIntegral g / 255)- (A.fromIntegral b / 255)- (A.fromIntegral a / 255)+ = RGBA_ (A.fromIntegral r / 255 :: Exp Float)+ (A.fromIntegral g / 255)+ (A.fromIntegral b / 255)+ (A.fromIntegral a / 255) -- | Clamp each component to the range [0..1]@@ -114,11 +112,8 @@ -> Exp Colour -- ^ First colour -> Exp Colour -- ^ Second colour -> Exp Colour -- ^ Resulting colour-blend m1 m2 c1 c2 =+blend m1 m2 (RGBA_ r1 g1 b1 a1) (RGBA_ r2 g2 b2 a2) = let- RGBA r1 g1 b1 a1 = unlift c1- RGBA r2 g2 b2 a2 = unlift c2- -- Normalise mixing proportions to ratios. m12 = m1 + m2 m1' = m1 / m12@@ -139,14 +134,14 @@ -- | Luminance of an RGB colour (Y component of a YUV colour). -- luminance :: Exp Colour -> Exp Float-luminance (unlift -> RGBA r g b _) = 0.299*r + 0.587*g + 0.114*b+luminance (RGBA_ r g b _) = 0.299*r + 0.587*g + 0.114*b -- | Set the opacity of the given colour. The opacity is clamped to the range -- [0..1]. -- opacity :: Exp Float -> Exp Colour -> Exp Colour-opacity a (unlift -> RGBA r g b _) = lift $ RGBA r g b (0 `A.max` a `A.min` 1)+opacity a (RGBA_ r g b _) = RGBA_ r g b (0 `A.max` a `A.min` 1) -- | Make colour transparent --@@ -165,44 +160,47 @@ -- | Convert a Colour into a packed-word RGBA representation -- packRGBA :: Exp Colour -> Exp Word32-packRGBA (unlift -> RGBA r g b a)+packRGBA (RGBA_ r g b a) = bitcast- . lift- $ RGBA (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) (word8OfFloat a)+ $ 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)+packABGR (RGBA_ r g b a) = bitcast- . lift- $ RGBA (word8OfFloat a) (word8OfFloat b) (word8OfFloat g) (word8OfFloat r)+ $ RGBA_ (word8OfFloat a) (word8OfFloat b) (word8OfFloat g) (word8OfFloat r) packRGBA8 :: Exp (RGBA Word8) -> Exp Word32 packRGBA8 = bitcast packABGR8 :: Exp (RGBA Word8) -> Exp Word32-packABGR8 (unlift -> RGBA r g b a :: RGBA (Exp Word8))+packABGR8 (RGBA_ r g b a) = bitcast- $ lift (RGBA a b g r)+ $ RGBA_ a b g r -- | Convert a colour from a packed-word RGBA representation -- unpackRGBA :: Exp Word32 -> Exp Colour-unpackRGBA (unlift . bitcast -> RGBA r g b a) = rgba8 r g b a+unpackRGBA w =+ let RGBA_ r g b a = bitcast w+ in rgba8 r g b a -- | Convert a colour from a packed-word ABGR representation -- unpackABGR :: Exp Word32 -> Exp Colour-unpackABGR (unlift . bitcast -> RGBA a b g r) = rgba8 r g b a+unpackABGR w =+ let RGBA_ a b g r = bitcast w+ in rgba8 r g b a unpackRGBA8 :: Exp Word32 -> Exp (RGBA Word8) unpackRGBA8 = bitcast unpackABGR8 :: Exp Word32 -> Exp (RGBA Word8)-unpackABGR8 (unlift . bitcast -> RGBA a b g r :: RGBA (Exp Word8)) =- lift (RGBA r g b a)+unpackABGR8 w =+ let RGBA_ a b g r = bitcast w+ in RGBA_ r g b a -- Accelerate bits@@ -217,32 +215,25 @@ -- 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)+ deriving (Show, P.Eq, Functor, Typeable, Generic) -type instance EltRepr (RGBA Float) = EltRepr (Float,Float,Float,Float)-type instance EltRepr (RGBA Word8) = V4 Word8+pattern RGBA_ :: (Elt (RGBA a), Elt a, VecElt a, EltR (RGBA a) ~ Vec4 a) => Exp a -> Exp a -> Exp a -> Exp a -> Exp (RGBA a)+pattern RGBA_ r g b a = V4 r g b a+{-# COMPLETE RGBA_ #-} 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)+ type EltR (RGBA Float) = Vec4 Float+ eltR = eltR @(Vec4 Float)+ tagsR = tagsR @(Vec4 Float)+ toElt (Vec4 r g b a) = RGBA r g b a+ fromElt (RGBA r g b a) = Vec4 r g b 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 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 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)+ type EltR (RGBA Word8) = Vec4 Word8+ eltR = eltR @(Vec4 Word8)+ tagsR = tagsR @(Vec4 Word8)+ toElt (Vec4 r g b a) = RGBA r g b a+ fromElt (RGBA r g b a) = Vec4 r g b a instance Lift Exp (RGBA Float) where type Plain (RGBA Float) = RGBA Float@@ -254,29 +245,17 @@ 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+ lift (RGBA r g b a) = RGBA_ r g b 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+ lift (RGBA r g b a) = RGBA_ r g b 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+ unlift (RGBA_ r g b a) = 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+ unlift (RGBA_ r g b a) = RGBA r g b a instance P.Num a => P.Num (RGBA a) where@@ -297,7 +276,7 @@ fromInteger i = let f = P.fromInteger i- in RGBA f f f 1+ in RGBA f f f 1 instance (P.Num a, P.Fractional a) => P.Fractional (RGBA a) where (/) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)@@ -308,7 +287,7 @@ fromRational r = let f = P.fromRational r- in RGBA f f f 1+ in RGBA f f f 1 instance (A.Num a, Unlift Exp (RGBA (Exp a)), Plain (RGBA (Exp a)) ~ RGBA a) => P.Num (Exp (RGBA a)) where@@ -319,7 +298,7 @@ signum = lift1 (signum :: RGBA (Exp a) -> RGBA (Exp a)) fromInteger i = let f = P.fromInteger i a = P.fromInteger 1 :: Exp a- in lift $ RGBA f f f a+ in lift $ RGBA f f f a instance (A.Fractional a, Unlift Exp (RGBA (Exp a)), Plain (RGBA (Exp a)) ~ RGBA a) => P.Fractional (Exp (RGBA a)) where@@ -327,7 +306,7 @@ recip = lift1 (recip :: RGBA (Exp a) -> RGBA (Exp a)) fromRational r = let f = P.fromRational r a = P.fromRational 1 :: Exp a- in lift $ RGBA f f f a+ in lift $ RGBA f f f a -- Named colours
Data/Array/Accelerate/Data/Colour/SRGB.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Array.Accelerate.Data.Colour.SRGB--- Copyright : [2016] Trevor L. McDonell+-- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 ----- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability : experimental -- Portability : non-portable (GHC extensions) --@@ -24,7 +25,7 @@ ) where import Data.Array.Accelerate as A hiding ( clamp )-import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) )+import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..), pattern RGB_ ) import Data.Functor ( fmap ) @@ -46,7 +47,7 @@ -> Exp Colour srgb r g b = clamp- $ lift (RGB r g b)+ $ RGB_ r g b -- | Construct an sRGB colour from 8-bit-per-channel colour components.@@ -56,10 +57,9 @@ -> Exp Word8 -- ^ blue component -> Exp Colour srgb8 r g b- = lift- $ RGB (fromIntegral r / 255 :: Exp Float)- (fromIntegral g / 255)- (fromIntegral b / 255)+ = RGB_ (fromIntegral r / 255 :: Exp Float)+ (fromIntegral g / 255)+ (fromIntegral b / 255) -- | Clamp each component of a colour to the range [0..1].@@ -74,21 +74,19 @@ -- colour space. -- fromRGB :: Exp (RGB Float) -> Exp (SRGB Float)-fromRGB (unlift -> RGB r g b)- = lift- $ RGB (invTransferFunction r)- (invTransferFunction g)- (invTransferFunction b)+fromRGB (RGB_ r g b)+ = RGB_ (invTransferFunction r)+ (invTransferFunction g)+ (invTransferFunction b) -- | Convert a colour in the linear sRGB colour space into the non-linear RGB -- colour space. -- toRGB :: Exp (SRGB Float) -> Exp (RGB Float)-toRGB (unlift -> RGB r g b)- = lift- $ RGB (transferFunction r)- (transferFunction g)- (transferFunction b)+toRGB (RGB_ r g b)+ = RGB_ (transferFunction r)+ (transferFunction g)+ (transferFunction b) -- The non-linear sRGB transfer function approximates a gamma of about 2.2.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2016, Trevor L. McDonell+Copyright (c) [2016..2020], Trevor L. McDonell All rights reserved.
README.md view
@@ -1,16 +1,25 @@-colour-accelerate-=================+<div align="center">+<img width="450" src="https://github.com/AccelerateHS/accelerate/raw/master/images/accelerate-logo-text-v.png?raw=true" alt="henlo, my name is Theia"/> -[](https://travis-ci.org/tmcdonell/colour-accelerate)+# colour-accelerate++[](https://github.com/tmcdonell/colour-accelerate/actions)+[](https://gitter.im/AccelerateHS/Lobby)+<br> [](https://stackage.org/lts/package/colour-accelerate) [](https://stackage.org/nightly/package/colour-accelerate) [](https://hackage.haskell.org/package/colour-accelerate) +</div>+ This package provides data types and operations for dealing with colours in Accelerate. For details on Accelerate, refer to the [main-repository](https://github.com/AccelerateHS/accelerate).+repository][accelerate]. +Contributions and bug reports are welcome!<br>+Please feel free to contact me through [GitHub][accelerate] or [gitter.im][gitter.im]. + Example: Blur ------------- @@ -38,3 +47,6 @@ [blocks]: https://github.com/tmcdonell/colour-accelerate/raw/master/samples/blocks.bmp [blur_srgb]: https://github.com/tmcdonell/colour-accelerate/raw/master/samples/blur_srgb.bmp [blur_rgb]: https://github.com/tmcdonell/colour-accelerate/raw/master/samples/blur_rgb.bmp+[accelerate]: https://github.com/AccelerateHS/accelerate+[gitter.im]: https://gitter.im/AccelerateHS/Lobby+
colour-accelerate.cabal view
@@ -1,5 +1,5 @@ name: colour-accelerate-version: 0.3.0.0+version: 0.4.0.0 synopsis: Working with colours in Accelerate description: This package provides data types for colours and transparency for use with@@ -9,11 +9,10 @@ license: BSD3 license-file: LICENSE author: Trevor L. McDonell-maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>-copyright: Copyright (c) [2016]. Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>-category: Data, Graphics+maintainer: Trevor L. McDonell <trevor.mcdonell@gmail.com>+category: Accelerate, Data, Graphics build-type: Simple-cabal-version: >=1.18+cabal-version: 1.18 homepage: https://github.com/tmcdonell/colour-accelerate bug-reports: https://github.com/tmcdonell/colour-accelerate/issues@@ -30,8 +29,8 @@ library default-language: Haskell2010 build-depends:- base >= 4.7 && < 4.12- , accelerate >= 1.2+ base >= 4.8 && < 5+ , accelerate >= 1.3 ghc-options: -Wall@@ -54,8 +53,7 @@ source-repository this type: git- tag: 0.3.0.0+ tag: v0.4.0.0 location: https://github.com/tmcdonell/colour-accelerate -- vim: nospell-