module Scope.Layer (
addLayersFromFile
, plotLayers
) where
import Control.Applicative ((<$>), (<*>), (<|>))
import Control.Monad (join, replicateM, when, (>=>))
import Control.Monad.Trans (lift)
import Data.ByteString (ByteString)
import Data.Function (on)
import qualified Data.IntMap as IM
import qualified Data.Iteratee as I
import qualified Data.Iteratee.IO.Fd as I
import Data.List (groupBy)
import Data.Maybe (fromJust, listToMaybe)
import Data.Time.Clock
import Data.ZoomCache.Multichannel
import Data.ZoomCache.Numeric
import System.Posix
import qualified System.Random.MWC as MWC
import Scope.Numeric.IEEE754()
import Scope.Types hiding (b)
import Scope.View
genColor :: RGB -> Double -> MWC.GenIO -> IO RGB
genColor (r, g, b) a gen = do
let a' = 1.0 a
r' <- MWC.uniformR (0.0, a') gen
g' <- MWC.uniformR (0.0, a') gen
b' <- MWC.uniformR (0.0, a') gen
return (r*a + r', g*a + g', b*a * b')
genColors :: Int -> RGB -> Double -> IO [RGB]
genColors n rgb a = MWC.withSystemRandom (replicateM n . genColor rgb a)
scopeBufSize :: Int
scopeBufSize = 1024
openScopeFile :: FilePath -> IO ScopeFile
openScopeFile path = do
fd <- openFd path ReadOnly Nothing defaultFileFlags
let f = ScopeFile path fd undefined
cf <- scopeEnum f (iterHeaders standardIdentifiers)
return f{scopeCF = cf}
scopeEnum :: ScopeRender m => ScopeFile -> I.Iteratee ByteString m a -> m a
scopeEnum ScopeFile{..} iter = I.enumFdRandom scopeBufSize fd iter >>= I.run
layersFromFile :: ScopeFile -> IO ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))
layersFromFile file@ScopeFile{..} = do
let base = baseUTC . cfGlobal $ scopeCF
tracks = IM.keys . cfSpecs $ scopeCF
colors <- genColors (length tracks) (0.9, 0.9, 0.9) (0.5)
foldl1 merge <$> mapM (\t -> scopeEnum file (I.joinI $ enumBlock scopeCF $ iterListLayers base t))
(zip tracks colors)
where
merge :: ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))
-> ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))
-> ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))
merge (ls1, bs1, ubs1) (ls2, bs2, ubs2) =
(ls1 ++ ls2, unionBounds bs1 bs2, unionBounds ubs1 ubs2)
iterListLayers base (trackNo, color) = listLayers base trackNo color <$>
wholeTrackSummaryListDouble trackNo
listLayers :: Maybe UTCTime -> TrackNo -> RGB -> [Summary Double]
-> ([ScopeLayer], Maybe (TimeStamp, TimeStamp), Maybe (UTCTime, UTCTime))
listLayers base trackNo rgb ss = ([ ScopeLayer (rawListLayer base trackNo ss)
, ScopeLayer (sListLayer base trackNo rgb ss)
]
, Just (entry, exit)
, utcBounds (entry, exit) <$> base)
where
s = head ss
entry = summaryEntry s
exit = summaryExit s
utcBounds (t1, t2) b = (ub t1, ub t2)
where
ub = utcTimeFromTimeStamp b
rawListLayer :: Maybe UTCTime -> TrackNo
-> [Summary Double] -> Layer (TimeStamp, [Double])
rawListLayer base trackNo ss = Layer file trackNo
base
(summaryEntry s) (summaryExit s)
enumListDouble
(rawLayerPlot (maxRange ss) (0,0,0))
where
s = head ss
sListLayer :: Maybe UTCTime -> TrackNo -> RGB
-> [Summary Double] -> Layer [Summary Double]
sListLayer base trackNo rgb ss = Layer file trackNo
base
(summaryEntry s) (summaryExit s)
(enumSummaryListDouble 1)
(summaryLayerPlot (maxRange ss) rgb)
where
s = head ss
maxRange :: [Summary Double] -> Double
maxRange = maximum . map yRange
yRange :: Summary Double -> Double
yRange s = 2 * ((abs . numMin . summaryData $ s) + (abs . numMax . summaryData $ s))
addLayersFromFile :: FilePath -> Scope ui -> IO (Scope ui)
addLayersFromFile path scope = do
(newLayers, newBounds, newUTCBounds) <- layersFromFile =<< openScopeFile path
let scope' = scopeUpdate newBounds newUTCBounds scope
return $ scope' { layers = layers scope ++ newLayers }
plotLayers :: ScopeRender m => Scope ui -> m ()
plotLayers scope = mapM_ f layersByFile
where
f :: ScopeRender m => [ScopeLayer] -> m ()
f ls = plotFileLayers (lf . head $ ls) ls scope
layersByFile = groupBy ((==) `on` (fd . lf)) (layers scope)
lf (ScopeLayer l) = layerFile l
plotFileLayers :: ScopeRender m => ScopeFile -> [ScopeLayer] -> Scope ui -> m ()
plotFileLayers file layers scope = when (any visible layers) $
scopeEnum file $ do
I.seek 0
I.joinI $ enumBlock (scopeCF file) $ do
seekTimeStamp seekStart
I.joinI . (I.takeWhileE (before seekEnd) >=> I.take 1) $ I.sequence_ is
where
v = view scope
is = map (plotLayer scope) layers
visible (ScopeLayer Layer{..}) =
maybe False (< endTime) seekStart &&
maybe False (> startTime) seekEnd
seekStart = ts (viewStartUTC scope v) <|> viewStartTime scope v
seekEnd = ts (viewEndUTC scope v) <|> viewEndTime scope v
ts = (timeStampFromUTCTime <$> base <*>)
base :: Maybe UTCTime
base = join . listToMaybe $ lBase <$> take 1 layers
lBase (ScopeLayer l) = layerBaseUTC l
plotLayer :: ScopeRender m => Scope ui -> ScopeLayer -> I.Iteratee [Block] m ()
plotLayer scope (ScopeLayer Layer{..}) =
I.joinI . filterTracks [layerTrackNo] . I.joinI . convEnee $ render plotter
where
render (LayerMap f initCmds) = do
d0'm <- I.tryHead
case d0'm of
Just d0 -> do
asdf <- I.foldM renderMap (toX d0, initCmds)
lift $ mapM_ renderCmds (snd asdf)
Nothing -> return ()
where
renderMap (x0, prev) d = do
let x = toX d
cmds = f x0 (xx0) d
return (x, zipWith (++) prev cmds)
render (LayerFold f initCmds b00) = do
d0'm <- I.tryHead
case d0'm of
Just d0 -> do
asdf <- I.foldM renderFold (toX d0, initCmds, b00)
lift $ mapM_ renderCmds (mid asdf)
Nothing -> return ()
where
renderFold (x0, prev, b0) d = do
let x = toX d
(cmds, b) = f x0 (xx0) b0 d
return (x, zipWith (++) prev cmds, b)
mid (_,x,_) = x
toX :: Timestampable a => a -> Double
toX = case (utcBounds scope, layerBaseUTC) of
(Just _, Just base) -> toUTCX base
_ -> toTSX
toTSX :: Timestampable a => a -> Double
toTSX = toDouble . timeStampToCanvas scope . fromJust . timestamp
toUTCX :: Timestampable a => UTCTime -> a -> Double
toUTCX base = toDouble . utcToCanvas scope . utcTimeFromTimeStamp base . fromJust . timestamp