module Simulation.Aivika.Dynamics.Signal
(Signal,
SignalSource,
newSignalSource,
newSignalSourceWithUpdate,
newSignalInTimes,
newSignalInIntegTimes,
newSignalInStartTime,
newSignalInStopTime,
publishSignal,
triggerSignal,
handleSignal,
handleSignal_,
updateSignal,
awaitSignal,
mapSignal,
mapSignalM,
apSignal,
filterSignal,
filterSignalM,
emptySignal,
merge2Signals,
merge3Signals,
merge4Signals,
merge5Signals,
SignalHistory,
signalHistorySignal,
newSignalHistory,
newSignalHistoryThrough,
readSignalHistory) where
import Data.IORef
import Data.Array
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Dynamics.EventQueue
import Simulation.Aivika.Dynamics.Internal.Signal
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import Simulation.Aivika.Dynamics.Internal.Cont
import Simulation.Aivika.Dynamics.Internal.Process
import Simulation.Aivika.Dynamics.Base
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.UVector as UV
newSignalSource :: EventQueue -> Simulation (SignalSource a)
newSignalSource queue =
newSignalSourceWithUpdate $ runQueueSyncBefore queue
awaitSignal :: Signal a -> Process a
awaitSignal signal =
Process $ \pid ->
Cont $ \c ->
Dynamics $ \p ->
do r <- newIORef Nothing
let Dynamics m =
handleSignal signal $
\a -> Dynamics $
\p -> do x <- readIORef r
case x of
Nothing ->
error "The signal was lost: awaitSignal."
Just x ->
do let Dynamics m = x
m p
let Dynamics m = resumeContByParams c a
m p
h <- m p
writeIORef r $ Just h
data SignalHistory a =
SignalHistory { signalHistorySignal :: Signal a,
signalHistoryTimes :: UV.UVector Double,
signalHistoryValues :: V.Vector a }
newSignalHistory :: Signal a -> Dynamics (SignalHistory a)
newSignalHistory signal =
do ts <- liftIO UV.newVector
xs <- liftIO V.newVector
handleSignal_ signal $ \a ->
Dynamics $ \p ->
do liftIO $ UV.appendVector ts (pointTime p)
liftIO $ V.appendVector xs a
return SignalHistory { signalHistorySignal = signal,
signalHistoryTimes = ts,
signalHistoryValues = xs }
newSignalHistoryThrough :: EventQueue -> Signal a -> Dynamics (SignalHistory a)
newSignalHistoryThrough q signal =
do ts <- liftIO UV.newVector
xs <- liftIO V.newVector
enqueueWithCurrentTime q $
handleSignal_ signal $ \a ->
Dynamics $ \p ->
do liftIO $ UV.appendVector ts (pointTime p)
liftIO $ V.appendVector xs a
return SignalHistory { signalHistorySignal = signal,
signalHistoryTimes = ts,
signalHistoryValues = xs }
readSignalHistory :: SignalHistory a -> Dynamics (Array Int Double, Array Int a)
readSignalHistory history =
do updateSignal $ signalHistorySignal history
xs <- liftIO $ UV.freezeVector (signalHistoryTimes history)
ys <- liftIO $ V.freezeVector (signalHistoryValues history)
return (xs, ys)
triggerSignalWithTime :: SignalSource Double -> Dynamics ()
triggerSignalWithTime s =
Dynamics $ \p ->
do let Dynamics m = triggerSignal s (pointTime p)
m p
newSignalInTimes :: EventQueue -> [Double] -> Dynamics (Signal Double)
newSignalInTimes q xs =
do s <- liftSimulation $ newSignalSource q
enqueueWithTimes q xs $ triggerSignalWithTime s
return $ publishSignal s
newSignalInIntegTimes :: EventQueue -> Dynamics (Signal Double)
newSignalInIntegTimes q =
do s <- liftSimulation $ newSignalSource q
enqueueWithIntegTimes q $ triggerSignalWithTime s
return $ publishSignal s
newSignalInStartTime :: EventQueue -> Dynamics (Signal Double)
newSignalInStartTime q =
do s <- liftSimulation $ newSignalSource q
enqueueWithStartTime q $ triggerSignalWithTime s
return $ publishSignal s
newSignalInStopTime :: EventQueue -> Dynamics (Signal Double)
newSignalInStopTime q =
do s <- liftSimulation $ newSignalSource q
enqueueWithStopTime q $ triggerSignalWithTime s
return $ publishSignal s