module Simulation.Aivika.Dynamics.Buffer
(Buffer,
bufferQueue,
bufferNull,
bufferFull,
bufferMaxCount,
bufferCount,
bufferLostCount,
newBuffer,
dequeueBuffer,
tryDequeueBuffer,
enqueueBuffer,
tryEnqueueBuffer,
enqueueBufferOrLost) where
import Data.IORef
import Data.Array
import Data.Array.IO
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Dynamics.Simulation
import Simulation.Aivika.Dynamics.EventQueue
import Simulation.Aivika.Dynamics.Process
import Simulation.Aivika.Dynamics.Resource
import Simulation.Aivika.Dynamics.LIFO
import Simulation.Aivika.Dynamics.FIFO
data Buffer =
Buffer { bufferQueue :: EventQueue,
bufferMaxCount :: Int,
bufferReadRes :: Resource,
bufferWriteRes :: Resource,
bufferCountRef :: IORef Int,
bufferLostCountRef :: IORef Int }
newBuffer :: EventQueue -> Int -> Simulation Buffer
newBuffer q count =
do i <- liftIO $ newIORef 0
l <- liftIO $ newIORef 0
r <- newResourceWithCount q count 0
w <- newResourceWithCount q count count
return Buffer { bufferQueue = q,
bufferMaxCount = count,
bufferReadRes = r,
bufferWriteRes = w,
bufferCountRef = i,
bufferLostCountRef = l }
bufferNull :: Buffer -> Dynamics Bool
bufferNull q =
do a <- bufferCount q
return (a == 0)
bufferFull :: Buffer -> Dynamics Bool
bufferFull q =
do a <- bufferCount q
return (a == bufferMaxCount q)
bufferCount :: Buffer -> Dynamics Int
bufferCount q =
liftIO $ readIORef (bufferCountRef q)
bufferLostCount :: Buffer -> Dynamics Int
bufferLostCount q =
liftIO $ readIORef (bufferLostCountRef q)
dequeueBuffer :: Buffer -> Process ()
dequeueBuffer q =
do requestResource (bufferReadRes q)
liftIO $ dequeueImpl q
releaseResource (bufferWriteRes q)
tryDequeueBuffer :: Buffer -> Dynamics Bool
tryDequeueBuffer q =
do x <- tryRequestResourceInDynamics (bufferReadRes q)
if x
then do liftIO $ dequeueImpl q
releaseResourceInDynamics (bufferWriteRes q)
return True
else return False
enqueueBuffer :: Buffer -> Process ()
enqueueBuffer q =
do requestResource (bufferWriteRes q)
liftIO $ enqueueImpl q
releaseResource (bufferReadRes q)
tryEnqueueBuffer :: Buffer -> Dynamics Bool
tryEnqueueBuffer q =
do x <- tryRequestResourceInDynamics (bufferWriteRes q)
if x
then do liftIO $ enqueueImpl q
releaseResourceInDynamics (bufferReadRes q)
return True
else return False
enqueueBufferOrLost :: Buffer -> Dynamics ()
enqueueBufferOrLost q =
do x <- tryRequestResourceInDynamics (bufferWriteRes q)
if x
then do liftIO $ enqueueImpl q
releaseResourceInDynamics (bufferReadRes q)
else liftIO $ modifyIORef (bufferLostCountRef q) $ (+) 1
dequeueImpl :: Buffer -> IO ()
dequeueImpl q =
do i <- readIORef (bufferCountRef q)
let i' = i 1
i' `seq` writeIORef (bufferCountRef q) i'
enqueueImpl :: Buffer -> IO ()
enqueueImpl q =
do i <- readIORef (bufferCountRef q)
let i' = i + 1
i' `seq` writeIORef (bufferCountRef q) i'