summaryrefslogtreecommitdiff
path: root/VectorRing.hs
blob: 4362fa72ab1f0ffeae8b28ab0bc00bde7effa780 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
module VectorRing where

import Data.Vector.Storable.Mutable
import RingBuffer

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import GHC.Exts (RealWorld)

data Point = Point
    { pointX :: Double
    , pointY :: Double
    }
 deriving (Eq,Ord,Show)

instance Storable Point where
    sizeOf _ = 2 * sizeOf (0::Double)
    alignment _ = alignment (0::Double)
    peek ptr = Point <$> peek (castPtr ptr) <*> peekElemOff (castPtr ptr) 1
    poke ptr (Point x y) = do poke (castPtr ptr) x
                              pokeElemOff (castPtr ptr) 1 y

-- | Typical usage:
--
-- > v <- unsafeNew capacity
-- > ringBuffer <- newRing capacity (VectorRing.new v)
new :: Storable a => MVector RealWorld a -> IO (TargetBuffer a)
new v = return TargetBuffer
            { syncBuffer   = \_ -> return ()
            , updateBuffer = \i u -> write v i u
            }

withData :: Storable a => MVector RealWorld a -> (Int -> Ptr a -> IO b) -> IO b
withData v f = let (fptr,len) = unsafeToForeignPtr0 v
               in withForeignPtr fptr $ f len