module B1.Program.Chart.Overlay
  ( OverlayInput(..)
  , OverlayOutput(..)
  , OverlayState
  , OverlayOptions(..)
  , OverlayBoundSet(..)
  , drawOverlay
  , newOverlayState
  ) where

import Control.Monad
import Data.Maybe
import Data.Time
import Data.Time.Format
import Graphics.Rendering.OpenGL
import System.Locale
import Text.Printf

import B1.Data.Direction
import B1.Data.Price
import B1.Data.Technicals.StockData
import B1.Graphics.Rendering.FTGL.Utils
import B1.Graphics.Rendering.OpenGL.Box
import B1.Graphics.Rendering.OpenGL.Point
import B1.Graphics.Rendering.OpenGL.Shapes
import B1.Graphics.Rendering.OpenGL.Utils
import B1.Program.Chart.Colors
import B1.Program.Chart.Dirty
import B1.Program.Chart.GraphUtils
import B1.Program.Chart.Resources

data OverlayInput = OverlayInput
  { bounds :: Box
  , alpha :: GLfloat
  , inputState :: OverlayState
  }

data OverlayOutput = OverlayOutput
  { outputState :: OverlayState
  , isDirty :: Dirty
  }

data OverlayState = OverlayState
  { options :: OverlayOptions
  , stockData :: StockData
  , infoHorizontalPosition :: Direction
  , infoVerticalPosition :: Direction
  , minInfoBubbleWidth :: GLfloat
  }

data OverlayOptions = OverlayOptions
  { boundSet :: OverlayBoundSet
  }

data OverlayBoundSet = OverlayBoundSet
  { graphBounds :: Maybe Box
  , volumeBounds :: Maybe Box
  , stochasticBounds :: Maybe Box
  , weeklyStochasticBounds :: Maybe Box
  }

textPadding :: GLfloat
textPadding = 5

lineColor4 :: GLfloat -> Color4 GLfloat
lineColor4 = gray4

newOverlayState :: OverlayOptions -> StockData -> OverlayState
newOverlayState options stockData = OverlayState
  { options = options
  , stockData = stockData
  , infoHorizontalPosition = West
  , infoVerticalPosition = East
  , minInfoBubbleWidth = 0
  }

drawOverlay :: Resources -> OverlayInput -> IO OverlayOutput
drawOverlay resources
    input@OverlayInput
      { inputState = inputState@OverlayState
        { stockData = stockData
        }
      } = do
  outputState <- handleStockData (renderOverlay resources input)
      (\_ -> return inputState) inputState stockData
  return OverlayOutput
    { outputState = outputState
    , isDirty = False
    }

renderOverlay :: Resources -> OverlayInput -> StockPriceData -> IO OverlayState
renderOverlay resources
    input@OverlayInput
      { bounds = bounds
      , alpha = alpha
      , inputState = state@OverlayState
        { options = OverlayOptions
          { boundSet = boundSet
          }
        , infoHorizontalPosition = horizontalPosition
        , infoVerticalPosition = verticalPosition
        , minInfoBubbleWidth = minInfoBubbleWidth
        }
      }
    priceData =
  if alpha >= 1 -- Too expensive to draw the overlay while animating
      && not (isMouseDrag resources)
      && boxContains bounds (mousePosition resources)
    then do
      let maybeTextX = getHorizontalAxisText resources bounds boundSet priceData
          maybeTextY = getVerticalAxisText resources bounds priceData
          maybePrice = getPriceDataForMousePosition resources bounds priceData
      case maybePrice of
        Just price -> do
          (horizontalDirection, verticalDirection, bubbleWidth)
              <- renderPriceInfoBox resources bounds boundSet
                  horizontalPosition verticalPosition
                  minInfoBubbleWidth  price
          renderCrosshair resources bounds maybeTextY
          renderHorizontalAxisText resources bounds maybeTextX
              horizontalDirection
          renderVerticalAxisText resources bounds maybeTextY
          return state
            { infoHorizontalPosition = horizontalDirection
            , infoVerticalPosition = verticalDirection
            , minInfoBubbleWidth = bubbleWidth
            }
        _ -> return state
    else
      return state

getHorizontalAxisText :: Resources -> Box -> OverlayBoundSet -> StockPriceData
    -> Maybe String
