content: module B1.Program.Chart.Main
    ( main
    ) where
  
  import Control.Monad
  import Data.IORef
  import Debug.Trace
  import Graphics.Rendering.FTGL
  import Graphics.Rendering.OpenGL
  import Graphics.UI.GLFW
  import Paths_b1
  import System.Environment
  
  import B1.Control.TaskManager
  import B1.Data.Action
  import B1.Graphics.Rendering.OpenGL.BufferManager
  import B1.Program.Chart.Dirty
  import B1.Program.Chart.Options
  import B1.Program.Chart.Resources
  import B1.Program.Chart.Screen
  
  main :: IO ()
  main = do
    args <- getArgs
    (options, nonOptions) <- readOptions args
  
    initialize
    createWindow
    initClientState
  
    resourcesRef <- createInitialResources options
    resources <- readIORef resourcesRef
    loadTextures
  
    windowDirtyRef <- newIORef False
    windowSizeCallback $= myWindowSizeCallback resourcesRef windowDirtyRef
  
    drawLoop resourcesRef windowDirtyRef drawScreen
  
    -- TODO: Need to clean up shader resources before leaving?
    closeWindow
    terminate
  
  createWindow :: IO ()
  createWindow = do
    openWindow (Size 400 400) [DisplayAlphaBits 8] Window
    windowTitle $= "B1"
  
  initClientState :: IO ()
  initClientState = do
    blendFunc $= (SrcAlpha, One)
    blend $= Enabled
    clientState VertexArray $= Enabled
    clientState ColorArray $= Enabled
  
  loadTextures :: IO ()
  loadTextures = do
    filePaths <- mapM getDataFileName fileNames
    mapM_ (uncurry bindTexture) (zip [0 ..] filePaths)
    texture Texture2D $= Disabled
    where
      fileNames =
        [ "res/tga/add-button.tga"
        , "res/tga/remove-button.tga"
        , "res/tga/refresh-button.tga"
        ]
  
  bindTexture :: Int -> String -> IO ()
  bindTexture textureNumber fileName = do
    textureBinding Texture2D $= Just (TextureObject (fromIntegral textureNumber))
    textureFilter Texture2D $= ((Linear', Nothing), Linear')
    loadResult <- loadTexture2D fileName [BuildMipMaps]
    putTraceMsg $ "Loading texture " ++ fileName ++ "..."
        ++ if loadResult then "SUCCESS" else "FAIL"
  
  -- | Initialize the resources that should be immutable like fonts.
  -- The other fields will be filled in later.
  createInitialResources :: Options -> IO (IORef Resources)
  createInitialResources options = do
    fontPath <- getDataFileName "res/fonts/orbitron/orbitron-medium.ttf"
    font <- createTextureFont fontPath
    vertexShaderPath <- getDataFileName "res/shaders/vertex-shader.txt"
    fragmentShaderPath <- getDataFileName "res/shaders/fragment-shader.txt"
    program <- loadProgram [vertexShaderPath] [fragmentShaderPath]
    bufferManager <- newBufferManager
    taskManager <- newTaskManager
    newIORef $ newResources font program bufferManager taskManager
  
  -- TODO: Move loading program code to a helper module
  loadProgram :: [FilePath] -> [FilePath] -> IO Program
  loadProgram vertexShaderPaths fragmentShaderPaths= do
    vertexShaders <- mapM (readAndCompileShader VertexShader) vertexShaderPaths
    fragmentShaders <- mapM (readAndCompileShader FragmentShader) fragmentShaderPaths
    B1.Program.Chart.Main.createProgram vertexShaders fragmentShaders
  
  readAndCompileShader :: ShaderType -> FilePath -> IO Shader
  readAndCompileShader shaderType filePath = do
    src <- readFile filePath
    shader <- createShader shaderType
    shaderSource shader $= [src]
    compileShader shader
    ok <- get $ compileStatus shader
    infoLog <- get $ shaderInfoLog shader
    putTraceMsg $ "Shader info log: " ++ infoLog
    unless ok $ do
      deleteObjectNames [shader]
      ioError $ userError "Shader compilation failed"
    return shader
  
  createProgram :: [Shader] -> [Shader] -> IO Program
  createProgram vertexShader fragmentShader = do
    program <- Graphics.Rendering.OpenGL.createProgram
    attachedShaders program $= (vertexShader ++ fragmentShader)
    linkProgram program
    ok <- get $ linkStatus program
    infoLog <- get $ programInfoLog program
    putTraceMsg $ "Program info log: " ++ infoLog
    unless ok $ do
      deleteObjectNames [program]
      ioError $ userError "Program linking failed"
    return program
  
  myWindowSizeCallback :: IORef Resources -> IORef Dirty -> Size -> IO ()
  myWindowSizeCallback resourcesRef windowDirtyRef size@(Size width height) = do
    viewport $= (Position 0 0, size)
    modifyIORef resourcesRef $ updateWindowSize size
    writeIORef windowDirtyRef True
  
    -- Use orthographic projection, since it is easier to position text.
    -- (0, 0) is lower left corner of the screen.
    matrixMode $= Projection
    loadIdentity
    ortho2D 0 (realToFrac width) 0 (realToFrac height)
  
    matrixMode $= Modelview 0
    loadIdentity
  
  drawLoop :: IORef Resources -> IORef Dirty
      -> (Resources -> IO (Action Resources Dirty, Dirty)) -> IO ()
  drawLoop resourcesRef windowDirtyRef action = do
    clear [ColorBuffer, DepthBuffer]
  
    refreshMousePosition resourcesRef
        >>= refreshMouseButtonState
        >>= refreshMouseWheelPosition
        >>= refreshKeysPressed
    resources <- readIORef resourcesRef
  --  print resources
  
    (Action nextAction, isContentDirty) <- action resources
  
    swapBuffers
    sleep 0.001
  
    -- Screen may have been resized after swapBuffers even though
    -- there are no dirty animations.
    isWindowDirty <- readIORef windowDirtyRef
    writeIORef windowDirtyRef False
  
    control <- getKey LCTRL
    c <- getKey 'C'
    unless (control == Press && c == Press) $ do
      -- TODO: Need to do the same for key presses.
      let isMouseStateDirty = isMouseButtonPressed resources ButtonLeft
              || isMouseButtonClicked resources ButtonLeft
              || isMouseWheelMoving resources
              || isMouseDrag resources
  
      -- If the screen is not dirty, then wait for events rather than drawing
      -- the same frame again and pegging the CPU to a 100%.
      unless (isWindowDirty || isContentDirty || isMouseStateDirty) $ do
  --      putTraceMsg $ "Waiting isWindowDirty: " ++ show isWindowDirty
  --          ++ " isContentDirty: " ++ show isContentDirty
  --          ++ " isMouseStateDirty: " ++ show isMouseStateDirty
        waitEvents
  
      drawLoop resourcesRef windowDirtyRef nextAction
  
  refreshMousePosition :: IORef Resources -> IO (IORef Resources)
  refreshMousePosition resourcesRef = do
    position <- get mousePos
    modifyIORef resourcesRef
        (invertMousePositionY . updateMousePosition position)
    return resourcesRef
  
  refreshMouseButtonState :: IORef Resources -> IO (IORef Resources)
  refreshMouseButtonState resourcesRef = do
    leftState <- getMouseButton ButtonLeft
    rightState <- getMouseButton ButtonRight
    let keyStates = [(ButtonLeft, leftState), (ButtonRight, rightState)]
        pressedButtons = (map fst . filter ((== Press) . snd)) keyStates
        releasedButtons = (map fst . filter ((== Release) . snd)) keyStates
    modifyIORef resourcesRef $
        updateMouseButtonState pressedButtons releasedButtons
    return resourcesRef
  
  refreshMouseWheelPosition :: IORef Resources -> IO (IORef Resources)
  refreshMouseWheelPosition resourcesRef = do
    position <- get mouseWheel
    modifyIORef resourcesRef $ updateMouseWheelPosition position
    return resourcesRef
  
  refreshKeysPressed :: IORef Resources -> IO (IORef Resources)
  refreshKeysPressed resourcesRef = do
    updatePressed resourcesRef getKey keys Press updateKeysPressed
    return resourcesRef
    where
      alphaKeys = map CharKey ['A'..'Z']
      specialKeys = map SpecialKey [ENTER, BACKSPACE, ESC]
      keys = alphaKeys ++ specialKeys
  
  updatePressed :: IORef Resources -> (a -> IO KeyButtonState)
      -> [a] -> KeyButtonState -> ([a] -> Resources -> Resources) -> IO ()
  updatePressed resourcesRef ioFunction values buttonState updateFunction = do
    states <- mapM ioFunction values
    let indexedStates = zip values states
        matchingStates = filter ((== buttonState) . snd) indexedStates
        matchingValues = map fst matchingStates
    modifyIORef resourcesRef $ updateFunction matchingValues
  
  