{- | Common definitions for all @gloss@ backends.
-}

module FRP.Rhine.Gloss.Common
  ( module FRP.Rhine.Gloss.Common
  , module X
  ) where

-- gloss
import qualified Graphics.Gloss as X
import qualified Graphics.Gloss.Interface.Pure.Game as X
import Graphics.Gloss.Interface.Pure.Game

-- | Collect all settings that the @gloss@ backend requires.
data GlossSettings = GlossSettings
  { GlossSettings -> Display
display         :: Display      -- ^ Display mode (e.g. 'InWindow' or 'FullScreen').
  , GlossSettings -> Color
backgroundColor :: Color        -- ^ Background color.
  , GlossSettings -> Int
stepsPerSecond  :: Int          -- ^ Number of simulation steps per second of real time.
  }

-- | Some standard settings, a 400 x 400 window with grey background, at 30 FPS.
defaultSettings :: GlossSettings
defaultSettings :: GlossSettings
defaultSettings = GlossSettings
  { display :: Display
display         = String -> (Int, Int) -> (Int, Int) -> Display
InWindow String
"rhine-gloss" (Int
400, Int
400) (Int
10, Int
10)
  , backgroundColor :: Color
backgroundColor = Float -> Color
greyN Float
0.3
  , stepsPerSecond :: Int
stepsPerSecond  = Int
30
  }