gloss 1.12.0.0 → 1.13.2.2
raw patch · 8 files changed
Files
- Graphics/Gloss.hs +12/−0
- Graphics/Gloss/Data/Bitmap.hs +6/−1
- Graphics/Gloss/Data/Picture.hs +13/−12
- Graphics/Gloss/Interface/Environment.hs +8/−9
- Graphics/Gloss/Internals/Interface/Backend/GLFW.hs +299/−178
- Graphics/Gloss/Internals/Interface/Backend/GLUT.hs +4/−0
- Graphics/Gloss/Internals/Interface/Backend/Types.hs +3/−0
- gloss.cabal +15/−15
Graphics/Gloss.hs view
@@ -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.
Graphics/Gloss/Data/Bitmap.hs view
@@ -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
Graphics/Gloss/Data/Picture.hs view
@@ -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.
Graphics/Gloss/Interface/Environment.hs view
@@ -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
Graphics/Gloss/Internals/Interface/Backend/GLFW.hs view
@@ -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
Graphics/Gloss/Internals/Interface/Backend/GLUT.hs view
@@ -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
Graphics/Gloss/Internals/Interface/Backend/Types.hs view
@@ -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
gloss.cabal view
@@ -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