diff --git a/Graphics/Gloss.hs b/Graphics/Gloss.hs --- a/Graphics/Gloss.hs +++ b/Graphics/Gloss.hs @@ -52,6 +52,18 @@ -- @ -- Release Notes: -- +-- For 1.13.1: +-- Thanks to Thaler Jonathan +-- * Repaired GLFW backend. +-- Thanks to Samuel Gfrörer +-- * Support for bitmap sections. +-- Thanks to Basile Henry +-- * Handle resize events in playField driver. +-- +-- For 1.12.1: +-- Thanks to Trevor McDonell +-- * Travis CI integration, general cleanups. +-- -- For 1.11.1: -- Thanks to Lars Wyssard -- * Use default display resolution in full-screen mode. diff --git a/Graphics/Gloss/Data/Bitmap.hs b/Graphics/Gloss/Data/Bitmap.hs --- a/Graphics/Gloss/Data/Bitmap.hs +++ b/Graphics/Gloss/Data/Bitmap.hs @@ -1,10 +1,15 @@ -- | Functions to load bitmap data from various places. module Graphics.Gloss.Data.Bitmap - ( BitmapData, BitmapFormat(..), RowOrder(..), PixelFormat(..) + ( Rectangle(..) + , BitmapData, bitmapSize + , BitmapFormat(..), RowOrder(..), PixelFormat(..) , bitmapOfForeignPtr + , bitmapDataOfForeignPtr , bitmapOfByteString + , bitmapDataOfByteString , bitmapOfBMP + , bitmapDataOfBMP , loadBMP) where import Graphics.Gloss.Rendering diff --git a/Graphics/Gloss/Data/Picture.hs b/Graphics/Gloss/Data/Picture.hs --- a/Graphics/Gloss/Data/Picture.hs +++ b/Graphics/Gloss/Data/Picture.hs @@ -11,6 +11,8 @@ , arc, thickArc , text , bitmap + , bitmapSection + -- , bitmap , color , translate, rotate, scale , pictures @@ -70,17 +72,16 @@ text :: String -> Picture text = Text --- | A bitmap image with a width, height and a Vector holding the --- 32-bit RGBA bitmap data. --- --- The boolean flag controls whether Gloss should cache the data --- between frames for speed. --- If you are programatically generating the image for --- each frame then use `False`. --- If you have loaded it from a file then use `True`. -bitmap :: Int -> Int -> BitmapData -> Bool -> Picture -bitmap = Bitmap +-- | A bitmap image +bitmap :: BitmapData -> Picture +bitmap bitmapData = Bitmap bitmapData +-- | a subsection of a bitmap image +-- first argument selects a sub section in the bitmap +-- second argument determines the bitmap data +bitmapSection :: Rectangle -> BitmapData -> Picture +bitmapSection = BitmapSection + -- | A picture drawn with this color. color :: Color -> Picture -> Picture color = Color @@ -116,14 +117,14 @@ = thickCircle (r/2) r --- | A solid arc, drawn counter-clockwise between two angles at the given radius. +-- | A solid arc, drawn counter-clockwise between two angles (in degrees) at the given radius. arcSolid :: Float -> Float -> Float -> Picture arcSolid a1 a2 r = thickArc a1 a2 (r/2) r -- | A wireframe sector of a circle. --- An arc is draw counter-clockwise from the first to the second angle at +-- An arc is draw counter-clockwise from the first to the second angle (in degrees) at -- the given radius. Lines are drawn from the origin to the ends of the arc. --- -- NOTE: We take the absolute value of the radius incase it's negative. diff --git a/Graphics/Gloss/Interface/Environment.hs b/Graphics/Gloss/Interface/Environment.hs --- a/Graphics/Gloss/Interface/Environment.hs +++ b/Graphics/Gloss/Interface/Environment.hs @@ -1,19 +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 +import Data.IORef (newIORef) +import qualified Graphics.Gloss.Internals.Interface.Backend.Types as Backend.Types +import Graphics.Gloss.Internals.Interface.Backend (defaultBackendState) + -- | 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) +getScreenSize = do + backendStateRef <- newIORef defaultBackendState + Backend.Types.initializeBackend backendStateRef False + Backend.Types.getScreenSize backendStateRef diff --git a/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs b/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs --- a/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs +++ b/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs @@ -6,11 +6,12 @@ (GLFWState) where import Data.IORef -import Data.Char (toLower) +import Data.Maybe (fromJust) +import Control.Concurrent import Control.Monad import Graphics.Gloss.Data.Display -import Graphics.UI.GLFW (WindowValue(..)) import qualified Graphics.UI.GLFW as GLFW +import Graphics.Rendering.OpenGL (($=)) import qualified Graphics.Rendering.OpenGL as GL import qualified Control.Exception as X @@ -54,6 +55,9 @@ -- | Action perforrmed when idling , idle :: IO () + + -- | The Window Handle + , optWinHdl :: Maybe GLFW.Window } @@ -66,10 +70,18 @@ , mouseWheelPos = 0 , dirtyScreen = True , display = return () - , idle = return () } + , idle = return () + , optWinHdl = Nothing } +-- | Fetch the window handle from the state if it has been initialized. +winHdl :: GLFWState -> GLFW.Window +winHdl state = + case optWinHdl state of + Just handle -> handle + Nothing -> error "GLFW backend: requested uninitialized window handle" + instance Backend GLFWState where initBackendState = glfwStateInit initializeBackend = initializeGLFW @@ -84,19 +96,24 @@ installIdleCallback = installIdleCallbackGLFW runMainLoop = runMainLoopGLFW postRedisplay = postRedisplayGLFW - getWindowDimensions = (\_ -> GLFW.getWindowDimensions) - elapsedTime = (\_ -> GLFW.getTime) - sleep = (\_ sec -> GLFW.sleep sec) - + getWindowDimensions = (\ref -> windowHandle ref >>= \win -> GLFW.getWindowSize win) + getScreenSize = getScreenSizeGLFW + elapsedTime = (\_ -> GLFW.getTime >>= \mt -> return $ fromJust mt) + sleep = (\_ sec -> threadDelay (floor (sec * 1000000.0))) --GLFW.sleep sec) -- Initialise ----------------------------------------------------------------- -- | Initialise the GLFW backend. initializeGLFW :: IORef GLFWState -> Bool-> IO () initializeGLFW _ debug = do - _ <- GLFW.initialize - glfwVersion <- GLFW.getGlfwVersion + let simpleErrorCallback e s = + putStrLn $ unwords [ "GLFW backend: ", show e, show s ] + GLFW.setErrorCallback (Just simpleErrorCallback) + + _ <- GLFW.init + glfwVersion <- GLFW.getVersion + #ifdef linux_HOST_OS -- See [Note: FreeGlut] for why we need this. (_progName, _args) <- GLUT.getArgsAndInitialize @@ -109,13 +126,14 @@ -- Exit ----------------------------------------------------------------------- -- | Tell the GLFW backend to close the window and exit. exitGLFW :: IORef GLFWState -> IO () -exitGLFW _ +exitGLFW ref = do #ifdef linux_HOST_OS -- See [Note: FreeGlut] on why we exit GLUT for Linux GLUT.exit #endif - GLFW.closeWindow + win <- windowHandle ref + GLFW.setWindowShouldClose win True -- Open Window ---------------------------------------------------------------- @@ -125,57 +143,94 @@ -> Display -> IO () -openWindowGLFW _ (InWindow title (sizeX, sizeY) pos) - = do _ <- GLFW.openWindow - GLFW.defaultDisplayOptions - { GLFW.displayOptions_width = sizeX - , GLFW.displayOptions_height = sizeY - , GLFW.displayOptions_displayMode = GLFW.Window } +openWindowGLFW ref (InWindow title (sizeX, sizeY) pos) + = do win <- GLFW.createWindow + sizeX + sizeY + title + Nothing + Nothing - uncurry GLFW.setWindowPosition pos - GLFW.setWindowTitle title + modifyIORef' ref (\s -> s { optWinHdl = win }) + uncurry (GLFW.setWindowPos (fromJust win)) pos + GLFW.makeContextCurrent win -- Try to enable sync-to-vertical-refresh by setting the number -- of buffer swaps per vertical refresh to 1. - GLFW.setWindowBufferSwapInterval 1 + GLFW.swapInterval 1 -openWindowGLFW _ (FullScreen (sizeX, sizeY)) - = do _ <- GLFW.openWindow - GLFW.defaultDisplayOptions - { GLFW.displayOptions_width = sizeX - , GLFW.displayOptions_height = sizeY - , GLFW.displayOptions_displayMode = GLFW.Fullscreen } +openWindowGLFW ref FullScreen + = do mon <- GLFW.getPrimaryMonitor + vmode <- GLFW.getVideoMode (fromJust mon) + let sizeX = GLFW.videoModeWidth (fromJust vmode) + let sizeY = GLFW.videoModeHeight (fromJust vmode) + + win <- GLFW.createWindow + sizeX + sizeY + "" + mon + Nothing + + modifyIORef' ref (\s -> s { optWinHdl = win}) + GLFW.makeContextCurrent win + -- Try to enable sync-to-vertical-refresh by setting the number -- of buffer swaps per vertical refresh to 1. - GLFW.setWindowBufferSwapInterval 1 - GLFW.enableMouseCursor + GLFW.swapInterval 1 + --GLFW.enableMouseCursor + GLFW.setCursorInputMode (fromJust win) GLFW.CursorInputMode'Normal + +windowHandle :: IORef GLFWState -> IO GLFW.Window +windowHandle ref + = do s <- readIORef ref + return $ winHdl s + + +getScreenSizeGLFW :: IORef GLFWState -> IO (Int,Int) +getScreenSizeGLFW _state = do + monitor <- GLFW.getPrimaryMonitor + vmode <- GLFW.getVideoMode (fromJust monitor) + + let sizeX = GLFW.videoModeWidth (fromJust vmode) + let sizeY = GLFW.videoModeHeight (fromJust vmode) + + pure (sizeX, sizeY) + + -- Dump State ----------------------------------------------------------------- -- | Print out the internal GLFW state. -dumpStateGLFW :: IORef a -> IO () -dumpStateGLFW _ - = do (ww,wh) <- GLFW.getWindowDimensions +dumpStateGLFW :: IORef GLFWState -> IO () +dumpStateGLFW ref + = do win <- windowHandle ref + (ww,wh) <- GLFW.getWindowSize win - r <- GLFW.getWindowValue NumRedBits - g <- GLFW.getWindowValue NumGreenBits - b <- GLFW.getWindowValue NumBlueBits - a <- GLFW.getWindowValue NumAlphaBits +-- GLFW-b does not provide a general function to query windowHints +-- could be added by adding additional getWindowHint which +-- uses glfwGetWindowAttrib behind the scenes as has been done +-- already for e.g. getWindowVisible which uses glfwGetWindowAttrib +{- + r <- GLFW.getWindowHint NumRedBits + g <- GLFW.getWindowHint NumGreenBits + b <- GLFW.getWindowHint NumBlueBits + a <- GLFW.getWindowHint NumAlphaBits let rgbaBD = [r,g,b,a] - depthBD <- GLFW.getWindowValue NumDepthBits + depthBD <- GLFW.getWindowHint NumDepthBits - ra <- GLFW.getWindowValue NumAccumRedBits - ga <- GLFW.getWindowValue NumAccumGreenBits - ba <- GLFW.getWindowValue NumAccumBlueBits - aa <- GLFW.getWindowValue NumAccumAlphaBits + ra <- GLFW.getWindowHint NumAccumRedBits + ga <- GLFW.getWindowHint NumAccumGreenBits + ba <- GLFW.getWindowHint NumAccumBlueBits + aa <- GLFW.getWindowHint NumAccumAlphaBits let accumBD = [ra,ga,ba,aa] - stencilBD <- GLFW.getWindowValue NumStencilBits + stencilBD <- GLFW.getWindowHint NumStencilBits - auxBuffers <- GLFW.getWindowValue NumAuxBuffers + auxBuffers <- GLFW.getWindowHint NumAuxBuffers - fsaaSamples <- GLFW.getWindowValue NumFsaaSamples + fsaaSamples <- GLFW.getWindowHint NumFsaaSamples putStr $ "* dumpGlfwState\n" ++ " windowWidth = " ++ show ww ++ "\n" @@ -187,7 +242,12 @@ ++ " aux Buffers = " ++ show auxBuffers ++ "\n" ++ " FSAA Samples = " ++ show fsaaSamples ++ "\n" ++ "\n" +-} + putStr $ "* dumpGlfwState\n" + ++ " windowWidth = " ++ show ww ++ "\n" + ++ " windowHeight = " ++ show wh ++ "\n" + ++ "\n" -- Display Callback ----------------------------------------------------------- -- | Callback for when GLFW needs us to redraw the contents of the window. @@ -208,6 +268,11 @@ GL.clear [GL.ColorBuffer, GL.DepthBuffer] GL.color $ GL.Color4 0 0 0 (1 :: GL.GLfloat) + -- set the OpenGL viewport to account for any HiDPI discrepancy + (width, height) <- windowHandle stateRef >>= GLFW.getFramebufferSize + GL.viewport $= ( GL.Position 0 0 + , GL.Size (fromIntegral width) (fromIntegral height)) + -- get the display callbacks from the chain let funs = [f stateRef | (Display f) <- callbacks] sequence_ funs @@ -221,32 +286,32 @@ installWindowCloseCallbackGLFW :: IORef GLFWState -> IO () -installWindowCloseCallbackGLFW _ - = GLFW.setWindowCloseCallback - $ do +installWindowCloseCallbackGLFW ref + = do win <- windowHandle ref + GLFW.setWindowCloseCallback win (Just winClosed) + where + winClosed :: GLFW.WindowCloseCallback + winClosed _win = do #ifdef linux_HOST_OS -- See [Note: FreeGlut] for why we need this. GLUT.exit #endif - return True - + return () -- Reshape -------------------------------------------------------------------- -- | Callback for when the user reshapes the window. installReshapeCallbackGLFW - :: Backend a - => IORef a -> [Callback] -> IO () + :: IORef GLFWState -> [Callback] -> IO () installReshapeCallbackGLFW stateRef callbacks - = GLFW.setWindowSizeCallback (callbackReshape stateRef callbacks) + = do win <- windowHandle stateRef + GLFW.setWindowSizeCallback win (Just $ callbackReshape stateRef callbacks) callbackReshape - :: Backend a - => IORef a -> [Callback] - -> Int -> Int - -> IO () + :: IORef GLFWState -> [Callback] + -> GLFW.WindowSizeCallback -- = Window -> Int -> Int -> IO () -callbackReshape glfwState callbacks sizeX sizeY +callbackReshape glfwState callbacks _win sizeX sizeY = sequence_ $ map (\f -> f (sizeX, sizeY)) [f glfwState | Reshape f <- callbacks] @@ -265,20 +330,23 @@ -> IO () installKeyMouseCallbackGLFW stateRef callbacks - = do GLFW.setKeyCallback $ (callbackKeyboard stateRef callbacks) - GLFW.setCharCallback $ (callbackChar stateRef callbacks) - GLFW.setMouseButtonCallback $ (callbackMouseButton stateRef callbacks) - GLFW.setMouseWheelCallback $ (callbackMouseWheel stateRef callbacks) + = do win <- windowHandle stateRef + GLFW.setKeyCallback win (Just $ callbackKeyboard stateRef callbacks) + GLFW.setCharCallback win (Just $ callbackChar stateRef callbacks) + GLFW.setMouseButtonCallback win (Just $ callbackMouseButton stateRef callbacks) + GLFW.setScrollCallback win (Just $ callbackMouseWheel stateRef callbacks) -- GLFW calls this on a non-character keyboard action. callbackKeyboard :: IORef GLFWState -> [Callback] - -> GLFW.Key -> Bool - -> IO () + -> GLFW.KeyCallback -- = Window -> Key -> Int -> KeyState -> ModifierKeys -> IO () + -- -> GLFW.Key -> Bool + -- -> IO () -callbackKeyboard stateRef callbacks key keystate - = do (modsSet, GLFWState mods pos _ _ _ _) +callbackKeyboard stateRef callbacks _win key _scancode keystateglfw _modifiers + = do let keystate = keystateglfw == GLFW.KeyState'Pressed + (modsSet, GLFWState mods pos _ _ _ _ _) <- setModifiers stateRef key keystate let key' = fromGLFW key let keystate' = if keystate then Down else Up @@ -301,10 +369,10 @@ = do glfwState <- readIORef stateRef let mods = modifiers glfwState let mods' = case key of - GLFW.KeyLeftShift -> mods {shift = if pressed then Down else Up} - GLFW.KeyLeftCtrl -> mods {ctrl = if pressed then Down else Up} - GLFW.KeyLeftAlt -> mods {alt = if pressed then Down else Up} - _ -> mods + GLFW.Key'LeftShift -> mods {shift = if pressed then Down else Up} + GLFW.Key'LeftControl -> mods {ctrl = if pressed then Down else Up} + GLFW.Key'LeftAlt -> mods {alt = if pressed then Down else Up} + _ -> mods if (mods' /= mods) then do @@ -317,11 +385,17 @@ -- GLFW calls this on a when the user presses or releases a character key. callbackChar :: IORef GLFWState -> [Callback] - -> Char -> Bool -> IO () + -> GLFW.CharCallback + -- Window -> Char -> IO () + -- -> Char -> Bool -> IO () -callbackChar stateRef callbacks char keystate - = do (GLFWState mods pos _ _ _ _) <- readIORef stateRef +callbackChar stateRef callbacks _win char -- keystate + = do (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef let key' = charToSpecial char + -- TODO: is this correct? GLFW does not provide the keystate + -- in a character callback, here we asume that its pressed + let keystate = True + -- Only key presses of characters are passed to this callback, -- character key releases are caught by the 'keyCallback'. This is an -- intentional feature of GLFW. What this means that a key press of @@ -339,14 +413,12 @@ -- GLFW calls on this when the user clicks or releases a mouse button. callbackMouseButton :: IORef GLFWState -> [Callback] - -> GLFW.MouseButton - -> Bool - -> IO () + -> GLFW.MouseButtonCallback -- = Window -> MouseButton -> MouseButtonState -> ModifierKeys -> IO () -callbackMouseButton stateRef callbacks key keystate - = do (GLFWState mods pos _ _ _ _) <- readIORef stateRef +callbackMouseButton stateRef callbacks _win key keystate _modifier + = do (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef let key' = fromGLFW key - let keystate' = if keystate then Down else Up + let keystate' = if keystate == GLFW.MouseButtonState'Pressed then Down else Up -- Call all the Gloss KeyMouse actions with the new state. sequence_ @@ -357,12 +429,13 @@ -- GLFW calls on this when the user moves the mouse wheel. callbackMouseWheel :: IORef GLFWState -> [Callback] - -> Int - -> IO () - -callbackMouseWheel stateRef callbacks w - = do (key, keystate) <- setMouseWheel stateRef w - (GLFWState mods pos _ _ _ _) <- readIORef stateRef + -> GLFW.ScrollCallback + -- -> Int + -- -> IO () +-- ScrollCallback = Window -> Double -> Double -> IO () +callbackMouseWheel stateRef callbacks _win x _y + = do (key, keystate) <- setMouseWheel stateRef (floor x) + (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef -- Call all the Gloss KeyMouse actions with the new state. sequence_ @@ -390,14 +463,16 @@ -> IO () installMotionCallbackGLFW stateRef callbacks - = GLFW.setMousePositionCallback $ (callbackMotion stateRef callbacks) + = do win <- windowHandle stateRef + GLFW.setCursorPosCallback win (Just $ callbackMotion stateRef callbacks) +--CursorPosCallback = Window -> Double -> Double -> IO () + callbackMotion :: IORef GLFWState -> [Callback] - -> Int -> Int - -> IO () -callbackMotion stateRef callbacks x y - = do pos <- setMousePos stateRef x y + -> GLFW.CursorPosCallback +callbackMotion stateRef callbacks _win x y + = do pos <- setMousePos stateRef (floor x) (floor y) -- Call all the Gloss Motion actions with the new state. sequence_ @@ -438,36 +513,57 @@ -- Main Loop ------------------------------------------------------------------ -runMainLoopGLFW - :: IORef GLFWState - -> IO () -runMainLoopGLFW stateRef - = X.catch go exit - where - exit :: X.SomeException -> IO () - exit e = print e >> exitGLFW stateRef +runMainLoopGLFW :: IORef GLFWState -> IO () +runMainLoopGLFW stateRef = do + X.catch go handleException + GLFW.destroyWindow =<< windowHandle stateRef + GLFW.terminate - go :: IO () - go - = do windowIsOpen <- GLFW.windowIsOpen - when windowIsOpen - $ do GLFW.pollEvents - dirty <- fmap dirtyScreen $ readIORef stateRef + where + handleException :: X.SomeException -> IO () + handleException = print - when dirty - $ do s <- readIORef stateRef - display s - GLFW.swapBuffers + clearDirtyFlag :: IO () + clearDirtyFlag = modifyIORef' + stateRef + (\state -> state { dirtyScreen = False }) - modifyIORef' stateRef $ \s -> s - { dirtyScreen = False } + display' :: IO () + display' = readIORef stateRef >>= display - (readIORef stateRef) >>= (\s -> idle s) - GLFW.sleep 0.001 - runMainLoopGLFW stateRef + idle' :: IO () + idle' = readIORef stateRef >>= idle + swapBuffers' :: IO () + swapBuffers' = windowHandle stateRef >>= GLFW.swapBuffers + windowShouldClose :: IO Bool + windowShouldClose = windowHandle stateRef >>= GLFW.windowShouldClose + + unlessM :: Monad m => m Bool -> m () -> m () + unlessM testAction action = do + sentinel <- testAction + unless sentinel action + + go :: IO () + go = do + -- Perform drawing, clear the dirty flag, do idle processing + display' + clearDirtyFlag + idle' + + -- Swap buffers. This swaps the GL buffers and will block + -- until the next v-sync. In GLFW, this effectively pegs the + -- maximum frame rate to 60fps, but will also stop the + -- application from consuming 100% CPU. + swapBuffers' + + -- Poll for GLFW events; quit if necessary. + GLFW.pollEvents + unlessM windowShouldClose go + + -- Redisplay ------------------------------------------------------------------ postRedisplayGLFW :: IORef GLFWState @@ -485,65 +581,90 @@ instance GLFWKey GLFW.Key where fromGLFW key = case key of - GLFW.CharKey c -> charToSpecial (toLower c) - GLFW.KeySpace -> SpecialKey KeySpace - GLFW.KeyEsc -> SpecialKey KeyEsc - GLFW.KeyF1 -> SpecialKey KeyF1 - GLFW.KeyF2 -> SpecialKey KeyF2 - GLFW.KeyF3 -> SpecialKey KeyF3 - GLFW.KeyF4 -> SpecialKey KeyF4 - GLFW.KeyF5 -> SpecialKey KeyF5 - GLFW.KeyF6 -> SpecialKey KeyF6 - GLFW.KeyF7 -> SpecialKey KeyF7 - GLFW.KeyF8 -> SpecialKey KeyF8 - GLFW.KeyF9 -> SpecialKey KeyF9 - GLFW.KeyF10 -> SpecialKey KeyF10 - GLFW.KeyF11 -> SpecialKey KeyF11 - GLFW.KeyF12 -> SpecialKey KeyF12 - GLFW.KeyF13 -> SpecialKey KeyF13 - GLFW.KeyF14 -> SpecialKey KeyF14 - GLFW.KeyF15 -> SpecialKey KeyF15 - GLFW.KeyF16 -> SpecialKey KeyF16 - GLFW.KeyF17 -> SpecialKey KeyF17 - GLFW.KeyF18 -> SpecialKey KeyF18 - GLFW.KeyF19 -> SpecialKey KeyF19 - GLFW.KeyF20 -> SpecialKey KeyF20 - GLFW.KeyF21 -> SpecialKey KeyF21 - GLFW.KeyF22 -> SpecialKey KeyF22 - GLFW.KeyF23 -> SpecialKey KeyF23 - GLFW.KeyF24 -> SpecialKey KeyF24 - GLFW.KeyF25 -> SpecialKey KeyF25 - GLFW.KeyUp -> SpecialKey KeyUp - GLFW.KeyDown -> SpecialKey KeyDown - GLFW.KeyLeft -> SpecialKey KeyLeft - GLFW.KeyRight -> SpecialKey KeyRight - GLFW.KeyTab -> SpecialKey KeyTab - GLFW.KeyEnter -> SpecialKey KeyEnter - GLFW.KeyBackspace -> SpecialKey KeyBackspace - GLFW.KeyInsert -> SpecialKey KeyInsert - GLFW.KeyDel -> SpecialKey KeyDelete - GLFW.KeyPageup -> SpecialKey KeyPageUp - GLFW.KeyPagedown -> SpecialKey KeyPageDown - GLFW.KeyHome -> SpecialKey KeyHome - GLFW.KeyEnd -> SpecialKey KeyEnd - GLFW.KeyPad0 -> SpecialKey KeyPad0 - GLFW.KeyPad1 -> SpecialKey KeyPad1 - GLFW.KeyPad2 -> SpecialKey KeyPad2 - GLFW.KeyPad3 -> SpecialKey KeyPad3 - GLFW.KeyPad4 -> SpecialKey KeyPad4 - GLFW.KeyPad5 -> SpecialKey KeyPad5 - GLFW.KeyPad6 -> SpecialKey KeyPad6 - GLFW.KeyPad7 -> SpecialKey KeyPad7 - GLFW.KeyPad8 -> SpecialKey KeyPad8 - GLFW.KeyPad9 -> SpecialKey KeyPad9 - GLFW.KeyPadDivide -> SpecialKey KeyPadDivide - GLFW.KeyPadMultiply -> SpecialKey KeyPadMultiply - GLFW.KeyPadSubtract -> SpecialKey KeyPadSubtract - GLFW.KeyPadAdd -> SpecialKey KeyPadAdd - GLFW.KeyPadDecimal -> SpecialKey KeyPadDecimal - GLFW.KeyPadEqual -> Char '=' - GLFW.KeyPadEnter -> SpecialKey KeyPadEnter - _ -> SpecialKey KeyUnknown + GLFW.Key'A -> charToSpecial 'a' + GLFW.Key'B -> charToSpecial 'b' + GLFW.Key'C -> charToSpecial 'c' + GLFW.Key'D -> charToSpecial 'd' + GLFW.Key'E -> charToSpecial 'e' + GLFW.Key'F -> charToSpecial 'f' + GLFW.Key'G -> charToSpecial 'g' + GLFW.Key'H -> charToSpecial 'h' + GLFW.Key'I -> charToSpecial 'i' + GLFW.Key'J -> charToSpecial 'j' + GLFW.Key'K -> charToSpecial 'k' + GLFW.Key'L -> charToSpecial 'l' + GLFW.Key'M -> charToSpecial 'm' + GLFW.Key'N -> charToSpecial 'n' + GLFW.Key'O -> charToSpecial 'o' + GLFW.Key'P -> charToSpecial 'p' + GLFW.Key'Q -> charToSpecial 'q' + GLFW.Key'R -> charToSpecial 'r' + GLFW.Key'S -> charToSpecial 's' + GLFW.Key'T -> charToSpecial 't' + GLFW.Key'U -> charToSpecial 'u' + GLFW.Key'V -> charToSpecial 'v' + GLFW.Key'W -> charToSpecial 'w' + GLFW.Key'X -> charToSpecial 'x' + GLFW.Key'Y -> charToSpecial 'y' + GLFW.Key'Z -> charToSpecial 'z' + GLFW.Key'Space -> SpecialKey KeySpace + GLFW.Key'Escape -> SpecialKey KeyEsc + GLFW.Key'F1 -> SpecialKey KeyF1 + GLFW.Key'F2 -> SpecialKey KeyF2 + GLFW.Key'F3 -> SpecialKey KeyF3 + GLFW.Key'F4 -> SpecialKey KeyF4 + GLFW.Key'F5 -> SpecialKey KeyF5 + GLFW.Key'F6 -> SpecialKey KeyF6 + GLFW.Key'F7 -> SpecialKey KeyF7 + GLFW.Key'F8 -> SpecialKey KeyF8 + GLFW.Key'F9 -> SpecialKey KeyF9 + GLFW.Key'F10 -> SpecialKey KeyF10 + GLFW.Key'F11 -> SpecialKey KeyF11 + GLFW.Key'F12 -> SpecialKey KeyF12 + GLFW.Key'F13 -> SpecialKey KeyF13 + GLFW.Key'F14 -> SpecialKey KeyF14 + GLFW.Key'F15 -> SpecialKey KeyF15 + GLFW.Key'F16 -> SpecialKey KeyF16 + GLFW.Key'F17 -> SpecialKey KeyF17 + GLFW.Key'F18 -> SpecialKey KeyF18 + GLFW.Key'F19 -> SpecialKey KeyF19 + GLFW.Key'F20 -> SpecialKey KeyF20 + GLFW.Key'F21 -> SpecialKey KeyF21 + GLFW.Key'F22 -> SpecialKey KeyF22 + GLFW.Key'F23 -> SpecialKey KeyF23 + GLFW.Key'F24 -> SpecialKey KeyF24 + GLFW.Key'F25 -> SpecialKey KeyF25 + GLFW.Key'Up -> SpecialKey KeyUp + GLFW.Key'Down -> SpecialKey KeyDown + GLFW.Key'Left -> SpecialKey KeyLeft + GLFW.Key'Right -> SpecialKey KeyRight + GLFW.Key'Tab -> SpecialKey KeyTab + GLFW.Key'Enter -> SpecialKey KeyEnter + GLFW.Key'Backspace -> SpecialKey KeyBackspace + GLFW.Key'Insert -> SpecialKey KeyInsert + GLFW.Key'Delete -> SpecialKey KeyDelete + GLFW.Key'PageUp -> SpecialKey KeyPageUp + GLFW.Key'PageDown -> SpecialKey KeyPageDown + GLFW.Key'Home -> SpecialKey KeyHome + GLFW.Key'End -> SpecialKey KeyEnd + GLFW.Key'Pad0 -> SpecialKey KeyPad0 + GLFW.Key'Pad1 -> SpecialKey KeyPad1 + GLFW.Key'Pad2 -> SpecialKey KeyPad2 + GLFW.Key'Pad3 -> SpecialKey KeyPad3 + GLFW.Key'Pad4 -> SpecialKey KeyPad4 + GLFW.Key'Pad5 -> SpecialKey KeyPad5 + GLFW.Key'Pad6 -> SpecialKey KeyPad6 + GLFW.Key'Pad7 -> SpecialKey KeyPad7 + GLFW.Key'Pad8 -> SpecialKey KeyPad8 + GLFW.Key'Pad9 -> SpecialKey KeyPad9 + GLFW.Key'PadDivide -> SpecialKey KeyPadDivide + GLFW.Key'PadMultiply -> SpecialKey KeyPadMultiply + GLFW.Key'PadSubtract -> SpecialKey KeyPadSubtract + GLFW.Key'PadAdd -> SpecialKey KeyPadAdd + GLFW.Key'PadDecimal -> SpecialKey KeyPadDecimal + GLFW.Key'PadEqual -> Char '=' + GLFW.Key'PadEnter -> SpecialKey KeyPadEnter + _ -> SpecialKey KeyUnknown -- | Convert char keys to special keys to work around a bug in @@ -581,11 +702,11 @@ instance GLFWKey GLFW.MouseButton where fromGLFW mouse = case mouse of - GLFW.MouseButton0 -> MouseButton LeftButton - GLFW.MouseButton1 -> MouseButton RightButton - GLFW.MouseButton2 -> MouseButton MiddleButton - GLFW.MouseButton3 -> MouseButton $ AdditionalButton 3 - GLFW.MouseButton4 -> MouseButton $ AdditionalButton 4 - GLFW.MouseButton5 -> MouseButton $ AdditionalButton 5 - GLFW.MouseButton6 -> MouseButton $ AdditionalButton 6 - GLFW.MouseButton7 -> MouseButton $ AdditionalButton 7 + GLFW.MouseButton'1 -> MouseButton LeftButton + GLFW.MouseButton'2 -> MouseButton RightButton + GLFW.MouseButton'3 -> MouseButton MiddleButton + GLFW.MouseButton'4 -> MouseButton $ AdditionalButton 4 + GLFW.MouseButton'5 -> MouseButton $ AdditionalButton 5 + GLFW.MouseButton'6 -> MouseButton $ AdditionalButton 6 + GLFW.MouseButton'7 -> MouseButton $ AdditionalButton 7 + GLFW.MouseButton'8 -> MouseButton $ AdditionalButton 8 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 @@ -78,6 +78,10 @@ = do GL.Size sizeX sizeY <- get GLUT.windowSize return (fromEnum sizeX,fromEnum sizeY) + getScreenSize _ + = do GL.Size width height <- get GLUT.screenSize + return (fromIntegral width, fromIntegral height) + elapsedTime _ = do t <- get GLUT.elapsedTime return $ (fromIntegral t) / 1000 diff --git a/Graphics/Gloss/Internals/Interface/Backend/Types.hs b/Graphics/Gloss/Internals/Interface/Backend/Types.hs --- a/Graphics/Gloss/Internals/Interface/Backend/Types.hs +++ b/Graphics/Gloss/Internals/Interface/Backend/Types.hs @@ -64,6 +64,9 @@ -- | Function that returns (width,height) of the window in pixels. getWindowDimensions :: IORef a -> IO (Int,Int) + -- | Function that returns (width,height) of a fullscreen window in pixels. + getScreenSize :: IORef a -> IO (Int,Int) + -- | Function that reports the time elapsed since the application started. -- (in seconds) elapsedTime :: IORef a -> IO Double diff --git a/gloss.cabal b/gloss.cabal --- a/gloss.cabal +++ b/gloss.cabal @@ -1,11 +1,11 @@ Name: gloss -Version: 1.12.0.0 +Version: 1.13.2.2 License: MIT License-file: LICENSE Author: Ben Lippmeier Maintainer: benl@ouroborus.net Build-Type: Simple -Cabal-Version: >=1.6 +Cabal-Version: >=1.10 Stability: stable Category: Graphics Homepage: http://gloss.ouroborus.net @@ -24,7 +24,7 @@ source-repository this type: git - tag: v1.12.0.0 + tag: v1.13.0.0 location: https://github.com/benl23x5/gloss Flag GLUT @@ -35,19 +35,14 @@ Description: Enable the GLFW backend Default: False -Flag ExplicitBackend - Description: Expose versions of 'display' and friends that allow - you to choose what window manager backend to use. - Default: False - Library Build-Depends: - base >= 4.8 && < 4.12 - , bmp == 1.2.* - , bytestring == 0.10.* - , containers == 0.5.* + base >= 4.8 && < 5 , ghc-prim - , gloss-rendering == 1.12.* + , bmp == 1.2.* + , bytestring == 0.11.* + , containers >= 0.5 && < 0.7 + , gloss-rendering == 1.13.* , GLUT == 2.7.* , OpenGL >= 2.12 && < 3.1 @@ -55,6 +50,9 @@ -O2 -Wall + Default-Language: + Haskell2010 + Exposed-modules: Graphics.Gloss Graphics.Gloss.Data.Bitmap @@ -105,11 +103,13 @@ If flag(GLUT) CPP-Options: -DWITHGLUT Other-modules: - Graphics.Gloss.Internals.Interface.Backend.GLUT + Graphics.Gloss.Internals.Interface.Backend.GLUT + -- NOTE: GLUT is still required for text rendering, and must be initialized + -- on Linux platforms. Thus, the GLFW backend still requires GLUT. If flag(GLFW) Build-Depends: - GLFW-b >= 1.4.1.0 && < 2 + GLFW-b >= 1.4.1.0 && < 2 CPP-Options: -DWITHGLFW Other-modules: Graphics.Gloss.Internals.Interface.Backend.GLFW