gloss-accelerate 1.9.0.0 → 2.0.0.0
raw patch · 6 files changed
+62/−690 lines, 6 filesdep ~acceleratedep ~basedep ~gloss
Dependency ranges changed: accelerate, base, gloss, gloss-rendering
Files
- Graphics/Gloss/Accelerate/Data/Color.hs +0/−11
- Graphics/Gloss/Accelerate/Data/Color/RGB.hs +0/−309
- Graphics/Gloss/Accelerate/Data/Color/RGBA.hs +0/−325
- Graphics/Gloss/Accelerate/Data/Picture.hs +24/−6
- Graphics/Gloss/Accelerate/Data/Point.hs +27/−20
- gloss-accelerate.cabal +11/−19
− Graphics/Gloss/Accelerate/Data/Color.hs
@@ -1,11 +0,0 @@--- | Predefined and custom colors. Essentially equivalent to the--- "Graphics.Gloss.Data.Color", but lifted to Accelerate types.----module Graphics.Gloss.Accelerate.Data.Color (-- module Graphics.Gloss.Accelerate.Data.Color.RGBA--) where--import Graphics.Gloss.Accelerate.Data.Color.RGBA-
− Graphics/Gloss/Accelerate/Data/Color/RGB.hs
@@ -1,309 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}---- | Colours without an alpha component----module Graphics.Gloss.Accelerate.Data.Color.RGB (-- -- ** Color data type- Color, RGB(..),- makeColor,- makeColor8,- rawColor,- rgbOfColor,- packRGBA, packABGR,- clampColor,-- -- ** Color functions- mixColors,- addColors,- dim, brighten,- lighten, darken,-- -- ** Pre-defined colors- greyN, black, white,-- -- *** Primary- red, green, blue,-- -- *** Secondary- yellow, cyan, magenta,-- -- *** Tertiary- rose, violet, azure, aquamarine, chartreuse, orange,--) where--import Prelude as P-import Data.Bits-import Data.Typeable-import Data.Array.Accelerate as A-import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Tuple ( Tuple(..), TupleIdx(..), IsTuple(..), )-import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, EltRepr' )----- | An abstract color value.------ We keep the type abstract so we can be sure that the components are in the--- required range. To make a custom color use 'makeColor'.----type Color = RGB Float---- | Same as 'Graphics.Gloss.Accelerate.Data.Color.RGBA.RGBA', but colours don't--- have an alpha component. All components like in the range [0..1).------ We need to parameterise by a type so that we can have both Exp (RGB a) and--- RGB (Exp a).----data RGB a = RGB a a a- deriving (Show, Eq, Typeable)---instance Num a => Num (RGB a) where- (+) (RGB r1 g1 b1 ) (RGB r2 g2 b2)- = RGB (r1 + r2) (g1 + g2) (b1 + b2)-- (-) (RGB r1 g1 b1) (RGB r2 g2 b2)- = RGB (r1 - r2) (g1 - g2) (b1 - b2)-- (*) (RGB r1 g1 b1) (RGB r2 g2 b2)- = RGB (r1 * r2) (g1 * g2) (b1 * b2)-- abs (RGB r1 g1 b1)- = RGB (abs r1) (abs g1) (abs b1)-- signum (RGB r1 g1 b1)- = RGB (signum r1) (signum g1) (signum b1)-- fromInteger i- = let f = fromInteger i- in RGB f f f--instance (Elt a, IsNum a) => Num (Exp (RGB a)) where- (+) = lift2 ((+) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a))- (-) = lift2 ((-) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a))- (*) = lift2 ((*) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a))- abs = lift1 (abs :: RGB (Exp a) -> RGB (Exp a))- signum = lift1 (signum :: RGB (Exp a) -> RGB (Exp a))- fromInteger i = let f = constant (fromInteger i)- in lift $ RGB f f f---- Represent colours in Accelerate as a 4-tuple----type instance EltRepr (RGB a) = EltRepr (a, a, a)-type instance EltRepr' (RGB a) = EltRepr (a, a, a)--instance Elt a => Elt (RGB a) where- eltType (_ :: RGB a) = eltType (undefined :: (a,a,a))- toElt c = let (r,g,b) = toElt c in RGB r g b- fromElt (RGB r g b) = fromElt (r,g,b)-- eltType' (_ :: RGB a) = eltType' (undefined :: (a,a,a))- toElt' c = let (r,g,b) = toElt' c in RGB r g b- fromElt' (RGB r g b) = fromElt' (r,g,b)--instance IsTuple (RGB a) where- type TupleRepr (RGB a) = ((((),a), a), a)- fromTuple (RGB r g b) = ((((), r), g), b)- toTuple ((((),r),g),b) = RGB r g b--instance (Lift Exp a, Elt (Plain a)) => Lift Exp (RGB a) where- type Plain (RGB a) = RGB (Plain a)- lift (RGB r g b) = Exp . Tuple $ NilTup `SnocTup` lift r `SnocTup` lift g `SnocTup` lift b--instance Elt a => Unlift Exp (RGB (Exp a)) where- unlift c = let r = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c- g = Exp $ SuccTupIdx ZeroTupIdx `Prj` c- b = Exp $ ZeroTupIdx `Prj` c- in RGB r g b----- | Make a custom color. All components are clamped to the range [0..1].----makeColor- :: Exp Float -- ^ Red component.- -> Exp Float -- ^ Green component.- -> Exp Float -- ^ Blue component.- -> Exp Color-makeColor r g b- = clampColor- $ rawColor r g b----- | Make a custom color.--- You promise that all components are clamped to the range [0..1]----rawColor :: Exp Float -> Exp Float -> Exp Float -> Exp Color-rawColor r g b = lift (RGB r g b)----- | Make a custom color from 8-bit values.----makeColor8- :: Exp Word8 -- ^ Red component.- -> Exp Word8 -- ^ Green component.- -> Exp Word8 -- ^ Blue component.- -> Exp Color-makeColor8 r g b- = clampColor- $ rawColor (A.fromIntegral r / 255)- (A.fromIntegral g / 255)- (A.fromIntegral b / 255)----- | Take the RGB components of a color.-rgbOfColor :: Exp Color -> (Exp Float, Exp Float, Exp Float)-rgbOfColor c- = let (RGB r g b) = unlift c- in (r, g, b)----- Internal--- ------------ | Clamp components of a color into the required range.----clampColor :: Exp Color -> Exp Color-clampColor cc- = let (r, g, b) = rgbOfColor cc- in rawColor (min 1 r) (min 1 g) (min 1 b)----- | Normalise a color to the value of its largest RGB component.----normaliseColor :: Exp Color -> Exp Color-normaliseColor cc- = let (r, g, b) = rgbOfColor cc- m = P.maximum [r, g, b]- in rawColor (r / m) (g / m) (b / m)----- | Convert a color into a packed RGBA value.----packRGBA :: Exp Color -> Exp Word32-packRGBA c- = let (r, g, b) = rgbOfColor c- in word32OfFloat r `A.shiftL` 24- .|. word32OfFloat g `A.shiftL` 16- .|. word32OfFloat b `A.shiftL` 8- .|. 0xFF---- | Convert a colour into a packed BGRA value.------ This is necessary as OpenGL reads pixel data as ABGR, rather than RGBA.----packABGR :: Exp Color -> Exp Word32-packABGR c- = let (r, g, b) = rgbOfColor c- a = 1.0- in word32OfFloat a `A.shiftL` 24- .|. word32OfFloat b `A.shiftL` 16- .|. word32OfFloat g `A.shiftL` 8- .|. word32OfFloat r--word32OfFloat :: Exp Float -> Exp Word32-word32OfFloat f = A.truncate (f * 255)----- Color functions ---------------------------------------------------------------- | Mix two colors with the given ratios.----mixColors- :: Exp Float -- ^ Ratio of first color.- -> Exp Float -- ^ Ratio of second color.- -> Exp Color -- ^ First color.- -> Exp Color -- ^ Second color.- -> Exp Color -- ^ Resulting color.--mixColors ratio1 ratio2 c1 c2- = let (r1, g1, b1) = rgbOfColor c1- (r2, g2, b2) = rgbOfColor c2-- total = ratio1 + ratio2- m1 = ratio1 / total- m2 = ratio2 / total- in- rawColor (m1 * r1 + m2 * r2)- (m1 * g1 + m2 * g2)- (m1 * b1 + m2 * b2)----- | Add RGB components of a color component-wise, then normalise them to the--- highest resulting one. The alpha components are averaged.----addColors :: Exp Color -> Exp Color -> Exp Color-addColors c1 c2- = let (r1, g1, b1) = rgbOfColor c1- (r2, g2, b2) = rgbOfColor c2- in- normaliseColor $ rawColor (r1 + r2) (g1 + g2) (b1 + b2)---- | Make a dimmer version of a color, scaling towards black.----dim :: Exp Color -> Exp Color-dim c- = let (r, g, b) = rgbOfColor c- in rawColor (r / 1.2) (g / 1.2) (b / 1.2)---- | Make a brighter version of a color, scaling towards white.----brighten :: Exp Color -> Exp Color-brighten c- = let (r, g, b) = rgbOfColor c- in clampColor $ rawColor (r * 1.2) (g * 1.2) (b * 1.2)---- | Lighten a color, adding white.----lighten :: Exp Color -> Exp Color-lighten c- = let (r, g, b) = rgbOfColor c- in clampColor $ rawColor (r + 0.2) (g + 0.2) (b + 0.2)---- | Darken a color, adding black.----darken :: Exp Color -> Exp Color-darken c- = let (r, g, b) = rgbOfColor c- in clampColor $ rawColor (r - 0.2) (g - 0.2) (b - 0.2)----- Pre-defined Colors ------------------------------------------------------------- | A greyness of a given magnitude.----greyN :: Exp Float -- ^ Range is 0 = black, to 1 = white.- -> Exp Color-greyN n = rawColor n n n--black, white :: Exp Color-black = rawColor 0.0 0.0 0.0-white = rawColor 1.0 1.0 1.0---- Colors from the additive color wheel.-red, green, blue :: Exp Color-red = rawColor 1.0 0.0 0.0-green = rawColor 0.0 1.0 0.0-blue = rawColor 0.0 0.0 1.0---- secondary-yellow, cyan, magenta :: Exp Color-yellow = addColors red green-cyan = addColors green blue-magenta = addColors red blue---- tertiary-rose, violet, azure, aquamarine, chartreuse, orange :: Exp Color-rose = addColors red magenta-violet = addColors magenta blue-azure = addColors blue cyan-aquamarine = addColors cyan green-chartreuse = addColors green yellow-orange = addColors yellow red-
− Graphics/Gloss/Accelerate/Data/Color/RGBA.hs
@@ -1,325 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}---- | Predefined and custom colors. Essentially equivalent to the--- "Graphics.Gloss.Data.Color", but lifted to Accelerate types.----module Graphics.Gloss.Accelerate.Data.Color.RGBA (-- -- ** Color data type- Color, RGBA(..),- makeColor,- makeColor8,- rawColor,- rgbaOfColor,- packRGBA, packABGR,- clampColor,-- -- ** Color functions- mixColors,- addColors,- dim, brighten,- lighten, darken,- opaque,-- -- ** Pre-defined colors- greyN, black, white,-- -- *** Primary- red, green, blue,-- -- *** Secondary- yellow, cyan, magenta,-- -- *** Tertiary- rose, violet, azure, aquamarine, chartreuse, orange,--) where--import Prelude as P-import Data.Bits-import Data.Typeable-import Data.Array.Accelerate as A-import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Tuple ( Tuple(..), TupleIdx(..), IsTuple(..), )-import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, EltRepr' )----- | An abstract color value.------ We keep the type abstract so we can be sure that the components are in the--- required range. To make a custom color use 'makeColor'.----type Color = RGBA Float----- | An RGBA colour value to hold the color components. All components lie in--- the range [0..1).------ We need to parameterise by a type so that we can have both Exp (RGBA a) and--- RGBA (Exp a).----data RGBA a = RGBA a a a a- deriving (Show, Eq, Typeable)---instance Num a => Num (RGBA a) where- (+) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)- = RGBA (r1 + r2) (g1 + g2) (b1 + b2) 1-- (-) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)- = RGBA (r1 - r2) (g1 - g2) (b1 - b2) 1-- (*) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)- = RGBA (r1 * r2) (g1 * g2) (b1 * b2) 1-- abs (RGBA r1 g1 b1 _)- = RGBA (abs r1) (abs g1) (abs b1) 1-- signum (RGBA r1 g1 b1 _)- = RGBA (signum r1) (signum g1) (signum b1) 1-- fromInteger i- = let f = fromInteger i- in RGBA f f f 1--instance (Elt a, IsNum a) => Num (Exp (RGBA a)) where- (+) = lift2 ((+) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a))- (-) = lift2 ((-) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a))- (*) = lift2 ((*) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a))- abs = lift1 (abs :: RGBA (Exp a) -> RGBA (Exp a))- signum = lift1 (signum :: RGBA (Exp a) -> RGBA (Exp a))- fromInteger i = let f = constant (fromInteger i)- a = constant 1- in lift $ RGBA f f f a---- Represent colours in Accelerate as a 4-tuple----type instance EltRepr (RGBA a) = EltRepr (a, a, a, a)-type instance EltRepr' (RGBA a) = EltRepr (a, a, a, a)--instance Elt a => Elt (RGBA a) where- eltType (_ :: RGBA a) = eltType (undefined :: (a,a,a,a))- toElt c = let (r,g,b,a) = toElt c in RGBA r g b a- fromElt (RGBA r g b a) = fromElt (r,g,b,a)-- eltType' (_ :: RGBA a) = eltType' (undefined :: (a,a,a,a))- toElt' c = let (r,g,b,a) = toElt' c in RGBA r g b a- fromElt' (RGBA r g b a) = fromElt' (r,g,b,a)--instance IsTuple (RGBA a) where- type TupleRepr (RGBA a) = (((((),a), a), a), a)- fromTuple (RGBA r g b a) = (((((), r), g), b), a)- toTuple (((((),r),g),b),a) = RGBA r g b a--instance (Lift Exp a, Elt (Plain a)) => Lift Exp (RGBA a) where- type Plain (RGBA a) = RGBA (Plain a)- lift (RGBA r g b a) = Exp . Tuple $ NilTup `SnocTup` lift r `SnocTup` lift g- `SnocTup` lift b `SnocTup` lift a--instance Elt a => Unlift Exp (RGBA (Exp a)) where- unlift c = let r = Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` c- g = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c- b = Exp $ SuccTupIdx ZeroTupIdx `Prj` c- a = Exp $ ZeroTupIdx `Prj` c- in RGBA r g b a----- | Make a custom color. All components are clamped to the range [0..1].----makeColor- :: Exp Float -- ^ Red component.- -> Exp Float -- ^ Green component.- -> Exp Float -- ^ Blue component.- -> Exp Float -- ^ Alpha component.- -> Exp Color-makeColor r g b a- = clampColor- $ rawColor r g b a----- | Make a custom color.--- You promise that all components are clamped to the range [0..1]----rawColor :: Exp Float -> Exp Float -> Exp Float -> Exp Float -> Exp Color-rawColor r g b a = lift (RGBA r g b a)----- | Make a custom color from 8-bit values.----makeColor8- :: Exp Word8 -- ^ Red component.- -> Exp Word8 -- ^ Green component.- -> Exp Word8 -- ^ Blue component.- -> Exp Word8 -- ^ Alpha component.- -> Exp Color-makeColor8 r g b a- = clampColor- $ rawColor (A.fromIntegral r / 255)- (A.fromIntegral g / 255)- (A.fromIntegral b / 255)- (A.fromIntegral a / 255)----- | Take the RGBA components of a color.-rgbaOfColor :: Exp Color -> (Exp Float, Exp Float, Exp Float, Exp Float)-rgbaOfColor c- = let (RGBA r g b a) = unlift c- in (r, g, b, a)----- Internal--- ------------ | Clamp components of a color into the required range.----clampColor :: Exp Color -> Exp Color-clampColor cc- = let (r, g, b, a) = rgbaOfColor cc- in rawColor (min 1 r) (min 1 g) (min 1 b) (min 1 a)----- | Normalise a color to the value of its largest RGB component.----normaliseColor :: Exp Color -> Exp Color-normaliseColor cc- = let (r, g, b, a) = rgbaOfColor cc- m = P.maximum [r, g, b]- in rawColor (r / m) (g / m) (b / m) a----- | Convert a color into a packed RGBA value.----packRGBA :: Exp Color -> Exp Word32-packRGBA c- = let (r, g, b, a) = rgbaOfColor c- in word32OfFloat r `A.shiftL` 24- .|. word32OfFloat g `A.shiftL` 16- .|. word32OfFloat b `A.shiftL` 8- .|. word32OfFloat a---- | Convert a colour into a packed BGRA value.------ This is necessary as OpenGL reads pixel data as ABGR, rather than RGBA.----packABGR :: Exp Color -> Exp Word32-packABGR c- = let (r, g, b, a) = rgbaOfColor c- in word32OfFloat a `A.shiftL` 24- .|. word32OfFloat b `A.shiftL` 16- .|. word32OfFloat g `A.shiftL` 8- .|. word32OfFloat r--word32OfFloat :: Exp Float -> Exp Word32-word32OfFloat f = A.truncate (f * 255)----- Color functions ---------------------------------------------------------------- | Mix two colors with the given ratios.----mixColors- :: Exp Float -- ^ Ratio of first color.- -> Exp Float -- ^ Ratio of second color.- -> Exp Color -- ^ First color.- -> Exp Color -- ^ Second color.- -> Exp Color -- ^ Resulting color.--mixColors ratio1 ratio2 c1 c2- = let (r1, g1, b1, a1) = rgbaOfColor c1- (r2, g2, b2, a2) = rgbaOfColor c2-- total = ratio1 + ratio2- m1 = ratio1 / total- m2 = ratio2 / total- in- rawColor (m1 * r1 + m2 * r2)- (m1 * g1 + m2 * g2)- (m1 * b1 + m2 * b2)- (m1 * a1 + m2 * a2)----- | Add RGB components of a color component-wise, then normalise them to the--- highest resulting one. The alpha components are averaged.----addColors :: Exp Color -> Exp Color -> Exp Color-addColors c1 c2- = let (r1, g1, b1, a1) = rgbaOfColor c1- (r2, g2, b2, a2) = rgbaOfColor c2- in- normaliseColor $ rawColor (r1 + r2) (g1 + g2) (b1 + b2) ((a1 + a2) / 2)---- | Make a dimmer version of a color, scaling towards black.----dim :: Exp Color -> Exp Color-dim c- = let (r, g, b, a) = rgbaOfColor c- in rawColor (r / 1.2) (g / 1.2) (b / 1.2) a---- | Make a brighter version of a color, scaling towards white.----brighten :: Exp Color -> Exp Color-brighten c- = let (r, g, b, a) = rgbaOfColor c- in clampColor $ rawColor (r * 1.2) (g * 1.2) (b * 1.2) a---- | Lighten a color, adding white.----lighten :: Exp Color -> Exp Color-lighten c- = let (r, g, b, a) = rgbaOfColor c- in clampColor $ rawColor (r + 0.2) (g + 0.2) (b + 0.2) a---- | Darken a color, adding black.----darken :: Exp Color -> Exp Color-darken c- = let (r, g, b, a) = rgbaOfColor c- in clampColor $ rawColor (r - 0.2) (g - 0.2) (b - 0.2) a---- | Make a colour completely opaque.----opaque :: Exp Color -> Exp Color-opaque c- = let (r, g, b, _) = rgbaOfColor c- in rawColor r g b 1.0----- Pre-defined Colors ------------------------------------------------------------- | A greyness of a given magnitude.----greyN :: Exp Float -- ^ Range is 0 = black, to 1 = white.- -> Exp Color-greyN n = rawColor n n n 1.0--black, white :: Exp Color-black = rawColor 0.0 0.0 0.0 1.0-white = rawColor 1.0 1.0 1.0 1.0---- Colors from the additive color wheel.-red, green, blue :: Exp Color-red = rawColor 1.0 0.0 0.0 1.0-green = rawColor 0.0 1.0 0.0 1.0-blue = rawColor 0.0 0.0 1.0 1.0---- secondary-yellow, cyan, magenta :: Exp Color-yellow = addColors red green-cyan = addColors green blue-magenta = addColors red blue---- tertiary-rose, violet, azure, aquamarine, chartreuse, orange :: Exp Color-rose = addColors red magenta-violet = addColors magenta blue-azure = addColors blue cyan-aquamarine = addColors cyan green-chartreuse = addColors green yellow-orange = addColors yellow red-
Graphics/Gloss/Accelerate/Data/Picture.hs view
@@ -1,3 +1,13 @@+{-# LANGUAGE CPP #-}+-- |+-- Module : Graphics.Gloss.Accelerate.Data.Picture+-- Copyright : [2013..2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+-- module Graphics.Gloss.Accelerate.Data.Picture where@@ -9,8 +19,7 @@ import System.IO.Unsafe -- Gloss-import Graphics.Gloss.Rendering ( bitmapOfForeignPtr )-import Graphics.Gloss.Data.Picture ( Picture(..) )+import Graphics.Gloss.Rendering -- Accelerate import Data.Array.Accelerate as A@@ -36,7 +45,7 @@ -- 4. Copy the CUDA result directly to the mapped texture -- bitmapOfArray- :: Array DIM2 Word32 -- The array data+ :: Array DIM2 Word32 -- The array data (packed RGBA) -> Bool -- Should the image be cached between frames? -> Picture bitmapOfArray arrPixels cacheMe@@ -46,13 +55,22 @@ -- Wrap the array data in a Foreign pointer and turn into a Gloss picture {-# NOINLINE rawData #-} rawData = let (Array _ adata) = arrPixels- ((),ptr) = ptrsOfArrayData adata+ ptr = ptrsOfArrayData adata in unsafePerformIO $ newForeignPtr_ (castPtr ptr) +#if MIN_VERSION_gloss_rendering(1,10,0)+ fmt = BitmapFormat BottomToTop PxRGBA -- assume little-endian host pic = bitmapOfForeignPtr- sizeX sizeY -- raw image size- rawData -- the image data+ sizeX sizeY -- image size+ fmt -- image format+ rawData -- raw image data cacheMe+#else+ pic = bitmapOfForeignPtr+ sizeX sizeY -- raw image size+ rawData -- the image data+ cacheMe+#endif in pic
Graphics/Gloss/Accelerate/Data/Point.hs view
@@ -5,6 +5,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+-- |+-- Module : Graphics.Gloss.Accelerate.Data.Point+-- Copyright : [2013..2017] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+-- module Graphics.Gloss.Accelerate.Data.Point ( @@ -21,14 +30,16 @@ ) where -import Prelude as P-import Data.Typeable import Data.Array.Accelerate as A import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Tuple ( Tuple(..), TupleIdx(..), IsTuple(..), )-import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, EltRepr' )+import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..), )+import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) ) +import Data.Typeable+import Prelude ( fromInteger ) -- ghc < 8 bug+import qualified Prelude as P + -- | An abstract point value on the xy-plane. -- type Point = XY Float@@ -37,7 +48,7 @@ -- Exp (Point' a) and Point' (Exp a). -- data XY a = XY a a- deriving (Show, Eq, Typeable)+ deriving (P.Show, P.Eq, Typeable) -- | Pretend a point is a number. --@@ -45,7 +56,7 @@ -- the multiply and divide field operators. We can pretend they are though, and -- use the (+) and (-) operators as component-wise addition and subtraction. ---instance Num a => Num (XY a) where+instance P.Num a => P.Num (XY a) where (+) (XY x1 y1) (XY x2 y2) = XY (x1 + x2) (y1 + y2) (-) (XY x1 y1) (XY x2 y2) = XY (x1 - x2) (y1 - y2) (*) (XY x1 y1) (XY x2 y2) = XY (x1 * x2) (y1 * y2)@@ -57,22 +68,18 @@ -- Represent points in Accelerate as a tuple ---type instance EltRepr (XY a) = EltRepr (a, a)-type instance EltRepr' (XY a) = EltRepr (a, a)+type instance EltRepr (XY a) = EltRepr (a, a) instance Elt a => Elt (XY a) where eltType (_ :: XY a) = eltType (undefined :: (a,a)) toElt p = let (x,y) = toElt p in XY x y fromElt (XY x y) = fromElt (x,y) - eltType' (_ :: XY a) = eltType' (undefined :: (a,a))- toElt' p = let (x,y) = toElt' p in XY x y- fromElt' (XY x y) = fromElt' (x,y)--instance IsTuple (XY a) where- type TupleRepr (XY a) = (((),a), a)- fromTuple (XY x y) = (((), x), y)- toTuple (((),x),y) = XY x y+instance Elt a => IsProduct Elt (XY a) where+ type ProdRepr (XY a) = (((),a), a)+ fromProd _ (XY x y) = (((), x), y)+ toProd _ (((),x),y) = XY x y+ prod cst _ = prod cst (undefined :: (a,a)) instance (Lift Exp a, Elt (Plain a)) => Lift Exp (XY a) where type Plain (XY a) = XY (Plain a)@@ -156,8 +163,8 @@ XY x1 y1 = unlift p1 XY x2 y2 = unlift p2 in- x0 >=* min x1 x2 &&*- x0 <=* max x1 x2 &&*- y0 >=* min y1 y2 &&*- y0 <=* max y1 y2+ x0 >= min x1 x2 &&+ x0 <= max x1 x2 &&+ y0 >= min y1 y2 &&+ y0 <= max y1 y2
gloss-accelerate.cabal view
@@ -1,38 +1,25 @@ Name: gloss-accelerate-Version: 1.9.0.0+Version: 2.0.0.0 Synopsis: Extras to interface Gloss and Accelerate Description: Extras to interface Gloss and Accelerate License: BSD3 License-file: LICENSE Author: Trevor L. McDonell-Maintainer: tmcdonell@cse.unsw.edu.au+Maintainer: Trevor L. McDonell <tmcdonell@cse.unsw.edu.au> Category: Graphics Build-type: Simple Cabal-version: >=1.10 -Flag cuda- Description: Enable the CUDA parallel backend for NVIDIA GPUs- Default: True-- Library Exposed-modules:- Graphics.Gloss.Accelerate.Data.Color- Graphics.Gloss.Accelerate.Data.Color.RGB- Graphics.Gloss.Accelerate.Data.Color.RGBA Graphics.Gloss.Accelerate.Data.Picture Graphics.Gloss.Accelerate.Data.Point Build-depends:- base >= 4.6 && < 4.9,- accelerate == 0.15.*,- gloss == 1.9.*,- gloss-rendering == 1.9.*---- if flag(cuda)--- cpp-options: -DACCELERATE_CUDA_BACKEND--- Build-depends:--- accelerate-cuda >= 0.15+ base >= 4.6 && < 4.10+ , accelerate >= 0.16+ , gloss >= 1.9+ , gloss-rendering >= 1.9 ghc-options: -Wall -O2@@ -42,6 +29,11 @@ source-repository head type: git+ location: https://github.com/tmcdonell/gloss-accelerate++source-repository this+ type: git+ tag: v2.0.0.0 location: https://github.com/tmcdonell/gloss-accelerate -- vim: nospell