content: module GUI.Timeline.Sparks (
      treesProfile,
      maxSparkRenderedValue,
      renderSparkCreation,
      renderSparkConversion,
      renderSparkPool,
      renderSparkHistogram,
    ) where
  
  import GUI.Timeline.Render.Constants
  
  import Events.HECs
  import Events.SparkTree
  import qualified Events.SparkStats as SparkStats
  
  import GUI.Types
  import GUI.ViewerColours
  import GUI.Timeline.Ticks
  
  import Graphics.Rendering.Cairo
  
  import Control.Monad
  
  -- Rendering sparks. No approximation nor extrapolation is going on here.
  -- The sample data, recalculated for a given slice size in sparkProfile,
  -- before these functions are called, is straightforwardly rendered.
  
  maxSparkRenderedValue :: Timestamp -> SparkStats.SparkStats -> Double
  maxSparkRenderedValue duration c =
    max (SparkStats.rateDud c +
         SparkStats.rateCreated c +
         SparkStats.rateOverflowed c)
        (SparkStats.rateFizzled c +
         SparkStats.rateConverted c +
         SparkStats.rateGCd c)
    / fromIntegral duration
  
  spark_detail :: Int
  spark_detail = 4 -- in pixels
  
  treesProfile :: Double -> Timestamp -> Timestamp -> HECs
               -> (Timestamp, [[SparkStats.SparkStats]])
  treesProfile scale start end hecs =
    let slice = ceiling (fromIntegral spark_detail * scale)
        pr trees = let (_, _, stree) = trees
                   in sparkProfile slice start end stree
    in (slice, map pr (hecTrees hecs))
  
  
  renderSparkCreation :: ViewParameters -> Timestamp -> Timestamp -> Timestamp
                      -> [SparkStats.SparkStats]
                      -> Render ()
  renderSparkCreation params !slice !start !end prof = do
    let f1 c =        SparkStats.rateCreated c
        f2 c = f1 c + SparkStats.rateDud c
        f3 c = f2 c + SparkStats.rateOverflowed c
    renderSpark params slice start end prof
      f1 createdConvertedColour f2 fizzledDudsColour f3 overflowedColour
  
  renderSparkConversion :: ViewParameters -> Timestamp -> Timestamp -> Timestamp
                        -> [SparkStats.SparkStats]
                        -> Render ()
  renderSparkConversion params !slice !start !end prof = do
    let f1 c =        SparkStats.rateConverted c
        f2 c = f1 c + SparkStats.rateFizzled c
        f3 c = f2 c + SparkStats.rateGCd c
    renderSpark params slice start end prof
      f1 createdConvertedColour f2 fizzledDudsColour f3 gcColour
  
  renderSparkPool :: ViewParameters -> Timestamp -> Timestamp -> Timestamp
                  -> [SparkStats.SparkStats]
                  -> Double -> Render ()
  renderSparkPool ViewParameters{..} !slice !start !end prof !maxSparkPool = do
    let f1 c = SparkStats.minPool c
        f2 c = SparkStats.meanPool c
        f3 c = SparkStats.maxPool c
    addSparks outerPercentilesColour maxSparkPool f1 f2 start slice prof
    addSparks outerPercentilesColour maxSparkPool f2 f3 start slice prof
    outlineSparks maxSparkPool f2 start slice prof
    outlineSparks maxSparkPool (const 0) start slice prof
    renderHRulers hecSparksHeight start end
  
  renderSpark :: ViewParameters -> Timestamp -> Timestamp -> Timestamp
              -> [SparkStats.SparkStats]
              -> (SparkStats.SparkStats -> Double) -> Color
              -> (SparkStats.SparkStats -> Double) -> Color
              -> (SparkStats.SparkStats -> Double) -> Color
              -> Render ()
  renderSpark ViewParameters{..} slice start end prof f1 c1 f2 c2 f3 c3 = do
    -- maxSpkValue is maximal spark transition rate, so
    -- maxSliceSpark is maximal number of sparks per slice for current data.
    let maxSliceSpark = maxSpkValue * fromIntegral slice
    outlineSparks maxSliceSpark f3 start slice prof
    addSparks c1 maxSliceSpark (const 0) f1 start slice prof
    addSparks c2 maxSliceSpark f1 f2 start slice prof
    addSparks c3 maxSliceSpark f2 f3 start slice prof
    renderHRulers hecSparksHeight start end
  
  off :: Double -> (SparkStats.SparkStats -> Double)
      -> SparkStats.SparkStats
      -> Double
  off maxSliceSpark f t =
    let clipped = min 1 (f t / maxSliceSpark)
    in fromIntegral hecSparksHeight * (1 - clipped)
  
  outlineSparks :: Double
                -> (SparkStats.SparkStats -> Double)
                -> Timestamp -> Timestamp
                -> [SparkStats.SparkStats]
                -> Render ()
  outlineSparks maxSliceSpark f start slice ts = do
    case ts of
      [] -> return ()
      ts -> do
        let dstart = fromIntegral start
            dslice = fromIntegral slice
            points = [dstart-dslice/2, dstart+dslice/2 ..]
            t = zip points (map (off maxSliceSpark f) ts)
        newPath
        moveTo (dstart-dslice/2) (snd $ head t)
        mapM_ (uncurry lineTo) t
        setSourceRGBAhex black 1.0
        setLineWidth 1
        stroke
  
  addSparks :: Color
            -> Double
            -> (SparkStats.SparkStats -> Double)
            -> (SparkStats.SparkStats -> Double)
            -> Timestamp -> Timestamp
            -> [SparkStats.SparkStats]
            -> Render ()
  addSparks colour maxSliceSpark f0 f1 start slice ts = do
    case ts of
      [] -> return ()
      ts -> do
        -- liftIO $ printf "ts: %s\n" (show (map f1 (ts)))
        -- liftIO $ printf "off: %s\n"
        --   (show (map (off maxSliceSpark f1) (ts) :: [Double]))
        let dstart = fromIntegral start
            dslice = fromIntegral slice
            points = [dstart-dslice/2, dstart+dslice/2 ..]
            t0 = zip points (map (off maxSliceSpark f0) ts)
            t1 = zip points (map (off maxSliceSpark f1) ts)
        newPath
        moveTo (dstart-dslice/2) (snd $ head t1)
        mapM_ (uncurry lineTo) t1
        mapM_ (uncurry lineTo) (reverse t0)
        setSourceRGBAhex colour 1.0
        fill
  
  -- | Render the spark duration histogram together with it's X scale and
  -- horizontal and vertical rulers.
  renderSparkHistogram :: ViewParameters -> HECs -> Render ()
  renderSparkHistogram ViewParameters{..} hecs =
    let intDoub :: Integral a => a -> Double
        intDoub = fromIntegral
        inR :: Timestamp -> Bool
        inR = case minterval of
                Nothing -> const True
                Just (from, to) -> \ t -> t >= from && t <= to
        -- TODO: if xs is sorted, we can slightly optimize the filtering
        inRange :: [(Timestamp, Int, Timestamp)] -> [(Int, (Timestamp, Int))]
        inRange xs = [(logdur, (dur, 1))
                     | (start, logdur, dur) <- xs, inR start]
        xs = durHistogram hecs
        bars :: [(Double, Double, Int)]
        bars = [(intDoub t, intDoub height, count)
                | (t, (height, count)) <- histogramCounts $ inRange xs]
        -- TODO: data processing up to this point could be done only at interval
        -- changes (keeping @bars@ in ViewParameters and in probably also in IOref.
        -- The rest has to be recomputed at each redraw, because resizing
        -- the window modifies the way the graph is drawn.
        -- TODO: at least pull the above out into a separate function.
  
        -- Define general parameters for visualization.
        width' = width - 5  -- add a little margin on the right
        (w, h) = (intDoub width', intDoub histogramHeight)
        (minX, maxX, maxY) = (intDoub (minXHistogram hecs),
                              intDoub (maxXHistogram hecs),
                              intDoub (maxYHistogram hecs))
        nBars = max 5 (maxX - minX + 1)
        segmentWidth = w / nBars
        -- Define parameters for drawing the bars.
        gapWidth = 10
        barWidth = segmentWidth - gapWidth
        sX x = gapWidth / 2 + (x - minX) * segmentWidth
        sY y = y * h / (max 2 maxY)
        plotRect (x, y, count) = do
          -- Draw a single bar.
          setSourceRGBAhex blue 1.0
          rectangle (sX x) (sY maxY) barWidth (sY (-y))
          fillPreserve
          setSourceRGBA 0 0 0 0.7
          setLineWidth 1
          stroke
          -- Print the number of sparks in the bar.
          selectFontFace "sans serif" FontSlantNormal FontWeightNormal
          setFontSize 10
          let above = sY (-y) > -20
          if above
            then setSourceRGBAhex black 1.0
            else setSourceRGBAhex white 1.0
          moveTo (sX x + 3) (sY (maxY - y) + if above then -3 else 13)
          showText (show count)
        drawHist = forM_ bars plotRect
        -- Define parameters for X scale.
        off y = 16 - y
        xScaleMode = XScaleLog minX segmentWidth
        drawXScale = renderXScale 1 0 maxBound width' off xScaleMode
        -- Define parameters for vertical rulers.
        nB = round nBars
        mult | nB <= 7 = 1
             | nB `mod` 5 == 0 = 5
             | nB `mod` 4 == 0 = 4
             | nB `mod` 3 == 0 = 3
             | nB `mod` 2 == 0 = nB `div` 2
             | otherwise = nB
        drawVRulers = renderVRulers 1 0 (fromIntegral width') histogramHeight
                        (XScaleLog undefined (segmentWidth * fromIntegral mult))
        -- Define the horizontal rulers call.
        drawHRulers = renderHRulers histogramHeight 0 (fromIntegral width')
    in do
      -- Start the drawing by wiping out timeline vertical rules
      -- (for PNG/PDF that require clear, transparent background)
      save
      translate hadjValue 0
      scale scaleValue 1
      rectangle 0 (fromIntegral $ - tracePad) (fromIntegral width)
        (fromIntegral $ histogramHeight + histXScaleHeight + 2 * tracePad)
      setSourceRGBAhex white 1
      op <- getOperator
      setOperator OperatorAtop  -- TODO: fixme: it paints white vertical rulers
      fill
      setOperator op
      -- Draw the bars.
      drawHist
      -- Draw the rulers on top of the bars (they are partially transparent).
      drawVRulers
      drawHRulers
      -- Move to the bottom and draw the X scale. The Y scale is drawn
      -- independetly in another drawing area.
      translate 0 (fromIntegral histogramHeight)
      drawXScale
      restore
  