{-# LANGUAGE MultiParamTypeClasses #-}
--{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE TypeSynonymInstances  #-}

module Main where

import           Spear.App
import           Spear.Game
import           Spear.Math.AABB
import qualified Spear.Math.Matrix3         as Matrix3
import qualified Spear.Math.Matrix4         as Matrix4
import           Spear.Math.Spatial
import           Spear.Math.Spatial2
import           Spear.Math.Vector
import           Spear.Physics.Collision
--import           Spear.Prelude
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)


ballSize = 0.01
numBalls = 1000

data Ball = Ball
  { ballPosition :: {-# UNPACK #-} !Vector2
  , ballVelocity :: {-# UNPACK #-} !Vector2
  }

instance Positional Ball Vector2 where
  setPosition p ball = ball { ballPosition = p }
  position = ballPosition
  translate v ball = ball { ballPosition = v + ballPosition ball }

instance Bounded2 Ball where
  boundingVolume ball = aabb2Volume $ translate (ballPosition ball) (AABB2 (-size) size)
    where size = vec2 s s
          s    = ballSize / (2::Float)

data World = World
  { viewProjection :: Matrix4.Matrix4
  , balls          :: [Ball]
  }

type GameState = AppState World


options = defaultAppOptions { title = "Balls" }

app = App options initGame endGame step render resize


main :: IO ()
main = runApp app

initGame :: Game AppContext World
initGame =
  let
    world          = zipWith Ball positions velocities
    positions      = (+vec2 0.5 0.5) . makePosition <$> numbers
    makePosition i = radius * vec2 (sin (f*i)) (cos (f*i))
    velocities     = makeVelocity <$> numbers
    makeVelocity i = scale speed $ vec2 (sin (f*i)) (cos (f*i))
    numbers        = [1..numBalls]
    f              = 2*pi / numBalls
    radius         = 0.05
    speed          = 0.4
  in
    return $ World Matrix4.id world

endGame :: Game GameState ()
endGame = return ()


step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
step elapsed dt inputEvents = do
  modifyGameState $ \world -> world
    { balls = moveBalls dt $ balls world
    }
  return (not $ exitRequested inputEvents)

exitRequested = elem (KeyDown KEY_ESC)

moveBalls :: Elapsed -> [Ball] -> [Ball]
moveBalls dt = (bounceBall dt . moveBall dt <$>)

moveBall :: Elapsed -> Ball -> Ball
moveBall dt ball = translate (scale (realToFrac dt) $ ballVelocity ball) ball

bounceBall :: Elapsed -> Ball -> Ball
bounceBall dt ball =
  let
    (AABB2Volume (AABB2 pmin pmax)) = boundingVolume ball
    sideCollision = x pmin < 0 || x pmax > 1
    backCollision = y pmin < 0 || y pmax > 1
    flipX v@(Vector2 x y) = if sideCollision then vec2 (-x) y else v
    flipY v@(Vector2 x y) = if backCollision then vec2 x (-y) else v
    velocity = ballVelocity ball
    velocity'
      = flipX
      . flipY
      $ velocity
    collision = velocity' /= velocity
    -- Apply offset when collision occurs to avoid sticky collisions.
    delta = if collision then 1 else 0
    dt' = realToFrac dt
   in
    ball
    { ballPosition = ballPosition ball + scale (delta * dt') velocity'
    , ballVelocity = velocity'
    }


render :: Game GameState ()
render = do
  gameState <- getGameState
  siblingGame $ 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' $ balls gameState
    immEnd

render' :: [Ball] -> Game ImmRenderState ()
render' balls = do
  immLoadIdentity
  renderBackground
  -- Draw objects.
  immSetColour (vec4 1.0 1.0 1.0 1.0)
  mapM_ renderBall balls

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)]

renderBall :: Ball -> Game ImmRenderState ()
renderBall ball =
  let (AABB2Volume (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax))) = boundingVolume ball
  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
    }