Prevent Timeline selections that are out of bounds

timelineSetSelection now returns Nothing in case of an invalid selection
that's solely outside of the TimelineView for both a PointSelection and
a RangeSelection. A RangeSelection is additionally clamped to the bounds
of the TimelineView to stop dragging when the bounds have been reached.

The new return value is processed inside the Mouse and Event handling
accordingly. Within this the EventCursorChangedIndex handling now
includes updating previously omitted views. This fixes an issue where
following a RangeSelection with a selection inside the EventsView would
cause the previously omitted views to still display the information of
the RangeSelection and not the equivalent PointSelection of the
EventsView selection.

Lastly, fix an issue from the previous commit that added styling usage
inside the EventsView. The wrong background color was applied to a
selected Event when making the second PointSelection after a
RangeSelection or a PointSelection without a preceding RangeSelection.
StateSelected is now always applied when selected.

Author: TuongNM

GUI/EventsView.hs

@@ -331,7 +331,7 @@ drawEvents EventsView{drawArea, adj}
           selected = cursorPos == n
           (state1, state2)
             | inside    = (StateSelected, StateSelected)
-            | selected  = (state, state)
+            | selected  = (StateSelected, state)
             | otherwise = (state, StateNormal)
     ]
 

GUI/Main.hs

@@ -350,37 +350,21 @@ eventLoop uienv@UIEnv{..} eventlogState = do
     dispatch (EventCursorChangedIndex cursorPos') EventlogLoaded{hecs} = do
       let cursorTs'  = eventIndexToTimestamp hecs cursorPos'
           selection' = PointSelection cursorTs'
-      timelineSetSelection timelineWin selection'
-      eventsViewSetCursor eventsView  cursorPos' Nothing
-      continueWith eventlogState {
-        selection = selection',
-        cursorPos = cursorPos'
-      }
+      mselection <- timelineSetSelection timelineWin selection'
+      setSelection cursorPos' Nothing mselection
 
     dispatch (EventCursorChangedSelection selection'@(PointSelection cursorTs'))
              EventlogLoaded{hecs} = do
       let cursorPos' = timestampToEventIndex hecs cursorTs'
-      timelineSetSelection timelineWin selection'
-      eventsViewSetCursor eventsView cursorPos' Nothing
-      histogramViewSetInterval histogramView Nothing
-      summaryViewSetInterval summaryView Nothing
-      continueWith eventlogState {
-        selection = selection',
-        cursorPos = cursorPos'
-      }
+      mselection <- timelineSetSelection timelineWin selection'
+      setSelection cursorPos' Nothing mselection
 
     dispatch (EventCursorChangedSelection selection'@(RangeSelection start end))
              EventlogLoaded{hecs} = do
       let cursorPos' = timestampToEventIndex hecs start
           mrange = Just (cursorPos', timestampToEventIndex hecs end)
-      timelineSetSelection timelineWin selection'
-      eventsViewSetCursor eventsView cursorPos' mrange
-      histogramViewSetInterval histogramView (Just (start, end))
-      summaryViewSetInterval summaryView (Just (start, end))
-      continueWith eventlogState {
-        selection = selection',
-        cursorPos = cursorPos'
-      }
+      mselection <- timelineSetSelection timelineWin selection'
+      setSelection cursorPos' mrange mselection
 
     dispatch (EventTracesChanged traces) _ = do
       timelineWindowSetTraces timelineWin traces
@@ -435,6 +419,24 @@ eventLoop uienv@UIEnv{..} eventlogState = do
     async doing action =
       forkIO (action `catch` \e -> post (EventUserError doing e))
 
+    setSelection cursorPos' _ (Just selection'@(PointSelection _)) = do
+      eventsViewSetCursor eventsView cursorPos' Nothing
+      histogramViewSetInterval histogramView Nothing
+      summaryViewSetInterval summaryView Nothing
+      continueWith eventlogState {
+        selection = selection',
+        cursorPos = cursorPos'
+      }
+    setSelection cursorPos' mrange (Just selection'@(RangeSelection start end)) = do
+      eventsViewSetCursor eventsView cursorPos' mrange
+      histogramViewSetInterval histogramView (Just (start, end))
+      summaryViewSetInterval summaryView (Just (start, end))
+      continueWith eventlogState {
+        selection = selection',
+        cursorPos = cursorPos'
+      }
+    setSelection _ _ Nothing = continue
+
     post = postEvent eventQueue
     continue = continueWith eventlogState
     continueWith = return . Right

GUI/Timeline.hs

@@ -37,6 +37,7 @@ import Graphics.UI.Gtk
 import Graphics.Rendering.Cairo ( liftIO )
 
 import Data.IORef
+import Data.Ord
 import Control.Monad
 import Control.Monad.Trans
 import qualified Data.Text as T
@@ -384,10 +385,25 @@ updateTimelineHPageSize TimelineState{..} = do
 -------------------------------------------------------------------------------
 -- Cursor / selection and mouse interaction
 
-timelineSetSelection :: TimelineView -> TimeSelection -> IO ()
+timelineSetSelection :: TimelineView -> TimeSelection -> IO (Maybe TimeSelection)
 timelineSetSelection TimelineView{..} selection = do
-  writeIORef selectionRef selection
-  queueRedrawTimelines timelineState
+  mhecs <- readIORef hecsIORef
+  case mhecs >>= (adjustSelection selection . hecLastEventTime) of
+    Nothing -> return Nothing
+    Just selection' -> do
+      writeIORef selectionRef selection'
+      queueRedrawTimelines timelineState
+      return $ Just selection'
+  where
+    -- Prevent selections that are out of bounds.
+    adjustSelection (PointSelection timestamp) lastTx
+      | timestamp < 0 || timestamp > lastTx = Nothing
+      | otherwise = Just $ PointSelection timestamp
+    adjustSelection (RangeSelection start end) lastTx
+      | start < 0 && end < 0 || start > lastTx && end > lastTx = Nothing
+      | otherwise = Just $ RangeSelection (clampSelection lastTx start) (clampSelection lastTx end)
+
+    clampSelection lastTx = clamp (0, lastTx)
 
 -- little state machine
 data MouseState = None
@@ -402,8 +418,10 @@ mousePress view@TimelineView{..} state button x =
   case (state, button) of
     (None, LeftButton)   -> do xv <- viewPointToTime view x
                                -- update the view without notifying the client
-                               timelineSetSelection view (PointSelection xv)
-                               return (PressLeft x)
+                               selection <- timelineSetSelection view (PointSelection xv)
+                               case selection of
+                                 Nothing -> return None
+                                 Just _ -> return (PressLeft x)
     (None, MiddleButton) -> do widgetSetCursor timelineDrawingArea (Just cursorMove)
                                v <- adjustmentGetValue timelineAdj
                                return (DragMiddle x v)
@@ -424,8 +442,10 @@ mouseMove view@TimelineView{..} state x =
         dragThreshold = abs (x - x0) > 5
     DragLeft  x0      -> do (xv, xv') <- viewRangeToTimeRange view (x0, x)
                             -- update the view without notifying the client
-                            timelineSetSelection view (RangeSelection xv xv')
-                            return (DragLeft x0)
+                            selection <- timelineSetSelection view (RangeSelection xv xv')
+                            case selection of
+                              Nothing -> return None
+                              Just _ -> return (DragLeft x0)
     DragMiddle x0 v   -> do xv  <- viewPointToTimeNoClamp view x
                             xv' <- viewPointToTimeNoClamp view x0
                             scrollTo timelineState (v + (xv' - xv))