module Vision.Primitive.Shape (
Shape (..), Z (..), (:.) (..)
, DIM0, DIM1, DIM2, DIM3, DIM4, DIM5, DIM6, DIM7, DIM8, DIM9
, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, ix9
) where
import Control.Applicative
import Data.Word
import Foreign.Storable (Storable (..))
import Foreign.Ptr (castPtr, plusPtr)
class Eq sh => Shape sh where
shapeRank :: sh -> Int
shapeLength :: sh -> Int
shapeZero :: sh
shapeSucc :: sh
-> sh
-> sh
toLinearIndex :: sh
-> sh
-> Int
fromLinearIndex :: sh
-> Int
-> sh
shapeList :: sh -> [sh]
inShape :: sh
-> sh
-> Bool
data Z = Z deriving (Show, Read, Eq, Ord)
infixl 3 :.
data tail :. head = !tail :. !head
deriving (Show, Read, Eq, Ord)
type DIM0 = Z
type DIM1 = DIM0 :. Int
type DIM2 = DIM1 :. Int
type DIM3 = DIM2 :. Int
type DIM4 = DIM3 :. Int
type DIM5 = DIM4 :. Int
type DIM6 = DIM5 :. Int
type DIM7 = DIM6 :. Int
type DIM8 = DIM7 :. Int
type DIM9 = DIM8 :. Int
instance Shape Z where
shapeRank Z = 0
shapeLength Z = 1
shapeZero = Z
shapeSucc _ _= Z
toLinearIndex Z _ = 0
fromLinearIndex Z _ = Z
shapeList Z = [Z]
inShape Z Z = True
instance Storable Z where
sizeOf _ = 0
alignment _ = 0
peek _ = return Z
poke _ _ = return ()
instance Shape sh => Shape (sh :. Int) where
shapeRank (sh :. _) = shapeRank sh + 1
shapeLength (sh :. n) = shapeLength sh * n
shapeZero = shapeZero :. 0
shapeSucc (sh :. n) (sh' :. ix)
| ix' >= n = shapeSucc sh sh' :. 0
| otherwise = sh' :. ix'
where
!ix' = ix + 1
toLinearIndex (sh :. n) (sh' :. ix) = toLinearIndex sh sh' * n
+ ix
fromLinearIndex (sh :. n) ix
| shapeRank sh == 0 = fromLinearIndex sh 0 :. ix
| otherwise = let (q, r) = ix `quotRem` n
in fromLinearIndex sh q :. r
shapeList (sh :. n) = [ sh' :. i | sh' <- shapeList sh, i <- [0..n1] ]
inShape (sh :. n) (sh' :. ix) = word ix < word n && inShape sh sh'
instance Storable sh => Storable (sh :. Int) where
sizeOf ~(sh :. _) = sizeOf (undefined :: Int) + sizeOf sh
alignment _ = alignment (undefined :: Int)
peek !ptr = do
let !ptr' = castPtr ptr
(:.) <$> peek (castPtr $! ptr' `plusPtr` 1) <*> peek ptr'
poke !ptr (sh :. n) = do
let !ptr' = castPtr ptr
poke (castPtr $! ptr' `plusPtr` 1) sh >> poke ptr' n
ix1 :: Int -> DIM1
ix1 x = Z :. x
ix2 :: Int -> Int -> DIM2
ix2 y x = Z :. y :. x
ix3 :: Int -> Int -> Int -> DIM3
ix3 z y x = Z :. z :. y :. x
ix4 :: Int -> Int -> Int -> Int -> DIM4
ix4 a z y x = Z :. a :. z :. y :. x
ix5 :: Int -> Int -> Int -> Int -> Int -> DIM5
ix5 b a z y x = Z :. b :. a :. z :. y :. x
ix6 :: Int -> Int -> Int -> Int -> Int -> Int -> DIM6
ix6 c b a z y x = Z :. c :. b :. a :. z :. y :. x
ix7 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> DIM7
ix7 d c b a z y x = Z :. d :. c :. b :. a :. z :. y :. x
ix8 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> DIM8
ix8 e d c b a z y x = Z :. e :. d :. c :. b :. a :. z :. y :. x
ix9 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> DIM9
ix9 f e d c b a z y x = Z :. f :. e :. d :. c :. b :. a :. z :. y :. x
word :: Integral a => a -> Word
word = fromIntegral