getHorizontalAxisText resources bounds 
    OverlayBoundSet
      { graphBounds = graphBounds
      , volumeBounds = volumeBounds
      , stochasticBounds = stochasticBounds
      , weeklyStochasticBounds = weeklyStochasticBounds
      }
    priceData =
  let labelGroups =
        [ (graphBounds, getPriceText)
        , (volumeBounds, getVolumeText)
        , (stochasticBounds, getStochasticText)
        , (weeklyStochasticBounds, getStochasticText)
        ]

      filterLabelGroup :: Maybe Box
          -> (Resources -> StockPriceData -> Box -> String)
          -> Maybe String
      filterLabelGroup maybeRelativeBounds textFunction
        | isNothing maybeRelativeBounds = Nothing
        | isMouseWithinBounds = Just text
        | otherwise = Nothing
        where
          absoluteBounds = convertRelativeBounds bounds $
              fromJust maybeRelativeBounds
          isMouseWithinBounds = boxContains absoluteBounds
              (mousePosition resources)
          text = textFunction resources priceData absoluteBounds

      maybeTextItems = map (uncurry filterLabelGroup) labelGroups

  in listToMaybe $ catMaybes maybeTextItems

convertRelativeBounds :: Box -> Box -> Box
convertRelativeBounds bounds relativeBounds =
  let (centerX, centerY) = boxCenter bounds
      Box (relativeLeft, relativeTop)
          (relativeRight, relativeBottom) = relativeBounds
      newLeft = centerX + boxWidth bounds / 2 * relativeLeft
      newRight = centerX + boxWidth bounds / 2 * relativeRight
      newTop = centerY + boxHeight bounds / 2 * relativeTop
      newBottom = centerY + boxHeight bounds / 2 * relativeBottom
  in Box (newLeft, newTop) (newRight, newBottom)

getPriceText :: Resources -> StockPriceData -> Box -> String
getPriceText resources priceData bounds = priceText
  where
    (_, mouseY) = mousePosition resources
    (minPrice, maxPrice) = getPriceRange priceData
    priceRange = realToFrac $ maxPrice - minPrice
    heightPercentage = (realToFrac mouseY - boxBottom bounds) / boxHeight bounds
    price = minPrice + realToFrac (priceRange * heightPercentage)
    priceText = printf "%+.2f" price
 
getVolumeText :: Resources -> StockPriceData -> Box -> String
getVolumeText resources priceData bounds = volumeText
  where
    (_, mouseY) = mousePosition resources
    numElements = numDailyElements priceData
    maxVolume = maximum $ map volume $ take numElements $ prices priceData
    heightPercentage = (realToFrac mouseY - boxBottom bounds) / boxHeight bounds
    volumeValue = floor $ realToFrac maxVolume * heightPercentage

    reduceVolume :: Int -> Int
    reduceVolume volumeValue = volumeValue `div` 1000

    printVolume = printf "%+dK"
    volumeText = printVolume $ reduceVolume volumeValue

getStochasticText :: Resources -> StockPriceData -> Box -> String
getStochasticText resources priceData bounds = stochasticText
  where
    (_, mouseY) = mousePosition resources
    heightPercentage = (realToFrac mouseY - boxBottom bounds) / boxHeight bounds
    stochastic :: Float
    stochastic = realToFrac heightPercentage * 100.0
    stochasticText = printf "%.0f%%" stochastic

renderCrosshair :: Resources -> Box -> Maybe String -> IO ()
renderCrosshair resources bounds maybeTextY = do
  let (mouseX, mouseY) = mousePosition resources
      (lowAlpha, highAlpha) = (0.1, 1)
  preservingMatrix $ do
    translateToWindowLowerLeft bounds
    renderPrimitive Lines $ do
      -- Vertical line
      color $ lineColor4 lowAlpha 
      vertex $ vertex2 mouseX (boxBottom bounds)

      color $ lineColor4 highAlpha
      vertex $ vertex2 mouseX mouseY
      vertex $ vertex2 mouseX mouseY

      color $ lineColor4 lowAlpha
      vertex $ vertex2 mouseX (boxTop bounds)

  Horizontal line
      color $ lineColor4 lowAlpha 
      vertex $ vertex2 (boxLeft bounds) mouseY

      color $ lineColor4 highAlpha
      vertex $ vertex2 mouseX mouseY
      vertex $ vertex2 mouseX mouseY

      color $ lineColor4 lowAlpha
      vertex $ vertex2 (boxRight bounds) mouseY

renderHorizontalAxisText :: Resources -> Box -> Maybe String -> Direction
    -> IO ()
