module Graphics.Image.Interface.Repa.Storable (
RSS(..), RPS(..), Image(..)
) where
import Prelude as P
import Data.Array.Repa.Index
import qualified Data.Array.Repa as R
import qualified Data.Array.Repa.Eval as R
import qualified Data.Array.Repa.Repr.ForeignPtr as R
import qualified Data.Vector.Storable as VS
import Foreign.Storable
import Data.Typeable (Typeable)
import Graphics.Image.Interface as I
import Graphics.Image.Interface.Repa.Generic
import qualified Graphics.Image.Interface.Vector.Storable as IVS
data RSS = RSS deriving Typeable
data RPS = RPS deriving Typeable
instance Show RSS where
show _ = "RepaSequentialStorable"
instance Show RPS where
show _ = "RepaParallelStorable"
type instance Repr IVS.VS = R.F
instance SuperClass RSS cs e => BaseArray RSS cs e where
type SuperClass RSS cs e =
(ColorSpace cs e,
Storable e, Storable (Pixel cs e),
R.Elt e, R.Elt (Pixel cs e))
newtype Image RSS cs e = SSImage (Image (RS IVS.VS) cs e)
dims (SSImage img) = dims img
instance BaseArray RSS cs e => Array RSS cs e where
type Manifest RSS = IVS.VS
type Vector RSS = Vector IVS.VS
makeImage !sz f = SSImage (makeImage sz f)
makeImageWindowed !sz !w f = SSImage . makeImageWindowed sz w f
scalar = SSImage . I.scalar
index00 (SSImage img) = index00 img
map f (SSImage img) = SSImage (I.map f img)
imap f (SSImage img) = SSImage (I.imap f img)
zipWith f (SSImage img1) (SSImage img2) = SSImage (I.zipWith f img1 img2)
izipWith f (SSImage img1) (SSImage img2) = SSImage (I.izipWith f img1 img2)
traverse (SSImage img) f g = SSImage (I.traverse img f g)
traverse2 (SSImage img1) (SSImage img2) f g = SSImage (I.traverse2 img1 img2 f g)
transpose (SSImage img) = SSImage (I.transpose img)
backpermute !sz g (SSImage img) = SSImage (I.backpermute sz g img)
fromLists = SSImage . fromLists
fold f !px0 (SSImage img) = fold f px0 img
foldIx f !px0 (SSImage img) = foldIx f px0 img
eq (SSImage img1) (SSImage img2) = img1 == img2
compute (SSImage img) = SSImage (compute img)
(|*|) (SSImage img1) (SSImage img2) = SSImage (img1 |*| img2)
toManifest (SSImage (SScalar px)) = I.scalar px
toManifest (SSImage (STImage arr)) = fromRepaArrayStorable arr
toManifest !img = toManifest (compute img)
toVector = I.toVector . toManifest
fromVector !sz = SSImage . STImage . fromVectorStorable sz
instance SuperClass RPS cs e => BaseArray RPS cs e where
type SuperClass RPS cs e =
(ColorSpace cs e,
Storable e, Storable (Pixel cs e),
R.Elt e, R.Elt (Pixel cs e))
newtype Image RPS cs e = PSImage (Image (RP IVS.VS) cs e)
dims (PSImage img) = dims img
instance BaseArray RPS cs e => Array RPS cs e where
type Manifest RPS = IVS.VS
type Vector RPS = Vector IVS.VS
makeImage !sz f = PSImage (makeImage sz f)
makeImageWindowed !sz !w f = PSImage . makeImageWindowed sz w f
scalar = PSImage . scalar
index00 (PSImage img) = index00 img
map f (PSImage img) = PSImage (I.map f img)
imap f (PSImage img) = PSImage (I.imap f img)
zipWith f (PSImage img1) (PSImage img2) = PSImage (I.zipWith f img1 img2)
izipWith f (PSImage img1) (PSImage img2) = PSImage (I.izipWith f img1 img2)
traverse (PSImage img) f g = PSImage (I.traverse img f g)
traverse2 (PSImage img1) (PSImage img2) f g = PSImage (I.traverse2 img1 img2 f g)
transpose (PSImage img) = PSImage (I.transpose img)
backpermute !sz g (PSImage img) = PSImage (backpermute sz g img)
fromLists = PSImage . fromLists
fold f !px0 (PSImage img) = I.fold f px0 img
foldIx f !px0 (PSImage img) = I.foldIx f px0 img
eq (PSImage img1) (PSImage img2) = img1 == img2
compute (PSImage img) = PSImage (compute img)
(|*|) (PSImage img1) (PSImage img2) = PSImage (img1 |*| img2)
toManifest (PSImage (PScalar px)) = scalar px
toManifest (PSImage (PTImage arr)) = fromRepaArrayStorable arr
toManifest !img = toManifest (compute img)
toVector = I.toVector . toManifest
fromVector !sz = PSImage . PTImage . fromVectorStorable sz
fromRepaArrayStorable
:: forall cs e.
Array IVS.VS cs e
=> R.Array R.F DIM2 (Pixel cs e) -> Image IVS.VS cs e
fromRepaArrayStorable !arr =
fromVector (sh2ix (R.extent arr)) $
VS.unsafeFromForeignPtr0 (R.toForeignPtr arr) (m * n)
where
(Z :. m :. n) = R.extent arr
fromVectorStorable
:: forall cs e.
Storable (Pixel cs e)
=> (Int, Int) -> VS.Vector (Pixel cs e) -> R.Array R.F DIM2 (Pixel cs e)
fromVectorStorable !(m, n) !v
| sz == sz' = R.fromForeignPtr (ix2sh (m, n)) fp
| otherwise = error $ "fromVectorStorable: (impossible) Vector size mismatch: " ++
show sz ++ " vs " ++ show sz'
where
!(fp, sz) = VS.unsafeToForeignPtr0 v
!sz' = m * n