diff --git a/Graphics/Gloss.hs b/Graphics/Gloss.hs --- a/Graphics/Gloss.hs +++ b/Graphics/Gloss.hs @@ -52,6 +52,10 @@ -- @ -- Release Notes: -- +-- For 1.11.1: +-- Thanks to Lars Wyssard +-- * Use default display resolution in full-screen mode. +-- -- For 1.10.1: -- * Gloss no longer consumes CPU time when displaying static pictures. -- * Added displayIO wrapper for mostly static pictures, eg when @@ -65,14 +69,6 @@ -- * Allow bitmaps to be specified in RGBA byte order as well as ABGR. -- Thanks to Gabriel Gonzalez -- * Package definitions for building with Stack. --- --- For 1.9.1: --- Thanks to Elise Huard --- * Split rendering code into gloss-rendering package. --- --- For 1.8.0: --- Thanks to Francesco Mazzoli --- * Factored out ViewPort and ViewState handling into user visible modules. -- @ -- -- For more information, check out . @@ -95,3 +91,4 @@ import Graphics.Gloss.Interface.Pure.Animate import Graphics.Gloss.Interface.Pure.Simulate import Graphics.Gloss.Interface.Pure.Game + diff --git a/Graphics/Gloss/Data/Display.hs b/Graphics/Gloss/Data/Display.hs --- a/Graphics/Gloss/Data/Display.hs +++ b/Graphics/Gloss/Data/Display.hs @@ -8,6 +8,6 @@ -- | Display in a window with the given name, size and position. = InWindow String (Int, Int) (Int, Int) - -- | Display full screen with a drawing area of the given size. - | FullScreen (Int, Int) + -- | Display full screen. + | FullScreen deriving (Eq, Read, Show) diff --git a/Graphics/Gloss/Interface/Environment.hs b/Graphics/Gloss/Interface/Environment.hs new file mode 100644 --- /dev/null +++ b/Graphics/Gloss/Interface/Environment.hs @@ -0,0 +1,18 @@ +module Graphics.Gloss.Interface.Environment where +import Graphics.Gloss.Internals.Interface.Backend.GLUT +import qualified Graphics.UI.GLUT as GLUT +import qualified Graphics.Rendering.OpenGL as GL +import Data.IORef + + +-- | Get the size of the screen, in pixels. +-- +-- This will be the size of the rendered gloss image when +-- fullscreen mode is enabled. +-- +getScreenSize :: IO (Int, Int) +getScreenSize + = do backendStateRef <- newIORef glutStateInit + initializeGLUT backendStateRef False + GL.Size width height <- GLUT.get GLUT.screenSize + return (fromIntegral width, fromIntegral height) diff --git a/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs b/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs --- a/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs +++ b/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs @@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Interface.Backend.GLUT - (GLUTState) + (GLUTState,glutStateInit,initializeGLUT) where import Data.IORef @@ -11,7 +11,17 @@ import qualified Graphics.UI.GLUT as GLUT import qualified System.Exit as System import Graphics.Gloss.Internals.Interface.Backend.Types +import System.IO.Unsafe +-- Were we to support freeglut only, we could use GLUT.get to discover +-- whether we are initialized or not. If not, we do a quick initialize, +-- get the screenzie, and then do GLUT.exit. This avoids the use of +-- global variables. Unfortunately, there is no failsafe way to check +-- whether glut is initialized in some older versions of glut, which is +-- what we'd use instead of the global variable to get the required info. +glutInitialized :: IORef Bool +{-# NOINLINE glutInitialized #-} +glutInitialized = unsafePerformIO $ do newIORef False -- | State information for the GLUT backend. data GLUTState @@ -31,8 +41,8 @@ glutStateInit :: GLUTState glutStateInit = GLUTState - { glutStateFrameCount = 0 - , glutStateHasTimeout = False + { glutStateFrameCount = 0 + , glutStateHasTimeout = False , glutStateHasIdle = False } @@ -83,25 +93,28 @@ -> IO () initializeGLUT _ debug - = do (_progName, _args) <- GLUT.getArgsAndInitialize - - glutVersion <- get GLUT.glutVersion - when debug - $ putStr $ " glutVersion = " ++ show glutVersion ++ "\n" - - GLUT.initialDisplayMode - $= [ GLUT.RGBMode - , GLUT.DoubleBuffered] - - -- See if our requested display mode is possible - displayMode <- get GLUT.initialDisplayMode - displayModePossible <- get GLUT.displayModePossible - when debug - $ do putStr $ " displayMode = " ++ show displayMode ++ "\n" - ++ " possible = " ++ show displayModePossible ++ "\n" - ++ "\n" - + = do initialized <- readIORef glutInitialized + if not initialized + then do (_progName, _args) <- GLUT.getArgsAndInitialize + glutVersion <- get GLUT.glutVersion + when debug + $ putStr $ " glutVersion = " ++ show glutVersion ++ "\n" + + GLUT.initialDisplayMode + $= [ GLUT.RGBMode + , GLUT.DoubleBuffered] + writeIORef glutInitialized True + + -- See if our requested display mode is possible + displayMode <- get GLUT.initialDisplayMode + displayModePossible <- get GLUT.displayModePossible + when debug + $ do putStr $ " displayMode = " ++ show displayMode ++ "\n" + ++ " possible = " ++ show displayModePossible ++ "\n" + ++ "\n" + else when debug (putStrLn "Already initialized") + -- Open Window ---------------------------------------------------------------- openWindowGLUT :: IORef GLUTState @@ -133,11 +146,9 @@ (fromIntegral sizeX) (fromIntegral sizeY) - FullScreen (sizeX, sizeY) -> - do GLUT.initialWindowSize - $= GL.Size - (fromIntegral sizeX) - (fromIntegral sizeY) + FullScreen -> + do size <- get GLUT.screenSize + GLUT.initialWindowSize $= size _ <- GLUT.createWindow "Gloss Application" GLUT.fullScreen diff --git a/gloss.cabal b/gloss.cabal --- a/gloss.cabal +++ b/gloss.cabal @@ -1,5 +1,5 @@ Name: gloss -Version: 1.10.2.5 +Version: 1.11.1.1 License: MIT License-file: LICENSE Author: Ben Lippmeier @@ -44,7 +44,7 @@ OpenGL >= 2.12 && < 3.1, GLUT == 2.7.*, bmp == 1.2.*, - gloss-rendering == 1.10.* + gloss-rendering == 1.11.* ghc-options: -O2 -Wall @@ -70,7 +70,8 @@ Graphics.Gloss.Interface.IO.Display Graphics.Gloss.Interface.IO.Simulate Graphics.Gloss.Interface.IO.Game - + Graphics.Gloss.Interface.Environment + Other-modules: Graphics.Gloss.Internals.Color Graphics.Gloss.Internals.Interface.Animate.State