renderHorizontalAxisText resources bounds maybeText direction =
  case maybeText of
    Just text -> do
      let textSpec = TextSpec (font resources) 14 text
      textBox <- measureText textSpec

      let windowPadding = -2
          bubblePadding = 5
          bubbleWidth = bubblePadding + boxWidth textBox + bubblePadding
          bubbleHeight = bubblePadding + boxHeight textBox + bubblePadding

          (mouseX, mouseY) = mousePosition resources
          bubbleX = case direction of
                      West -> boxLeft bounds + bubbleWidth / 2 + windowPadding
                      _ -> boxRight bounds - bubbleWidth / 2 - windowPadding
          bubbleY = mouseY
          (bubbleTranslateX, bubbleTranslateY) =
              globalTranslate bounds (bubbleX, bubbleY)

      preservingMatrix $ do
        translate $ vector3 bubbleTranslateX bubbleTranslateY 0
        opaqueBubble bubbleWidth bubbleHeight bubblePadding
            (black4 1) (lineColor4 1)
       
      let textX = case direction of
                    West -> boxLeft bounds + bubblePadding + windowPadding
                    _ -> boxRight bounds - bubblePadding - boxWidth textBox
                        - windowPadding
          textY = mouseY - boxHeight textBox / 2
          (textTranslateX, textTranslateY) =
              globalTranslate bounds (textX, textY)

      preservingMatrix $ do
        translate $ vector3 textTranslateX textTranslateY 0
        color $ yellow4 1
        renderText textSpec

    _ -> return ()

-- TODO: Put into a separate module
globalTranslate :: Box -> Point -> Point
globalTranslate bounds (globalX, globalY) = 
  let translateX = -boxWidth bounds / 2 - boxLeft bounds + globalX
      translateY = -boxHeight bounds / 2 - boxBottom bounds + globalY
  in (translateX, translateY)

renderVerticalAxisText :: Resources -> Box -> Maybe String -> IO ()
renderVerticalAxisText resources bounds maybeText =
  case maybeText of
    Just text -> do
      let textSpec = TextSpec (font resources) 14 text
      textBox <- measureText textSpec

      let windowPadding = -2
          bubblePadding = 5
          bubbleWidth = bubblePadding + boxWidth textBox + bubblePadding
          bubbleHeight = bubblePadding + boxHeight textBox + bubblePadding

          (mouseX, mouseY) = mousePosition resources
          centerX 
            | mouseX - bubbleWidth / 2 < boxLeft bounds =
                  boxLeft bounds + bubbleWidth / 2
            | mouseX + bubbleWidth / 2 > boxRight bounds =
                  boxRight bounds - bubbleWidth / 2
            | otherwise = mouseX

          bubbleX = centerX
          bubbleY = boxTop bounds - bubbleHeight / 2 - windowPadding
          (bubbleTranslateX, bubbleTranslateY) =
              globalTranslate bounds (bubbleX, bubbleY)

      preservingMatrix $ do
        translate $ vector3 bubbleTranslateX bubbleTranslateY 0
        opaqueBubble bubbleWidth bubbleHeight bubblePadding
            (black4 1) (lineColor4 1)

      let textX = centerX - boxWidth textBox / 2
          textY = boxTop bounds - boxHeight textBox - bubblePadding
              - windowPadding
          (textTranslateX, textTranslateY) =
              globalTranslate bounds (textX, textY)
       
      preservingMatrix $ do
        translate $ vector3 textTranslateX textTranslateY 0
        color $ yellow4 1
        renderText textSpec

    _ -> return ()

getVerticalAxisText :: Resources -> Box -> StockPriceData -> Maybe String
getVerticalAxisText resources bounds priceData = do
  let maybePrice = getPriceDataForMousePosition resources bounds priceData
  case maybePrice of
    Just price -> Just $ formatTime Data.Time.defaultTimeLocale "%D" $ endTime price
    _ -> Nothing

getPriceDataForMousePosition :: Resources -> Box -> StockPriceData
    -> Maybe Price
getPriceDataForMousePosition resources bounds priceData
  | mouseX < left = Nothing
  | mouseX >= right = Nothing
  | index < numElements = Just price
  | otherwise = Nothing
  where
    (mouseX, _) = mousePosition resources
    Box (left, _) (right, _) = bounds
    numElements = numDailyElements priceData
    elementWidth = boxWidth bounds / realToFrac numElements
    index = floor $ (mouseX - left) / elementWidth
    reverseIndex = numElements - 1 - index
    price = prices priceData !! reverseIndex

renderPriceInfoBox :: Resources -> Box -> OverlayBoundSet
    -> Direction -> Direction -> GLfloat -> Price
    -> IO (Direction, Direction, GLfloat)
