module Simulation.Aivika.Dynamics.Buffer
(Buffer,
bufferQueue,
bufferNull,
bufferFull,
bufferMaxCount,
bufferCount,
bufferLostCount,
bufferEnqueue,
bufferDequeue,
bufferEnqueueLost,
newBuffer,
dequeueBuffer,
tryDequeueBuffer,
enqueueBuffer,
tryEnqueueBuffer,
enqueueBufferOrLost) where
import Data.IORef
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.Internal.Signal
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,
bufferEnqueueSource :: SignalSource (),
bufferEnqueueLostSource :: SignalSource (),
bufferDequeueSource :: SignalSource (),
bufferUpdatedSource :: SignalSource () }
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
s1 <- newSignalSourceUnsafe
s2 <- newSignalSourceUnsafe
s3 <- newSignalSourceUnsafe
s4 <- newSignalSourceWithUpdate (runQueue q)
return Buffer { bufferQueue = q,
bufferMaxCount = count,
bufferReadRes = r,
bufferWriteRes = w,
bufferCountRef = i,
bufferLostCountRef = l,
bufferEnqueueSource = s1,
bufferEnqueueLostSource = s2,
bufferDequeueSource = s3,
bufferUpdatedSource = s4 }
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)
liftDynamics $ triggerSignal (bufferDequeueSource q) ()
tryDequeueBuffer :: Buffer -> Dynamics Bool
tryDequeueBuffer q =
do x <- tryRequestResourceInDynamics (bufferReadRes q)
if x
then do liftIO $ dequeueImpl q
releaseResourceInDynamics (bufferWriteRes q)
triggerSignal (bufferDequeueSource q) ()
return True
else return False
enqueueBuffer :: Buffer -> Process ()
enqueueBuffer q =
do requestResource (bufferWriteRes q)
liftIO $ enqueueImpl q
releaseResource (bufferReadRes q)
liftDynamics $ triggerSignal (bufferEnqueueSource q) ()
tryEnqueueBuffer :: Buffer -> Dynamics Bool
tryEnqueueBuffer q =
do x <- tryRequestResourceInDynamics (bufferWriteRes q)
if x
then do liftIO $ enqueueImpl q
releaseResourceInDynamics (bufferReadRes q)
triggerSignal (bufferEnqueueSource 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)
triggerSignal (bufferEnqueueSource q) ()
else do liftIO $ modifyIORef (bufferLostCountRef q) $ (+) 1
triggerSignal (bufferEnqueueLostSource q) ()
bufferEnqueue :: Buffer -> Signal ()
bufferEnqueue q = merge2Signals m1 m2
where m1 = publishSignal (bufferUpdatedSource q)
m2 = publishSignal (bufferEnqueueSource q)
bufferEnqueueLost :: Buffer -> Signal ()
bufferEnqueueLost q = merge2Signals m1 m2
where m1 = publishSignal (bufferUpdatedSource q)
m2 = publishSignal (bufferEnqueueLostSource q)
bufferDequeue :: Buffer -> Signal ()
bufferDequeue q = merge2Signals m1 m2
where m1 = publishSignal (bufferUpdatedSource q)
m2 = publishSignal (bufferDequeueSource q)
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'