module Timeline (
setupTimelineView,
renderTraces,
timelineParamsChanged,
defaultScaleValue,
queueRedrawTimelines,
setCursorToTime
) where
import Timeline.Motion
import Timeline.Render
import Timeline.Key
import State
import GHC.RTS.Events
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.Events as Old hiding (eventModifier)
import Graphics.UI.Gtk.Gdk.EventM as New
import Graphics.Rendering.Cairo as C
import Data.Maybe
import Data.IORef
import Control.Monad
import Text.Printf
-- import Debug.Trace
-----------------------------------------------------------------------------
-- The CPUs view
setupTimelineView :: ViewerState -> IO ()
setupTimelineView state@ViewerState{..} = do
------------------------------------------------------------------------
-- Key presses
onKeyPress mainWindow $ \Key { Old.eventKeyName = key, eventKeyChar = mch } -> do
-- when debug $ putStrLn ("key " ++ key)
case key of
"Escape" -> mainQuit >> return True
"Right" -> do scrollRight state; return True
"Left" -> do scrollLeft state; return True
_ -> if isJust mch then
case fromJust mch of
'+' -> do zoomIn state; return True
'-' -> do zoomOut state; return True
_ -> return True
else
return True
------------------------------------------------------------------------
-- Porgram the callback for the capability drawingArea
timelineLabelDrawingArea `onExpose` updateLabelDrawingArea state
------------------------------------------------------------------------
-- Set-up the key timelineDrawingArea.
timelineKeyDrawingArea `onExpose` updateKeyDrawingArea timelineKeyDrawingArea
------------------------------------------------------------------------
-- zoom buttons
zoomInButton `onToolButtonClicked` zoomIn state
zoomOutButton `onToolButtonClicked` zoomOut state
zoomFitButton `onToolButtonClicked` zoomToFit state
firstButton `onToolButtonClicked` scrollToBeginning state
lastButton `onToolButtonClicked` scrollToEnd state
centreButton `onToolButtonClicked` centreOnCursor state
------------------------------------------------------------------------
-- Allow mouse wheel to be used for zoom in/out
on timelineDrawingArea scrollEvent $ tryEvent $ do
dir <- eventScrollDirection
mods <- eventModifier
liftIO $ do
case (dir,mods) of
(ScrollUp, [Control]) -> zoomIn state
(ScrollDown, [Control]) -> zoomOut state
(ScrollUp, []) -> vscrollUp state
(ScrollDown, []) -> vscrollDown state
_ -> return ()
------------------------------------------------------------------------
-- Mouse button
onButtonPress timelineDrawingArea $ \button -> do
when debug $ putStrLn ("button pressed: " ++ show button)
case button of
Button{ Old.eventButton = LeftButton, Old.eventClick = SingleClick,
-- eventModifier = [], -- contains [Alt2] for me
eventX = x } -> do
setCursor state x
return True
_other -> do
return False
onValueChanged timelineAdj $ queueRedrawTimelines state
onValueChanged timelineVAdj $ queueRedrawTimelines state
on timelineDrawingArea exposeEvent $ do
exposeRegion <- New.eventRegion
liftIO $ exposeTraceView state exposeRegion
return True
on timelineDrawingArea configureEvent $ do
liftIO $ configureTimelineDrawingArea state
return True
return ()
-------------------------------------------------------------------------------
-- Update the internal state and the timemline view after changing which
-- traces are displayed, or the order of traces.
timelineParamsChanged :: ViewerState -> IO ()
timelineParamsChanged state = do
queueRedrawTimelines state
updateTimelineVScroll state
configureTimelineDrawingArea :: ViewerState -> IO ()
configureTimelineDrawingArea state = do
updateTimelineVScroll state
updateTimelineHPageSize state
updateTimelineVScroll :: ViewerState -> IO ()
updateTimelineVScroll state@ViewerState{..} = do
h <- calculateTotalTimelineHeight state
(_,winh) <- widgetGetSize timelineDrawingArea
let winh' = fromIntegral winh; h' = fromIntegral h
adjustmentSetLower timelineVAdj 0
adjustmentSetUpper timelineVAdj h'
val <- adjustmentGetValue timelineVAdj
when (val > h') $ adjustmentSetValue timelineVAdj h'
adjustmentSetPageSize timelineVAdj winh'
rangeSetIncrements timelineVScrollbar (0.1 * winh') (0.9 * winh')
-- when the drawing area is resized, we update the page size of the
-- adjustment. Everything else stays the same: we don't scale or move
-- the view at all.
updateTimelineHPageSize :: ViewerState -> IO ()
updateTimelineHPageSize state@ViewerState{..} = do
(winw,_) <- widgetGetSize timelineDrawingArea
scaleValue <- readIORef scaleIORef
adjustmentSetPageSize timelineAdj (fromIntegral winw * scaleValue)
-------------------------------------------------------------------------------
-- Set the cursor to a new position
setCursor :: ViewerState -> Double -> IO ()
setCursor state@ViewerState{..} x = do
hadjValue <- adjustmentGetValue timelineAdj
scaleValue <- readIORef scaleIORef
let cursor = round (hadjValue + x * scaleValue)
when debug $ printf "cursor set to: %d\n" cursor
writeIORef cursorIORef cursor
queueRedrawTimelines state
-------------------------------------------------------------------------------
setCursorToTime :: ViewerState -> Timestamp -> IO ()
setCursorToTime state@ViewerState{..} x
= do hadjValue <- adjustmentGetValue timelineAdj
scaleValue <- readIORef scaleIORef
-- let cursor = round (hadjValue + x * scaleValue)
-- when debug $ printf "cursor set to: %d\n" cursor
writeIORef cursorIORef x
pageSize <- adjustmentGetPageSize timelineAdj
adjustmentSetValue timelineAdj ((fromIntegral x - pageSize/2) `max` 0)
queueRedrawTimelines state
-------------------------------------------------------------------------------
-- This scale value is used to map a micro-second value to a pixel unit.
-- To convert a timestamp value to a pixel value, multiply it by scale.
-- To convert a pixel value to a micro-second value, divide it by scale.
-- A negative value means the scale value to be computed to fit the
-- trace to the display.
defaultScaleValue :: Double
defaultScaleValue = -1.0