renderPriceInfoBox resources bounds boundSet
    horizontalPosition verticalPosition
    minInfoBubbleWidth price = do
  let windowPadding = 10
      bubblePadding = 7
      lineSpacing = 3
      alpha = 1

      textSpec = TextSpec (font resources) 12
      openLabel = "Open: "
      closeLabel = "Close: "
      highLabel = "High: "
      lowLabel = "Low: "
      volumeLabel = "Volume: "

      printFloat = printf "%+.2f"
      openText = openLabel ++ (printFloat . open) price
      closeText = closeLabel ++ (printFloat . close) price
      highText = highLabel ++ (printFloat . high) price
      lowText = lowLabel ++ (printFloat . low) price

      printVolume = printf "%+dK"
      reduceVolume volume = volume `div` 1000
      volumeText = volumeLabel ++ (printVolume . reduceVolume . volume) price

  openLabelBox <- measureText $ textSpec openLabel
  closeLabelBox <- measureText $ textSpec closeLabel
  highLabelBox <- measureText $ textSpec highLabel
  lowLabelBox <- measureText $ textSpec lowLabel
  volumeLabelBox <- measureText $ textSpec volumeLabel

  openTextBox <- measureText $ textSpec openText
  closeTextBox <- measureText $ textSpec closeText
  highTextBox <- measureText $ textSpec highText
  lowTextBox <- measureText $ textSpec lowText
  volumeTextBox <- measureText $ textSpec volumeText

  let textLabels = [closeLabel, openLabel, highLabel, lowLabel, volumeLabel]
      textLabelBoxes = [closeLabelBox, openLabelBox, highLabelBox, lowLabelBox,
          volumeLabelBox]

      textItems = [closeText, openText, highText, lowText, volumeText]
      textBoxes = [closeTextBox, openTextBox, highTextBox, lowTextBox,
          volumeTextBox]

      largestLabelWidth = maximum $ map boxWidth textLabelBoxes
      getTextIndentation labelBox = largestLabelWidth - boxWidth labelBox
      textIndents = map getTextIndentation textLabelBoxes
      textWidths = map (\(indent, box) -> indent + boxWidth box)
          (zip textIndents textBoxes)

      largestTextWidth = maximum textWidths
      tightBubbleWidth = bubblePadding + largestTextWidth + bubblePadding
      bubbleWidth = max minInfoBubbleWidth tightBubbleWidth

      totalTextHeight = sum $ map ((+) lineSpacing . boxHeight) textBoxes
      bubbleHeight = bubblePadding + totalTextHeight + bubblePadding

      subBounds = case graphBounds boundSet of
                    Just sub -> convertRelativeBounds bounds sub
                    _ -> bounds
      (centerX, centerY) = boxCenter subBounds

      (mouseX, mouseY) = mousePosition resources
      leftBubbleLeft = boxLeft subBounds + windowPadding
      leftBubbleRight = leftBubbleLeft + bubbleWidth
      rightBubbleLeft = boxRight subBounds - windowPadding - bubbleWidth
      rightBubbleRight = rightBubbleLeft + bubbleWidth
      (bubbleX, horizontalDirection)
        | mouseX < leftBubbleRight = (rightBubbleLeft, East)
        | mouseX > rightBubbleLeft = (leftBubbleLeft, West)
        | otherwise = case horizontalPosition of
                        West -> (leftBubbleLeft, West)
                        _ -> (rightBubbleLeft, East)

      topBubbleTop = boxTop subBounds - windowPadding
      topBubbleBottom = topBubbleTop - bubbleHeight

      bottomBubbleBottom = boxBottom subBounds + windowPadding
      bottomBubbleTop = bottomBubbleBottom + bubbleHeight
      (bubbleY, verticalDirection)
        | mouseY > topBubbleBottom = (bottomBubbleTop, South)
        | mouseY < bottomBubbleTop = (topBubbleTop, North)
        | otherwise = case verticalPosition of
                        North -> (topBubbleTop, North)
                        _ -> (bottomBubbleTop, South)

      (translateX, translateY) = globalTranslate bounds (bubbleX, bubbleY)

  preservingMatrix $ do
    translate $ vector3 translateX translateY 0

    preservingMatrix $ do
      translate $ vector3 (bubbleWidth / 2) (-bubbleHeight / 2) 0
      opaqueBubble bubbleWidth bubbleHeight bubblePadding
          (black4 1) (lineColor4 1)

    color $ yellow4 alpha
    translate $ vector3 bubblePadding (-bubblePadding) 0
    mapM_ (\(textIndent, textBox, text) -> do
        translate $ vector3 textIndent (-boxHeight textBox) 0
        renderText $ textSpec text
        translate $ vector3 (-textIndent) (-lineSpacing) 0
        ) (zip3 textIndents textBoxes textItems)

    return (horizontalDirection, verticalDirection, bubbleWidth)

translateToWindowLowerLeft :: Box -> IO ()
translateToWindowLowerLeft bounds =
  Switch to global coordinates
  let translateX = (-boxWidth bounds / 2) - boxLeft bounds
      translateY = (-boxHeight bounds / 2) - boxBottom bounds
  in translate $ vector3 translateX translateY 0


 Too expensive to draw the overlay while animating
 Vertical line
 TODO: Put into a separate module
