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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
module RingBuffer where
import Control.Monad
import Data.Int
import Data.IORef
data TargetBuffer u = TargetBuffer
{ -- | Called whenever the rBack or rSize changes. The purpose is so that
-- some other state, such as an OpenGL vertex buffer object, can remain in
-- sync.
syncBuffer :: (Int32 -> [(Int32,Int32)]) -> IO ()
-- | This updates the data associated with a particular index (usually
-- rBack). The update specification /u/ may be a value or a set of
-- key-value pairs or whatever is most convenient way to instruct the
-- target representation to update itself.
, updateBuffer :: Int -> u -> IO ()
}
data RingBuffer u = RingBuffer
{ rBack :: IORef Int
, rSize :: IORef Int
, ringCapacity :: Int
, rBuffer :: TargetBuffer u
}
newRing :: Int -> IO (TargetBuffer u) -> IO (RingBuffer u)
newRing sz newBuffer = do
backRef <- newIORef 0
sizeRef <- newIORef 0
b <- newBuffer
let r = RingBuffer
{ rBack = backRef
, rSize = sizeRef
, ringCapacity = sz
, rBuffer = b
}
syncRing r
return r
ringMask :: RingBuffer u -> IO (Int32 -> [(Int32,Int32)])
ringMask r = do
size <- fromIntegral <$> readIORef (rSize r)
back <- fromIntegral <$> readIORef (rBack r)
let mask 0 = []
mask cnt
| cnt==size = [(0,cnt)]
| otherwise = case cnt + back - size of
front | front >= cnt -> [(front - cnt,size)]
| otherwise -> [(0,back), (front,cnt - front)]
return mask
syncRing :: RingBuffer u -> IO ()
syncRing r = do
mask <- ringMask r
syncBuffer (rBuffer r) mask
clearRing :: RingBuffer u -> IO ()
clearRing r = do
writeIORef (rBack r) 0
writeIORef (rSize r) 0
syncRing r
pushBack :: RingBuffer u -> u -> IO ()
pushBack r upd = do
back <- readIORef $ rBack r
writeIORef (rBack r) (mod (back + 1) (ringCapacity r))
updateBuffer (rBuffer r) back upd
sz <- readIORef (rSize r)
when (sz < ringCapacity r) $ writeIORef (rSize r) (sz + 1)
syncRing r
updateBack :: RingBuffer u -> u -> IO ()
updateBack r upd = do
size <- readIORef $ rSize r
when (size > 0) $ do
back <- readIORef $ rBack r
updateBuffer (rBuffer r) (mod (back + ringCapacity r - 1) (ringCapacity r)) upd
|
