diff --git a/Scope/Types.hs b/Scope/Types.hs index 8c253a5..242d232 100644 --- a/Scope/Types.hs +++ b/Scope/Types.hs @@ -49,9 +49,10 @@ module Scope.Types ( , mkTransform , mkTSDataTransform + , translateRange + , unionRange , restrictRange , restrictRange01 - , translateRange , zoomRange -- * Scope @@ -138,6 +139,9 @@ instance Coordinate TimeStamp where translateRange :: Coordinate a => a -> (a, a) -> (a, a) translateRange t (x1, x2) = (translate t x1, translate t x2) +unionRange :: Ord a => (a, a) -> (a, a) -> (a, a) +unionRange (a1, a2) (b1, b2) = (min a1 b1, max a2 b2) + -- | Restrict a window to within a given range restrictRange :: (Ord a, Coordinate a) => (a, a) -> (a, a) -> (a, a) restrictRange (rangeX1, rangeX2) (x1, x2) diff --git a/src/GUI.hs b/src/GUI.hs index 283a8bd..f9ef47f 100644 --- a/src/GUI.hs +++ b/src/GUI.hs @@ -578,7 +578,7 @@ layersFromFile path = do merge :: ([ScopeLayer], Maybe (TimeStamp, TimeStamp)) -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp)) -> ([ScopeLayer], Maybe (TimeStamp, TimeStamp)) - merge (ls1, bs1) (ls2, bs2) = (ls1 ++ ls2, mergeBounds bs1 bs2) + merge (ls1, bs1) (ls2, bs2) = (ls1 ++ ls2, unionBounds bs1 bs2) iterLayers (trackNo, color) = layers trackNo color <$> wholeTrackSummaryDouble standardIdentifiers trackNo @@ -600,16 +600,16 @@ layersFromFile path = do yRange :: Summary Double -> Double yRange s = 2 * ((abs . numMin . summaryData $ s) + (abs . numMax . summaryData $ s)) -mergeBounds :: Ord a => Maybe (a, a) -> Maybe (a, a) -> Maybe (a, a) -mergeBounds a Nothing = a -mergeBounds Nothing b = b -mergeBounds (Just (a1, a2)) (Just (b1, b2)) = Just (min a1 b1, max a2 b2) +unionBounds :: Ord a => Maybe (a, a) -> Maybe (a, a) -> Maybe (a, a) +unionBounds a Nothing = a +unionBounds Nothing b = b +unionBounds (Just r1) (Just r2) = Just (unionRange r1 r2) addLayersFromFile :: FilePath -> Scope -> IO Scope addLayersFromFile path scope = do (newLayers, newBounds) <- layersFromFile path let oldBounds = bounds scope - mb = mergeBounds oldBounds newBounds + mb = unionBounds oldBounds newBounds t = case oldBounds of Just ob -> if oldBounds == mb then id