-- | Internal module for generating and assessing GLFW hint lists
module Graphics.GPipe.Context.GLFW.Format where

-- stdlib
import           Control.Exception (Exception)
-- third party
import qualified Graphics.GPipe    as GPipe
import           Graphics.UI.GLFW  (WindowHint (..))
import qualified Graphics.UI.GLFW  as GLFW

-- | IO Exception thrown when attempting to create a new window using GLFW
-- hints which GPipe manages.
newtype UnsafeWindowHintsException
    = UnsafeWindowHintsException [WindowHint]
    deriving Int -> UnsafeWindowHintsException -> ShowS
[UnsafeWindowHintsException] -> ShowS
UnsafeWindowHintsException -> String
(Int -> UnsafeWindowHintsException -> ShowS)
-> (UnsafeWindowHintsException -> String)
-> ([UnsafeWindowHintsException] -> ShowS)
-> Show UnsafeWindowHintsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsafeWindowHintsException] -> ShowS
$cshowList :: [UnsafeWindowHintsException] -> ShowS
show :: UnsafeWindowHintsException -> String
$cshow :: UnsafeWindowHintsException -> String
showsPrec :: Int -> UnsafeWindowHintsException -> ShowS
$cshowsPrec :: Int -> UnsafeWindowHintsException -> ShowS
Show
instance Exception UnsafeWindowHintsException

allowedHint :: WindowHint -> Bool
allowedHint :: WindowHint -> Bool
allowedHint (WindowHint'Visible Bool
_)             = Bool
False
allowedHint (WindowHint'sRGBCapable Bool
_)         = Bool
False
allowedHint (WindowHint'RedBits Maybe Int
_)             = Bool
False
allowedHint (WindowHint'GreenBits Maybe Int
_)           = Bool
False
allowedHint (WindowHint'BlueBits Maybe Int
_)            = Bool
False
allowedHint (WindowHint'AlphaBits Maybe Int
_)           = Bool
False
allowedHint (WindowHint'DepthBits Maybe Int
_)           = Bool
False
allowedHint (WindowHint'StencilBits Maybe Int
_)         = Bool
False
allowedHint (WindowHint'ContextVersionMajor Int
_) = Bool
False
allowedHint (WindowHint'ContextVersionMinor Int
_) = Bool
False
allowedHint (WindowHint'OpenGLForwardCompat Bool
_) = Bool
False
allowedHint (WindowHint'OpenGLProfile OpenGLProfile
_)       = Bool
False
allowedHint WindowHint
_                                  = Bool
True

unconditionalHints :: [GLFW.WindowHint]
unconditionalHints :: [WindowHint]
unconditionalHints =
    [ Int -> WindowHint
GLFW.WindowHint'ContextVersionMajor Int
4
    , Int -> WindowHint
GLFW.WindowHint'ContextVersionMinor Int
5
    , Bool -> WindowHint
GLFW.WindowHint'OpenGLForwardCompat Bool
True
    , OpenGLProfile -> WindowHint
GLFW.WindowHint'OpenGLProfile OpenGLProfile
GLFW.OpenGLProfile'Core
    ]

bitsToHints :: Maybe GPipe.WindowBits -> [GLFW.WindowHint]
bitsToHints :: Maybe WindowBits -> [WindowHint]
bitsToHints Maybe WindowBits
Nothing = [Bool -> WindowHint
GLFW.WindowHint'Visible Bool
False]
bitsToHints (Just ((Int
red, Int
green, Int
blue, Int
alpha, Bool
sRGB), Int
depth, Int
stencil)) =
    [ Bool -> WindowHint
GLFW.WindowHint'sRGBCapable Bool
sRGB
    , Maybe Int -> WindowHint
GLFW.WindowHint'RedBits (Maybe Int -> WindowHint) -> Maybe Int -> WindowHint
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
red
    , Maybe Int -> WindowHint
GLFW.WindowHint'GreenBits (Maybe Int -> WindowHint) -> Maybe Int -> WindowHint
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
green
    , Maybe Int -> WindowHint
GLFW.WindowHint'BlueBits (Maybe Int -> WindowHint) -> Maybe Int -> WindowHint
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
blue
    , Maybe Int -> WindowHint
GLFW.WindowHint'AlphaBits (Maybe Int -> WindowHint) -> Maybe Int -> WindowHint
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
alpha
    , Maybe Int -> WindowHint
GLFW.WindowHint'DepthBits (Maybe Int -> WindowHint) -> Maybe Int -> WindowHint
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
depth
    , Maybe Int -> WindowHint
GLFW.WindowHint'StencilBits (Maybe Int -> WindowHint) -> Maybe Int -> WindowHint
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
stencil
    ]