module B1.Program.Chart.Overlay
  ( OverlayInput(..)
  , OverlayOutput(..)
  , OverlayState
  , OverlayOptions(..)
  , OverlayBoundSet(..)
  , drawOverlay
  , newOverlayState
  ) where

import Control.Monad
import Data.Maybe
import Data.Time
import Data.Time.Format
import Graphics.Rendering.OpenGL
import System.Locale
import Text.Printf

import B1.Data.Direction
import B1.Data.Price
import B1.Data.Technicals.StockData
import B1.Graphics.Rendering.FTGL.Utils
import B1.Graphics.Rendering.OpenGL.Box
import B1.Graphics.Rendering.OpenGL.Point
import B1.Graphics.Rendering.OpenGL.Shapes
import B1.Graphics.Rendering.OpenGL.Utils
import B1.Program.Chart.Colors
import B1.Program.Chart.Dirty
import B1.Program.Chart.GraphUtils
import B1.Program.Chart.Resources

data OverlayInput = OverlayInput
  { bounds :: Box
  , alpha :: GLfloat
  , inputState :: OverlayState
  }

data OverlayOutput = OverlayOutput
  { outputState :: OverlayState
  , isDirty :: Dirty
  }

data OverlayState = OverlayState
  { options :: OverlayOptions
  , stockData :: StockData
  , infoHorizontalPosition :: Direction
  , infoVerticalPosition :: Direction
  , minInfoBubbleWidth :: GLfloat
  }

data OverlayOptions = OverlayOptions
  { boundSet :: OverlayBoundSet
  }

data OverlayBoundSet = OverlayBoundSet
  { graphBounds :: Maybe Box
  , volumeBounds :: Maybe Box
  , stochasticBounds :: Maybe Box
  , weeklyStochasticBounds :: Maybe Box
  }

textPadding :: GLfloat
textPadding = 5

lineColor4 :: GLfloat -> Color4 GLfloat
lineColor4 = gray4

newOverlayState :: OverlayOptions -> StockData -> OverlayState
newOverlayState options stockData = OverlayState
  { options = options
  , stockData = stockData
  , infoHorizontalPosition = West
  , infoVerticalPosition = East
  , minInfoBubbleWidth = 0
  }

drawOverlay :: Resources -> OverlayInput -> IO OverlayOutput
drawOverlay resources
    input@OverlayInput
      { inputState = inputState@OverlayState
        { stockData = stockData
        }
      } = do
  outputState <- handleStockData (renderOverlay resources input)
      (\_ -> return inputState) inputState stockData
  return OverlayOutput
    { outputState = outputState
    , isDirty = False
    }

renderOverlay :: Resources -> OverlayInput -> StockPriceData -> IO OverlayState
renderOverlay resources
    input@OverlayInput
      { bounds = bounds
      , alpha = alpha
      , inputState = state@OverlayState
        { options = OverlayOptions
          { boundSet = boundSet
          }
        , infoHorizontalPosition = horizontalPosition
        , infoVerticalPosition = verticalPosition
        , minInfoBubbleWidth = minInfoBubbleWidth
        }
      }
    priceData =
      && not (isMouseDrag resources)
      && boxContains bounds (mousePosition resources)
    then do
      let maybeTextX = getHorizontalAxisText resources bounds boundSet priceData
          maybeTextY = getVerticalAxisText resources bounds priceData
          maybePrice = getPriceDataForMousePosition resources bounds priceData
      case maybePrice of
        Just price -> do
          (horizontalDirection, verticalDirection, bubbleWidth)
              <- renderPriceInfoBox resources bounds boundSet
                  horizontalPosition verticalPosition
                  minInfoBubbleWidth  price
          renderCrosshair resources bounds maybeTextY
          renderHorizontalAxisText resources bounds maybeTextX
              horizontalDirection
          renderVerticalAxisText resources bounds maybeTextY
          return state
            { infoHorizontalPosition = horizontalDirection
            , infoVerticalPosition = verticalDirection
            , minInfoBubbleWidth = bubbleWidth
            }
        _ -> return state
    else
      return state

getHorizontalAxisText :: Resources -> Box -> OverlayBoundSet -> StockPriceData
    -> Maybe String
