gloss-accelerate 2.0.0.1 → 2.1.0.0

raw patch · 7 files changed

+208/−269 lines, 7 filesdep +linear-acceleratedep ~acceleratedep ~basedep ~gloss-renderingPVP ok

version bump matches the API change (PVP)

Dependencies added: linear-accelerate

Dependency ranges changed: accelerate, base, gloss-rendering

API changes (from Hackage documentation)

Files

• Graphics/Gloss/Accelerate/Data/Picture.hs +0/−76
• Graphics/Gloss/Accelerate/Data/Point.hs +0/−170
• LICENSE +1/−1
• README.md +16/−4
• gloss-accelerate.cabal +22/−18
• src/Graphics/Gloss/Accelerate/Data/Picture.hs +63/−0
• src/Graphics/Gloss/Accelerate/Data/Point.hs +106/−0

@@ -1,76 +0,0 @@-{-# 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---- Standard library-import Prelude                                          as P-import Foreign.Ptr-import Foreign.ForeignPtr-import System.IO.Unsafe---- Gloss-import Graphics.Gloss.Rendering---- Accelerate-import Data.Array.Accelerate                            as A-import Data.Array.Accelerate.Array.Data                 ( ptrsOfArrayData )-import Data.Array.Accelerate.Array.Sugar                ( Array(..) )----- | Use an Accelerate array of RGBA data as a bitmap image. If the image is---   generated programatically every frame, then the second parameter should be---   `False`. If you have loaded it from static data then use `True`.------- TODO:------   If CUDA is enabled, check whether the array already exists on the device---   and if so blitz it straight to a texture as described below. Otherwise,---   just use this method. See also the cuda examples in the---   non-USE_TEXSUBIMAGE2D path.------       1. (once) Allocate a new texture object---       2. Run the CUDA computation, but do not copy the result back to the host---       3. Map the texture resource to an array---       4. Copy the CUDA result directly to the mapped texture----bitmapOfArray-    :: Array DIM2 Word32                -- The array data (packed RGBA)-    -> Bool                             -- Should the image be cached between frames?-    -> Picture-bitmapOfArray arrPixels cacheMe-  = let -- Size of the raw image-        Z :. sizeY :. sizeX     = arrayShape arrPixels--        -- Wrap the array data in a Foreign pointer and turn into a Gloss picture-        {-# NOINLINE rawData #-}-        rawData         = let (Array _ adata)   = arrPixels-                              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                   -- 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-

@@ -1,170 +0,0 @@-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# 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 (--  -- ** Point data type-  Point,--  -- ** Point creation-  makePoint,-  xyOfPoint,-  pointOfIndex,--  -- ** Testing points-  pointInBox,--) where--import Data.Array.Accelerate                    as A-import Data.Array.Accelerate.Smart-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---- | A parameterised point in the xy-plane. This is so that the type can be both--- Exp (Point' a) and Point' (Exp a).----data XY a = XY a a-  deriving (P.Show, P.Eq, Typeable)---- | Pretend a point is a number.------ Vectors aren't real numbers according to Haskell, because they don't support--- the multiply and divide field operators. We can pretend they are though, and--- use the (+) and (-) operators as component-wise addition and subtraction.----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)-  signum (XY x y)                       = XY (signum x) (signum y)-  abs (XY x y)                          = XY (abs x) (abs y)-  negate (XY x y)                       = XY (negate x) (negate y)-  fromInteger i                         = let f = P.fromInteger i-                                          in  XY f f---- Represent points in Accelerate as a tuple----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)--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)-  lift (XY x y)         = Exp . Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y--instance Elt a => Unlift Exp (XY (Exp a)) where-  unlift p      = let x = Exp $ SuccTupIdx ZeroTupIdx `Prj` p-                      y = Exp $ ZeroTupIdx `Prj` p-                  in XY x y----- | Make a custom point----makePoint-    :: Exp Float                -- ^ x-coordinate-    -> Exp Float                -- ^ y-coordinate-    -> Exp Point-makePoint x y = lift (XY x y)----- | Take the components of a point----xyOfPoint-    :: Exp Point-    -> (Exp Float, Exp Float)-xyOfPoint p-  = let XY x y  = unlift p-    in  (x, y)----- | Convert a two-dimensional index into a point centered in a plane of the--- given width and height.----pointOfIndex-    :: Int                      -- ^ width-    -> Int                      -- ^ height-    -> Exp DIM2-    -> Exp Point-pointOfIndex sizeX sizeY ix-  = let -- Size of the raw plane-        fsizeX, fsizeY  :: Float-        fsizeX          = P.fromIntegral sizeX-        fsizeY          = P.fromIntegral sizeY--        fsizeX2, fsizeY2 :: Exp Float-        fsizeX2         = constant $ fsizeX / 2-        fsizeY2         = constant $ fsizeY / 2--        -- Midpoint of plane-        midX, midY :: Exp Int-        midX            = constant $ sizeX `div` 2-        midY            = constant $ sizeY `div` 2--        -- Centre coordinate in the plane-        Z :. y :. x     = unlift ix-        x'              = A.fromIntegral (x - midX) / fsizeX2-        y'              = A.fromIntegral (y - midY) / fsizeY2-    in-    makePoint x' y'----- | Test whether a point lies within a rectangular box that is oriented---   on the x-y plane. The points P1-P2 are opposing points of the box,---   but need not be in a particular order.------ @---    P2 +-------+---       |       |---       | + P0  |---       |       |---       +-------+ P1--- @----pointInBox-    :: Exp Point                -- ^ point to test-    -> Exp Point                -- ^ corner of box-    -> Exp Point                -- ^ opposite corner of box-    -> Exp Bool-pointInBox p0 p1 p2-  = let XY x0 y0        = unlift p0-        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-

@@ -1,4 +1,4 @@-Copyright (c) 2013, Trevor L. McDonell+Copyright (c) [2013..2020], Trevor L. McDonell  All rights reserved. 

@@ -1,12 +1,24 @@-gloss-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/gloss-accelerate.svg)](https://travis-ci.org/tmcdonell/gloss-accelerate)+# gloss-accelerate++[![GitHub CI](https://github.com/tmcdonell/gloss-accelerate/workflows/CI/badge.svg)](https://github.com/tmcdonell/gloss-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/gloss-accelerate/badge/lts)](https://stackage.org/lts/package/gloss-accelerate)+[![Stackage Nightly](https://stackage.org/package/gloss-accelerate/badge/nightly)](https://stackage.org/nightly/package/gloss-accelerate) [![Hackage](https://img.shields.io/hackage/v/gloss-accelerate.svg)](https://hackage.haskell.org/package/gloss-accelerate) -Extras to help interface [gloss][gloss] and [accelerate][accelerate]. Refer to+</div>++Extras to help interface [gloss][gloss] and [Accelerate][accelerate]. Refer to the main repositories of each project for more information. +Contributions and bug reports are welcome!<br>+Please feel free to contact me through [GitHub][accelerate] or [gitter.im][gitter.im].+   [gloss]:      https://github.com/benl23x5/gloss   [accelerate]: https://github.com/AccelerateHS/accelerate+  [gitter.im]:  https://gitter.im/AccelerateHS/Lobby 

@@ -1,28 +1,29 @@-Name:                   gloss-accelerate-Version:                2.0.0.1-Synopsis:               Extras to interface Gloss and Accelerate-Description:            Extras to interface Gloss and Accelerate-License:                BSD3-License-file:           LICENSE-Author:                 Trevor L. McDonell-Maintainer:             Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>-Category:               Graphics-Build-type:             Simple-Cabal-version:          >=1.10+name:                   gloss-accelerate+version:                2.1.0.0+synopsis:               Extras to interface Gloss and Accelerate+description:            Please see the README on GitHub at <https://github.com/tmcdonell/gloss-accelerate#readme>+license:                BSD3+license-file:           LICENSE+author:                 Trevor L. McDonell+maintainer:             Trevor L. McDonell <trevor.mcdonell@gmail.com>+category:               Accelerate, Graphics+build-type:             Simple+cabal-version:          >=1.10  extra-source-files:     README.md -Library-  Exposed-modules:+library+  exposed-modules:         Graphics.Gloss.Accelerate.Data.Picture         Graphics.Gloss.Accelerate.Data.Point -  Build-depends:-        base                    >= 4.6 && < 4.12-      , accelerate              >= 0.16+  build-depends:+        base                    >= 4.9 && < 5+      , accelerate              >= 1.3       , gloss                   >= 1.9-      , gloss-rendering         >= 1.9+      , gloss-rendering         >= 1.10+      , linear-accelerate       >= 0.7    ghc-options:         -Wall@@ -31,13 +32,16 @@   default-language:         Haskell2010 +  hs-source-dirs:+        src+ source-repository head   type:                         git   location:                     https://github.com/tmcdonell/gloss-accelerate  source-repository this   type:                         git-  tag:                          v2.0.0.1+  tag:                          v2.1.0.0   location:                     https://github.com/tmcdonell/gloss-accelerate  -- vim: nospell

@@ -0,0 +1,63 @@+-- |+-- Module      : Graphics.Gloss.Accelerate.Data.Picture+-- Copyright   : [2013..2020] Trevor L. McDonell+-- License     : BSD3+--+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--++module Graphics.Gloss.Accelerate.Data.Picture+  where++import Data.Array.Accelerate                                        as A+import Data.Array.Accelerate.Array.Unique+import Data.Array.Accelerate.Lifetime+import Data.Array.Accelerate.Sugar.Array+import qualified Data.Array.Accelerate.Representation.Array         as R++import Graphics.Gloss.Rendering++import Foreign.ForeignPtr+++-- | Use an Accelerate array of RGBA data as a bitmap image. If the image+-- is generated programatically every frame, then the second parameter+-- should be `False`. If you have loaded it from static data then use+-- `True`.+--++-- TODO:+--+--   If CUDA is enabled, check whether the array already exists on the device+--   and if so blitz it straight to a texture as described below. Otherwise,+--   just use this method. See also the cuda examples in the+--   non-USE_TEXSUBIMAGE2D path.+--+--       1. (once) Allocate a new texture object+--       2. Run the CUDA computation, but do not copy the result back to the host+--       3. Map the texture resource to an array+--       4. Copy the CUDA result directly to the mapped texture+--+bitmapOfArray+    :: Array DIM2 Word32                -- The array data (packed RGBA)+    -> Bool                             -- Should the image be cached between frames?+    -> Picture+bitmapOfArray arrPixels cacheMe+  = let -- Size of the raw image+        Z :. sizeY :. sizeX = arrayShape arrPixels++        rawData         = let Array (R.Array _ adata) = arrPixels+                              ptr                     = unsafeGetValue (uniqueArrayData adata)+                          in+                          castForeignPtr ptr++        fmt             = BitmapFormat TopToBottom PxRGBA   -- assume little-endian host+        pic             = bitmapOfForeignPtr+                              sizeX sizeY                   -- image size+                              fmt                           -- image format+                              rawData                       -- raw image data+                              cacheMe+    in pic+

@@ -0,0 +1,106 @@+-- |+-- Module      : Graphics.Gloss.Accelerate.Data.Point+-- Copyright   : [2013..2020] Trevor L. McDonell+-- License     : BSD3+--+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--++module Graphics.Gloss.Accelerate.Data.Point (++  -- ** Point data type+  Point,++  -- ** Point creation+  makePoint,+  xyOfPoint,+  pointOfIndex,++  -- ** Testing points+  pointInBox,++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Linear.V2++import qualified Prelude                        as P+++-- | An abstract point value on the xy-plane.+--+type Point = V2 Float++-- | Make a custom point+--+makePoint+    :: Exp Float                -- ^ x-coordinate+    -> Exp Float                -- ^ y-coordinate+    -> Exp Point+makePoint = V2_+++-- | Take the components of a point+--+xyOfPoint+    :: Exp Point+    -> (Exp Float, Exp Float)+xyOfPoint (V2_ x y) = (x, y)+++-- | Convert a two-dimensional index into a point centered in a plane of the+-- given width and height.+--+pointOfIndex+    :: Int                      -- ^ width+    -> Int                      -- ^ height+    -> Exp DIM2+    -> Exp Point+pointOfIndex sizeX sizeY ix+  = let -- Size of the raw plane+        fsizeX, fsizeY  :: Float+        fsizeX          = P.fromIntegral sizeX+        fsizeY          = P.fromIntegral sizeY++        fsizeX2, fsizeY2 :: Exp Float+        fsizeX2         = constant $ fsizeX / 2+        fsizeY2         = constant $ fsizeY / 2++        -- Midpoint of plane+        midX, midY :: Exp Int+        midX            = constant $ sizeX `div` 2+        midY            = constant $ sizeY `div` 2++        -- Centre coordinate in the plane+        Z :. y :. x     = unlift ix+        x'              = A.fromIntegral (x - midX) / fsizeX2+        y'              = A.fromIntegral (y - midY) / fsizeY2+    in+    makePoint x' y'+++-- | Test whether a point lies within a rectangular box that is oriented+--   on the x-y plane. The points P1-P2 are opposing points of the box,+--   but need not be in a particular order.+--+-- @+--    P2 +-------++--       |       |+--       | + P0  |+--       |       |+--       +-------+ P1+-- @+--+pointInBox+    :: Exp Point                -- ^ point to test+    -> Exp Point                -- ^ corner of box+    -> Exp Point                -- ^ opposite corner of box+    -> Exp Bool+pointInBox (V2_ x0 y0) (V2_ x1 y1) (V2_ x2 y2) =+  x0 >= min x1 x2 &&+  x0 <= max x1 x2 &&+  y0 >= min y1 y2 &&+  y0 <= max y1 y2+