diff --git a/Graphics/Gloss/Accelerate/Data/Color.hs b/Graphics/Gloss/Accelerate/Data/Color.hs deleted file mode 100644 --- a/Graphics/Gloss/Accelerate/Data/Color.hs +++ /dev/null @@ -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 - diff --git a/Graphics/Gloss/Accelerate/Data/Color/RGB.hs b/Graphics/Gloss/Accelerate/Data/Color/RGB.hs deleted file mode 100644 --- a/Graphics/Gloss/Accelerate/Data/Color/RGB.hs +++ /dev/null @@ -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 - diff --git a/Graphics/Gloss/Accelerate/Data/Color/RGBA.hs b/Graphics/Gloss/Accelerate/Data/Color/RGBA.hs deleted file mode 100644 --- a/Graphics/Gloss/Accelerate/Data/Color/RGBA.hs +++ /dev/null @@ -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 - diff --git a/Graphics/Gloss/Accelerate/Data/Picture.hs b/Graphics/Gloss/Accelerate/Data/Picture.hs --- a/Graphics/Gloss/Accelerate/Data/Picture.hs +++ b/Graphics/Gloss/Accelerate/Data/Picture.hs @@ -1,3 +1,13 @@ +{-# LANGUAGE CPP #-} +-- | +-- Module : Graphics.Gloss.Accelerate.Data.Picture +-- Copyright : [2013..2017] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- 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 diff --git a/Graphics/Gloss/Accelerate/Data/Point.hs b/Graphics/Gloss/Accelerate/Data/Point.hs --- a/Graphics/Gloss/Accelerate/Data/Point.hs +++ b/Graphics/Gloss/Accelerate/Data/Point.hs @@ -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 +-- 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 diff --git a/gloss-accelerate.cabal b/gloss-accelerate.cabal --- a/gloss-accelerate.cabal +++ b/gloss-accelerate.cabal @@ -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 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