getHorizontalAxisText resources bounds 
    OverlayBoundSet
      { graphBounds = graphBounds
      , volumeBounds = volumeBounds
      , stochasticBounds = stochasticBounds
      , weeklyStochasticBounds = weeklyStochasticBounds
      }
    priceData =
  let labelGroups =
        [ (graphBounds, getPriceText)
        , (volumeBounds, getVolumeText)
        , (stochasticBounds, getStochasticText)
        , (weeklyStochasticBounds, getStochasticText)
        ]

      filterLabelGroup :: Maybe Box
          -> (Resources -> StockPriceData -> Box -> String)
          -> Maybe String
      filterLabelGroup maybeRelativeBounds textFunction
        | isNothing maybeRelativeBounds = Nothing
        | isMouseWithinBounds = Just text
        | otherwise = Nothing
        where
          absoluteBounds = convertRelativeBounds bounds $
              fromJust maybeRelativeBounds
          isMouseWithinBounds = boxContains absoluteBounds
              (mousePosition resources)
          text = textFunction resources priceData absoluteBounds

      maybeTextItems = map (uncurry filterLabelGroup) labelGroups

  in listToMaybe $ catMaybes maybeTextItems

convertRelativeBounds :: Box -> Box -> Box
convertRelativeBounds bounds relativeBounds =
  let (centerX, centerY) = boxCenter bounds
      Box (relativeLeft, relativeTop)
          (relativeRight, relativeBottom) = relativeBounds
      newLeft = centerX + boxWidth bounds / 2 * relativeLeft
      newRight = centerX + boxWidth bounds / 2 * relativeRight
      newTop = centerY + boxHeight bounds / 2 * relativeTop
      newBottom = centerY + boxHeight bounds / 2 * relativeBottom
  in Box (newLeft, newTop) (newRight, newBottom)

getPriceText :: Resources -> StockPriceData -> Box -> String
getPriceText resources priceData bounds = priceText
  where
    (_, mouseY) = mousePosition resources
    (minPrice, maxPrice) = getPriceRange priceData
    priceRange = realToFrac $ maxPrice - minPrice
    heightPercentage = (realToFrac mouseY - boxBottom bounds) / boxHeight bounds
    price = minPrice + realToFrac (priceRange * heightPercentage)
    priceText = printf "%+.2f" price
 
getVolumeText :: Resources -> StockPriceData -> Box -> String
getVolumeText resources priceData bounds = volumeText
  where
    (_, mouseY) = mousePosition resources
    numElements = numDailyElements priceData
    maxVolume = maximum $ map volume $ take numElements $ prices priceData
    heightPercentage = (realToFrac mouseY - boxBottom bounds) / boxHeight bounds
    volumeValue = floor $ realToFrac maxVolume * heightPercentage

    reduceVolume :: Int -> Int
    reduceVolume volumeValue = volumeValue `div` 1000

    printVolume = printf "%+dK"
    volumeText = printVolume $ reduceVolume volumeValue

getStochasticText :: Resources -> StockPriceData -> Box -> String
getStochasticText resources priceData bounds = stochasticText
  where
    (_, mouseY) = mousePosition resources
    heightPercentage = (realToFrac mouseY - boxBottom bounds) / boxHeight bounds
    stochastic :: Float
    stochastic = realToFrac heightPercentage * 100.0
    stochasticText = printf "%.0f%%" stochastic

renderCrosshair :: Resources -> Box -> Maybe String -> IO ()
renderCrosshair resources bounds maybeTextY = do
  let (mouseX, mouseY) = mousePosition resources
      (lowAlpha, highAlpha) = (0.1, 1)
  preservingMatrix $ do
    translateToWindowLowerLeft bounds
    renderPrimitive Lines $ do
      color $ lineColor4 lowAlpha 
      vertex $ vertex2 mouseX (boxBottom bounds)

      color $ lineColor4 highAlpha
      vertex $ vertex2 mouseX mouseY
      vertex $ vertex2 mouseX mouseY

      color $ lineColor4 lowAlpha
      vertex $ vertex2 mouseX (boxTop bounds)

  Horizontal line
      color $ lineColor4 lowAlpha 
      vertex $ vertex2 (boxLeft bounds) mouseY

      color $ lineColor4 highAlpha
      vertex $ vertex2 mouseX mouseY
      vertex $ vertex2 mouseX mouseY

      color $ lineColor4 lowAlpha
      vertex $ vertex2 (boxRight bounds) mouseY

renderHorizontalAxisText :: Resources -> Box -> Maybe String -> Direction
    -> IO ()
