module Simulation.Aivika.Signal
(Signal(..),
handleSignal_,
SignalSource,
newSignalSource,
publishSignal,
triggerSignal,
awaitSignal,
mapSignal,
mapSignalM,
apSignal,
filterSignal,
filterSignalM,
emptySignal,
merge2Signals,
merge3Signals,
merge4Signals,
merge5Signals,
newSignalInTimes,
newSignalInIntegTimes,
newSignalInStartTime,
newSignalInStopTime,
SignalHistory,
signalHistorySignal,
newSignalHistory,
readSignalHistory) where
import Data.IORef
import Data.Array
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Signal
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Cont
import Simulation.Aivika.Internal.Process
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.Vector.Unboxed as UV
awaitSignal :: Signal a -> Process a
awaitSignal signal =
Process $ \pid ->
Cont $ \c ->
Event $ \p ->
do r <- newIORef Nothing
h <- invokeEvent p $
handleSignal signal $
\a -> Event $
\p -> do x <- readIORef r
case x of
Nothing ->
error "The signal was lost: awaitSignal."
Just x ->
do invokeEvent p x
invokeEvent p $ resumeCont c a
writeIORef r $ Just h
data SignalHistory a =
SignalHistory { signalHistorySignal :: Signal a,
signalHistoryTimes :: UV.Vector Double,
signalHistoryValues :: V.Vector a }
newSignalHistory :: Signal a -> Event (SignalHistory a)
newSignalHistory signal =
do ts <- liftIO UV.newVector
xs <- liftIO V.newVector
handleSignal_ signal $ \a ->
Event $ \p ->
do liftIO $ UV.appendVector ts (pointTime p)
liftIO $ V.appendVector xs a
return SignalHistory { signalHistorySignal = signal,
signalHistoryTimes = ts,
signalHistoryValues = xs }
readSignalHistory :: SignalHistory a -> Event (Array Int Double, Array Int a)
readSignalHistory history =
do xs <- liftIO $ UV.freezeVector (signalHistoryTimes history)
ys <- liftIO $ V.freezeVector (signalHistoryValues history)
return (xs, ys)
triggerSignalWithCurrentTime :: SignalSource Double -> Event ()
triggerSignalWithCurrentTime s =
Event $ \p -> invokeEvent p $ triggerSignal s (pointTime p)
newSignalInTimes :: [Double] -> Event (Signal Double)
newSignalInTimes xs =
do s <- liftSimulation newSignalSource
enqueueEventWithTimes xs $ triggerSignalWithCurrentTime s
return $ publishSignal s
newSignalInIntegTimes :: Event (Signal Double)
newSignalInIntegTimes =
do s <- liftSimulation newSignalSource
enqueueEventWithIntegTimes $ triggerSignalWithCurrentTime s
return $ publishSignal s
newSignalInStartTime :: Event (Signal Double)
newSignalInStartTime =
do s <- liftSimulation newSignalSource
enqueueEventWithStartTime $ triggerSignalWithCurrentTime s
return $ publishSignal s
newSignalInStopTime :: Event (Signal Double)
newSignalInStopTime =
do s <- liftSimulation newSignalSource
enqueueEventWithStopTime $ triggerSignalWithCurrentTime s
return $ publishSignal s