content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TypeFamilies     #-}
  
  module Apecs.Gloss
    ( module Apecs.Gloss
    , module G
    ) where
  
  import           Data.Semigroup                   (Semigroup (..))
  import           Graphics.Gloss.Interface.IO.Game as G
  import           Linear.V2
  import           Linear.Vector
  
  import           Apecs
  
  data Camera = Camera
    { camOffset :: V2 Float
    , camScale  :: Float
    } deriving (Eq, Show, Read)
  
  instance Semigroup Camera where
    Camera x1 r1 <> Camera x2 r2 = Camera (x1 + x2) (r1 * r2)
  instance Monoid Camera where
    mempty = Camera 0 1
    mappend = (<>)
  
  -- | Apply a camera transformation to a picture
  cameraTransform :: Camera -> Picture -> Picture
  cameraTransform (Camera (V2 cx cy) cs) =
      Scale cs cs .  Translate (-cx) (-cy)
  
  windowToWorld :: Camera -> (Float,Float) -> V2 Float
  windowToWorld (Camera cx cs) (x,y) = V2 x y ^/ cs + cx
  
  instance Component Camera where
    type Storage Camera = Global Camera
  
  play
    :: (Has w IO Camera)
    => Display            -- ^ Display mode
    -> Color              -- ^ Background color
    -> Int                  -- ^ Desired FPS
    -> System w Picture -- ^ Drawing function
    -> (Event -> System w ()) -- ^ Event handling function
    -> (Float  -> System w ()) -- ^ Stepping function, with a time delta argument.
    -> System w ()
  play disp col fps draw handle step = do
    w <- ask
    liftIO$ playIO disp col fps w draw' handle' step'
      where
        handle' event = runSystem $ handle event >> ask
        step'   dT    = runSystem $ step dT >> ask
        draw'         = runSystem $ do
          cam <- get global
          cameraTransform cam <$> draw
  
  -- | Renders a picture given a component rendering function.
  foldDraw :: (Get w IO c, Members w IO c)
           => (c -> Picture) -- ^ Component render function.
           -> System w Picture
  foldDraw fn = cfold (\pic -> mappend pic . fn) mempty
  
  -- | Monadically renders a picture given a component rendering function.
  foldDrawM :: (Get w IO c, Members w IO c)
            => (c -> System w Picture) -- ^ Component render function.
            -> System w Picture
  foldDrawM fn = cfoldM (\pic -> fmap (mappend pic) . fn) mempty
  