module Simulation.Aivika.Dynamics.EventQueue
(EventQueue,
newQueue,
enqueueCont,
enqueue,
queueRun) where
import Data.IORef
import Control.Monad
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import qualified Simulation.Aivika.PriorityQueue as PQ
data EventQueue = EventQueue {
queuePQ :: PQ.PriorityQueue (() -> Dynamics ()),
queueRun :: Dynamics (),
queueBusy :: IORef Bool,
queueTime :: IORef Double }
newQueue :: Simulation EventQueue
newQueue =
Simulation $ \r ->
do let sc = runSpecs r
f <- newIORef False
t <- newIORef $ spcStartTime sc
pq <- PQ.newQueue
let q = EventQueue { queuePQ = pq,
queueRun = runQueue q,
queueBusy = f,
queueTime = t }
return q
enqueueCont :: EventQueue -> Double -> (() -> Dynamics ()) -> Dynamics ()
enqueueCont q t c = Dynamics r where
r p = let pq = queuePQ q in PQ.enqueue pq t c
enqueue :: EventQueue -> Double -> Dynamics () -> Dynamics ()
enqueue q t m = enqueueCont q t (const m)
runQueue :: EventQueue -> Dynamics ()
runQueue q = Dynamics r where
r p =
do let f = queueBusy q
f' <- readIORef f
unless f' $
do writeIORef f True
call q p
writeIORef f False
call q p =
do let pq = queuePQ q
f <- PQ.queueNull pq
unless f $
do (t2, c2) <- PQ.queueFront pq
let t = queueTime q
t' <- readIORef t
when (t2 < t') $
error "The time value is too small: subrunQueue"
when (t2 <= pointTime p) $
do writeIORef t t2
PQ.dequeue pq
let sc = pointSpecs p
t0 = spcStartTime sc
dt = spcDT sc
n2 = fromInteger $ toInteger $ floor ((t2 t0) / dt)
Dynamics k = c2 ()
k $ p { pointTime = t2,
pointIteration = n2,
pointPhase = 1 }
call q p