content: module B1.Program.Chart.SymbolEntry
    ( SymbolEntryInput(..)
    , SymbolEntryOutput(..)
    , SymbolEntryState
    , drawSymbolEntry
    , newSymbolEntryState
    ) where
  
  import Control.Monad
  import Data.Char
  import Graphics.Rendering.OpenGL
  import Graphics.UI.GLFW
  
  import B1.Data.Symbol
  import B1.Graphics.Rendering.FTGL.Utils
  import B1.Graphics.Rendering.OpenGL.Box
  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.Resources
  
  data SymbolEntryState = SymbolEntryState
    { pendingSymbol :: Symbol
    }
  
  newSymbolEntryState :: SymbolEntryState
  newSymbolEntryState = SymbolEntryState { pendingSymbol = "" }
  
  data SymbolEntryInput = SymbolEntryInput
    { bounds :: Box
    , inputState :: SymbolEntryState
    }
  
  data SymbolEntryOutput = SymbolEntryOutput
    { outputState :: SymbolEntryState
    , isDirty :: Dirty
    , maybeEnteredSymbol :: Maybe Symbol
    }
  
  drawSymbolEntry :: Resources -> SymbolEntryInput -> IO SymbolEntryOutput
  drawSymbolEntry resources input = do
    renderSymbolEntry resources input
    return output
    where
      currentSymbol = pendingSymbol (inputState input)
      checkKeyPress = isKeyPressed resources
      maybeLetterKey = getKeyPressed resources $ map CharKey ['A'..'Z']
      output
        | checkKeyPress (SpecialKey ENTER) = handleEnterKey currentSymbol
        | checkKeyPress (SpecialKey BACKSPACE) = handleBackspaceKey currentSymbol
        | checkKeyPress (SpecialKey ESC) = handleEscapeKey currentSymbol
        | otherwise = handleCharKey maybeLetterKey currentSymbol
  
  renderSymbolEntry :: Resources -> SymbolEntryInput -> IO ()
  renderSymbolEntry resources input = do
    let symbol = pendingSymbol (inputState input)
    unless (null symbol) $ do
      let textSpec = TextSpec (font resources) 48 symbol
      textBounds <- measureText textSpec
  
      let textBubblePadding = 15
          textBubbleWidth = boxWidth textBounds + textBubblePadding * 2
          textBubbleHeight = boxHeight textBounds + textBubblePadding * 2
      opaqueBubble textBubbleWidth textBubbleHeight textBubblePadding
          (black4 1) (blue4 1)
  
      let textWidth = boxWidth textBounds
          textHeight = boxHeight textBounds
      preservingMatrix $ do
        color $ green4 1
        translate $ vector3 (-textWidth / 2) (-textHeight / 2) 0
        renderText textSpec
  
  handleEnterKey :: Symbol -> SymbolEntryOutput
  handleEnterKey currentSymbol
    | null currentSymbol = newSymbolEntryOutput currentSymbol False Nothing
    | otherwise = newSymbolEntryOutput "" True (Just currentSymbol)
  
  handleBackspaceKey :: Symbol -> SymbolEntryOutput
  handleBackspaceKey currentSymbol = newSymbolEntryOutput nextSymbol nextIsDirty Nothing
    where
      (nextSymbol, nextIsDirty)
        | null currentSymbol = (currentSymbol, False)
        | otherwise = (init currentSymbol, True)
  
  handleEscapeKey :: Symbol -> SymbolEntryOutput
  handleEscapeKey currentSymbol = newSymbolEntryOutput "" True Nothing
  
  handleCharKey :: Maybe Key -> Symbol -> SymbolEntryOutput
  handleCharKey (Just (CharKey char)) symbol
    | isAlpha char = newSymbolEntryOutput (symbol ++ [char]) True Nothing
    | otherwise = newSymbolEntryOutput symbol False Nothing
  handleCharKey _ symbol = newSymbolEntryOutput symbol False Nothing
  
  newSymbolEntryOutput :: Symbol -> Dirty -> Maybe Symbol -> SymbolEntryOutput
  newSymbolEntryOutput newSymbol newIsDirty maybeSymbol = SymbolEntryOutput
    { outputState = SymbolEntryState { pendingSymbol = newSymbol }
    , isDirty = newIsDirty
    , maybeEnteredSymbol = maybeSymbol
    }
  
  