packages feed

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 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"/> -[![Build Status](https://travis-ci.org/tmcdonell/colour-accelerate.svg?branch=master)](https://travis-ci.org/tmcdonell/colour-accelerate)+# colour-accelerate++[![GitHub CI](https://github.com/tmcdonell/colour-accelerate/workflows/CI/badge.svg)](https://github.com/tmcdonell/colour-accelerate/actions)+[![Gitter](https://img.shields.io/gitter/room/nwjs/nw.js.svg)](https://gitter.im/AccelerateHS/Lobby)+<br> [![Stackage LTS](https://stackage.org/package/colour-accelerate/badge/lts)](https://stackage.org/lts/package/colour-accelerate) [![Stackage Nightly](https://stackage.org/package/colour-accelerate/badge/nightly)](https://stackage.org/nightly/package/colour-accelerate) [![Hackage](https://img.shields.io/hackage/v/colour-accelerate.svg)](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-