{-# LANGUAGE TemplateHaskell #-}

module Main where

import           RIO
import           RIO.Process
import           RIO.Time

import qualified RIO.ByteString             as B

import qualified RIO.List                   as L
import qualified RIO.Vector                 as V

import           Options.Applicative.Simple
import qualified Paths_cellularfluid

import           SDL                        hiding (Vector)

import           Data.Time.Clock.System

import qualified Data.Serialize             as S

-- import qualified Data.Attoparsec.Text as A
import           CellularFluid

-- import qualified CellularFluid.Grid.Parse as CGP
data SimLog =
  SimLog
    { slEntries    :: [SimLogEntry]
    , slGridWidth  :: Int
    , slGridHeight :: Int
    }

type SimLogEntry = RIO.Vector Cell

data WindowHandler =
  WindowHandler
    { whndWindow   :: !Window
    , whndRenderer :: !Renderer
    }

data App =
  App
    { appLogFunc        :: !LogFunc
    , appProcessContext :: !ProcessContext
    , appWindowHandler  :: !WindowHandler
    }

instance HasLogFunc App where
  logFuncL = lens appLogFunc (\x y -> x {appLogFunc = y})

data Options =
  Options
    { optVerbose   :: !Bool
    , optWidth     :: !Int
    , optHeight    :: !Int
    , optHiDPI     :: !Bool
    , optInputFile :: !FilePath
    }

main :: IO ()
main = do
  options <- parseCmd
  eSimLog <- readSimLog $ optInputFile options
  case eSimLog of
    Left e -> error e
    Right simlog -> do
      whnd <-
        initGUI (V2 (optWidth options) (optHeight options)) (optHiDPI options)
      lo <- logOptionsHandle stderr (optVerbose options)
      pc <- mkDefaultProcessContext
      withLogFunc lo $ \lf ->
        let app =
              App
                { appLogFunc = lf
                , appProcessContext = pc
                , appWindowHandler = whnd
                }
         in runRIO app $ run simlog Nothing

-- | Main drawing loop
run :: SimLog -> Maybe Double -> RIO App ()
run (SimLog [] _ _) _ = exitSuccess
run sl@(SimLog (l:logs) w h) mx = do
  t0 <- liftIO $ systemToUTCTime <$> getSystemTime
  evts <- pollEvents
  let escPressed e =
        case eventPayload e of
          KeyboardEvent kbd ->
            keyboardEventKeyMotion kbd == Pressed &&
            keysymKeycode (keyboardEventKeysym kbd) == KeycodeEscape
          _ -> False
  logDebug "Drawing... "
  let mx' =
        case mx of
          Nothing -> gridMax l
          Just x  -> x
  draw w h mx' l
  logDebug "Done Drawing."
  t1 <- liftIO $ systemToUTCTime <$> getSystemTime
  let dt = realToFrac $ diffUTCTime t1 t0
      dtus = diffTimeToPicoseconds dt `div` 1000000
      dtrem = 16667 - dtus -- 60 FPS
  logDebug . fromString $ "Frame time remaining: " ++ show dtrem ++ "μs"
  liftIO $ threadDelay $ fromIntegral dtrem
  unless (any escPressed evts) $ run (sl {slEntries = logs}) (Just mx')

------------------------------- Drawing -----------------------------------
-- | Draws grid at one time step
draw ::
     Int -- ^ Grid Width/Cols
  -> Int -- ^ Grid Height/Rows
  -> Double -- ^ Max pressure
  -> SimLogEntry
  -> RIO App ()
draw w h mx logentry = do
  whnd <- appWindowHandler <$> ask
  let win = whndWindow whnd
      rdr = whndRenderer whnd
    -- Drawing area size
  V2 drawW drawH <- fmap fromIntegral <$> glGetDrawableSize win
    -- On screen grid size
  let gridW = drawW `div` w
      gridH = drawH `div` h
      gridR = V2 gridW gridH -- Grid rectangle size
        -- gridM = gridMax grid
    -- Clear to black
  rendererDrawColor rdr $= V4 0 0 0 255
  clear rdr
  let gridCs = gridColor mx <$> logentry
      gridIs = gridIdx w logentry
  liftIO $ renderGrid rdr gridR gridCs gridIs
  present rdr

-- | Lower level, renders grid to SDL renderer
renderGrid ::
     Renderer
  -> V2 Int -- ^ Grid size
  -> Vector (V4 Word8) -- ^ Color
  -> Vector (V2 Int) -- ^ Grid Index
  -> IO ()
renderGrid rdr size css iss = V.zipWithM_ f css iss
  where
    f color idx = drawGrid rdr size color idx

-- | Get color from cell. The higher the pressure, the brighter.
gridColor ::
     Double -- ^ Maximum pressure
  -> Cell
  -> V4 Word8 -- ^ Color
gridColor pmax (FluidD p) = V4 v v v 255
  where
    v = round . (255.0 *) . abs $ p / pmax
gridColor _ _ = V4 64 0 0 255

-- | Get grid (r, c) index
gridIdx :: Int -> Vector a -> Vector (V2 Int)
gridIdx width = V.imap f
  where
    f i _ =
      let (q, r) = i `divMod` width
       in V2 q r

-- | Get max pressure from grid
gridMax :: SimLogEntry -> Double -- ^ Pressure
gridMax = V.foldr f 0.0
  where
    f Wall x          = x
    f Edge x          = x
    f (FluidD p) pmax = max p pmax

-- | Draws one cell
drawGrid ::
     Renderer
  -> V2 Int -- ^ Rectangle Size
  -> V4 Word8 -- ^ Color
  -> V2 Int -- ^ i, j
  -> IO ()
drawGrid rdr siz color (V2 i j) =
  (rendererDrawColor rdr $= color) >> fillRect rdr (Just rect)
  where
    rect = Rectangle (fromIntegral <$> p) (fromIntegral <$> siz)
    p = P $ siz * (V2 j i)

------------------------------- Initialization ---------------------------------
-- | Parse command line options
parseCmd :: IO Options
parseCmd = do
  (options, ()) <-
    simpleOptions
      $(simpleVersion Paths_cellularfluid.version)
      "Views fluid simulation"
      "Description: TODO"
      cmdOptions
      empty
  return options

-- | Command line options definition
cmdOptions :: Parser Options
cmdOptions =
  Options <$> switch (long "verbose" <> short 'v' <> help "Verbose logging?") <*>
  option auto (long "width" <> help "Window width" <> value 1024) <*>
  option auto (long "height" <> help "Window height" <> value 1024) <*>
  switch (long "hidpi" <> help "HiDPI support") <*>
  strOption (long "input" <> short 'i' <> help "Input file")

-- | Load simulation log and checks sanity
readSimLog :: FilePath -> IO (Either String SimLog)
readSimLog fp = do
  bs <- readFileBinary fp
  let simlog = parseSimLog bs
  return simlog

-- | Parses binary log then combines to simulation log
parseSimLog :: ByteString -> Either String SimLog
parseSimLog bs = do
  gs <- parseBGrid bs
  g0 <- fromMaybe (Left "Log is empty.") $ Right <$> L.headMaybe gs
  let slGridWidth = gridWidth g0
      slGridHeight = gridHeight g0
      slEntries = gridCells <$> gs
  return $ SimLog {..}

parseBGrid :: ByteString -> Either String [Grid]
parseBGrid = fmap reverse . go []
  where
    go gs bs
      | B.null bs = return gs
      | otherwise = do
        let rg = S.runGetPartial S.get bs
        case rg of
          S.Fail _ _      -> fail "Parse failed. Format incorrect."
          S.Partial _     -> return gs
          S.Done grid bs' -> go (grid : gs) bs'

-- | Initializes SDL and returns an SDL window handler
initGUI :: V2 Int -> Bool -> IO WindowHandler
initGUI size hidpi = do
  window <-
    createWindow "View Simulation Results" $
    defaultWindow
      {windowInitialSize = fromIntegral <$> size, windowHighDPI = hidpi}
  renderer <- createRenderer window (-1) defaultRenderer
  return $ WindowHandler {whndWindow = window, whndRenderer = renderer}
