-- | Internal module defining resources and associated types
module Graphics.GPipe.Context.GLFW.Resource where

-- thirdparty
import qualified Graphics.UI.GLFW as GLFW (Monitor, WindowHint)

-- | Configuration for a new GLFW window and associated OpenGL context.
data WindowConfig = WindowConfig
    { WindowConfig -> Int
configWidth        :: Int
    , WindowConfig -> Int
configHeight       :: Int
    , WindowConfig -> String
configTitle        :: String
    , WindowConfig -> Maybe Monitor
configMonitor      :: Maybe GLFW.Monitor
    , WindowConfig -> [WindowHint]
configHints        :: [GLFW.WindowHint]
    , WindowConfig -> Maybe Int
configSwapInterval :: Maybe Int
    } deriving
    ( Int -> WindowConfig -> ShowS
[WindowConfig] -> ShowS
WindowConfig -> String
(Int -> WindowConfig -> ShowS)
-> (WindowConfig -> String)
-> ([WindowConfig] -> ShowS)
-> Show WindowConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowConfig] -> ShowS
$cshowList :: [WindowConfig] -> ShowS
show :: WindowConfig -> String
$cshow :: WindowConfig -> String
showsPrec :: Int -> WindowConfig -> ShowS
$cshowsPrec :: Int -> WindowConfig -> ShowS
Show
    )

-- | Default window configuration for a small window on any monitor with the given title.
defaultWindowConfig :: String -> WindowConfig
defaultWindowConfig :: String -> WindowConfig
defaultWindowConfig String
title = Int
-> Int
-> String
-> Maybe Monitor
-> [WindowHint]
-> Maybe Int
-> WindowConfig
WindowConfig Int
640 Int
480 String
title Maybe Monitor
forall a. Maybe a
Nothing [] Maybe Int
forall a. Maybe a
Nothing