renderHorizontalAxisText resources bounds maybeText direction =
  case maybeText of
    Just text -> do
      let textSpec = TextSpec (font resources) 14 text
      textBox <- measureText textSpec

      let windowPadding = -2
          bubblePadding = 5
          bubbleWidth = bubblePadding + boxWidth textBox + bubblePadding
          bubbleHeight = bubblePadding + boxHeight textBox + bubblePadding

          (mouseX, mouseY) = mousePosition resources
          bubbleX = case direction of
                      West -> boxLeft bounds + bubbleWidth / 2 + windowPadding
                      _ -> boxRight bounds - bubbleWidth / 2 - windowPadding
          bubbleY = mouseY
          (bubbleTranslateX, bubbleTranslateY) =
              globalTranslate bounds (bubbleX, bubbleY)

      preservingMatrix $ do
        translate $ vector3 bubbleTranslateX bubbleTranslateY 0
        opaqueBubble bubbleWidth bubbleHeight bubblePadding
            (black4 1) (lineColor4 1)
       
      let textX = case direction of
                    West -> boxLeft bounds + bubblePadding + windowPadding
                    _ -> boxRight bounds - bubblePadding - boxWidth textBox
                        - windowPadding
          textY = mouseY - boxHeight textBox / 2
          (textTranslateX, textTranslateY) =
              globalTranslate bounds (textX, textY)

      preservingMatrix $ do
        translate $ vector3 textTranslateX textTranslateY 0
        color $ yellow4 1
        renderText textSpec

    _ -> return ()

globalTranslate :: Box -> Point -> Point
globalTranslate bounds (globalX, globalY) = 
  let translateX = -boxWidth bounds / 2 - boxLeft bounds + globalX
      translateY = -boxHeight bounds / 2 - boxBottom bounds + globalY
  in (translateX, translateY)

renderVerticalAxisText :: Resources -> Box -> Maybe String -> IO ()
renderVerticalAxisText resources bounds maybeText =
  case maybeText of
    Just text -> do
      let textSpec = TextSpec (font resources) 14 text
      textBox <- measureText textSpec

      let windowPadding = -2
          bubblePadding = 5
          bubbleWidth = bubblePadding + boxWidth textBox + bubblePadding
          bubbleHeight = bubblePadding + boxHeight textBox + bubblePadding

          (mouseX, mouseY) = mousePosition resources
          centerX 
            | mouseX - bubbleWidth / 2 < boxLeft bounds =
                  boxLeft bounds + bubbleWidth / 2
            | mouseX + bubbleWidth / 2 > boxRight bounds =
                  boxRight bounds - bubbleWidth / 2
            | otherwise = mouseX

          bubbleX = centerX
          bubbleY = boxTop bounds - bubbleHeight / 2 - windowPadding
          (bubbleTranslateX, bubbleTranslateY) =
              globalTranslate bounds (bubbleX, bubbleY)

      preservingMatrix $ do
        translate $ vector3 bubbleTranslateX bubbleTranslateY 0
        opaqueBubble bubbleWidth bubbleHeight bubblePadding
            (black4 1) (lineColor4 1)

      let textX = centerX - boxWidth textBox / 2
          textY = boxTop bounds - boxHeight textBox - bubblePadding
              - windowPadding
          (textTranslateX, textTranslateY) =
              globalTranslate bounds (textX, textY)
       
      preservingMatrix $ do
        translate $ vector3 textTranslateX textTranslateY 0
        color $ yellow4 1
        renderText textSpec

    _ -> return ()

getVerticalAxisText :: Resources -> Box -> StockPriceData -> Maybe String
getVerticalAxisText resources bounds priceData = do
  let maybePrice = getPriceDataForMousePosition resources bounds priceData
  case maybePrice of
    Just price -> Just $ formatTime Data.Time.defaultTimeLocale "%D" $ endTime price
    _ -> Nothing

getPriceDataForMousePosition :: Resources -> Box -> StockPriceData
    -> Maybe Price
getPriceDataForMousePosition resources bounds priceData
  | mouseX < left = Nothing
  | mouseX >= right = Nothing
  | index < numElements = Just price
  | otherwise = Nothing
  where
    (mouseX, _) = mousePosition resources
    Box (left, _) (right, _) = bounds
    numElements = numDailyElements priceData
    elementWidth = boxWidth bounds / realToFrac numElements
    index = floor $ (mouseX - left) / elementWidth
    reverseIndex = numElements - 1 - index
    price = prices priceData !! reverseIndex

renderPriceInfoBox :: Resources -> Box -> OverlayBoundSet
    -> Direction -> Direction -> GLfloat -> Price
    -> IO (Direction, Direction, GLfloat)
