{-# LANGUAGE MultiParamTypeClasses #-}

module Main where

import           Pong

import           Spear.App
import           Spear.Game
import           Spear.Math.AABB
import           Spear.Math.Matrix4         as Matrix4 hiding (position)
import           Spear.Math.Spatial
import           Spear.Math.Spatial2
import           Spear.Math.Vector
import           Spear.Physics.Collision
import           Spear.Render.Core.Pipeline
import           Spear.Render.Core.State
import           Spear.Render.Immediate
import           Spear.Sound.Sound
import           Spear.Sound.State
import           Spear.Window

import           Control.Monad              (when)
import           Data.Maybe                 (mapMaybe)


data Pong = Pong
  { immRenderState  :: ImmRenderState
  , viewProjection  :: Matrix4
  , backgroundMusic :: SoundSource
  , world           :: [GameObject]
  }

type GameState = AppState Pong


options = defaultAppOptions { title = "Pong" }

app = App options initGame endGame step render resize


main :: IO ()
main = runApp app

initGame :: Game AppContext Pong
initGame = do
  renderCoreState <- contextRenderCoreState <$> get
  (immRenderState, renderCoreState') <- runSiblingGame renderCoreState newImmRenderer
  -- TODO: This can work if we use FlexibleContexts and change the function signatures.
  --immRenderState <- newImmRenderer
  music <- siblingGame $ do
    musicBuffer <- loadAudioFile "/home/jeanne/Casual Tiki Party Main.wav"
    music <- makeSoundSource
    setSoundSourceBuffer music musicBuffer
    setSoundLoopMode music Loop
    playSounds [music]
    return music
  return $ Pong immRenderState Matrix4.id music newWorld

endGame :: Game GameState ()
endGame = do
  renderCoreState <- appRenderCoreState <$> get
  game <- getGameState
  exec' runSiblingGame renderCoreState (deleteImmRenderer $ immRenderState game)


step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
step elapsed dt inputEvents = do
  appState  <- get
  gameState <- getGameState
  events    <- processInput (appWindow appState)
  --when (events /= []) $ liftIO . putStrLn $ show events
  modifyGameState $ \pong -> pong
    { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gameState)
    }
  return (not $ exitRequested inputEvents)

processInput :: Window -> Game GameState [GameEvent]
processInput window = processKeys window
  [ (KEY_A, MoveLeft)
  , (KEY_D, MoveRight)
  ]

exitRequested = elem (KeyDown KEY_ESC)


render :: Game GameState ()
render = do
  gameState <- getGameState
  immRenderState' <- exec runSiblingGame (immRenderState gameState) $ do
    immStart
    immSetViewProjectionMatrix (viewProjection gameState)
    -- Clear the background to a different colour than the playable area to make
    -- the latter distinguishable.
    setClearColour (0.2, 0.2, 0.2, 0.0)
    clearBuffers [ColourBuffer]
    render' $ world gameState
    immEnd
  putGameState $ gameState { immRenderState = immRenderState' }

render' :: [GameObject] -> Game ImmRenderState ()
render' world = do
  immLoadIdentity
  renderBackground
  -- Draw objects.
  immSetColour (vec4 1.0 1.0 1.0 1.0)
  mapM_ renderGO world

renderBackground :: Game ImmRenderState ()
renderBackground =
  let pmin = 0 :: Float
      pmax = 1 :: Float
  in do
    immSetColour (vec4 0.0 0.25 0.41 1.0)
    immDrawQuads2d [
      (vec2 pmin pmin
      ,vec2 pmax pmin
      ,vec2 pmax pmax
      ,vec2 pmin pmax)]

renderGO :: GameObject -> Game ImmRenderState ()
renderGO go =
  let (AABB2Volume (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax))) = boundingVolume go
  in
    immDrawQuads2d [
      (vec2 xmin ymin
      ,vec2 xmax ymin
      ,vec2 xmax ymax
      ,vec2 xmin ymax)]


resize :: WindowEvent -> Game GameState ()
resize (ResizeEvent w h) =
  let r = fromIntegral w / fromIntegral h
      pad    = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
      left   = if r > 1 then -pad else 0
      right  = if r > 1 then 1 + pad else 1
      bottom = if r > 1 then 0 else -pad
      top    = if r > 1 then 1 else 1 + pad
  in do
    setViewport 0 0 w h
    modifyGameState $ \pong -> pong {
      viewProjection = Matrix4.ortho left right bottom top (-1) 1
    }