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 Graphics.Image.Interface as I
import Graphics.Image.Interface.Repa.Generic
import qualified Graphics.Image.Interface.Vector.Storable as IVS
import qualified Graphics.Image.Interface.Vector.Unboxed as IVU
data RSS = RSS
data RPS = RPS
instance Show RSS where
show RSS = "RepaSequentialStorable"
instance Show RPS where
show RPS = "RepaParallelStorable"
type instance Repr (RS IVS.S) = R.F
type instance Repr (RP IVS.S) = R.F
instance SuperClass RSS cs e => BaseArray RSS cs e where
type SuperClass RSS cs e =
(ColorSpace cs e, Num (Pixel cs e),
Storable e, Storable (Pixel cs e),
IVU.Unbox e, IVU.Unbox (Components cs e),
R.Elt e, R.Elt (Pixel cs e))
data Image RSS cs e = SSImage !(Image (RS IVS.S) cs e)
dims (SSImage img) = dims img
instance (BaseArray RSS cs e) => Array RSS cs e where
type Manifest RSS = IVS.VS
makeImage !sz f = SSImage (makeImage sz f)
makeImageWindowed !sz !w f = SSImage . makeImageWindowed sz w f
singleton = SSImage . I.singleton
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.singleton px
toManifest (SSImage (STImage arr)) = fromRepaArrayStorable arr
toManifest !img = toManifest (compute img)
instance SuperClass RPS cs e => BaseArray RPS cs e where
type SuperClass RPS cs e =
(ColorSpace cs e, Num (Pixel cs e),
Storable e, Storable (Pixel cs e),
IVU.Unbox e, IVU.Unbox (Components cs e),
R.Elt e, R.Elt (Pixel cs e))
data Image RPS cs e = PSImage !(Image (RP IVS.S) cs e)
dims (PSImage img) = dims img
instance (BaseArray RPS cs e) => Array RPS cs e where
type Manifest RPS = IVS.VS
makeImage !sz f = PSImage (makeImage sz f)
makeImageWindowed !sz !w f = PSImage . makeImageWindowed sz w f
singleton = PSImage . singleton
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)) = singleton px
toManifest (PSImage (PTImage arr)) = fromRepaArrayStorable arr
toManifest !img = toManifest (compute img)
instance Exchangable RPS RSS where
exchange _ (PSImage img) = SSImage (toRS img)
instance Exchangable RSS RPS where
exchange _ (SSImage img) = PSImage (toRP img)
instance Exchangable IVS.VS RSS where
exchange _ !img@(dims -> (1, 1)) = singleton (index00 img)
exchange _ !img =
SSImage . STImage . toRepaArrayStorable $ img
instance Exchangable IVS.VS RPS where
exchange _ !img@(dims -> (1, 1)) = singleton (index00 img)
exchange _ !img =
PSImage . PTImage . toRepaArrayStorable $ img
instance Exchangable RSS IVS.VS where
exchange _ = toManifest
instance Exchangable RPS IVS.VS where
exchange _ = toManifest
fromRepaArrayStorable
:: forall cs e.
Array IVS.VS cs e
=> R.Array R.F DIM2 (Pixel cs e) -> Image IVS.VS cs e
fromRepaArrayStorable !arr =
IVS.fromStorableVector (sh2ix (R.extent arr)) $
VS.unsafeFromForeignPtr0 (R.toForeignPtr arr) sz
where
!sz = sizeOf (undefined :: Pixel cs e) * m * n
(Z :. m :. n) = R.extent arr
toRepaArrayStorable
:: forall cs e.
Array IVS.VS cs e
=> Image IVS.VS cs e -> R.Array R.F DIM2 (Pixel cs e)
toRepaArrayStorable !img
| sz == sz' = R.fromForeignPtr (ix2sh (dims img)) fp
| otherwise = error $ "toRepaArrayStorable: (impossible) Vector size mismatch: " ++
show sz ++ " vs " ++ show sz'
where
!(fp, sz) = VS.unsafeToForeignPtr0 $ IVS.toStorableVector img
!sz' = sizeOf (undefined :: Pixel cs e) * m * n
!(m, n) = dims img