module PlotHo.Channel
( newChannel, newChannel'
) where
import qualified Control.Concurrent as CC
import qualified Data.IORef as IORef
import PlotHo.PlotTypes ( Channel(..), Channel'(..), GraphComms(..), SignalTree, debug )
newChannel ::
forall a
. String
-> (a -> a -> Bool)
-> (a -> SignalTree a)
-> IO (Channel, a -> IO ())
newChannel name sameSignalTree toSignalTree = do
(channel', newMessage) <- newChannel' name sameSignalTree toSignalTree
return (Channel channel', newMessage)
newChannel' ::
forall a
. String
-> (a -> a -> Bool)
-> (a -> SignalTree a)
-> IO (Channel' a, a -> IO ())
newChannel' name sameSignalTree toSignalTree = do
lastMsgMVar <- CC.newMVar Nothing
graphCommsMapMVar <- CC.newMVar mempty
maxHist <- IORef.newIORef 0
let newMessage :: a -> IO ()
newMessage newVal = do
debug "newMessage(newChannel): got message"
mlastMsg <- CC.takeMVar lastMsgMVar
let (latestSignalTree, signalTreeNewOrChanged) = case mlastMsg of
Just (oldVal, oldSignalTree)
| sameSignalTree oldVal newVal -> (oldSignalTree, False)
| otherwise -> (toSignalTree newVal, True)
Nothing -> (toSignalTree newVal, True)
CC.putMVar lastMsgMVar (Just (newVal, latestSignalTree))
signalTreeNewOrChanged `seq` return ()
let updateGraph :: GraphComms a -> IO ()
updateGraph (GraphComms {gcRedrawSignal = redraw, gcMsgStore = graphMsgStore}) = do
mmsgStore <- CC.takeMVar graphMsgStore
case (mmsgStore, signalTreeNewOrChanged) of
(Nothing, _) -> CC.putMVar graphMsgStore (Just (newVal, Just latestSignalTree))
(_, True) ->
CC.putMVar graphMsgStore (Just (newVal, Just latestSignalTree))
(Just (_, graphsLatestSignalTree), False) ->
CC.putMVar graphMsgStore (Just (newVal, graphsLatestSignalTree))
debug "newMessage(newChannel): signaling redraw"
redraw
CC.readMVar graphCommsMapMVar >>= mapM_ updateGraph
let retChan =
Channel'
{ chanName = name
, chanLatestValueMVar = lastMsgMVar
, chanSameSignalTree = sameSignalTree
, chanToSignalTree = toSignalTree
, chanMaxHistory = maxHist
, chanClearHistory = Nothing
, chanGraphCommsMap = graphCommsMapMVar
}
return (retChan, newMessage)