renderPriceInfoBox resources bounds boundSet
    horizontalPosition verticalPosition
    minInfoBubbleWidth price = do
  let windowPadding = 10
      bubblePadding = 7
      lineSpacing = 3
      alpha = 1

      textSpec = TextSpec (font resources) 12
      openLabel = "Open: "
      closeLabel = "Close: "
      highLabel = "High: "
      lowLabel = "Low: "
      volumeLabel = "Volume: "

      printFloat = printf "%+.2f"
      openText = openLabel ++ (printFloat . open) price
      closeText = closeLabel ++ (printFloat . close) price
      highText = highLabel ++ (printFloat . high) price
      lowText = lowLabel ++ (printFloat . low) price

      printVolume = printf "%+dK"
      reduceVolume volume = volume `div` 1000
      volumeText = volumeLabel ++ (printVolume . reduceVolume . volume) price

  openLabelBox <- measureText $ textSpec openLabel
  closeLabelBox <- measureText $ textSpec closeLabel
  highLabelBox <- measureText $ textSpec highLabel
  lowLabelBox <- measureText $ textSpec lowLabel
  volumeLabelBox <- measureText $ textSpec volumeLabel

  openTextBox <- measureText $ textSpec openText
  closeTextBox <- measureText $ textSpec closeText
  highTextBox <- measureText $ textSpec highText
  lowTextBox <- measureText $ textSpec lowText
  volumeTextBox <- measureText $ textSpec volumeText

  let textLabels = [closeLabel, openLabel, highLabel, lowLabel, volumeLabel]
      textLabelBoxes = [closeLabelBox, openLabelBox, highLabelBox, lowLabelBox,
          volumeLabelBox]

      textItems = [closeText, openText, highText, lowText, volumeText]
      textBoxes = [closeTextBox, openTextBox, highTextBox, lowTextBox,
          volumeTextBox]

      largestLabelWidth = maximum $ map boxWidth textLabelBoxes
      getTextIndentation labelBox = largestLabelWidth - boxWidth labelBox
      textIndents = map getTextIndentation textLabelBoxes
      textWidths = map (\(indent, box) -> indent + boxWidth box)
          (zip textIndents textBoxes)

      largestTextWidth = maximum textWidths
      tightBubbleWidth = bubblePadding + largestTextWidth + bubblePadding
      bubbleWidth = max minInfoBubbleWidth tightBubbleWidth

      totalTextHeight = sum $ map ((+) lineSpacing . boxHeight) textBoxes
      bubbleHeight = bubblePadding + totalTextHeight + bubblePadding

      subBounds = case graphBounds boundSet of
                    Just sub -> convertRelativeBounds bounds sub
                    _ -> bounds
      (centerX, centerY) = boxCenter subBounds

      (mouseX, mouseY) = mousePosition resources
      leftBubbleLeft = boxLeft subBounds + windowPadding
      leftBubbleRight = leftBubbleLeft + bubbleWidth
      rightBubbleLeft = boxRight subBounds - windowPadding - bubbleWidth
      rightBubbleRight = rightBubbleLeft + bubbleWidth
      (bubbleX, horizontalDirection)
        | mouseX < leftBubbleRight = (rightBubbleLeft, East)
        | mouseX > rightBubbleLeft = (leftBubbleLeft, West)
        | otherwise = case horizontalPosition of
                        West -> (leftBubbleLeft, West)
                        _ -> (rightBubbleLeft, East)

      topBubbleTop = boxTop subBounds - windowPadding
      topBubbleBottom = topBubbleTop - bubbleHeight

      bottomBubbleBottom = boxBottom subBounds + windowPadding
      bottomBubbleTop = bottomBubbleBottom + bubbleHeight
      (bubbleY, verticalDirection)
        | mouseY > topBubbleBottom = (bottomBubbleTop, South)
        | mouseY < bottomBubbleTop = (topBubbleTop, North)
        | otherwise = case verticalPosition of
                        North -> (topBubbleTop, North)
                        _ -> (bottomBubbleTop, South)

      (translateX, translateY) = globalTranslate bounds (bubbleX, bubbleY)

  preservingMatrix $ do
    translate $ vector3 translateX translateY 0

    preservingMatrix $ do
      translate $ vector3 (bubbleWidth / 2) (-bubbleHeight / 2) 0
      opaqueBubble bubbleWidth bubbleHeight bubblePadding
          (black4 1) (lineColor4 1)

    color $ yellow4 alpha
    translate $ vector3 bubblePadding (-bubblePadding) 0
    mapM_ (\(textIndent, textBox, text) -> do
        translate $ vector3 textIndent (-boxHeight textBox) 0
        renderText $ textSpec text
        translate $ vector3 (-textIndent) (-lineSpacing) 0
        ) (zip3 textIndents textBoxes textItems)

    return (horizontalDirection, verticalDirection, bubbleWidth)

translateToWindowLowerLeft :: Box -> IO ()
translateToWindowLowerLeft bounds =
  Switch to global coordinates
  let translateX = (-boxWidth bounds / 2) - boxLeft bounds
      translateY = (-boxHeight bounds / 2) - boxBottom bounds
  in translate $ vector3 translateX translateY 0

