diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ +2.1.2 +===== + +* Revise some documentation examples to be more idomatic +* Update `.gitignore` to cover `stack` and other tools +* Raise upper bounds for `transformers` to 0.6 +* Lower required SDL2 version to 2.0.2. +* Fix decoding of `TextEditingEvent` where the Raw bindings failed to stop reading + character data past the null terminator. + 2.1.1 -====== +===== * `SDL.Input.Mouse` new has a new API for fetching the location of the mouse. This API gives you greater control over finding the mouse position with respect to the diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,30 @@ -Copyright (c) 2013, 2014 Gabríel Arthúr Pétursson - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Gabríel Arthúr Pétursson nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2013, 2014 Gabríel Arthúr Pétursson + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Gabríel Arthúr Pétursson nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/cbits/sdlhelper.c b/cbits/sdlhelper.c --- a/cbits/sdlhelper.c +++ b/cbits/sdlhelper.c @@ -1,77 +1,77 @@ -#include -#include "sdlhelper.h" - -void SDLHelper_JoystickGetDeviceGUID (int device_index, SDL_JoystickGUID *guid) -{ - SDL_JoystickGUID t = SDL_JoystickGetDeviceGUID (device_index); - memcpy (guid, &t, sizeof (*guid)); -} - -void SDLHelper_JoystickGetGUID (SDL_Joystick *joystick, SDL_JoystickGUID *guid) -{ - SDL_JoystickGUID t = SDL_JoystickGetGUID (joystick); - memcpy (guid, &t, sizeof (*guid)); -} - -void SDLHelper_JoystickGetGUIDFromString (const char *pchGUID, SDL_JoystickGUID *guid) -{ - SDL_JoystickGUID t = SDL_JoystickGetGUIDFromString (pchGUID); - memcpy (guid, &t, sizeof (*guid)); -} - -void SDLHelper_JoystickGetGUIDString (const SDL_JoystickGUID *guid, char *gszGUID, int cbGUID) -{ - SDL_JoystickGetGUIDString (*guid, gszGUID, cbGUID); -} - -void SDLHelper_GameControllerGetBindForAxis (SDL_GameController *gamecontroller, SDL_GameControllerAxis axis, SDL_GameControllerButtonBind *bind) -{ - SDL_GameControllerButtonBind t = SDL_GameControllerGetBindForAxis (gamecontroller, axis); - memcpy (bind, &t, sizeof (*bind)); -} - -void SDLHelper_GameControllerGetBindForButton (SDL_GameController *gamecontroller, SDL_GameControllerButton button, SDL_GameControllerButtonBind *bind) -{ - SDL_GameControllerButtonBind t = SDL_GameControllerGetBindForButton (gamecontroller, button); - memcpy (bind, &t, sizeof (*bind)); -} - -char *SDLHelper_GameControllerMappingForGUID (const SDL_JoystickGUID *guid) -{ - return SDL_GameControllerMappingForGUID (*guid); -} - -void SDLHelper_LogMessage (int category, SDL_LogPriority priority, const char *str) -{ - SDL_LogMessage (category, priority, "%s", str); -} - -int SDLHelper_RWclose (SDL_RWops *ctx) -{ - return SDL_RWclose (ctx); -} - -size_t SDLHelper_RWread (SDL_RWops *ctx, void *ptr, size_t size, size_t maxnum) -{ - return SDL_RWread (ctx, ptr, size, maxnum); -} - -Sint64 SDLHelper_RWseek (SDL_RWops *ctx, Sint64 offset, int whence) -{ - return SDL_RWseek (ctx, offset, whence); -} - -Sint64 SDLHelper_RWtell (SDL_RWops *ctx) -{ - return SDL_RWtell (ctx); -} - -size_t SDLHelper_RWwrite (SDL_RWops *ctx, const void *ptr, size_t size, size_t num) -{ - return SDL_RWwrite (ctx, ptr, size, num); -} - -int SDLHelper_SetError (const char *str) -{ - return SDL_SetError ("%s", str); -} +#include +#include "sdlhelper.h" + +void SDLHelper_JoystickGetDeviceGUID (int device_index, SDL_JoystickGUID *guid) +{ + SDL_JoystickGUID t = SDL_JoystickGetDeviceGUID (device_index); + memcpy (guid, &t, sizeof (*guid)); +} + +void SDLHelper_JoystickGetGUID (SDL_Joystick *joystick, SDL_JoystickGUID *guid) +{ + SDL_JoystickGUID t = SDL_JoystickGetGUID (joystick); + memcpy (guid, &t, sizeof (*guid)); +} + +void SDLHelper_JoystickGetGUIDFromString (const char *pchGUID, SDL_JoystickGUID *guid) +{ + SDL_JoystickGUID t = SDL_JoystickGetGUIDFromString (pchGUID); + memcpy (guid, &t, sizeof (*guid)); +} + +void SDLHelper_JoystickGetGUIDString (const SDL_JoystickGUID *guid, char *gszGUID, int cbGUID) +{ + SDL_JoystickGetGUIDString (*guid, gszGUID, cbGUID); +} + +void SDLHelper_GameControllerGetBindForAxis (SDL_GameController *gamecontroller, SDL_GameControllerAxis axis, SDL_GameControllerButtonBind *bind) +{ + SDL_GameControllerButtonBind t = SDL_GameControllerGetBindForAxis (gamecontroller, axis); + memcpy (bind, &t, sizeof (*bind)); +} + +void SDLHelper_GameControllerGetBindForButton (SDL_GameController *gamecontroller, SDL_GameControllerButton button, SDL_GameControllerButtonBind *bind) +{ + SDL_GameControllerButtonBind t = SDL_GameControllerGetBindForButton (gamecontroller, button); + memcpy (bind, &t, sizeof (*bind)); +} + +char *SDLHelper_GameControllerMappingForGUID (const SDL_JoystickGUID *guid) +{ + return SDL_GameControllerMappingForGUID (*guid); +} + +void SDLHelper_LogMessage (int category, SDL_LogPriority priority, const char *str) +{ + SDL_LogMessage (category, priority, "%s", str); +} + +int SDLHelper_RWclose (SDL_RWops *ctx) +{ + return SDL_RWclose (ctx); +} + +size_t SDLHelper_RWread (SDL_RWops *ctx, void *ptr, size_t size, size_t maxnum) +{ + return SDL_RWread (ctx, ptr, size, maxnum); +} + +Sint64 SDLHelper_RWseek (SDL_RWops *ctx, Sint64 offset, int whence) +{ + return SDL_RWseek (ctx, offset, whence); +} + +Sint64 SDLHelper_RWtell (SDL_RWops *ctx) +{ + return SDL_RWtell (ctx); +} + +size_t SDLHelper_RWwrite (SDL_RWops *ctx, const void *ptr, size_t size, size_t num) +{ + return SDL_RWwrite (ctx, ptr, size, num); +} + +int SDLHelper_SetError (const char *str) +{ + return SDL_SetError ("%s", str); +} diff --git a/examples/AudioExample.hs b/examples/AudioExample.hs --- a/examples/AudioExample.hs +++ b/examples/AudioExample.hs @@ -15,7 +15,7 @@ let t = fromIntegral n / 48000 :: Double freq = 440 * 4 in round (fromIntegral (maxBound `div` 2 :: Int16) * sin (t * freq))) - [0 :: Integer ..] + [0 :: Int16 ..] audioCB :: IORef [Int16] -> AudioFormat sampleType -> IOVector sampleType -> IO () audioCB samples format buffer = diff --git a/examples/OpenGLExample.hs b/examples/OpenGLExample.hs --- a/examples/OpenGLExample.hs +++ b/examples/OpenGLExample.hs @@ -1,139 +1,134 @@ ---port of https://github.com/bergey/haskell-OpenGL-examples - -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module OpenGLExample where - -import Control.Monad -import Foreign.C.Types -import Linear -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as V -import System.Exit (exitFailure) -import System.IO - -import SDL (($=)) -import qualified SDL -import qualified Graphics.Rendering.OpenGL as GL - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL / OpenGL Example" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight, - SDL.windowOpenGL = Just SDL.defaultOpenGL} - SDL.showWindow window - - _ <- SDL.glCreateContext(window) - (prog, attrib) <- initResources - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - GL.clear [GL.ColorBuffer] - draw prog attrib - SDL.glSwapWindow window - - unless quit (loop) - - loop - - SDL.destroyWindow window - SDL.quit - -initResources :: IO (GL.Program, GL.AttribLocation) -initResources = do - -- compile vertex shader - vs <- GL.createShader GL.VertexShader - GL.shaderSourceBS vs $= vsSource - GL.compileShader vs - vsOK <- GL.get $ GL.compileStatus vs - unless vsOK $ do - hPutStrLn stderr "Error in vertex shader\n" - exitFailure - - -- Do it again for the fragment shader - fs <- GL.createShader GL.FragmentShader - GL.shaderSourceBS fs $= fsSource - GL.compileShader fs - fsOK <- GL.get $ GL.compileStatus fs - unless fsOK $ do - hPutStrLn stderr "Error in fragment shader\n" - exitFailure - - program <- GL.createProgram - GL.attachShader program vs - GL.attachShader program fs - GL.attribLocation program "coord2d" $= GL.AttribLocation 0 - GL.linkProgram program - linkOK <- GL.get $ GL.linkStatus program - GL.validateProgram program - status <- GL.get $ GL.validateStatus program - unless (linkOK && status) $ do - hPutStrLn stderr "GL.linkProgram error" - plog <- GL.get $ GL.programInfoLog program - putStrLn plog - exitFailure - GL.currentProgram $= Just program - - return (program, GL.AttribLocation 0) - -draw :: GL.Program -> GL.AttribLocation -> IO () -draw program attrib = do - GL.clearColor $= GL.Color4 1 1 1 1 - GL.clear [GL.ColorBuffer] - GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral screenWidth) (fromIntegral screenHeight)) - - GL.currentProgram $= Just program - GL.vertexAttribArray attrib $= GL.Enabled - V.unsafeWith vertices $ \ptr -> - GL.vertexAttribPointer attrib $= - (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 ptr) - GL.drawArrays GL.Triangles 0 3 -- 3 is the number of vertices - GL.vertexAttribArray attrib $= GL.Disabled - -vsSource, fsSource :: BS.ByteString -vsSource = BS.intercalate "\n" - [ - "attribute vec2 coord2d; " - , "" - , "void main(void) { " - , " gl_Position = vec4(coord2d, 0.0, 1.0); " - , "}" - ] - -fsSource = BS.intercalate "\n" - [ - "" - , "#version 120" - , "void main(void) {" - , "gl_FragColor = vec4((gl_FragCoord.x/640), (gl_FragCoord.y/480), 0, 1);" - , "}" - ] - -vertices :: V.Vector Float -vertices = V.fromList [ 0.0, 0.8 - , -0.8, -0.8 - , 0.8, -0.8 - ] - +--port of https://github.com/bergey/haskell-OpenGL-examples + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module OpenGLExample where + +import Control.Monad +import Foreign.C.Types +import Linear +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as V +import System.Exit (exitFailure) +import System.IO + +import SDL (($=)) +import qualified SDL +import qualified Graphics.Rendering.OpenGL as GL + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL / OpenGL Example" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight, + SDL.windowOpenGL = Just SDL.defaultOpenGL} + SDL.showWindow window + + _ <- SDL.glCreateContext(window) + (prog, attrib) <- initResources + + let loop = do + events <- SDL.pollEvents + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + GL.clear [GL.ColorBuffer] + draw prog attrib + SDL.glSwapWindow window + + unless quit (loop) + + loop + + SDL.destroyWindow window + SDL.quit + +initResources :: IO (GL.Program, GL.AttribLocation) +initResources = do + -- compile vertex shader + vs <- GL.createShader GL.VertexShader + GL.shaderSourceBS vs $= vsSource + GL.compileShader vs + vsOK <- GL.get $ GL.compileStatus vs + unless vsOK $ do + hPutStrLn stderr "Error in vertex shader\n" + exitFailure + + -- Do it again for the fragment shader + fs <- GL.createShader GL.FragmentShader + GL.shaderSourceBS fs $= fsSource + GL.compileShader fs + fsOK <- GL.get $ GL.compileStatus fs + unless fsOK $ do + hPutStrLn stderr "Error in fragment shader\n" + exitFailure + + program <- GL.createProgram + GL.attachShader program vs + GL.attachShader program fs + GL.attribLocation program "coord2d" $= GL.AttribLocation 0 + GL.linkProgram program + linkOK <- GL.get $ GL.linkStatus program + GL.validateProgram program + status <- GL.get $ GL.validateStatus program + unless (linkOK && status) $ do + hPutStrLn stderr "GL.linkProgram error" + plog <- GL.get $ GL.programInfoLog program + putStrLn plog + exitFailure + GL.currentProgram $= Just program + + return (program, GL.AttribLocation 0) + +draw :: GL.Program -> GL.AttribLocation -> IO () +draw program attrib = do + GL.clearColor $= GL.Color4 1 1 1 1 + GL.clear [GL.ColorBuffer] + GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral screenWidth) (fromIntegral screenHeight)) + + GL.currentProgram $= Just program + GL.vertexAttribArray attrib $= GL.Enabled + V.unsafeWith vertices $ \ptr -> + GL.vertexAttribPointer attrib $= + (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 ptr) + GL.drawArrays GL.Triangles 0 3 -- 3 is the number of vertices + GL.vertexAttribArray attrib $= GL.Disabled + +vsSource, fsSource :: BS.ByteString +vsSource = BS.intercalate "\n" + [ + "attribute vec2 coord2d; " + , "" + , "void main(void) { " + , " gl_Position = vec4(coord2d, 0.0, 1.0); " + , "}" + ] + +fsSource = BS.intercalate "\n" + [ + "" + , "#version 120" + , "void main(void) {" + , "gl_FragColor = vec4((gl_FragCoord.x/640), (gl_FragCoord.y/480), 0, 1);" + , "}" + ] + +vertices :: V.Vector Float +vertices = V.fromList [ 0.0, 0.8 + , -0.8, -0.8 + , 0.8, -0.8 + ] + diff --git a/examples/lazyfoo/Lesson01.hs b/examples/lazyfoo/Lesson01.hs --- a/examples/lazyfoo/Lesson01.hs +++ b/examples/lazyfoo/Lesson01.hs @@ -1,27 +1,27 @@ -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson01 (main) where - -import Control.Concurrent (threadDelay) -import Foreign.C.Types -import Linear -import qualified SDL - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - SDL.showWindow window - - screenSurface <- SDL.getWindowSurface window - let white = V4 maxBound maxBound maxBound maxBound - SDL.surfaceFillRect screenSurface Nothing white - SDL.updateWindowSurface window - - threadDelay 2000000 - - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson01 (main) where + +import Control.Concurrent (threadDelay) +import Foreign.C.Types +import Linear +import qualified SDL + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + SDL.showWindow window + + screenSurface <- SDL.getWindowSurface window + let white = V4 maxBound maxBound maxBound maxBound + SDL.surfaceFillRect screenSurface Nothing white + SDL.updateWindowSurface window + + threadDelay 2000000 + + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson02.hs b/examples/lazyfoo/Lesson02.hs --- a/examples/lazyfoo/Lesson02.hs +++ b/examples/lazyfoo/Lesson02.hs @@ -1,30 +1,30 @@ -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson02 (main) where - -import Control.Concurrent (threadDelay) -import Foreign.C.Types -import Linear -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - SDL.showWindow window - screenSurface <- SDL.getWindowSurface window - - helloWorld <- getDataFileName "examples/lazyfoo/hello_world.bmp" >>= SDL.loadBMP - - SDL.surfaceBlit helloWorld Nothing screenSurface Nothing - SDL.updateWindowSurface window - - threadDelay 2000000 - - SDL.destroyWindow window - SDL.freeSurface helloWorld - SDL.quit +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson02 (main) where + +import Control.Concurrent (threadDelay) +import Foreign.C.Types +import Linear +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + SDL.showWindow window + screenSurface <- SDL.getWindowSurface window + + helloWorld <- getDataFileName "examples/lazyfoo/hello_world.bmp" >>= SDL.loadBMP + + SDL.surfaceBlit helloWorld Nothing screenSurface Nothing + SDL.updateWindowSurface window + + threadDelay 2000000 + + SDL.destroyWindow window + SDL.freeSurface helloWorld + SDL.quit diff --git a/examples/lazyfoo/Lesson03.hs b/examples/lazyfoo/Lesson03.hs --- a/examples/lazyfoo/Lesson03.hs +++ b/examples/lazyfoo/Lesson03.hs @@ -1,51 +1,44 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - -module Lazyfoo.Lesson03 (main) where - -import Control.Monad -import Foreign.C.Types -import Linear -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - SDL.showWindow window - screenSurface <- SDL.getWindowSurface window - - xOut <- getDataFileName "examples/lazyfoo/x.bmp" >>= SDL.loadBMP - - let - loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - - events <- collectEvents - let quit = any (\case SDL.QuitEvent -> True - _ -> False) $ map SDL.eventPayload events - - SDL.surfaceBlit xOut Nothing screenSurface Nothing - SDL.updateWindowSurface window - - unless quit loop - - loop - - SDL.freeSurface xOut - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Lazyfoo.Lesson03 (main) where + +import Control.Monad +import Foreign.C.Types +import Linear +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + SDL.showWindow window + screenSurface <- SDL.getWindowSurface window + + xOut <- getDataFileName "examples/lazyfoo/x.bmp" >>= SDL.loadBMP + + let + loop = do + events <- SDL.pollEvents + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.surfaceBlit xOut Nothing screenSurface Nothing + SDL.updateWindowSurface window + + unless quit loop + + loop + + SDL.freeSurface xOut + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson04.hs b/examples/lazyfoo/Lesson04.hs --- a/examples/lazyfoo/Lesson04.hs +++ b/examples/lazyfoo/Lesson04.hs @@ -1,75 +1,69 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -module Lazyfoo.Lesson04 (main) where - -import Prelude hiding (any, mapM_) -import Control.Monad hiding (mapM_) -import Data.Foldable -import Data.Maybe -import Data.Monoid -import Foreign.C.Types -import Linear -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -loadBMP :: FilePath -> IO (SDL.Surface) -loadBMP path = getDataFileName path >>= SDL.loadBMP - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - SDL.showWindow window - screenSurface <- SDL.getWindowSurface window - - surfaceDefault <- loadBMP "examples/lazyfoo/press.bmp" - surfaceUp <- loadBMP "examples/lazyfoo/up.bmp" - surfaceDown <- loadBMP "examples/lazyfoo/down.bmp" - surfaceLeft <- loadBMP "examples/lazyfoo/left.bmp" - surfaceRight <- loadBMP "examples/lazyfoo/right.bmp" - - let - loop oldSurface = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - - events <- map SDL.eventPayload <$> collectEvents - let quit = any (== SDL.QuitEvent) events - - currentSurface = - fromMaybe oldSurface $ getLast $ - foldMap (\case SDL.KeyboardEvent e - | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - case SDL.keysymKeycode (SDL.keyboardEventKeysym e) of - SDL.KeycodeUp -> Last (Just surfaceUp) - SDL.KeycodeDown -> Last (Just surfaceDown) - SDL.KeycodeRight -> Last (Just surfaceRight) - SDL.KeycodeLeft -> Last (Just surfaceLeft) - _ -> mempty - _ -> mempty) - events - - SDL.surfaceBlit currentSurface Nothing screenSurface Nothing - SDL.updateWindowSurface window - - unless quit (loop currentSurface) - - loop surfaceDefault - - mapM_ SDL.freeSurface [ surfaceDefault, surfaceUp, surfaceDown, surfaceRight, surfaceLeft ] - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +module Lazyfoo.Lesson04 (main) where + +import Prelude hiding (any, mapM_) +import Control.Monad hiding (mapM_) +import Data.Foldable +import Data.Maybe +import Data.Monoid +import Foreign.C.Types +import Linear +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +loadBMP :: FilePath -> IO (SDL.Surface) +loadBMP path = getDataFileName path >>= SDL.loadBMP + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + SDL.showWindow window + screenSurface <- SDL.getWindowSurface window + + surfaceDefault <- loadBMP "examples/lazyfoo/press.bmp" + surfaceUp <- loadBMP "examples/lazyfoo/up.bmp" + surfaceDown <- loadBMP "examples/lazyfoo/down.bmp" + surfaceLeft <- loadBMP "examples/lazyfoo/left.bmp" + surfaceRight <- loadBMP "examples/lazyfoo/right.bmp" + + let + loop oldSurface = do + events <- map SDL.eventPayload <$> SDL.pollEvents + let quit = any (== SDL.QuitEvent) events + + currentSurface = + fromMaybe oldSurface $ getLast $ + foldMap (\case SDL.KeyboardEvent e + | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case SDL.keysymKeycode (SDL.keyboardEventKeysym e) of + SDL.KeycodeUp -> Last (Just surfaceUp) + SDL.KeycodeDown -> Last (Just surfaceDown) + SDL.KeycodeRight -> Last (Just surfaceRight) + SDL.KeycodeLeft -> Last (Just surfaceLeft) + _ -> mempty + _ -> mempty) + events + + SDL.surfaceBlit currentSurface Nothing screenSurface Nothing + SDL.updateWindowSurface window + + unless quit (loop currentSurface) + + loop surfaceDefault + + mapM_ SDL.freeSurface [ surfaceDefault, surfaceUp, surfaceDown, surfaceRight, surfaceLeft ] + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson05.hs b/examples/lazyfoo/Lesson05.hs --- a/examples/lazyfoo/Lesson05.hs +++ b/examples/lazyfoo/Lesson05.hs @@ -1,54 +1,48 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson05 (main) where - -import Control.Monad -import Foreign.C.Types -import Linear -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -loadSurface :: SDL.Surface -> FilePath -> IO SDL.Surface -loadSurface screenSurface path = do - loadedSurface <- getDataFileName path >>= SDL.loadBMP - desiredFormat <- SDL.surfaceFormat screenSurface - SDL.convertSurface loadedSurface desiredFormat <* SDL.freeSurface loadedSurface - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - SDL.showWindow window - screenSurface <- SDL.getWindowSurface window - - stretchedSurface <- loadSurface screenSurface "examples/lazyfoo/stretch.bmp" - - let - loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - - events <- collectEvents - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - SDL.surfaceBlitScaled stretchedSurface Nothing screenSurface Nothing - SDL.updateWindowSurface window - - unless quit loop - - loop - - SDL.freeSurface stretchedSurface - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson05 (main) where + +import Control.Monad +import Foreign.C.Types +import Linear +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +loadSurface :: SDL.Surface -> FilePath -> IO SDL.Surface +loadSurface screenSurface path = do + loadedSurface <- getDataFileName path >>= SDL.loadBMP + desiredFormat <- SDL.surfaceFormat screenSurface + SDL.convertSurface loadedSurface desiredFormat <* SDL.freeSurface loadedSurface + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + window <- SDL.createWindow "SDL Tutorial" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + SDL.showWindow window + screenSurface <- SDL.getWindowSurface window + + stretchedSurface <- loadSurface screenSurface "examples/lazyfoo/stretch.bmp" + + let + loop = do + events <- SDL.pollEvents + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.surfaceBlitScaled stretchedSurface Nothing screenSurface Nothing + SDL.updateWindowSurface window + + unless quit loop + + loop + + SDL.freeSurface stretchedSurface + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson07.hs b/examples/lazyfoo/Lesson07.hs --- a/examples/lazyfoo/Lesson07.hs +++ b/examples/lazyfoo/Lesson07.hs @@ -1,70 +1,65 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson07 (main) where - -import Control.Monad -import Foreign.C.Types -import Linear -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - xOutSurface <- getDataFileName "examples/lazyfoo/texture.bmp" >>= SDL.loadBMP - texture <- SDL.createTextureFromSurface renderer xOutSurface - SDL.freeSurface xOutSurface - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - SDL.clear renderer - SDL.copy renderer texture Nothing Nothing - SDL.present renderer - - unless quit loop - - loop - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson07 (main) where + +import Control.Monad +import Foreign.C.Types +import Linear +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + xOutSurface <- getDataFileName "examples/lazyfoo/texture.bmp" >>= SDL.loadBMP + texture <- SDL.createTextureFromSurface renderer xOutSurface + SDL.freeSurface xOutSurface + + let loop = do + events <- SDL.pollEvents + + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.clear renderer + SDL.copy renderer texture Nothing Nothing + SDL.present renderer + + unless quit loop + + loop + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson08.hs b/examples/lazyfoo/Lesson08.hs --- a/examples/lazyfoo/Lesson08.hs +++ b/examples/lazyfoo/Lesson08.hs @@ -1,82 +1,77 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson08 (main) where - -import Control.Monad -import Data.Foldable (for_) -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - SDL.rendererDrawColor renderer $= V4 maxBound 0 0 maxBound - SDL.fillRect renderer (Just $ SDL.Rectangle (P $ V2 (screenWidth `div` 4) (screenHeight `div` 4)) - (V2 (screenWidth `div` 2) (screenHeight `div` 2))) - - SDL.rendererDrawColor renderer $= V4 0 0 maxBound maxBound - SDL.drawRect renderer (Just (SDL.Rectangle (P $ V2 (screenWidth `div` 6) (screenHeight `div` 6)) - (V2 (screenWidth * 2 `div` 3) (screenHeight * 2 `div` 3)))) - - SDL.rendererDrawColor renderer $= V4 0 maxBound 0 maxBound - SDL.drawLine renderer (P (V2 0 (screenHeight `div` 2))) (P (V2 screenWidth (screenHeight `div` 2))) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - for_ [0, 4 .. screenHeight] $ \i -> - SDL.drawPoint renderer (P (V2 (screenWidth `div` 2) i)) - - SDL.present renderer - - unless quit loop - - loop - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson08 (main) where + +import Control.Monad +import Data.Foldable (for_) +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + let loop = do + events <- SDL.pollEvents + + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + SDL.rendererDrawColor renderer $= V4 maxBound 0 0 maxBound + SDL.fillRect renderer (Just $ SDL.Rectangle (P $ V2 (screenWidth `div` 4) (screenHeight `div` 4)) + (V2 (screenWidth `div` 2) (screenHeight `div` 2))) + + SDL.rendererDrawColor renderer $= V4 0 0 maxBound maxBound + SDL.drawRect renderer (Just (SDL.Rectangle (P $ V2 (screenWidth `div` 6) (screenHeight `div` 6)) + (V2 (screenWidth * 2 `div` 3) (screenHeight * 2 `div` 3)))) + + SDL.rendererDrawColor renderer $= V4 0 maxBound 0 maxBound + SDL.drawLine renderer (P (V2 0 (screenHeight `div` 2))) (P (V2 screenWidth (screenHeight `div` 2))) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + for_ [0, 4 .. screenHeight] $ \i -> + SDL.drawPoint renderer (P (V2 (screenWidth `div` 2) i)) + + SDL.present renderer + + unless quit loop + + loop + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson09.hs b/examples/lazyfoo/Lesson09.hs --- a/examples/lazyfoo/Lesson09.hs +++ b/examples/lazyfoo/Lesson09.hs @@ -1,81 +1,76 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson09 (main) where - -import Control.Monad -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - textureSurface <- getDataFileName "examples/lazyfoo/viewport.bmp" >>= SDL.loadBMP - texture <- SDL.createTextureFromSurface renderer textureSurface - SDL.freeSurface textureSurface - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - SDL.rendererViewport renderer $= Just (SDL.Rectangle (P (V2 0 0)) (V2 (screenWidth `div` 2) (screenHeight `div` 2))) - SDL.copy renderer texture Nothing Nothing - - SDL.rendererViewport renderer $= Just (SDL.Rectangle (P (V2 (screenWidth `div` 2) 0)) (V2 (screenWidth `div` 2) (screenHeight `div` 2))) - SDL.copy renderer texture Nothing Nothing - - SDL.rendererViewport renderer $= Just (SDL.Rectangle (P (V2 0 (screenHeight `div` 2))) (V2 screenWidth (screenHeight `div` 2))) - SDL.copy renderer texture Nothing Nothing - - SDL.present renderer - - unless quit loop - - loop - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson09 (main) where + +import Control.Monad +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + textureSurface <- getDataFileName "examples/lazyfoo/viewport.bmp" >>= SDL.loadBMP + texture <- SDL.createTextureFromSurface renderer textureSurface + SDL.freeSurface textureSurface + + let loop = do + events <- SDL.pollEvents + + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + SDL.rendererViewport renderer $= Just (SDL.Rectangle (P (V2 0 0)) (V2 (screenWidth `div` 2) (screenHeight `div` 2))) + SDL.copy renderer texture Nothing Nothing + + SDL.rendererViewport renderer $= Just (SDL.Rectangle (P (V2 (screenWidth `div` 2) 0)) (V2 (screenWidth `div` 2) (screenHeight `div` 2))) + SDL.copy renderer texture Nothing Nothing + + SDL.rendererViewport renderer $= Just (SDL.Rectangle (P (V2 0 (screenHeight `div` 2))) (V2 screenWidth (screenHeight `div` 2))) + SDL.copy renderer texture Nothing Nothing + + SDL.present renderer + + unless quit loop + + loop + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson10.hs b/examples/lazyfoo/Lesson10.hs --- a/examples/lazyfoo/Lesson10.hs +++ b/examples/lazyfoo/Lesson10.hs @@ -1,90 +1,85 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson10 (main) where - -import Control.Monad -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> IO () -renderTexture r (Texture t size) xy = - SDL.copy r t Nothing (Just $ SDL.Rectangle xy size) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - fooTexture <- loadTexture renderer "examples/lazyfoo/foo.bmp" - backgroundTexture <- loadTexture renderer "examples/lazyfoo/background.bmp" - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - renderTexture renderer backgroundTexture 0 - renderTexture renderer fooTexture (P (V2 240 190)) - - SDL.present renderer - - unless quit loop - - loop - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson10 (main) where + +import Control.Monad +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> IO () +renderTexture r (Texture t size) xy = + SDL.copy r t Nothing (Just $ SDL.Rectangle xy size) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + fooTexture <- loadTexture renderer "examples/lazyfoo/foo.bmp" + backgroundTexture <- loadTexture renderer "examples/lazyfoo/background.bmp" + + let loop = do + events <- SDL.pollEvents + + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + renderTexture renderer backgroundTexture 0 + renderTexture renderer fooTexture (P (V2 240 190)) + + SDL.present renderer + + unless quit loop + + loop + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson11.hs b/examples/lazyfoo/Lesson11.hs --- a/examples/lazyfoo/Lesson11.hs +++ b/examples/lazyfoo/Lesson11.hs @@ -1,98 +1,93 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson11 (main) where - -import Control.Lens.Operators -import Control.Monad -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> IO () -renderTexture r (Texture t size) xy clip = - let dstSize = maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copy r t clip (Just (SDL.Rectangle xy dstSize)) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.SoftwareRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - spriteSheetTexture <- loadTexture renderer "examples/lazyfoo/dots.bmp" - let spriteSize = V2 100 100 - clip1 = SDL.Rectangle (P (V2 0 0)) spriteSize - clip2 = SDL.Rectangle (P (V2 100 0)) spriteSize - clip3 = SDL.Rectangle (P (V2 0 100)) spriteSize - clip4 = SDL.Rectangle (P (V2 100 100)) spriteSize - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - renderTexture renderer spriteSheetTexture (P (V2 0 0)) (Just clip1) - renderTexture renderer spriteSheetTexture (P (V2 (screenWidth - spriteSize ^. _x) 0)) (Just clip2) - renderTexture renderer spriteSheetTexture (P (V2 0 (screenHeight - spriteSize ^. _y))) (Just clip3) - renderTexture renderer spriteSheetTexture (P (V2 (screenWidth - spriteSize ^. _x) (screenHeight - spriteSize ^. _y))) (Just clip4) - - SDL.present renderer - - unless quit loop - - loop - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson11 (main) where + +import Control.Lens.Operators +import Control.Monad +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> IO () +renderTexture r (Texture t size) xy clip = + let dstSize = maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copy r t clip (Just (SDL.Rectangle xy dstSize)) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.SoftwareRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + spriteSheetTexture <- loadTexture renderer "examples/lazyfoo/dots.bmp" + let spriteSize = V2 100 100 + clip1 = SDL.Rectangle (P (V2 0 0)) spriteSize + clip2 = SDL.Rectangle (P (V2 100 0)) spriteSize + clip3 = SDL.Rectangle (P (V2 0 100)) spriteSize + clip4 = SDL.Rectangle (P (V2 100 100)) spriteSize + + let loop = do + events <- SDL.pollEvents + + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + renderTexture renderer spriteSheetTexture (P (V2 0 0)) (Just clip1) + renderTexture renderer spriteSheetTexture (P (V2 (screenWidth - spriteSize ^. _x) 0)) (Just clip2) + renderTexture renderer spriteSheetTexture (P (V2 0 (screenHeight - spriteSize ^. _y))) (Just clip3) + renderTexture renderer spriteSheetTexture (P (V2 (screenWidth - spriteSize ^. _x) (screenHeight - spriteSize ^. _y))) (Just clip4) + + SDL.present renderer + + unless quit loop + + loop + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson12.hs b/examples/lazyfoo/Lesson12.hs --- a/examples/lazyfoo/Lesson12.hs +++ b/examples/lazyfoo/Lesson12.hs @@ -1,115 +1,110 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson12 (main) where - -import Control.Monad -import Data.Monoid -import Data.Word -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> IO () -renderTexture r (Texture t size) xy clip = - let dstSize = maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copy r t clip (Just (SDL.Rectangle xy dstSize)) - -setTextureColor :: Texture -> V3 Word8 -> IO () -setTextureColor (Texture t _) rgb = SDL.textureColorMod t $= rgb - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.SoftwareRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - modulatedTexture <- loadTexture renderer "examples/lazyfoo/colors.bmp" - - let loop color = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit, Sum colorAdjustment) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty) - SDL.KeyboardEvent e -> - (\x -> (mempty, x)) $ - if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.ScancodeQ -> Sum (V3 32 0 0) - | scancode == SDL.ScancodeW -> Sum (V3 0 32 0) - | scancode == SDL.ScancodeE -> Sum (V3 0 0 32) - | scancode == SDL.ScancodeA -> Sum (V3 (-32) 0 0) - | scancode == SDL.ScancodeS -> Sum (V3 0 (-32) 0) - | scancode == SDL.ScancodeD -> Sum (V3 0 0 (-32)) - | otherwise -> mempty - | otherwise -> mempty - _ -> mempty) $ - map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - let color' = color + colorAdjustment - setTextureColor modulatedTexture color' - renderTexture renderer modulatedTexture 0 Nothing - - SDL.present renderer - - unless quit (loop color') - - loop (V3 maxBound maxBound maxBound) - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson12 (main) where + +import Control.Monad +import Data.Monoid +import Data.Word +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> IO () +renderTexture r (Texture t size) xy clip = + let dstSize = maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copy r t clip (Just (SDL.Rectangle xy dstSize)) + +setTextureColor :: Texture -> V3 Word8 -> IO () +setTextureColor (Texture t _) rgb = SDL.textureColorMod t $= rgb + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.SoftwareRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + modulatedTexture <- loadTexture renderer "examples/lazyfoo/colors.bmp" + + let loop color = do + events <- SDL.pollEvents + + let (Any quit, Sum colorAdjustment) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty) + SDL.KeyboardEvent e -> + (\x -> (mempty, x)) $ + if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.ScancodeQ -> Sum (V3 32 0 0) + SDL.ScancodeW -> Sum (V3 0 32 0) + SDL.ScancodeE -> Sum (V3 0 0 32) + SDL.ScancodeA -> Sum (V3 (-32) 0 0) + SDL.ScancodeS -> Sum (V3 0 (-32) 0) + SDL.ScancodeD -> Sum (V3 0 0 (-32)) + _ -> mempty + | otherwise -> mempty + _ -> mempty) $ + map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + let color' = color + colorAdjustment + setTextureColor modulatedTexture color' + renderTexture renderer modulatedTexture 0 Nothing + + SDL.present renderer + + unless quit (loop color') + + loop (V3 maxBound maxBound maxBound) + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson13.hs b/examples/lazyfoo/Lesson13.hs --- a/examples/lazyfoo/Lesson13.hs +++ b/examples/lazyfoo/Lesson13.hs @@ -78,12 +78,7 @@ backgroundTexture <- loadTexture renderer "examples/lazyfoo/fadein.bmp" let loop alpha = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents + events <- SDL.pollEvents let (Any quit, Sum alphaAdjustment) = foldMap (\case @@ -91,10 +86,10 @@ SDL.KeyboardEvent e -> (\x -> (mempty, x)) $ if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.ScancodeW -> Sum 32 - | scancode == SDL.ScancodeS -> Sum (-32) - | otherwise -> mempty + case SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.ScancodeW -> Sum 32 + SDL.ScancodeS -> Sum (-32) + _ -> mempty | otherwise -> mempty _ -> mempty) $ map SDL.eventPayload events diff --git a/examples/lazyfoo/Lesson14.hs b/examples/lazyfoo/Lesson14.hs --- a/examples/lazyfoo/Lesson14.hs +++ b/examples/lazyfoo/Lesson14.hs @@ -1,104 +1,95 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson14 (main) where - -import Control.Monad -import Data.Monoid -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> IO () -renderTexture r (Texture t size) xy clip = - let dstSize = maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copy r t clip (Just (SDL.Rectangle xy dstSize)) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - spriteSheetTexture <- loadTexture renderer "examples/lazyfoo/animation.bmp" - let spriteSize = V2 64 205 - clip1 = SDL.Rectangle (P (V2 0 0)) spriteSize - clip2 = SDL.Rectangle (P (V2 64 0)) spriteSize - clip3 = SDL.Rectangle (P (V2 128 0)) spriteSize - clip4 = SDL.Rectangle (P (V2 196 0)) spriteSize - - let loop [] = return () - loop (frame:frames) = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit) = - foldMap (\case - SDL.QuitEvent -> (Any True) - _ -> mempty) $ - map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - renderTexture renderer spriteSheetTexture (P (fmap (`div` 2) (V2 screenWidth screenHeight) - fmap (`div` 2) spriteSize)) (Just frame) - - SDL.present renderer - - unless quit (loop frames) - - loop (cycle ([clip1, clip2, clip3, clip4] >>= replicate 4)) - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson14 (main) where + +import Control.Monad +import Data.Monoid +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> IO () +renderTexture r (Texture t size) xy clip = + let dstSize = maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copy r t clip (Just (SDL.Rectangle xy dstSize)) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + spriteSheetTexture <- loadTexture renderer "examples/lazyfoo/animation.bmp" + let spriteSize = V2 64 205 + clip1 = SDL.Rectangle (P (V2 0 0)) spriteSize + clip2 = SDL.Rectangle (P (V2 64 0)) spriteSize + clip3 = SDL.Rectangle (P (V2 128 0)) spriteSize + clip4 = SDL.Rectangle (P (V2 196 0)) spriteSize + + let loop [] = return () + loop (frame:frames) = do + events <- SDL.pollEvents + + let quit = any (== SDL.QuitEvent) $ map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + renderTexture renderer spriteSheetTexture (P (fmap (`div` 2) (V2 screenWidth screenHeight) - fmap (`div` 2) spriteSize)) (Just frame) + + SDL.present renderer + + unless quit (loop frames) + + loop (cycle ([clip1, clip2, clip3, clip4] >>= replicate 4)) + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson15.hs b/examples/lazyfoo/Lesson15.hs --- a/examples/lazyfoo/Lesson15.hs +++ b/examples/lazyfoo/Lesson15.hs @@ -1,121 +1,116 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson15 (main) where - -import Control.Monad -import Data.Monoid -import Data.Maybe -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () -renderTexture r (Texture t size) xy clip theta center flips = - let dstSize = - maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copyEx r - t - clip - (Just (SDL.Rectangle xy dstSize)) - (fromMaybe 0 theta) - center - (fromMaybe (pure False) flips) - -textureSize :: Texture -> V2 CInt -textureSize (Texture _ sz) = sz - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - arrowTexture <- loadTexture renderer "examples/lazyfoo/arrow.bmp" - - let loop theta flips = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit, Sum phi, Last newFlips) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty, mempty) - SDL.KeyboardEvent e -> - (\(x,y) -> (mempty, x,y)) $ - if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.ScancodeQ -> (mempty, Last (Just (V2 True False))) - | scancode == SDL.ScancodeW -> (mempty, Last (Just (V2 False False))) - | scancode == SDL.ScancodeE -> (mempty, Last (Just (V2 False True))) - | scancode == SDL.ScancodeA -> (Sum (-60), mempty) - | scancode == SDL.ScancodeD -> (Sum 60, mempty) - | otherwise -> mempty - | otherwise -> mempty - _ -> mempty) $ - map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - let theta' = theta + phi - flips' = fromMaybe flips newFlips - renderTexture renderer arrowTexture (P (fmap (`div` 2) (V2 screenWidth screenHeight) - fmap (`div` 2) (textureSize arrowTexture))) Nothing (Just theta') Nothing (Just flips') - - SDL.present renderer - - unless quit (loop theta' flips') - - loop 0 (pure False) - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson15 (main) where + +import Control.Monad +import Data.Monoid +import Data.Maybe +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () +renderTexture r (Texture t size) xy clip theta center flips = + let dstSize = + maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copyEx r + t + clip + (Just (SDL.Rectangle xy dstSize)) + (fromMaybe 0 theta) + center + (fromMaybe (pure False) flips) + +textureSize :: Texture -> V2 CInt +textureSize (Texture _ sz) = sz + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + arrowTexture <- loadTexture renderer "examples/lazyfoo/arrow.bmp" + + let loop theta flips = do + events <- SDL.pollEvents + + let (Any quit, Sum phi, Last newFlips) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty, mempty) + SDL.KeyboardEvent e -> + (\(x,y) -> (mempty, x,y)) $ + if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.ScancodeQ -> (mempty, Last (Just (V2 True False))) + SDL.ScancodeW -> (mempty, Last (Just (V2 False False))) + SDL.ScancodeE -> (mempty, Last (Just (V2 False True))) + SDL.ScancodeA -> (Sum (-60), mempty) + SDL.ScancodeD -> (Sum 60, mempty) + _ -> mempty + | otherwise -> mempty + _ -> mempty) $ + map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + let theta' = theta + phi + flips' = fromMaybe flips newFlips + renderTexture renderer arrowTexture (P (fmap (`div` 2) (V2 screenWidth screenHeight) - fmap (`div` 2) (textureSize arrowTexture))) Nothing (Just theta') Nothing (Just flips') + + SDL.present renderer + + unless quit (loop theta' flips') + + loop 0 (pure False) + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson17.hs b/examples/lazyfoo/Lesson17.hs --- a/examples/lazyfoo/Lesson17.hs +++ b/examples/lazyfoo/Lesson17.hs @@ -1,150 +1,144 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} -module Lazyfoo.Lesson17 (main) where - -import Prelude hiding (foldl1) -import Control.Monad -import Data.Foldable -import Data.Monoid -import Data.Maybe -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () -renderTexture r (Texture t size) xy clip theta center flips = - let dstSize = - maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copyEx r - t - clip - (Just (SDL.Rectangle xy dstSize)) - (fromMaybe 0 theta) - center - (fromMaybe (pure False) flips) - -data ButtonSprite = MouseOut | MouseOver | MouseDown | MouseUp - -data Button = Button (Point V2 CInt) ButtonSprite - -buttonSize :: V2 CInt -buttonWidth, buttonHeight :: CInt -buttonSize@(V2 buttonWidth buttonHeight) = V2 300 200 - -handleEvent :: Point V2 CInt -> SDL.EventPayload -> Button -> Button -handleEvent mousePos ev (Button buttonPos _) = - let inside = foldl1 (&&) ((>=) <$> mousePos <*> buttonPos) && - foldl1 (&&) ((<=) <$> mousePos <*> buttonPos .+^ buttonSize) - sprite - | inside = case ev of - SDL.MouseButtonEvent e - | SDL.mouseButtonEventMotion e == SDL.Pressed -> MouseDown - | SDL.mouseButtonEventMotion e == SDL.Released -> MouseUp - | otherwise -> MouseOver - _ -> MouseOver - | otherwise = MouseOut - - in Button buttonPos sprite - -renderButton :: SDL.Renderer -> Texture -> Button -> IO () -renderButton r spriteSheet (Button xy sprite) = - renderTexture r spriteSheet xy (Just spriteClipRect) Nothing Nothing Nothing - where - spriteClipRect = - let i = case sprite of - MouseOut -> 0 - MouseOver -> 1 - MouseDown -> 2 - MouseUp -> 3 - in SDL.Rectangle (P (V2 0 (i * 200))) (V2 300 200) - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - buttonSpriteSheet <- loadTexture renderer "examples/lazyfoo/button.bmp" - - let loop buttons = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - - events <- collectEvents - mousePos <- SDL.getMouseLocation - - let (Any quit, Endo updateButton) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty) - e -> (mempty, Endo (handleEvent mousePos e))) $ - map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - let buttons' = map (\b -> updateButton b) buttons - for_ buttons' (renderButton renderer buttonSpriteSheet) - - SDL.present renderer - - unless quit (loop buttons') - - loop (let newButton xy = Button xy MouseOut - in [ newButton (P (V2 0 0)) - , newButton (P (V2 (screenWidth - buttonWidth) 0)) - , newButton (P (V2 0 (screenHeight - buttonHeight))) - , newButton (P (V2 screenWidth screenHeight - buttonSize)) - ]) - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +module Lazyfoo.Lesson17 (main) where + +import Prelude hiding (foldl1) +import Control.Monad +import Data.Foldable +import Data.Monoid +import Data.Maybe +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () +renderTexture r (Texture t size) xy clip theta center flips = + let dstSize = + maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copyEx r + t + clip + (Just (SDL.Rectangle xy dstSize)) + (fromMaybe 0 theta) + center + (fromMaybe (pure False) flips) + +data ButtonSprite = MouseOut | MouseOver | MouseDown | MouseUp + +data Button = Button (Point V2 CInt) ButtonSprite + +buttonSize :: V2 CInt +buttonWidth, buttonHeight :: CInt +buttonSize@(V2 buttonWidth buttonHeight) = V2 300 200 + +handleEvent :: Point V2 CInt -> SDL.EventPayload -> Button -> Button +handleEvent mousePos ev (Button buttonPos _) = + let inside = foldl1 (&&) ((>=) <$> mousePos <*> buttonPos) && + foldl1 (&&) ((<=) <$> mousePos <*> buttonPos .+^ buttonSize) + sprite + | inside = case ev of + SDL.MouseButtonEvent e + | SDL.mouseButtonEventMotion e == SDL.Pressed -> MouseDown + | SDL.mouseButtonEventMotion e == SDL.Released -> MouseUp + | otherwise -> MouseOver + _ -> MouseOver + | otherwise = MouseOut + + in Button buttonPos sprite + +renderButton :: SDL.Renderer -> Texture -> Button -> IO () +renderButton r spriteSheet (Button xy sprite) = + renderTexture r spriteSheet xy (Just spriteClipRect) Nothing Nothing Nothing + where + spriteClipRect = + let i = case sprite of + MouseOut -> 0 + MouseOver -> 1 + MouseDown -> 2 + MouseUp -> 3 + in SDL.Rectangle (P (V2 0 (i * 200))) (V2 300 200) + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + buttonSpriteSheet <- loadTexture renderer "examples/lazyfoo/button.bmp" + + let loop buttons = do + events <- SDL.pollEvents + mousePos <- SDL.getAbsoluteMouseLocation + + let (Any quit, Endo updateButton) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty) + e -> (mempty, Endo (handleEvent mousePos e))) $ + map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + let buttons' = map updateButton buttons + for_ buttons' (renderButton renderer buttonSpriteSheet) + + SDL.present renderer + + unless quit (loop buttons') + + loop (let newButton xy = Button xy MouseOut + in [ newButton (P (V2 0 0)) + , newButton (P (V2 (screenWidth - buttonWidth) 0)) + , newButton (P (V2 0 (screenHeight - buttonHeight))) + , newButton (P (V2 screenWidth screenHeight - buttonSize)) + ]) + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson18.hs b/examples/lazyfoo/Lesson18.hs --- a/examples/lazyfoo/Lesson18.hs +++ b/examples/lazyfoo/Lesson18.hs @@ -1,113 +1,107 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -module Lazyfoo.Lesson18 (main) where - -import Prelude hiding (any, mapM_) -import Control.Monad hiding (mapM_) -import Data.Foldable -import Data.Maybe -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () -renderTexture r (Texture t size) xy clip theta center flips = - let dstSize = - maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copyEx r - t - clip - (Just (SDL.Rectangle xy dstSize)) - (fromMaybe 0 theta) - center - (fromMaybe (pure False) flips) -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - pressTexture <- loadTexture renderer "examples/lazyfoo/press.bmp" - upTexture <- loadTexture renderer "examples/lazyfoo/up.bmp" - downTexture <- loadTexture renderer "examples/lazyfoo/down.bmp" - leftTexture <- loadTexture renderer "examples/lazyfoo/left.bmp" - rightTexture <- loadTexture renderer "examples/lazyfoo/right.bmp" - - let - loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - - events <- map SDL.eventPayload <$> collectEvents - let quit = any (== SDL.QuitEvent) events - - keyMap <- SDL.getKeyboardState - let texture = - if | keyMap SDL.ScancodeUp -> upTexture - | keyMap SDL.ScancodeDown -> downTexture - | keyMap SDL.ScancodeLeft -> leftTexture - | keyMap SDL.ScancodeRight -> rightTexture - | otherwise -> pressTexture - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - renderTexture renderer texture 0 Nothing Nothing Nothing Nothing - - SDL.present renderer - - unless quit loop - - loop - - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Lazyfoo.Lesson18 (main) where + +import Prelude hiding (any, mapM_) +import Control.Monad hiding (mapM_) +import Data.Foldable +import Data.Maybe +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () +renderTexture r (Texture t size) xy clip theta center flips = + let dstSize = + maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copyEx r + t + clip + (Just (SDL.Rectangle xy dstSize)) + (fromMaybe 0 theta) + center + (fromMaybe (pure False) flips) +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + pressTexture <- loadTexture renderer "examples/lazyfoo/press.bmp" + upTexture <- loadTexture renderer "examples/lazyfoo/up.bmp" + downTexture <- loadTexture renderer "examples/lazyfoo/down.bmp" + leftTexture <- loadTexture renderer "examples/lazyfoo/left.bmp" + rightTexture <- loadTexture renderer "examples/lazyfoo/right.bmp" + + let + loop = do + events <- map SDL.eventPayload <$> SDL.pollEvents + let quit = any (== SDL.QuitEvent) events + + keyMap <- SDL.getKeyboardState + let texture = + if | keyMap SDL.ScancodeUp -> upTexture + | keyMap SDL.ScancodeDown -> downTexture + | keyMap SDL.ScancodeLeft -> leftTexture + | keyMap SDL.ScancodeRight -> rightTexture + | otherwise -> pressTexture + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + renderTexture renderer texture 0 Nothing Nothing Nothing Nothing + + SDL.present renderer + + unless quit loop + + loop + + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson19.hs b/examples/lazyfoo/Lesson19.hs --- a/examples/lazyfoo/Lesson19.hs +++ b/examples/lazyfoo/Lesson19.hs @@ -1,153 +1,148 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -module Lazyfoo.Lesson19 (main) where - -import Prelude hiding (any, mapM_) -import Control.Monad hiding (mapM_) -import Data.Int -import Data.Maybe -import Data.Monoid -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL -import qualified Data.Vector as V - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -joystickDeadZone :: Int16 -joystickDeadZone = 8000 - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.surfaceColorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () -renderTexture r (Texture t size) xy clip theta center flips = - let dstSize = - maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copyEx r - t - clip - (Just (SDL.Rectangle xy dstSize)) - (fromMaybe 0 theta) - center - (fromMaybe (pure False) flips) - -textureSize :: Texture -> V2 CInt -textureSize (Texture _ sz) = sz - -getJoystick :: IO (SDL.Joystick) -getJoystick = do - joysticks <- SDL.availableJoysticks - joystick <- if V.length joysticks == 0 - then error "No joysticks connected!" - else return (joysticks V.! 0) - - SDL.openJoystick joystick - - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo, SDL.InitJoystick] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - arrowTexture <- loadTexture renderer "examples/lazyfoo/arrow.bmp" - - joystick <- getJoystick - joystickID <- SDL.getJoystickID joystick - - let loop (xDir', yDir') = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit, Last newDir) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty) - SDL.KeyboardEvent e -> - if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.ScancodeEscape -> (Any True, mempty) - | otherwise -> mempty - | otherwise -> mempty - SDL.JoyAxisEvent e -> - if | SDL.joyAxisEventWhich e == joystickID -> - (\x -> (mempty, Last $ Just x)) $ - case SDL.joyAxisEventAxis e of - 0 -> if | SDL.joyAxisEventValue e < -joystickDeadZone -> (-1, yDir') - | SDL.joyAxisEventValue e > joystickDeadZone -> (1, yDir') - | otherwise -> (0, yDir') - 1 -> if | SDL.joyAxisEventValue e < -joystickDeadZone -> (xDir', -1) - | SDL.joyAxisEventValue e > joystickDeadZone -> (xDir', 1) - | otherwise -> (xDir', 0) - _ -> (xDir', yDir') - | otherwise -> mempty - _ -> mempty) $ - map SDL.eventPayload events - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - let dir@(xDir, yDir) = fromMaybe (xDir', yDir') newDir - phi = if xDir == 0 && yDir == 0 - then 0 - else (atan2 yDir xDir) * (180.0 / pi) - - renderTexture renderer arrowTexture (P (fmap (`div` 2) (V2 screenWidth screenHeight) - fmap (`div` 2) (textureSize arrowTexture))) Nothing (Just phi) Nothing Nothing - - SDL.present renderer - - unless quit $ loop dir - - loop (0, 0) - - SDL.closeJoystick joystick - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Lazyfoo.Lesson19 (main) where + +import Prelude hiding (any, mapM_) +import Control.Monad hiding (mapM_) +import Data.Int +import Data.Maybe +import Data.Monoid +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL +import qualified Data.Vector as V + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +joystickDeadZone :: Int16 +joystickDeadZone = 8000 + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.surfaceColorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () +renderTexture r (Texture t size) xy clip theta center flips = + let dstSize = + maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copyEx r + t + clip + (Just (SDL.Rectangle xy dstSize)) + (fromMaybe 0 theta) + center + (fromMaybe (pure False) flips) + +textureSize :: Texture -> V2 CInt +textureSize (Texture _ sz) = sz + +getJoystick :: IO (SDL.Joystick) +getJoystick = do + joysticks <- SDL.availableJoysticks + joystick <- if V.length joysticks == 0 + then error "No joysticks connected!" + else return (joysticks V.! 0) + + SDL.openJoystick joystick + + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo, SDL.InitJoystick] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + arrowTexture <- loadTexture renderer "examples/lazyfoo/arrow.bmp" + + joystick <- getJoystick + joystickID <- SDL.getJoystickID joystick + + let loop (xDir', yDir') = do + events <- SDL.pollEvents + + let (Any quit, Last newDir) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty) + SDL.KeyboardEvent e -> + if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.ScancodeEscape -> (Any True, mempty) + _ -> mempty + | otherwise -> mempty + SDL.JoyAxisEvent e -> + if | SDL.joyAxisEventWhich e == joystickID -> + (\x -> (mempty, Last $ Just x)) $ + case SDL.joyAxisEventAxis e of + 0 -> if | SDL.joyAxisEventValue e < -joystickDeadZone -> (-1, yDir') + | SDL.joyAxisEventValue e > joystickDeadZone -> (1, yDir') + | otherwise -> (0, yDir') + 1 -> if | SDL.joyAxisEventValue e < -joystickDeadZone -> (xDir', -1) + | SDL.joyAxisEventValue e > joystickDeadZone -> (xDir', 1) + | otherwise -> (xDir', 0) + _ -> (xDir', yDir') + | otherwise -> mempty + _ -> mempty) $ + map SDL.eventPayload events + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + let dir@(xDir, yDir) = fromMaybe (xDir', yDir') newDir + phi = if xDir == 0 && yDir == 0 + then 0 + else (atan2 yDir xDir) * (180.0 / pi) + + renderTexture renderer arrowTexture (P (fmap (`div` 2) (V2 screenWidth screenHeight) - fmap (`div` 2) (textureSize arrowTexture))) Nothing (Just phi) Nothing Nothing + + SDL.present renderer + + unless quit $ loop dir + + loop (0, 0) + + SDL.closeJoystick joystick + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson20.hs b/examples/lazyfoo/Lesson20.hs --- a/examples/lazyfoo/Lesson20.hs +++ b/examples/lazyfoo/Lesson20.hs @@ -1,138 +1,133 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -module Lazyfoo.Lesson20 (main) where - -import Prelude hiding (any, mapM_) -import Control.Monad hiding (mapM_) -import Data.Maybe -import Data.Monoid -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import SDL.Haptic -import qualified SDL -import qualified Data.Vector as V - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -loadTexture :: SDL.Renderer -> FilePath -> IO Texture -loadTexture r filePath = do - surface <- getDataFileName filePath >>= SDL.loadBMP - size <- SDL.surfaceDimensions surface - let key = V4 0 maxBound maxBound maxBound - SDL.colorKey surface $= Just key - t <- SDL.createTextureFromSurface r surface - SDL.freeSurface surface - return (Texture t size) - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () -renderTexture r (Texture t size) xy clip theta center flips = - let dstSize = - maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.renderCopyEx r - t - clip - (Just (SDL.Rectangle xy dstSize)) - (fromMaybe 0 theta) - center - (fromMaybe (pure False) flips) - -getJoystick :: IO (SDL.Joystick) -getJoystick = do - joysticks <- SDL.availableJoysticks - joystick <- if V.length joysticks == 0 - then error "No joysticks connected!" - else return (joysticks V.! 0) - - SDL.openJoystick joystick - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo, SDL.InitJoystick, SDL.InitHaptic] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.renderDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - rumbleTexture <- loadTexture renderer "examples/lazyfoo/rumble.bmp" - - joystick <- getJoystick - hapticDevice <- SDL.openHaptic (SDL.OpenHapticJoystick joystick) - SDL.hapticRumbleInit hapticDevice - - let loop = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit, Any buttonDown) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty) - SDL.KeyboardEvent e -> - if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.ScancodeEscape -> (Any True, mempty) - | otherwise -> mempty - | otherwise -> mempty - SDL.JoyButtonEvent e -> - if | SDL.joyButtonEventState e /= 0 -> (mempty, Any True) - | otherwise -> mempty - _ -> mempty) $ - map SDL.eventPayload events - - if buttonDown - then SDL.hapticRumblePlay hapticDevice 0.75 500 - else return () - - SDL.renderDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.renderClear renderer - - renderTexture renderer rumbleTexture (P $ V2 0 0) Nothing Nothing Nothing Nothing - - SDL.renderPresent renderer - - unless quit $ loop - - loop - - SDL.closeHaptic hapticDevice - SDL.closeJoystick joystick - - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Lazyfoo.Lesson20 (main) where + +import Prelude hiding (any, mapM_) +import Control.Monad hiding (mapM_) +import Data.Maybe +import Data.Monoid +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import SDL.Haptic +import qualified SDL +import qualified Data.Vector as V + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +loadTexture :: SDL.Renderer -> FilePath -> IO Texture +loadTexture r filePath = do + surface <- getDataFileName filePath >>= SDL.loadBMP + size <- SDL.surfaceDimensions surface + let key = V4 0 maxBound maxBound maxBound + SDL.colorKey surface $= Just key + t <- SDL.createTextureFromSurface r surface + SDL.freeSurface surface + return (Texture t size) + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () +renderTexture r (Texture t size) xy clip theta center flips = + let dstSize = + maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.renderCopyEx r + t + clip + (Just (SDL.Rectangle xy dstSize)) + (fromMaybe 0 theta) + center + (fromMaybe (pure False) flips) + +getJoystick :: IO (SDL.Joystick) +getJoystick = do + joysticks <- SDL.availableJoysticks + joystick <- if V.length joysticks == 0 + then error "No joysticks connected!" + else return (joysticks V.! 0) + + SDL.openJoystick joystick + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo, SDL.InitJoystick, SDL.InitHaptic] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.renderDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + rumbleTexture <- loadTexture renderer "examples/lazyfoo/rumble.bmp" + + joystick <- getJoystick + hapticDevice <- SDL.openHaptic (SDL.OpenHapticJoystick joystick) + SDL.hapticRumbleInit hapticDevice + + let loop = do + events <- SDL.pollEvents + + let (Any quit, Any buttonDown) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty) + SDL.KeyboardEvent e -> + if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.ScancodeEscape -> (Any True, mempty) + _ -> mempty + | otherwise -> mempty + SDL.JoyButtonEvent e -> + if | SDL.joyButtonEventState e /= 0 -> (mempty, Any True) + | otherwise -> mempty + _ -> mempty) $ + map SDL.eventPayload events + + if buttonDown + then SDL.hapticRumblePlay hapticDevice 0.75 500 + else return () + + SDL.renderDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.renderClear renderer + + renderTexture renderer rumbleTexture (P $ V2 0 0) Nothing Nothing Nothing Nothing + + SDL.renderPresent renderer + + unless quit $ loop + + loop + + SDL.closeHaptic hapticDevice + SDL.closeJoystick joystick + + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit diff --git a/examples/lazyfoo/Lesson43.hs b/examples/lazyfoo/Lesson43.hs --- a/examples/lazyfoo/Lesson43.hs +++ b/examples/lazyfoo/Lesson43.hs @@ -1,118 +1,112 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -module Lazyfoo.Lesson43 (main) where - -import Prelude hiding (any, mapM_) -import Control.Monad hiding (mapM_) -import Data.Foldable -import Data.Maybe -import Foreign.C.Types -import Linear -import Linear.Affine -import SDL (($=)) -import qualified SDL - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -data Texture = Texture SDL.Texture (V2 CInt) - -createBlank :: SDL.Renderer -> V2 CInt -> SDL.TextureAccess -> IO Texture -createBlank r sz access = Texture <$> SDL.createTexture r SDL.RGBA8888 access sz <*> pure sz - -renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () -renderTexture r (Texture t size) xy clip theta center flips = - let dstSize = - maybe size (\(SDL.Rectangle _ size') -> size') clip - in SDL.copyEx r - t - clip - (Just (SDL.Rectangle xy dstSize)) - (fromMaybe 0 theta) - center - (fromMaybe (pure False) flips) - -setAsRenderTarget :: SDL.Renderer -> Maybe Texture -> IO () -setAsRenderTarget r Nothing = SDL.rendererRenderTarget r $= Nothing -setAsRenderTarget r (Just (Texture t _)) = SDL.rendererRenderTarget r $= Just t - -main :: IO () -main = do - SDL.initialize [SDL.InitVideo] - - SDL.HintRenderScaleQuality $= SDL.ScaleLinear - do renderQuality <- SDL.get SDL.HintRenderScaleQuality - when (renderQuality /= SDL.ScaleLinear) $ - putStrLn "Warning: Linear texture filtering not enabled!" - - window <- - SDL.createWindow - "SDL Tutorial" - SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} - SDL.showWindow window - - renderer <- - SDL.createRenderer - window - (-1) - (SDL.RendererConfig - { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = False - }) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - - targetTexture <- createBlank renderer (V2 screenWidth screenHeight) SDL.TextureAccessTarget - - let - screenCenter = P (V2 (screenWidth `div` 2) (screenHeight `div` 2)) - - loop theta = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - - events <- map SDL.eventPayload <$> collectEvents - let quit = any (== SDL.QuitEvent) events - - setAsRenderTarget renderer (Just targetTexture) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - SDL.clear renderer - - SDL.rendererDrawColor renderer $= V4 maxBound 0 0 maxBound - SDL.fillRect renderer (Just $ SDL.Rectangle (P $ V2 (screenWidth `div` 4) (screenHeight `div` 4)) - (V2 (screenWidth `div` 2) (screenHeight `div` 2))) - - SDL.rendererDrawColor renderer $= V4 0 0 maxBound maxBound - SDL.drawRect renderer (Just (SDL.Rectangle (P $ V2 (screenWidth `div` 6) (screenHeight `div` 6)) - (V2 (screenWidth * 2 `div` 3) (screenHeight * 2 `div` 3)))) - - SDL.rendererDrawColor renderer $= V4 0 maxBound 0 maxBound - SDL.drawLine renderer (P (V2 0 (screenHeight `div` 2))) (P (V2 screenWidth (screenHeight `div` 2))) - - SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound - for_ [0, 4 .. screenHeight] $ \i -> - SDL.drawPoint renderer (P (V2 (screenWidth `div` 2) i)) - - setAsRenderTarget renderer Nothing - - renderTexture renderer targetTexture 0 Nothing (Just (fromIntegral theta)) (Just screenCenter) Nothing - - SDL.present renderer - - unless quit (loop (theta + 2 `mod` 360)) - - loop (0 :: Int) - - SDL.destroyWindow window - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Lazyfoo.Lesson43 (main) where + +import Prelude hiding (any, mapM_) +import Control.Monad hiding (mapM_) +import Data.Foldable +import Data.Maybe +import Foreign.C.Types +import Linear +import Linear.Affine +import SDL (($=)) +import qualified SDL + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +data Texture = Texture SDL.Texture (V2 CInt) + +createBlank :: SDL.Renderer -> V2 CInt -> SDL.TextureAccess -> IO Texture +createBlank r sz access = Texture <$> SDL.createTexture r SDL.RGBA8888 access sz <*> pure sz + +renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> Maybe (SDL.Rectangle CInt) -> Maybe CDouble -> Maybe (Point V2 CInt) -> Maybe (V2 Bool) -> IO () +renderTexture r (Texture t size) xy clip theta center flips = + let dstSize = + maybe size (\(SDL.Rectangle _ size') -> size') clip + in SDL.copyEx r + t + clip + (Just (SDL.Rectangle xy dstSize)) + (fromMaybe 0 theta) + center + (fromMaybe (pure False) flips) + +setAsRenderTarget :: SDL.Renderer -> Maybe Texture -> IO () +setAsRenderTarget r Nothing = SDL.rendererRenderTarget r $= Nothing +setAsRenderTarget r (Just (Texture t _)) = SDL.rendererRenderTarget r $= Just t + +main :: IO () +main = do + SDL.initialize [SDL.InitVideo] + + SDL.HintRenderScaleQuality $= SDL.ScaleLinear + do renderQuality <- SDL.get SDL.HintRenderScaleQuality + when (renderQuality /= SDL.ScaleLinear) $ + putStrLn "Warning: Linear texture filtering not enabled!" + + window <- + SDL.createWindow + "SDL Tutorial" + SDL.defaultWindow {SDL.windowInitialSize = V2 screenWidth screenHeight} + SDL.showWindow window + + renderer <- + SDL.createRenderer + window + (-1) + (SDL.RendererConfig + { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = False + }) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + + targetTexture <- createBlank renderer (V2 screenWidth screenHeight) SDL.TextureAccessTarget + + let + screenCenter = P (V2 (screenWidth `div` 2) (screenHeight `div` 2)) + + loop theta = do + events <- map SDL.eventPayload <$> SDL.pollEvents + let quit = any (== SDL.QuitEvent) events + + setAsRenderTarget renderer (Just targetTexture) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + SDL.clear renderer + + SDL.rendererDrawColor renderer $= V4 maxBound 0 0 maxBound + SDL.fillRect renderer (Just $ SDL.Rectangle (P $ V2 (screenWidth `div` 4) (screenHeight `div` 4)) + (V2 (screenWidth `div` 2) (screenHeight `div` 2))) + + SDL.rendererDrawColor renderer $= V4 0 0 maxBound maxBound + SDL.drawRect renderer (Just (SDL.Rectangle (P $ V2 (screenWidth `div` 6) (screenHeight `div` 6)) + (V2 (screenWidth * 2 `div` 3) (screenHeight * 2 `div` 3)))) + + SDL.rendererDrawColor renderer $= V4 0 maxBound 0 maxBound + SDL.drawLine renderer (P (V2 0 (screenHeight `div` 2))) (P (V2 screenWidth (screenHeight `div` 2))) + + SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound + for_ [0, 4 .. screenHeight] $ \i -> + SDL.drawPoint renderer (P (V2 (screenWidth `div` 2) i)) + + setAsRenderTarget renderer Nothing + + renderTexture renderer targetTexture 0 Nothing (Just (fromIntegral theta)) (Just screenCenter) Nothing + + SDL.present renderer + + unless quit (loop (theta + 2 `mod` 360)) + + loop (0 :: Int) + + SDL.destroyWindow window + SDL.quit diff --git a/examples/twinklebear/Lesson01.hs b/examples/twinklebear/Lesson01.hs --- a/examples/twinklebear/Lesson01.hs +++ b/examples/twinklebear/Lesson01.hs @@ -1,39 +1,39 @@ -{-# LANGUAGE OverloadedStrings #-} -module TwinkleBear.Lesson01 (main) where - - -import Prelude hiding (init) -import Linear -import Linear.Affine ( Point(P) ) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -main :: IO () -main = do - SDL.initializeAll - - let winConfig = SDL.defaultWindow { SDL.windowPosition = SDL.Absolute (P (V2 100 100)) - , SDL.windowInitialSize = V2 640 480 } - - rdrConfig = SDL.RendererConfig { SDL.rendererType = SDL.AcceleratedVSyncRenderer - , SDL.rendererTargetTexture = True } - - window <- SDL.createWindow "Hello World!" winConfig - renderer <- SDL.createRenderer window (-1) rdrConfig - - bmp <- getDataFileName "examples/twinklebear/hello.bmp" >>= SDL.loadBMP - tex <- SDL.createTextureFromSurface renderer bmp - SDL.freeSurface bmp - - SDL.clear renderer - SDL.copy renderer tex Nothing Nothing - SDL.present renderer - - SDL.delay 2000 - - SDL.destroyTexture tex - SDL.destroyRenderer renderer - SDL.destroyWindow window - - SDL.quit +{-# LANGUAGE OverloadedStrings #-} +module TwinkleBear.Lesson01 (main) where + + +import Prelude hiding (init) +import Linear +import Linear.Affine ( Point(P) ) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +main :: IO () +main = do + SDL.initializeAll + + let winConfig = SDL.defaultWindow { SDL.windowPosition = SDL.Absolute (P (V2 100 100)) + , SDL.windowInitialSize = V2 640 480 } + + rdrConfig = SDL.RendererConfig { SDL.rendererType = SDL.AcceleratedVSyncRenderer + , SDL.rendererTargetTexture = True } + + window <- SDL.createWindow "Hello World!" winConfig + renderer <- SDL.createRenderer window (-1) rdrConfig + + bmp <- getDataFileName "examples/twinklebear/hello.bmp" >>= SDL.loadBMP + tex <- SDL.createTextureFromSurface renderer bmp + SDL.freeSurface bmp + + SDL.clear renderer + SDL.copy renderer tex Nothing Nothing + SDL.present renderer + + SDL.delay 2000 + + SDL.destroyTexture tex + SDL.destroyRenderer renderer + SDL.destroyWindow window + + SDL.quit diff --git a/examples/twinklebear/Lesson02.hs b/examples/twinklebear/Lesson02.hs --- a/examples/twinklebear/Lesson02.hs +++ b/examples/twinklebear/Lesson02.hs @@ -1,76 +1,76 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module TwinkleBear.Lesson02 (main) where - -import Prelude hiding (init) -import Control.Monad -import Foreign.C.Types -import Linear -import Linear.Affine ( Point(P) ) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - - -data RenderPos = Centered | At (Point V2 CInt) - - -loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture -loadTexture renderer path = do - bmp <- SDL.loadBMP path - SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp - - -renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO () -renderTexture renderer tex pos = do - ti <- SDL.queryTexture tex - let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) - pos' = case pos of - At p -> p - Centered -> let cntr a b = (a - b) `div` 2 - in P $ V2 (cntr screenWidth w) (cntr screenHeight h) - extent = (V2 w h) - SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent) - - -renderTiledBackground :: SDL.Renderer -> SDL.Texture -> IO () -renderTiledBackground renderer tex = do - ti <- SDL.queryTexture tex - let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) - grid = [ At . P $ V2 (x*w) (y*h) | x <- [ 0..screenWidth `div` w ], - y <- [ 0..screenHeight `div` h ]] - forM_ grid (renderTexture renderer tex) - - -main :: IO () -main = do - SDL.initializeAll - - let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - rdrConfig = SDL.defaultRenderer { SDL.rendererType = SDL.AcceleratedRenderer } - - window <- SDL.createWindow "Lesson 2" winConfig - renderer <- SDL.createRenderer window (-1) rdrConfig - - background <- getDataFileName "examples/twinklebear/background.bmp" >>= loadTexture renderer - image <- getDataFileName "examples/twinklebear/smiley.bmp" >>= loadTexture renderer - - renderTiledBackground renderer background - renderTexture renderer image Centered - SDL.present renderer - - SDL.delay 2000 - - SDL.destroyTexture image - SDL.destroyTexture background - SDL.destroyRenderer renderer - SDL.destroyWindow window - - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module TwinkleBear.Lesson02 (main) where + +import Prelude hiding (init) +import Control.Monad +import Foreign.C.Types +import Linear +import Linear.Affine ( Point(P) ) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + + +data RenderPos = Centered | At (Point V2 CInt) + + +loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture +loadTexture renderer path = do + bmp <- SDL.loadBMP path + SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp + + +renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO () +renderTexture renderer tex pos = do + ti <- SDL.queryTexture tex + let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) + pos' = case pos of + At p -> p + Centered -> let cntr a b = (a - b) `div` 2 + in P $ V2 (cntr screenWidth w) (cntr screenHeight h) + extent = (V2 w h) + SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent) + + +renderTiledBackground :: SDL.Renderer -> SDL.Texture -> IO () +renderTiledBackground renderer tex = do + ti <- SDL.queryTexture tex + let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) + grid = [ At . P $ V2 (x*w) (y*h) | x <- [ 0..screenWidth `div` w ], + y <- [ 0..screenHeight `div` h ]] + forM_ grid (renderTexture renderer tex) + + +main :: IO () +main = do + SDL.initializeAll + + let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + rdrConfig = SDL.defaultRenderer { SDL.rendererType = SDL.AcceleratedRenderer } + + window <- SDL.createWindow "Lesson 2" winConfig + renderer <- SDL.createRenderer window (-1) rdrConfig + + background <- getDataFileName "examples/twinklebear/background.bmp" >>= loadTexture renderer + image <- getDataFileName "examples/twinklebear/smiley.bmp" >>= loadTexture renderer + + renderTiledBackground renderer background + renderTexture renderer image Centered + SDL.present renderer + + SDL.delay 2000 + + SDL.destroyTexture image + SDL.destroyTexture background + SDL.destroyRenderer renderer + SDL.destroyWindow window + + SDL.quit diff --git a/examples/twinklebear/Lesson04.hs b/examples/twinklebear/Lesson04.hs --- a/examples/twinklebear/Lesson04.hs +++ b/examples/twinklebear/Lesson04.hs @@ -1,73 +1,73 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module TwinkleBear.Lesson04 (main) where - - -import Prelude hiding (init) -import Control.Monad -import Foreign.C.Types -import Linear -import Linear.Affine ( Point(P) ) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - - -data RenderPos = Centered | At (Point V2 CInt) - - -loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture -loadTexture renderer path = do - bmp <- SDL.loadBMP path - SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp - - -renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO () -renderTexture renderer tex pos = do - ti <- SDL.queryTexture tex - let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) - pos' = case pos of - At p -> p - Centered -> let cntr a b = (a - b) `div` 2 - in P $ V2 (cntr screenWidth w) (cntr screenHeight h) - extent = (V2 w h) - SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent) - - -main :: IO () -main = do - SDL.initialize [ SDL.InitVideo ] - - let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - - window <- SDL.createWindow "Lesson 4" winConfig - renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer - - image <- getDataFileName "examples/twinklebear/event-driven.bmp" >>= loadTexture renderer - - let loop = do - renderTexture renderer image Centered - SDL.present renderer - - quit <- fmap (\ev -> case SDL.eventPayload ev of - SDL.QuitEvent -> True - SDL.KeyboardEvent e -> SDL.keyboardEventKeyMotion e == SDL.Pressed - SDL.MouseButtonEvent e -> SDL.mouseButtonEventMotion e == SDL.Pressed - _ -> False) SDL.waitEvent - - unless quit loop - - loop - - SDL.destroyTexture image - SDL.destroyRenderer renderer - SDL.destroyWindow window - - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module TwinkleBear.Lesson04 (main) where + + +import Prelude hiding (init) +import Control.Monad +import Foreign.C.Types +import Linear +import Linear.Affine ( Point(P) ) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + + +data RenderPos = Centered | At (Point V2 CInt) + + +loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture +loadTexture renderer path = do + bmp <- SDL.loadBMP path + SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp + + +renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO () +renderTexture renderer tex pos = do + ti <- SDL.queryTexture tex + let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) + pos' = case pos of + At p -> p + Centered -> let cntr a b = (a - b) `div` 2 + in P $ V2 (cntr screenWidth w) (cntr screenHeight h) + extent = (V2 w h) + SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent) + + +main :: IO () +main = do + SDL.initialize [ SDL.InitVideo ] + + let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + + window <- SDL.createWindow "Lesson 4" winConfig + renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer + + image <- getDataFileName "examples/twinklebear/event-driven.bmp" >>= loadTexture renderer + + let loop = do + renderTexture renderer image Centered + SDL.present renderer + + quit <- fmap (\ev -> case SDL.eventPayload ev of + SDL.QuitEvent -> True + SDL.KeyboardEvent e -> SDL.keyboardEventKeyMotion e == SDL.Pressed + SDL.MouseButtonEvent e -> SDL.mouseButtonEventMotion e == SDL.Pressed + _ -> False) SDL.waitEvent + + unless quit loop + + loop + + SDL.destroyTexture image + SDL.destroyRenderer renderer + SDL.destroyWindow window + + SDL.quit diff --git a/examples/twinklebear/Lesson04a.hs b/examples/twinklebear/Lesson04a.hs --- a/examples/twinklebear/Lesson04a.hs +++ b/examples/twinklebear/Lesson04a.hs @@ -1,98 +1,93 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE MultiWayIf #-} -module TwinkleBear.Lesson04a (main) where - - -import Prelude hiding (init) -import Control.Monad -import Data.Monoid -import Foreign.C.Types -import Linear -import Linear.Affine ( Point(P) ) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - - -data RenderPos = Centered | At (Point V2 CInt) - - -loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture -loadTexture renderer path = do - bmp <- SDL.loadBMP path - SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp - - -renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO () -renderTexture renderer tex pos = do - ti <- SDL.queryTexture tex - let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) - pos' = case pos of - At p -> p - Centered -> let cntr a b = (a - b) `div` 2 - in P $ V2 (cntr screenWidth w) (cntr screenHeight h) - extent = (V2 w h) - SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent) - - -main :: IO () -main = do - SDL.initialize [ SDL.InitVideo ] - - let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - - window <- SDL.createWindow "Lesson 4a" winConfig - renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer - - image <- getDataFileName "examples/twinklebear/ladybeetle.bmp" >>= loadTexture renderer - - let loop imgPos = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit, Sum posDelta) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty) - SDL.KeyboardEvent e -> - if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.ScancodeUp -> (Any False, Sum (V2 0 (-10))) - | scancode == SDL.ScancodeDown -> (Any False, Sum (V2 0 10 )) - | scancode == SDL.ScancodeLeft -> (Any False, Sum (V2 (-10) 0 )) - | scancode == SDL.ScancodeRight -> (Any False, Sum (V2 10 0 )) - | scancode == SDL.ScancodeQ -> (Any True, mempty) - | otherwise -> mempty - | otherwise -> mempty - _ -> mempty) $ - map SDL.eventPayload events - - imgPos' = imgPos + posDelta - - SDL.clear renderer - renderTexture renderer image $ At (P imgPos') - SDL.present renderer - - unless quit $ loop imgPos' - - loop $ (V2 100 100) - - SDL.destroyTexture image - SDL.destroyRenderer renderer - SDL.destroyWindow window - - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} +module TwinkleBear.Lesson04a (main) where + + +import Prelude hiding (init) +import Control.Monad +import Data.Monoid +import Foreign.C.Types +import Linear +import Linear.Affine ( Point(P) ) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + + +data RenderPos = Centered | At (Point V2 CInt) + + +loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture +loadTexture renderer path = do + bmp <- SDL.loadBMP path + SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp + + +renderTexture :: SDL.Renderer -> SDL.Texture -> RenderPos -> IO () +renderTexture renderer tex pos = do + ti <- SDL.queryTexture tex + let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) + pos' = case pos of + At p -> p + Centered -> let cntr a b = (a - b) `div` 2 + in P $ V2 (cntr screenWidth w) (cntr screenHeight h) + extent = (V2 w h) + SDL.copy renderer tex Nothing (Just $ SDL.Rectangle pos' extent) + + +main :: IO () +main = do + SDL.initialize [ SDL.InitVideo ] + + let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + + window <- SDL.createWindow "Lesson 4a" winConfig + renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer + + image <- getDataFileName "examples/twinklebear/ladybeetle.bmp" >>= loadTexture renderer + + let loop imgPos = do + events <- SDL.pollEvents + + let (Any quit, Sum posDelta) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty) + SDL.KeyboardEvent e -> + if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.ScancodeUp -> (Any False, Sum (V2 0 (-10))) + SDL.ScancodeDown -> (Any False, Sum (V2 0 10 )) + SDL.ScancodeLeft -> (Any False, Sum (V2 (-10) 0 )) + SDL.ScancodeRight -> (Any False, Sum (V2 10 0 )) + SDL.ScancodeQ -> (Any True, mempty) + _ -> mempty + | otherwise -> mempty + _ -> mempty) $ + map SDL.eventPayload events + + imgPos' = imgPos + posDelta + + SDL.clear renderer + renderTexture renderer image $ At (P imgPos') + SDL.present renderer + + unless quit $ loop imgPos' + + loop $ (V2 100 100) + + SDL.destroyTexture image + SDL.destroyRenderer renderer + SDL.destroyWindow window + + SDL.quit diff --git a/examples/twinklebear/Lesson05.hs b/examples/twinklebear/Lesson05.hs --- a/examples/twinklebear/Lesson05.hs +++ b/examples/twinklebear/Lesson05.hs @@ -1,104 +1,99 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE MultiWayIf #-} -module TwinkleBear.Lesson05 (main) where - -import Prelude hiding (init) -import Control.Applicative -import Control.Monad -import Data.Monoid -import Foreign.C.Types -import Linear -import Linear.Affine ( Point(P) ) -import qualified SDL - -import Paths_sdl2 (getDataFileName) - -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable -#endif - -screenWidth, screenHeight :: CInt -(screenWidth, screenHeight) = (640, 480) - -spriteWidth, spriteHeight :: CInt -(spriteWidth, spriteHeight) = (100, 100) - - -type ClipRect = Maybe (SDL.Rectangle CInt) - -data RenderPos = Centered | At (Point V2 CInt) - - -loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture -loadTexture renderer path = do - bmp <- SDL.loadBMP path - SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp - - -renderTexture :: SDL.Renderer -> SDL.Texture -> ClipRect -> RenderPos -> IO () -renderTexture renderer tex clipRect pos = do - ti <- SDL.queryTexture tex - let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) - pos' = case pos of - At p -> p - Centered -> let cntr a b = (a - b) `div` 2 - in P $ V2 (cntr screenWidth w) (cntr screenHeight h) - extent = (V2 w h) - SDL.copy renderer tex clipRect (Just $ SDL.Rectangle pos' extent) - - -main :: IO () -main = do - SDL.initialize [ SDL.InitVideo ] - - let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } - - window <- SDL.createWindow "Lesson 5" winConfig - renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer - - spriteSheet <- getDataFileName "examples/twinklebear/spritesheet.bmp" >>= loadTexture renderer - let [spriteOne, spriteTwo, spriteThree, spriteFour] = - [ SDL.Rectangle (P (V2 (x * spriteWidth) (y * spriteHeight))) (V2 spriteWidth spriteHeight) - | x <- [0..1], y <- [0..1] ] - - let loop spriteRect = do - let collectEvents = do - e <- SDL.pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> collectEvents - events <- collectEvents - - let (Any quit, Last newSpriteRect) = - foldMap (\case - SDL.QuitEvent -> (Any True, mempty) - SDL.KeyboardEvent e -> - if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> - let scancode = SDL.keysymScancode (SDL.keyboardEventKeysym e) - in if | scancode == SDL.Scancode1 -> (Any False, Last (Just spriteOne)) - | scancode == SDL.Scancode2 -> (Any False, Last (Just spriteTwo)) - | scancode == SDL.Scancode3 -> (Any False, Last (Just spriteThree)) - | scancode == SDL.Scancode4 -> (Any False, Last (Just spriteFour)) - | scancode == SDL.ScancodeQ -> (Any True, mempty) - | otherwise -> mempty - | otherwise -> mempty - _ -> mempty) $ - map SDL.eventPayload events - - spriteRect' = newSpriteRect <|> spriteRect - - SDL.clear renderer - renderTexture renderer spriteSheet spriteRect' Centered - SDL.present renderer - - unless quit $ loop spriteRect' - - loop $ Just spriteOne - - SDL.destroyRenderer renderer - SDL.destroyWindow window - - SDL.quit +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} +module TwinkleBear.Lesson05 (main) where + +import Prelude hiding (init) +import Control.Applicative +import Control.Monad +import Data.Monoid +import Foreign.C.Types +import Linear +import Linear.Affine ( Point(P) ) +import qualified SDL + +import Paths_sdl2 (getDataFileName) + +#if !MIN_VERSION_base(4,8,0) +import Data.Foldable +#endif + +screenWidth, screenHeight :: CInt +(screenWidth, screenHeight) = (640, 480) + +spriteWidth, spriteHeight :: CInt +(spriteWidth, spriteHeight) = (100, 100) + + +type ClipRect = Maybe (SDL.Rectangle CInt) + +data RenderPos = Centered | At (Point V2 CInt) + + +loadTexture :: SDL.Renderer -> FilePath -> IO SDL.Texture +loadTexture renderer path = do + bmp <- SDL.loadBMP path + SDL.createTextureFromSurface renderer bmp <* SDL.freeSurface bmp + + +renderTexture :: SDL.Renderer -> SDL.Texture -> ClipRect -> RenderPos -> IO () +renderTexture renderer tex clipRect pos = do + ti <- SDL.queryTexture tex + let (w, h) = (SDL.textureWidth ti, SDL.textureHeight ti) + pos' = case pos of + At p -> p + Centered -> let cntr a b = (a - b) `div` 2 + in P $ V2 (cntr screenWidth w) (cntr screenHeight h) + extent = (V2 w h) + SDL.copy renderer tex clipRect (Just $ SDL.Rectangle pos' extent) + + +main :: IO () +main = do + SDL.initialize [ SDL.InitVideo ] + + let winConfig = SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight } + + window <- SDL.createWindow "Lesson 5" winConfig + renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer + + spriteSheet <- getDataFileName "examples/twinklebear/spritesheet.bmp" >>= loadTexture renderer + let [spriteOne, spriteTwo, spriteThree, spriteFour] = + [ SDL.Rectangle (P (V2 (x * spriteWidth) (y * spriteHeight))) (V2 spriteWidth spriteHeight) + | x <- [0..1], y <- [0..1] ] + + let loop spriteRect = do + events <- SDL.pollEvents + + let (Any quit, Last newSpriteRect) = + foldMap (\case + SDL.QuitEvent -> (Any True, mempty) + SDL.KeyboardEvent e -> + if | SDL.keyboardEventKeyMotion e == SDL.Pressed -> + case SDL.keysymScancode (SDL.keyboardEventKeysym e) of + SDL.Scancode1 -> (Any False, Last (Just spriteOne)) + SDL.Scancode2 -> (Any False, Last (Just spriteTwo)) + SDL.Scancode3 -> (Any False, Last (Just spriteThree)) + SDL.Scancode4 -> (Any False, Last (Just spriteFour)) + SDL.ScancodeQ -> (Any True, mempty) + _ -> mempty + | otherwise -> mempty + _ -> mempty) $ + map SDL.eventPayload events + + spriteRect' = newSpriteRect <|> spriteRect + + SDL.clear renderer + renderTexture renderer spriteSheet spriteRect' Centered + SDL.present renderer + + unless quit $ loop spriteRect' + + loop $ Just spriteOne + + SDL.destroyRenderer renderer + SDL.destroyWindow window + + SDL.quit diff --git a/include/sdlhelper.h b/include/sdlhelper.h --- a/include/sdlhelper.h +++ b/include/sdlhelper.h @@ -1,26 +1,26 @@ -#ifndef _HS_SDL2_HELPER_H_ -#define _HS_SDL2_HELPER_H_ - -#include -#include "SDL.h" - -void SDLHelper_JoystickGetDeviceGUID (int device_index, SDL_JoystickGUID *guid); -void SDLHelper_JoystickGetGUID (SDL_Joystick *joystick, SDL_JoystickGUID *guid); -void SDLHelper_JoystickGetGUIDFromString (const char *pchGUID, SDL_JoystickGUID *guid); -void SDLHelper_JoystickGetGUIDString (const SDL_JoystickGUID *guid, char *gszGUID, int cbGUID); - -void SDLHelper_GameControllerGetBindForAxis (SDL_GameController *gamecontroller, SDL_GameControllerAxis axis, SDL_GameControllerButtonBind *bind); -void SDLHelper_GameControllerGetBindForButton (SDL_GameController *gamecontroller, SDL_GameControllerButton button, SDL_GameControllerButtonBind *bind); -char *SDLHelper_GameControllerMappingForGUID (const SDL_JoystickGUID *guid); - -void SDLHelper_LogMessage (int category, SDL_LogPriority priority, const char *str); - -int SDLHelper_RWclose (SDL_RWops *ctx); -size_t SDLHelper_RWread (SDL_RWops *ctx, void *ptr, size_t size, size_t maxnum); -Sint64 SDLHelper_RWseek (SDL_RWops *ctx, Sint64 offset, int whence); -Sint64 SDLHelper_RWtell (SDL_RWops *ctx); -size_t SDLHelper_RWwrite (SDL_RWops *ctx, const void *ptr, size_t size, size_t num); - -int SDLHelper_SetError(const char *str); - -#endif +#ifndef _HS_SDL2_HELPER_H_ +#define _HS_SDL2_HELPER_H_ + +#include +#include "SDL.h" + +void SDLHelper_JoystickGetDeviceGUID (int device_index, SDL_JoystickGUID *guid); +void SDLHelper_JoystickGetGUID (SDL_Joystick *joystick, SDL_JoystickGUID *guid); +void SDLHelper_JoystickGetGUIDFromString (const char *pchGUID, SDL_JoystickGUID *guid); +void SDLHelper_JoystickGetGUIDString (const SDL_JoystickGUID *guid, char *gszGUID, int cbGUID); + +void SDLHelper_GameControllerGetBindForAxis (SDL_GameController *gamecontroller, SDL_GameControllerAxis axis, SDL_GameControllerButtonBind *bind); +void SDLHelper_GameControllerGetBindForButton (SDL_GameController *gamecontroller, SDL_GameControllerButton button, SDL_GameControllerButtonBind *bind); +char *SDLHelper_GameControllerMappingForGUID (const SDL_JoystickGUID *guid); + +void SDLHelper_LogMessage (int category, SDL_LogPriority priority, const char *str); + +int SDLHelper_RWclose (SDL_RWops *ctx); +size_t SDLHelper_RWread (SDL_RWops *ctx, void *ptr, size_t size, size_t maxnum); +Sint64 SDLHelper_RWseek (SDL_RWops *ctx, Sint64 offset, int whence); +Sint64 SDLHelper_RWtell (SDL_RWops *ctx); +size_t SDLHelper_RWwrite (SDL_RWops *ctx, const void *ptr, size_t size, size_t num); + +int SDLHelper_SetError(const char *str); + +#endif diff --git a/sdl2.cabal b/sdl2.cabal --- a/sdl2.cabal +++ b/sdl2.cabal @@ -1,6 +1,6 @@ name: sdl2 -version: 2.1.1 -synopsis: Both high- and low-level bindings to the SDL library (version 2.0.3). +version: 2.1.2 +synopsis: Both high- and low-level bindings to the SDL library (version 2.0.2). description: This package contains bindings to the SDL 2 library, in both high- and low-level forms: @@ -104,7 +104,7 @@ SDL2 pkgconfig-depends: - sdl2 >= 2.0.3 + sdl2 >= 2.0.2 build-depends: base >= 4.7 && < 5, @@ -113,7 +113,7 @@ linear >= 1.10.1.2 && < 1.21, StateVar >= 1.1.0.0 && < 1.2, text >= 1.1.0.0 && < 1.3, - transformers >= 0.2 && < 0.5, + transformers >= 0.2 && < 0.6, vector >= 0.10.9.0 && < 0.12 default-language: diff --git a/src/Data/Bitmask.hs b/src/Data/Bitmask.hs --- a/src/Data/Bitmask.hs +++ b/src/Data/Bitmask.hs @@ -1,9 +1,9 @@ -module Data.Bitmask (foldFlags) where - -import Prelude hiding (foldl) - -import Data.Bits -import Data.Foldable - -foldFlags :: (Bits b, Foldable f, Num b) => (flag -> b) -> f flag -> b -foldFlags f = foldl (\a b -> a .|. f b) 0 +module Data.Bitmask (foldFlags) where + +import Prelude hiding (foldl) + +import Data.Bits +import Data.Foldable + +foldFlags :: (Bits b, Foldable f, Num b) => (flag -> b) -> f flag -> b +foldFlags f = foldl (\a b -> a .|. f b) 0 diff --git a/src/SDL.hs b/src/SDL.hs --- a/src/SDL.hs +++ b/src/SDL.hs @@ -58,7 +58,7 @@ main :: IO () main = do - 'initialize' ['InitEverything'] + 'initializeAll' @ Next, you can create a 'Window' by using 'createWindow' @@ -128,7 +128,7 @@ main :: IO () main = do - 'initialize' ['InitEverything'] + 'initializeAll' window <- 'createWindow' "My SDL Application" 'defaultWindow' renderer <- 'createRenderer' window (-1) 'defaultRenderer' appLoop renderer @@ -142,7 +142,7 @@ 'keyboardEventKeyMotion' keyboardEvent == 'Pressed' && 'keysymKeycode' ('keyboardEventKeysym' keyboardEvent) == 'KeycodeQ' _ -> False - qPressed = not (null (filter eventIsQPress events)) + qPressed = any eventIsQPress events 'rendererDrawColor' renderer '$=' V4 0 0 255 255 'clear' renderer 'present' renderer diff --git a/src/SDL/Audio.hs b/src/SDL/Audio.hs --- a/src/SDL/Audio.hs +++ b/src/SDL/Audio.hs @@ -1,447 +1,447 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-| - -"SDL.Audio" provides a high-level API to SDL's audio device capabilities. - --} - -module SDL.Audio - ( -- * Managing 'AudioDevice's - -- $audioDevice - AudioDevice - - -- ** Opening and Closing 'AudioDevice's - , openAudioDevice - , closeAudioDevice - , OpenDeviceSpec(..) - , AudioDeviceUsage(..) - , Channels(..) - , Changeable(..) - - -- ** Working with Opened Devices - -- *** Locking 'AudioDevice's - , setAudioDeviceLocked - , LockState(..) - - -- *** Switching Playback States - , PlaybackState(..) - , setAudioDevicePlaybackState - - -- *** Querying an 'AudioDevice's Status. - , AudioDeviceStatus(..) - , audioDeviceStatus - - -- ** 'AudioFormat' - , AudioFormat(..) - - -- ** Enumerating 'AudioDevice's - , getAudioDeviceNames - - -- * 'AudioSpec' - , AudioSpec - , audioSpecFreq - , audioSpecFormat - , audioSpecChannels - , audioSpecSilence - , audioSpecSize - , audioSpecCallback - - -- * Audio Drivers - , getAudioDrivers - , currentAudioDriver - , AudioDriver - , audioDriverName - - -- * Explicit Initialization - , audioInit - ) where - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bits -import Data.Data (Data) -import Data.IORef (newIORef, writeIORef, readIORef) -import Data.Int (Int8, Int16, Int32) -import Data.Text (Text) -import Data.Traversable (for) -import Data.Typeable -import Data.Word -import Foreign.C.Types -import Foreign.ForeignPtr -import Foreign.Marshal.Alloc -import Foreign.Marshal.Utils -import Foreign.Ptr -import Foreign.Storable -import GHC.Exts (Constraint) -import GHC.Generics (Generic) -import SDL.Exception -import qualified Data.ByteString as BS -import qualified Data.Text.Encoding as Text -import qualified Data.Vector as V -import qualified Data.Vector.Storable.Mutable as MV -import qualified SDL.Raw.Audio as Raw -import qualified SDL.Raw.Enum as Raw -import qualified SDL.Raw.Types as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Foldable (Foldable) -import Data.Traversable (Traversable) -#endif - -{- - -$audioDevice - -In order to produce sound, you must first open an 'AudioDevice'. To do so, -pass an 'OpenDeviceSpec' to 'openAudioDevice'. - --} - --- | A specification to 'openAudioDevice', indicating the desired output format. --- Note that many of these properties are 'Changeable', meaning that you can --- choose whether or not SDL should interpret your specification as an --- unbreakable request ('Mandate'), or as an approximation 'Desire'. -data OpenDeviceSpec = forall sampleType. OpenDeviceSpec - { openDeviceFreq :: !(Changeable CInt) - -- ^ The output audio frequency in herts. - , openDeviceFormat :: !(Changeable (AudioFormat sampleType)) - -- ^ The format of audio that will be sampled from the output buffer. - , openDeviceChannels :: !(Changeable Channels) - -- ^ The amount of audio channels. - , openDeviceSamples :: !Word16 - -- ^ Output audio buffer size in samples. This should be a power of 2. - , openDeviceCallback :: forall actualSampleType. AudioFormat actualSampleType -> MV.IOVector actualSampleType -> IO () - -- ^ A callback to invoke whenever new sample data is required. The callback - -- will be passed a single 'MV.MVector' that must be filled with audio data. - , openDeviceUsage :: !AudioDeviceUsage - -- ^ How you intend to use the opened 'AudioDevice' - either for outputting - -- or capturing audio. - , openDeviceName :: !(Maybe Text) - -- ^ The name of the 'AudioDevice' that should be opened. If 'Nothing', - -- any suitable 'AudioDevice' will be used. - } deriving (Typeable) - --- | Attempt to open the closest matching 'AudioDevice', as specified by the --- given 'OpenDeviceSpec'. --- --- See @@ for C documentation. -openAudioDevice :: MonadIO m => OpenDeviceSpec -> m (AudioDevice, AudioSpec) -openAudioDevice OpenDeviceSpec{..} = liftIO $ - maybeWith (BS.useAsCString . Text.encodeUtf8) openDeviceName $ \cDevName -> do - anAudioFormatRef <- newIORef undefined - cb <- Raw.mkAudioCallback $ \_ buffer len -> do - fp <- newForeignPtr_ buffer - anAudioFormat <- readIORef anAudioFormatRef - case anAudioFormat of - AnAudioFormat audioFormat -> - case audioFormatStorable audioFormat of - Dict -> openDeviceCallback audioFormat - (MV.unsafeCast (MV.unsafeFromForeignPtr0 fp (fromIntegral len))) - with (desiredSpec cb) $ \desiredSpecPtr -> - alloca $ \actualSpecPtr -> do - devId <- throwIf0 "SDL.Audio.openAudioDevice" "SDL_OpenAudioDevice" $ - Raw.openAudioDevice cDevName (encodeUsage openDeviceUsage) desiredSpecPtr actualSpecPtr changes - actual <- peek actualSpecPtr - let audioDevice = AudioDevice devId - anAudioFormat = decodeAudioFormat (Raw.audioSpecFormat actual) - spec = - case anAudioFormat of - AnAudioFormat audioFormat -> - AudioSpec { audioSpecFreq = Raw.audioSpecFreq actual - , audioSpecFormat = audioFormat - , audioSpecChannels = fromC "SDL.Audio.openAudioDevice" "audioSpecChannels" readChannels (Raw.audioSpecChannels actual) - , audioSpecSilence = Raw.audioSpecSilence actual - , audioSpecSize = Raw.audioSpecSize actual - , audioSpecSamples = Raw.audioSpecSamples actual - , audioSpecCallback = openDeviceCallback - } - writeIORef anAudioFormatRef anAudioFormat - return (audioDevice, spec) - - where - changes = foldl (.|.) 0 [ foldChangeable (const Raw.SDL_AUDIO_ALLOW_FREQUENCY_CHANGE) (const 0) openDeviceFreq - , foldChangeable (const Raw.SDL_AUDIO_ALLOW_FORMAT_CHANGE) (const 0) openDeviceFormat - , foldChangeable (const Raw.SDL_AUDIO_ALLOW_CHANNELS_CHANGE) (const 0) openDeviceChannels - ] - - channelsToWord8 Mono = 1 - channelsToWord8 Stereo = 2 - channelsToWord8 Quad = 4 - channelsToWord8 FivePointOne = 6 - - readChannels 1 = Just Mono - readChannels 2 = Just Stereo - readChannels 4 = Just Quad - readChannels 6 = Just FivePointOne - readChannels _ = Nothing - - desiredSpec cb = Raw.AudioSpec - { Raw.audioSpecFreq = unpackChangeable openDeviceFreq - , Raw.audioSpecFormat = encodeAudioFormat (unpackChangeable openDeviceFormat) - , Raw.audioSpecChannels = channelsToWord8 (unpackChangeable openDeviceChannels) - , Raw.audioSpecSilence = 0 - , Raw.audioSpecSize = 0 - , Raw.audioSpecSamples = openDeviceSamples - , Raw.audioSpecCallback = cb - , Raw.audioSpecUserdata = nullPtr - } - - -- Witness the 'Storable' instance for the sample type of any audio format. Needed in order to use 'MV.unsafeCast' - audioFormatStorable :: AudioFormat sampleType -> Dict (Storable sampleType) - audioFormatStorable Signed8BitAudio = Dict - audioFormatStorable Unsigned8BitAudio = Dict - audioFormatStorable Signed16BitLEAudio = Dict - audioFormatStorable Signed16BitBEAudio = Dict - audioFormatStorable Signed16BitNativeAudio = Dict - audioFormatStorable Unsigned16BitLEAudio = Dict - audioFormatStorable Unsigned16BitBEAudio = Dict - audioFormatStorable Unsigned16BitNativeAudio = Dict - audioFormatStorable Signed32BitLEAudio = Dict - audioFormatStorable Signed32BitBEAudio = Dict - audioFormatStorable Signed32BitNativeAudio = Dict - audioFormatStorable FloatingLEAudio = Dict - audioFormatStorable FloatingBEAudio = Dict - audioFormatStorable FloatingNativeAudio = Dict - -data Dict :: Constraint -> * where - Dict :: c => Dict c - --- | --- --- See @@ for C documentation. -closeAudioDevice :: MonadIO m => AudioDevice -> m () -closeAudioDevice (AudioDevice d) = Raw.closeAudioDevice d - --- | An open audio device. These can be created via 'openAudioDevice' and should be closed with 'closeAudioDevice' -newtype AudioDevice = AudioDevice (Raw.AudioDeviceID) - deriving (Eq, Typeable) - --- | Enumerate all 'AudioDevice's attached to this system, that can be used as --- specified by the given 'AudioDeviceUsage'. SDL cannot always guarantee --- that this list can be produced, in which case 'Nothing' will be returned. -getAudioDeviceNames :: MonadIO m => AudioDeviceUsage -> m (Maybe (V.Vector Text)) -getAudioDeviceNames usage = liftIO $ do - n <- Raw.getNumAudioDevices usage' - if n == -1 - then return Nothing - else fmap (Just . V.fromList) $ - for [0 .. (n - 1)] $ \i -> do - cstr <- throwIfNull "SDL.Audio.getAudioDeviceNames" "SDL_GetAudioDeviceName" $ - Raw.getAudioDeviceName i usage' - Text.decodeUtf8 <$> BS.packCString cstr - - where usage' = encodeUsage usage - --- | Information about what format an audio bytestream is. The type variable --- @t@ indicates the type used for audio buffer samples. It is determined --- by the choice of the provided 'SampleBitSize'. For example: --- --- @AudioFormat UnsignedInteger Sample8Bit Native :: AudioFormat Word8@ --- --- Indicating that an 8-bit audio format in the platforms native endianness --- uses a buffer of 'Word8' values. -data AudioFormat sampleType where - Signed8BitAudio :: AudioFormat Int8 - Unsigned8BitAudio :: AudioFormat Word8 - Signed16BitLEAudio :: AudioFormat Int16 - Signed16BitBEAudio :: AudioFormat Int16 - Signed16BitNativeAudio :: AudioFormat Int16 - Unsigned16BitLEAudio :: AudioFormat Word16 - Unsigned16BitBEAudio :: AudioFormat Word16 - Unsigned16BitNativeAudio :: AudioFormat Word16 - Signed32BitLEAudio :: AudioFormat Int32 - Signed32BitBEAudio :: AudioFormat Int32 - Signed32BitNativeAudio :: AudioFormat Int32 - FloatingLEAudio :: AudioFormat Float - FloatingBEAudio :: AudioFormat Float - FloatingNativeAudio :: AudioFormat Float - -deriving instance Eq (AudioFormat sampleType) -deriving instance Ord (AudioFormat sampleType) -deriving instance Show (AudioFormat sampleType) - -data AnAudioFormat where - AnAudioFormat :: AudioFormat sampleType -> AnAudioFormat - -encodeAudioFormat :: AudioFormat sampleType -> Word16 -encodeAudioFormat Signed8BitAudio = Raw.SDL_AUDIO_S8 -encodeAudioFormat Unsigned8BitAudio = Raw.SDL_AUDIO_U8 -encodeAudioFormat Signed16BitLEAudio = Raw.SDL_AUDIO_S16LSB -encodeAudioFormat Signed16BitBEAudio = Raw.SDL_AUDIO_S16MSB -encodeAudioFormat Signed16BitNativeAudio = Raw.SDL_AUDIO_S16SYS -encodeAudioFormat Unsigned16BitLEAudio = Raw.SDL_AUDIO_U16LSB -encodeAudioFormat Unsigned16BitBEAudio = Raw.SDL_AUDIO_U16MSB -encodeAudioFormat Unsigned16BitNativeAudio = Raw.SDL_AUDIO_U16SYS -encodeAudioFormat Signed32BitLEAudio = Raw.SDL_AUDIO_S32LSB -encodeAudioFormat Signed32BitBEAudio = Raw.SDL_AUDIO_S32MSB -encodeAudioFormat Signed32BitNativeAudio = Raw.SDL_AUDIO_S32SYS -encodeAudioFormat FloatingLEAudio = Raw.SDL_AUDIO_F32LSB -encodeAudioFormat FloatingBEAudio = Raw.SDL_AUDIO_F32MSB -encodeAudioFormat FloatingNativeAudio = Raw.SDL_AUDIO_F32SYS - -decodeAudioFormat :: Word16 -> AnAudioFormat -decodeAudioFormat Raw.SDL_AUDIO_S8 = AnAudioFormat Signed8BitAudio -decodeAudioFormat Raw.SDL_AUDIO_U8 = AnAudioFormat Unsigned8BitAudio -decodeAudioFormat Raw.SDL_AUDIO_S16LSB = AnAudioFormat Signed16BitLEAudio -decodeAudioFormat Raw.SDL_AUDIO_S16MSB = AnAudioFormat Signed16BitBEAudio -decodeAudioFormat Raw.SDL_AUDIO_S16SYS = AnAudioFormat Signed16BitNativeAudio -decodeAudioFormat Raw.SDL_AUDIO_U16LSB = AnAudioFormat Unsigned16BitLEAudio -decodeAudioFormat Raw.SDL_AUDIO_U16MSB = AnAudioFormat Unsigned16BitBEAudio -decodeAudioFormat Raw.SDL_AUDIO_U16SYS = AnAudioFormat Unsigned16BitNativeAudio -decodeAudioFormat Raw.SDL_AUDIO_S32LSB = AnAudioFormat Signed32BitLEAudio -decodeAudioFormat Raw.SDL_AUDIO_S32MSB = AnAudioFormat Signed32BitBEAudio -decodeAudioFormat Raw.SDL_AUDIO_S32SYS = AnAudioFormat Signed32BitNativeAudio -decodeAudioFormat Raw.SDL_AUDIO_F32LSB = AnAudioFormat FloatingLEAudio -decodeAudioFormat Raw.SDL_AUDIO_F32MSB = AnAudioFormat FloatingBEAudio -decodeAudioFormat Raw.SDL_AUDIO_F32SYS = AnAudioFormat FloatingNativeAudio -decodeAudioFormat x = error ("decodeAudioFormat failed: Unknown format " ++ show x) - --- | How many channels audio should be played on -data Channels - = Mono -- ^ A single speaker configuration - | Stereo -- ^ A traditional left/right stereo system - | Quad - | FivePointOne -- ^ 5.1 surround sound - deriving (Bounded,Data,Enum,Eq,Generic,Ord,Read,Show,Typeable) - --- | 'AudioSpec' is the concrete specification of how an 'AudioDevice' was --- sucessfully opened. Unlike 'OpenDeviceSpec', which specifies what you --- /want/, 'AudioSpec' specifies what you /have/. -data AudioSpec = forall sampleType. AudioSpec - { audioSpecFreq :: !CInt - -- ^ DSP frequency (samples per second) - , audioSpecFormat :: !(AudioFormat sampleType) - -- ^ Audio data format - , audioSpecChannels :: !Channels - -- ^ Number of separate sound channels - , audioSpecSilence :: !Word8 - -- ^ Calculated udio buffer silence value - , audioSpecSamples :: !Word16 - -- ^ Audio buffer size in samples (power of 2) - , audioSpecSize :: !Word32 - -- ^ Calculated audio buffer size in bytes - , audioSpecCallback :: AudioFormat sampleType -> MV.IOVector sampleType -> IO () - -- ^ The function to call when the audio device needs more data - } - deriving (Typeable) - --- | How you intend to use an 'AudioDevice' -data AudioDeviceUsage - = ForPlayback -- ^ The device will be used for sample playback. - | ForCapture -- ^ The device will be used for sample capture. - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - -encodeUsage :: Num a => AudioDeviceUsage -> a -encodeUsage usage = - case usage of - ForPlayback -> 0 - ForCapture -> 1 - --- | Used to indicate to SDL whether it is allowed to open other audio devices (if a property is marked as a 'Desire') or if it should fail if the device is unavailable ('Mandate'). -data Changeable a - = Mandate !a - -- ^ 'Mandate' this exact property value, and fail if a matching audio device cannot be found. - | Desire !a - -- ^ 'Desire' this property value, but allow other audio devices to be opened. - deriving (Data, Foldable, Functor, Eq, Generic, Read, Show, Traversable, Typeable) - -foldChangeable :: (a -> b) -> (a -> b) -> Changeable a -> b -foldChangeable f _ (Mandate a) = f a -foldChangeable _ g (Desire a) = g a - -unpackChangeable :: Changeable a -> a -unpackChangeable = foldChangeable id id - --- | Whether a device should be locked or unlocked. -data LockState - = Locked -- ^ Lock the device, preventing the callback from producing data. - | Unlocked -- ^ Unlock the device, resuming calls to the callback. - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | Lock an 'AudioDevice' such that its associated callback will not be called --- until the device is unlocked. -setAudioDeviceLocked :: MonadIO m => AudioDevice -> LockState -> m () -setAudioDeviceLocked (AudioDevice d) Locked = Raw.lockAudioDevice d -setAudioDeviceLocked (AudioDevice d) Unlocked = Raw.unlockAudioDevice d - --- | Whether to allow an 'AudioDevice' to play sound or remain paused. -data PlaybackState - = Pause -- ^ Pause the 'AudioDevice', which will stop producing/capturing audio. - | Play -- ^ Resume the 'AudioDevice'. - deriving (Bounded, Enum, Eq, Ord, Read, Data, Generic, Show, Typeable) - --- | Change the playback state of an 'AudioDevice'. -setAudioDevicePlaybackState :: MonadIO m => AudioDevice -> PlaybackState -> m () -setAudioDevicePlaybackState (AudioDevice d) Pause = Raw.pauseAudioDevice d 1 -setAudioDevicePlaybackState (AudioDevice d) Play = Raw.pauseAudioDevice d 0 - --- | Opened devices are always 'Playing' or 'Paused' in normal circumstances. A --- failing device may change its status to 'Stopped' at any time, and closing a --- device will progress to 'Stopped' too. -data AudioDeviceStatus - = Playing -- ^ The 'AudioDevice' is playing. - | Paused -- ^ The 'AudioDevice' is paused. - | Stopped -- ^ The 'AudioDevice' is stopped. - deriving (Bounded, Enum, Eq, Ord, Read, Data, Generic, Show, Typeable) - --- | Query the state of an 'AudioDevice'. -audioDeviceStatus :: MonadIO m => AudioDevice -> m AudioDeviceStatus -audioDeviceStatus (AudioDevice d) = liftIO $ - fromC "SDL.Audio.audioDeviceStatus" "SDL_AudioStatus" readStatus <$> Raw.getAudioDeviceStatus d - where - readStatus n = case n of - Raw.SDL_AUDIO_PLAYING -> Just Playing - Raw.SDL_AUDIO_STOPPED -> Just Stopped - Raw.SDL_AUDIO_PAUSED -> Just Paused - _ -> Nothing - --- clearQueuedAudio :: AudioDevice -> IO () --- clearQueuedAudio (AudioDevice d) = Raw.clearQueuedAudio d - --- | An abstract description of an audio driver on the host machine. -newtype AudioDriver = AudioDriver Text - deriving (Eq, Show, Typeable) - --- | Get the human readable name of an 'AudioDriver' -audioDriverName :: AudioDriver -> Text -audioDriverName (AudioDriver t) = t - --- | Obtain a list of all possible audio drivers for this system. These drivers --- can be used to specificially initialize the audio system. -getAudioDrivers :: MonadIO m => m (V.Vector AudioDriver) -getAudioDrivers = liftIO $ do - n <- Raw.getNumAudioDrivers - fmap V.fromList $ - for [0 .. (n - 1)] $ \i -> do - -- TODO This could return null if i is invalid, but it's not an SDL_Error. - cstr <- Raw.getAudioDriver i - AudioDriver . Text.decodeUtf8 <$> BS.packCString cstr - --- | Explicitly initialize the audio system against a specific --- 'AudioDriver'. Note that most users will not need to do this, as the normal --- initialization routines will already take care of this for you. -audioInit :: MonadIO m => AudioDriver -> m () -audioInit (AudioDriver n) = liftIO $ BS.useAsCString (Text.encodeUtf8 n) $ - throwIfNeg_ "SDL.Audio.audioInit" "SDL_AudioInit" . Raw.audioInit - --- | Query SDL for the name of the currently initialized audio driver, if --- possible. This will return 'Nothing' if no driver has been initialized. -currentAudioDriver :: MonadIO m => m (Maybe Text) -currentAudioDriver = - liftIO $ maybePeek (fmap Text.decodeUtf8 . BS.packCString) =<< Raw.getCurrentAudioDriver +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-| + +"SDL.Audio" provides a high-level API to SDL's audio device capabilities. + +-} + +module SDL.Audio + ( -- * Managing 'AudioDevice's + -- $audioDevice + AudioDevice + + -- ** Opening and Closing 'AudioDevice's + , openAudioDevice + , closeAudioDevice + , OpenDeviceSpec(..) + , AudioDeviceUsage(..) + , Channels(..) + , Changeable(..) + + -- ** Working with Opened Devices + -- *** Locking 'AudioDevice's + , setAudioDeviceLocked + , LockState(..) + + -- *** Switching Playback States + , PlaybackState(..) + , setAudioDevicePlaybackState + + -- *** Querying an 'AudioDevice's Status. + , AudioDeviceStatus(..) + , audioDeviceStatus + + -- ** 'AudioFormat' + , AudioFormat(..) + + -- ** Enumerating 'AudioDevice's + , getAudioDeviceNames + + -- * 'AudioSpec' + , AudioSpec + , audioSpecFreq + , audioSpecFormat + , audioSpecChannels + , audioSpecSilence + , audioSpecSize + , audioSpecCallback + + -- * Audio Drivers + , getAudioDrivers + , currentAudioDriver + , AudioDriver + , audioDriverName + + -- * Explicit Initialization + , audioInit + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bits +import Data.Data (Data) +import Data.IORef (newIORef, writeIORef, readIORef) +import Data.Int (Int8, Int16, Int32) +import Data.Text (Text) +import Data.Traversable (for) +import Data.Typeable +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.Storable +import GHC.Exts (Constraint) +import GHC.Generics (Generic) +import SDL.Exception +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as Text +import qualified Data.Vector as V +import qualified Data.Vector.Storable.Mutable as MV +import qualified SDL.Raw.Audio as Raw +import qualified SDL.Raw.Enum as Raw +import qualified SDL.Raw.Types as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Foldable (Foldable) +import Data.Traversable (Traversable) +#endif + +{- + +$audioDevice + +In order to produce sound, you must first open an 'AudioDevice'. To do so, +pass an 'OpenDeviceSpec' to 'openAudioDevice'. + +-} + +-- | A specification to 'openAudioDevice', indicating the desired output format. +-- Note that many of these properties are 'Changeable', meaning that you can +-- choose whether or not SDL should interpret your specification as an +-- unbreakable request ('Mandate'), or as an approximation 'Desire'. +data OpenDeviceSpec = forall sampleType. OpenDeviceSpec + { openDeviceFreq :: !(Changeable CInt) + -- ^ The output audio frequency in herts. + , openDeviceFormat :: !(Changeable (AudioFormat sampleType)) + -- ^ The format of audio that will be sampled from the output buffer. + , openDeviceChannels :: !(Changeable Channels) + -- ^ The amount of audio channels. + , openDeviceSamples :: !Word16 + -- ^ Output audio buffer size in samples. This should be a power of 2. + , openDeviceCallback :: forall actualSampleType. AudioFormat actualSampleType -> MV.IOVector actualSampleType -> IO () + -- ^ A callback to invoke whenever new sample data is required. The callback + -- will be passed a single 'MV.MVector' that must be filled with audio data. + , openDeviceUsage :: !AudioDeviceUsage + -- ^ How you intend to use the opened 'AudioDevice' - either for outputting + -- or capturing audio. + , openDeviceName :: !(Maybe Text) + -- ^ The name of the 'AudioDevice' that should be opened. If 'Nothing', + -- any suitable 'AudioDevice' will be used. + } deriving (Typeable) + +-- | Attempt to open the closest matching 'AudioDevice', as specified by the +-- given 'OpenDeviceSpec'. +-- +-- See @@ for C documentation. +openAudioDevice :: MonadIO m => OpenDeviceSpec -> m (AudioDevice, AudioSpec) +openAudioDevice OpenDeviceSpec{..} = liftIO $ + maybeWith (BS.useAsCString . Text.encodeUtf8) openDeviceName $ \cDevName -> do + anAudioFormatRef <- newIORef undefined + cb <- Raw.mkAudioCallback $ \_ buffer len -> do + fp <- newForeignPtr_ buffer + anAudioFormat <- readIORef anAudioFormatRef + case anAudioFormat of + AnAudioFormat audioFormat -> + case audioFormatStorable audioFormat of + Dict -> openDeviceCallback audioFormat + (MV.unsafeCast (MV.unsafeFromForeignPtr0 fp (fromIntegral len))) + with (desiredSpec cb) $ \desiredSpecPtr -> + alloca $ \actualSpecPtr -> do + devId <- throwIf0 "SDL.Audio.openAudioDevice" "SDL_OpenAudioDevice" $ + Raw.openAudioDevice cDevName (encodeUsage openDeviceUsage) desiredSpecPtr actualSpecPtr changes + actual <- peek actualSpecPtr + let audioDevice = AudioDevice devId + anAudioFormat = decodeAudioFormat (Raw.audioSpecFormat actual) + spec = + case anAudioFormat of + AnAudioFormat audioFormat -> + AudioSpec { audioSpecFreq = Raw.audioSpecFreq actual + , audioSpecFormat = audioFormat + , audioSpecChannels = fromC "SDL.Audio.openAudioDevice" "audioSpecChannels" readChannels (Raw.audioSpecChannels actual) + , audioSpecSilence = Raw.audioSpecSilence actual + , audioSpecSize = Raw.audioSpecSize actual + , audioSpecSamples = Raw.audioSpecSamples actual + , audioSpecCallback = openDeviceCallback + } + writeIORef anAudioFormatRef anAudioFormat + return (audioDevice, spec) + + where + changes = foldl (.|.) 0 [ foldChangeable (const Raw.SDL_AUDIO_ALLOW_FREQUENCY_CHANGE) (const 0) openDeviceFreq + , foldChangeable (const Raw.SDL_AUDIO_ALLOW_FORMAT_CHANGE) (const 0) openDeviceFormat + , foldChangeable (const Raw.SDL_AUDIO_ALLOW_CHANNELS_CHANGE) (const 0) openDeviceChannels + ] + + channelsToWord8 Mono = 1 + channelsToWord8 Stereo = 2 + channelsToWord8 Quad = 4 + channelsToWord8 FivePointOne = 6 + + readChannels 1 = Just Mono + readChannels 2 = Just Stereo + readChannels 4 = Just Quad + readChannels 6 = Just FivePointOne + readChannels _ = Nothing + + desiredSpec cb = Raw.AudioSpec + { Raw.audioSpecFreq = unpackChangeable openDeviceFreq + , Raw.audioSpecFormat = encodeAudioFormat (unpackChangeable openDeviceFormat) + , Raw.audioSpecChannels = channelsToWord8 (unpackChangeable openDeviceChannels) + , Raw.audioSpecSilence = 0 + , Raw.audioSpecSize = 0 + , Raw.audioSpecSamples = openDeviceSamples + , Raw.audioSpecCallback = cb + , Raw.audioSpecUserdata = nullPtr + } + + -- Witness the 'Storable' instance for the sample type of any audio format. Needed in order to use 'MV.unsafeCast' + audioFormatStorable :: AudioFormat sampleType -> Dict (Storable sampleType) + audioFormatStorable Signed8BitAudio = Dict + audioFormatStorable Unsigned8BitAudio = Dict + audioFormatStorable Signed16BitLEAudio = Dict + audioFormatStorable Signed16BitBEAudio = Dict + audioFormatStorable Signed16BitNativeAudio = Dict + audioFormatStorable Unsigned16BitLEAudio = Dict + audioFormatStorable Unsigned16BitBEAudio = Dict + audioFormatStorable Unsigned16BitNativeAudio = Dict + audioFormatStorable Signed32BitLEAudio = Dict + audioFormatStorable Signed32BitBEAudio = Dict + audioFormatStorable Signed32BitNativeAudio = Dict + audioFormatStorable FloatingLEAudio = Dict + audioFormatStorable FloatingBEAudio = Dict + audioFormatStorable FloatingNativeAudio = Dict + +data Dict :: Constraint -> * where + Dict :: c => Dict c + +-- | +-- +-- See @@ for C documentation. +closeAudioDevice :: MonadIO m => AudioDevice -> m () +closeAudioDevice (AudioDevice d) = Raw.closeAudioDevice d + +-- | An open audio device. These can be created via 'openAudioDevice' and should be closed with 'closeAudioDevice' +newtype AudioDevice = AudioDevice (Raw.AudioDeviceID) + deriving (Eq, Typeable) + +-- | Enumerate all 'AudioDevice's attached to this system, that can be used as +-- specified by the given 'AudioDeviceUsage'. SDL cannot always guarantee +-- that this list can be produced, in which case 'Nothing' will be returned. +getAudioDeviceNames :: MonadIO m => AudioDeviceUsage -> m (Maybe (V.Vector Text)) +getAudioDeviceNames usage = liftIO $ do + n <- Raw.getNumAudioDevices usage' + if n == -1 + then return Nothing + else fmap (Just . V.fromList) $ + for [0 .. (n - 1)] $ \i -> do + cstr <- throwIfNull "SDL.Audio.getAudioDeviceNames" "SDL_GetAudioDeviceName" $ + Raw.getAudioDeviceName i usage' + Text.decodeUtf8 <$> BS.packCString cstr + + where usage' = encodeUsage usage + +-- | Information about what format an audio bytestream is. The type variable +-- @t@ indicates the type used for audio buffer samples. It is determined +-- by the choice of the provided 'SampleBitSize'. For example: +-- +-- @AudioFormat UnsignedInteger Sample8Bit Native :: AudioFormat Word8@ +-- +-- Indicating that an 8-bit audio format in the platforms native endianness +-- uses a buffer of 'Word8' values. +data AudioFormat sampleType where + Signed8BitAudio :: AudioFormat Int8 + Unsigned8BitAudio :: AudioFormat Word8 + Signed16BitLEAudio :: AudioFormat Int16 + Signed16BitBEAudio :: AudioFormat Int16 + Signed16BitNativeAudio :: AudioFormat Int16 + Unsigned16BitLEAudio :: AudioFormat Word16 + Unsigned16BitBEAudio :: AudioFormat Word16 + Unsigned16BitNativeAudio :: AudioFormat Word16 + Signed32BitLEAudio :: AudioFormat Int32 + Signed32BitBEAudio :: AudioFormat Int32 + Signed32BitNativeAudio :: AudioFormat Int32 + FloatingLEAudio :: AudioFormat Float + FloatingBEAudio :: AudioFormat Float + FloatingNativeAudio :: AudioFormat Float + +deriving instance Eq (AudioFormat sampleType) +deriving instance Ord (AudioFormat sampleType) +deriving instance Show (AudioFormat sampleType) + +data AnAudioFormat where + AnAudioFormat :: AudioFormat sampleType -> AnAudioFormat + +encodeAudioFormat :: AudioFormat sampleType -> Word16 +encodeAudioFormat Signed8BitAudio = Raw.SDL_AUDIO_S8 +encodeAudioFormat Unsigned8BitAudio = Raw.SDL_AUDIO_U8 +encodeAudioFormat Signed16BitLEAudio = Raw.SDL_AUDIO_S16LSB +encodeAudioFormat Signed16BitBEAudio = Raw.SDL_AUDIO_S16MSB +encodeAudioFormat Signed16BitNativeAudio = Raw.SDL_AUDIO_S16SYS +encodeAudioFormat Unsigned16BitLEAudio = Raw.SDL_AUDIO_U16LSB +encodeAudioFormat Unsigned16BitBEAudio = Raw.SDL_AUDIO_U16MSB +encodeAudioFormat Unsigned16BitNativeAudio = Raw.SDL_AUDIO_U16SYS +encodeAudioFormat Signed32BitLEAudio = Raw.SDL_AUDIO_S32LSB +encodeAudioFormat Signed32BitBEAudio = Raw.SDL_AUDIO_S32MSB +encodeAudioFormat Signed32BitNativeAudio = Raw.SDL_AUDIO_S32SYS +encodeAudioFormat FloatingLEAudio = Raw.SDL_AUDIO_F32LSB +encodeAudioFormat FloatingBEAudio = Raw.SDL_AUDIO_F32MSB +encodeAudioFormat FloatingNativeAudio = Raw.SDL_AUDIO_F32SYS + +decodeAudioFormat :: Word16 -> AnAudioFormat +decodeAudioFormat Raw.SDL_AUDIO_S8 = AnAudioFormat Signed8BitAudio +decodeAudioFormat Raw.SDL_AUDIO_U8 = AnAudioFormat Unsigned8BitAudio +decodeAudioFormat Raw.SDL_AUDIO_S16LSB = AnAudioFormat Signed16BitLEAudio +decodeAudioFormat Raw.SDL_AUDIO_S16MSB = AnAudioFormat Signed16BitBEAudio +decodeAudioFormat Raw.SDL_AUDIO_S16SYS = AnAudioFormat Signed16BitNativeAudio +decodeAudioFormat Raw.SDL_AUDIO_U16LSB = AnAudioFormat Unsigned16BitLEAudio +decodeAudioFormat Raw.SDL_AUDIO_U16MSB = AnAudioFormat Unsigned16BitBEAudio +decodeAudioFormat Raw.SDL_AUDIO_U16SYS = AnAudioFormat Unsigned16BitNativeAudio +decodeAudioFormat Raw.SDL_AUDIO_S32LSB = AnAudioFormat Signed32BitLEAudio +decodeAudioFormat Raw.SDL_AUDIO_S32MSB = AnAudioFormat Signed32BitBEAudio +decodeAudioFormat Raw.SDL_AUDIO_S32SYS = AnAudioFormat Signed32BitNativeAudio +decodeAudioFormat Raw.SDL_AUDIO_F32LSB = AnAudioFormat FloatingLEAudio +decodeAudioFormat Raw.SDL_AUDIO_F32MSB = AnAudioFormat FloatingBEAudio +decodeAudioFormat Raw.SDL_AUDIO_F32SYS = AnAudioFormat FloatingNativeAudio +decodeAudioFormat x = error ("decodeAudioFormat failed: Unknown format " ++ show x) + +-- | How many channels audio should be played on +data Channels + = Mono -- ^ A single speaker configuration + | Stereo -- ^ A traditional left/right stereo system + | Quad + | FivePointOne -- ^ 5.1 surround sound + deriving (Bounded,Data,Enum,Eq,Generic,Ord,Read,Show,Typeable) + +-- | 'AudioSpec' is the concrete specification of how an 'AudioDevice' was +-- sucessfully opened. Unlike 'OpenDeviceSpec', which specifies what you +-- /want/, 'AudioSpec' specifies what you /have/. +data AudioSpec = forall sampleType. AudioSpec + { audioSpecFreq :: !CInt + -- ^ DSP frequency (samples per second) + , audioSpecFormat :: !(AudioFormat sampleType) + -- ^ Audio data format + , audioSpecChannels :: !Channels + -- ^ Number of separate sound channels + , audioSpecSilence :: !Word8 + -- ^ Calculated udio buffer silence value + , audioSpecSamples :: !Word16 + -- ^ Audio buffer size in samples (power of 2) + , audioSpecSize :: !Word32 + -- ^ Calculated audio buffer size in bytes + , audioSpecCallback :: AudioFormat sampleType -> MV.IOVector sampleType -> IO () + -- ^ The function to call when the audio device needs more data + } + deriving (Typeable) + +-- | How you intend to use an 'AudioDevice' +data AudioDeviceUsage + = ForPlayback -- ^ The device will be used for sample playback. + | ForCapture -- ^ The device will be used for sample capture. + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +encodeUsage :: Num a => AudioDeviceUsage -> a +encodeUsage usage = + case usage of + ForPlayback -> 0 + ForCapture -> 1 + +-- | Used to indicate to SDL whether it is allowed to open other audio devices (if a property is marked as a 'Desire') or if it should fail if the device is unavailable ('Mandate'). +data Changeable a + = Mandate !a + -- ^ 'Mandate' this exact property value, and fail if a matching audio device cannot be found. + | Desire !a + -- ^ 'Desire' this property value, but allow other audio devices to be opened. + deriving (Data, Foldable, Functor, Eq, Generic, Read, Show, Traversable, Typeable) + +foldChangeable :: (a -> b) -> (a -> b) -> Changeable a -> b +foldChangeable f _ (Mandate a) = f a +foldChangeable _ g (Desire a) = g a + +unpackChangeable :: Changeable a -> a +unpackChangeable = foldChangeable id id + +-- | Whether a device should be locked or unlocked. +data LockState + = Locked -- ^ Lock the device, preventing the callback from producing data. + | Unlocked -- ^ Unlock the device, resuming calls to the callback. + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | Lock an 'AudioDevice' such that its associated callback will not be called +-- until the device is unlocked. +setAudioDeviceLocked :: MonadIO m => AudioDevice -> LockState -> m () +setAudioDeviceLocked (AudioDevice d) Locked = Raw.lockAudioDevice d +setAudioDeviceLocked (AudioDevice d) Unlocked = Raw.unlockAudioDevice d + +-- | Whether to allow an 'AudioDevice' to play sound or remain paused. +data PlaybackState + = Pause -- ^ Pause the 'AudioDevice', which will stop producing/capturing audio. + | Play -- ^ Resume the 'AudioDevice'. + deriving (Bounded, Enum, Eq, Ord, Read, Data, Generic, Show, Typeable) + +-- | Change the playback state of an 'AudioDevice'. +setAudioDevicePlaybackState :: MonadIO m => AudioDevice -> PlaybackState -> m () +setAudioDevicePlaybackState (AudioDevice d) Pause = Raw.pauseAudioDevice d 1 +setAudioDevicePlaybackState (AudioDevice d) Play = Raw.pauseAudioDevice d 0 + +-- | Opened devices are always 'Playing' or 'Paused' in normal circumstances. A +-- failing device may change its status to 'Stopped' at any time, and closing a +-- device will progress to 'Stopped' too. +data AudioDeviceStatus + = Playing -- ^ The 'AudioDevice' is playing. + | Paused -- ^ The 'AudioDevice' is paused. + | Stopped -- ^ The 'AudioDevice' is stopped. + deriving (Bounded, Enum, Eq, Ord, Read, Data, Generic, Show, Typeable) + +-- | Query the state of an 'AudioDevice'. +audioDeviceStatus :: MonadIO m => AudioDevice -> m AudioDeviceStatus +audioDeviceStatus (AudioDevice d) = liftIO $ + fromC "SDL.Audio.audioDeviceStatus" "SDL_AudioStatus" readStatus <$> Raw.getAudioDeviceStatus d + where + readStatus n = case n of + Raw.SDL_AUDIO_PLAYING -> Just Playing + Raw.SDL_AUDIO_STOPPED -> Just Stopped + Raw.SDL_AUDIO_PAUSED -> Just Paused + _ -> Nothing + +-- clearQueuedAudio :: AudioDevice -> IO () +-- clearQueuedAudio (AudioDevice d) = Raw.clearQueuedAudio d + +-- | An abstract description of an audio driver on the host machine. +newtype AudioDriver = AudioDriver Text + deriving (Eq, Show, Typeable) + +-- | Get the human readable name of an 'AudioDriver' +audioDriverName :: AudioDriver -> Text +audioDriverName (AudioDriver t) = t + +-- | Obtain a list of all possible audio drivers for this system. These drivers +-- can be used to specificially initialize the audio system. +getAudioDrivers :: MonadIO m => m (V.Vector AudioDriver) +getAudioDrivers = liftIO $ do + n <- Raw.getNumAudioDrivers + fmap V.fromList $ + for [0 .. (n - 1)] $ \i -> do + -- TODO This could return null if i is invalid, but it's not an SDL_Error. + cstr <- Raw.getAudioDriver i + AudioDriver . Text.decodeUtf8 <$> BS.packCString cstr + +-- | Explicitly initialize the audio system against a specific +-- 'AudioDriver'. Note that most users will not need to do this, as the normal +-- initialization routines will already take care of this for you. +audioInit :: MonadIO m => AudioDriver -> m () +audioInit (AudioDriver n) = liftIO $ BS.useAsCString (Text.encodeUtf8 n) $ + throwIfNeg_ "SDL.Audio.audioInit" "SDL_AudioInit" . Raw.audioInit + +-- | Query SDL for the name of the currently initialized audio driver, if +-- possible. This will return 'Nothing' if no driver has been initialized. +currentAudioDriver :: MonadIO m => m (Maybe Text) +currentAudioDriver = + liftIO $ maybePeek (fmap Text.decodeUtf8 . BS.packCString) =<< Raw.getCurrentAudioDriver diff --git a/src/SDL/Event.hs b/src/SDL/Event.hs --- a/src/SDL/Event.hs +++ b/src/SDL/Event.hs @@ -1,731 +1,731 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} - --- | "SDL.Event" exports an interface for working with the SDL event model. Event handling allows your application to receive input from the user. Internally, SDL stores all the events waiting to be handled in an event queue. Using functions like 'pollEvent' and 'waitEvent' you can observe and handle waiting input events. --- --- The event queue itself is composed of a series of 'Event' values, one for each waiting event. 'Event' values are read from the queue with the 'pollEvent' function and it is then up to the application to process the information stored with them. -module SDL.Event - ( -- * Polling events - pollEvent - , pollEvents - , mapEvents - , pumpEvents - , waitEvent - , waitEventTimeout - -- * Event data - , Event(..) - , EventPayload(..) - -- ** Window events - , WindowShownEventData(..) - , WindowHiddenEventData(..) - , WindowExposedEventData(..) - , WindowMovedEventData(..) - , WindowResizedEventData(..) - , WindowSizeChangedEventData(..) - , WindowMinimizedEventData(..) - , WindowMaximizedEventData(..) - , WindowRestoredEventData(..) - , WindowGainedMouseFocusEventData(..) - , WindowLostMouseFocusEventData(..) - , WindowGainedKeyboardFocusEventData(..) - , WindowLostKeyboardFocusEventData(..) - , WindowClosedEventData(..) - , SysWMEventData(..) - -- ** Keyboard events - , KeyboardEventData(..) - , TextEditingEventData(..) - , TextInputEventData(..) - -- ** Mouse events - , MouseMotionEventData(..) - , MouseButtonEventData(..) - , MouseWheelEventData(..) - -- ** Joystick events - , JoyAxisEventData(..) - , JoyBallEventData(..) - , JoyHatEventData(..) - , JoyButtonEventData(..) - , JoyDeviceEventData(..) - -- ** Controller events - , ControllerAxisEventData(..) - , ControllerButtonEventData(..) - , ControllerDeviceEventData(..) - -- ** User events - , UserEventData(..) - -- ** Touch events - , TouchFingerEventData(..) - -- ** Gesture events - , MultiGestureEventData(..) - , DollarGestureEventData(..) - -- ** Drag and drop events - , DropEventData(..) - -- ** Clipboard events - , ClipboardUpdateEventData(..) - -- ** Unknown events - , UnknownEventData(..) - -- * Auxiliary event data - , InputMotion(..) - , MouseButton(..) - ) where - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Data (Data) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Data.Typeable -import Foreign -import Foreign.C -import GHC.Generics (Generic) -import Linear -import Linear.Affine (Point(P)) -import SDL.Input.Keyboard -import SDL.Input.Mouse -import SDL.Internal.Numbered -import SDL.Internal.Types (Window(Window)) -import qualified Data.ByteString.Char8 as BSC8 -import qualified Data.Text.Encoding as Text -import qualified SDL.Exception as SDLEx -import qualified SDL.Raw as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- | A single SDL event. This event occured at 'eventTimestamp' and carries data under 'eventPayload'. -data Event = Event - { eventTimestamp :: Word32 - -- ^ The time the event occured. - , eventPayload :: EventPayload - -- ^ Data pertaining to this event. - } deriving (Eq, Ord, Generic, Show, Typeable) - --- | An enumeration of all possible SDL event types. This data type pairs up event types with --- their payload, where possible. -data EventPayload - = WindowShownEvent WindowShownEventData - | WindowHiddenEvent WindowHiddenEventData - | WindowExposedEvent WindowExposedEventData - | WindowMovedEvent WindowMovedEventData - | WindowResizedEvent WindowResizedEventData - | WindowSizeChangedEvent WindowSizeChangedEventData - | WindowMinimizedEvent WindowMinimizedEventData - | WindowMaximizedEvent WindowMaximizedEventData - | WindowRestoredEvent WindowRestoredEventData - | WindowGainedMouseFocusEvent WindowGainedMouseFocusEventData - | WindowLostMouseFocusEvent WindowLostMouseFocusEventData - | WindowGainedKeyboardFocusEvent WindowGainedKeyboardFocusEventData - | WindowLostKeyboardFocusEvent WindowLostKeyboardFocusEventData - | WindowClosedEvent WindowClosedEventData - | KeyboardEvent KeyboardEventData - | TextEditingEvent TextEditingEventData - | TextInputEvent TextInputEventData - | MouseMotionEvent MouseMotionEventData - | MouseButtonEvent MouseButtonEventData - | MouseWheelEvent MouseWheelEventData - | JoyAxisEvent JoyAxisEventData - | JoyBallEvent JoyBallEventData - | JoyHatEvent JoyHatEventData - | JoyButtonEvent JoyButtonEventData - | JoyDeviceEvent JoyDeviceEventData - | ControllerAxisEvent ControllerAxisEventData - | ControllerButtonEvent ControllerButtonEventData - | ControllerDeviceEvent ControllerDeviceEventData - | QuitEvent - | UserEvent UserEventData - | SysWMEvent SysWMEventData - | TouchFingerEvent TouchFingerEventData - | MultiGestureEvent MultiGestureEventData - | DollarGestureEvent DollarGestureEventData - | DropEvent DropEventData - | ClipboardUpdateEvent ClipboardUpdateEventData - | UnknownEvent UnknownEventData - deriving (Eq, Ord, Generic, Show, Typeable) - --- | A window has been shown. -data WindowShownEventData = - WindowShownEventData {windowShownEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A window has been hidden. -data WindowHiddenEventData = - WindowHiddenEventData {windowHiddenEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A part of a window has been exposed - where exposure means to become visible (for example, an overlapping window no longer overlaps with the window). -data WindowExposedEventData = - WindowExposedEventData {windowExposedEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A 'Window' has been moved. -data WindowMovedEventData = - WindowMovedEventData {windowMovedEventWindow :: Window - -- ^ The associated 'Window'. - ,windowMovedEventPosition :: Point V2 Int32 - -- ^ The new position of the 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Window has been resized. This is event is always preceded by 'WindowSizeChangedEvent'. -data WindowResizedEventData = - WindowResizedEventData {windowResizedEventWindow :: Window - -- ^ The associated 'Window'. - ,windowResizedEventSize :: V2 Int32 - -- ^ The new size of the 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window size has changed, either as a result of an API call or through the system or user changing the window size; this event is followed by 'WindowResizedEvent' if the size was changed by an external event, i.e. the user or the window manager. -data WindowSizeChangedEventData = - WindowSizeChangedEventData {windowSizeChangedEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has been minimized. -data WindowMinimizedEventData = - WindowMinimizedEventData {windowMinimizedEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has been maximized. -data WindowMaximizedEventData = - WindowMaximizedEventData {windowMaximizedEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has been restored to normal size and position. -data WindowRestoredEventData = - WindowRestoredEventData {windowRestoredEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has gained mouse focus. -data WindowGainedMouseFocusEventData = - WindowGainedMouseFocusEventData {windowGainedMouseFocusEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has lost mouse focus. -data WindowLostMouseFocusEventData = - WindowLostMouseFocusEventData {windowLostMouseFocusEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has gained keyboard focus. -data WindowGainedKeyboardFocusEventData = - WindowGainedKeyboardFocusEventData {windowGainedKeyboardFocusEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window has lost keyboard focus. -data WindowLostKeyboardFocusEventData = - WindowLostKeyboardFocusEventData {windowLostKeyboardFocusEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The window manager requests that the window be closed. -data WindowClosedEventData = - WindowClosedEventData {windowClosedEventWindow :: Window - -- ^ The associated 'Window'. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A keyboard key has been pressed or released. -data KeyboardEventData = - KeyboardEventData {keyboardEventWindow :: Window - -- ^ The associated 'Window'. - ,keyboardEventKeyMotion :: InputMotion - -- ^ Whether the key was pressed or released. - ,keyboardEventRepeat :: Bool - -- ^ 'True' if this is a repeating key press from the user holding the key down. - ,keyboardEventKeysym :: Keysym - -- ^ A description of the key that this event pertains to. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Keyboard text editing event information. -data TextEditingEventData = - TextEditingEventData {textEditingEventWindow :: Window - -- ^ The associated 'Window'. - ,textEditingEventText :: Text - -- ^ The editing text. - ,textEditingEventStart :: Int32 - -- ^ The location to begin editing from. - ,textEditingEventLength :: Int32 - -- ^ The number of characters to edit from the start point. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Keyboard text input event information. -data TextInputEventData = - TextInputEventData {textInputEventWindow :: Window - -- ^ The associated 'Window'. - ,textInputEventText :: Text - -- ^ The input text. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A mouse or pointer device was moved. -data MouseMotionEventData = - MouseMotionEventData {mouseMotionEventWindow :: Window - -- ^ The associated 'Window'. - ,mouseMotionEventWhich :: MouseDevice - -- ^ The 'MouseDevice' that was moved. - ,mouseMotionEventState :: [MouseButton] - -- ^ A collection of 'MouseButton's that are currently held down. - ,mouseMotionEventPos :: Point V2 Int32 - -- ^ The new position of the mouse. - ,mouseMotionEventRelMotion :: V2 Int32 - -- ^ The relative mouse motion of the mouse. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A mouse or pointer device button was pressed or released. -data MouseButtonEventData = - MouseButtonEventData {mouseButtonEventWindow :: Window - -- ^ The associated 'Window'. - ,mouseButtonEventMotion :: InputMotion - -- ^ Whether the button was pressed or released. - ,mouseButtonEventWhich :: MouseDevice - -- ^ The 'MouseDevice' whose button was pressed or released. - ,mouseButtonEventButton :: MouseButton - -- ^ The button that was pressed or released. - ,mouseButtonEventClicks :: Word8 - -- ^ The amount of clicks. 1 for a single-click, 2 for a double-click, etc. - ,mouseButtonEventPos :: Point V2 Int32 - -- ^ The coordinates of the mouse click. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Mouse wheel event information. -data MouseWheelEventData = - MouseWheelEventData {mouseWheelEventWindow :: Window - -- ^ The associated 'Window'. - ,mouseWheelEventWhich :: MouseDevice - -- ^ The 'MouseDevice' whose wheel was scrolled. - ,mouseWheelEventPos :: V2 Int32 - -- ^ The amount scrolled. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Joystick axis motion event information -data JoyAxisEventData = - JoyAxisEventData {joyAxisEventWhich :: Raw.JoystickID - -- ^ The instance id of the joystick that reported the event. - ,joyAxisEventAxis :: Word8 - -- ^ The index of the axis that changed. - ,joyAxisEventValue :: Int16 - -- ^ The current position of the axis, ranging between -32768 and 32767. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Joystick trackball motion event information. -data JoyBallEventData = - JoyBallEventData {joyBallEventWhich :: Raw.JoystickID - -- ^ The instance id of the joystick that reported the event. - ,joyBallEventBall :: Word8 - -- ^ The index of the trackball that changed. - ,joyBallEventRelMotion :: V2 Int16 - -- ^ The relative motion of the trackball. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Joystick hat position change event information -data JoyHatEventData = - JoyHatEventData {joyHatEventWhich :: Raw.JoystickID - -- ^ The instance id of the joystick that reported the event. - ,joyHatEventHat :: Word8 - -- ^ The index of the hat that changed. - ,joyHatEventValue :: Word8 - -- ^ The new position of the hat. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Joystick button event information. -data JoyButtonEventData = - JoyButtonEventData {joyButtonEventWhich :: Raw.JoystickID - -- ^ The instance id of the joystick that reported the event. - ,joyButtonEventButton :: Word8 - -- ^ The index of the button that changed. - ,joyButtonEventState :: Word8 - -- ^ The state of the button. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Joystick device event information. -data JoyDeviceEventData = - JoyDeviceEventData {joyDeviceEventWhich :: Int32 - -- ^ The instance id of the joystick that reported the event. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Game controller axis motion event information. -data ControllerAxisEventData = - ControllerAxisEventData {controllerAxisEventWhich :: Raw.JoystickID - -- ^ The joystick instance ID that reported the event. - ,controllerAxisEventAxis :: Word8 - -- ^ The index of the axis. - ,controllerAxisEventValue :: Int16 - -- ^ The axis value ranging between -32768 and 32767. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Game controller button event information -data ControllerButtonEventData = - ControllerButtonEventData {controllerButtonEventWhich :: Raw.JoystickID - -- ^ The joystick instance ID that reported the event. - ,controllerButtonEventButton :: Word8 - -- ^ The controller button. - ,controllerButtonEventState :: Word8 - -- ^ The state of the button. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Controller device event information -data ControllerDeviceEventData = - ControllerDeviceEventData {controllerDeviceEventWhich :: Int32 - -- ^ The joystick instance ID that reported the event. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Event data for application-defined events. -data UserEventData = - UserEventData {userEventWindow :: Window - -- ^ The associated 'Window'. - ,userEventCode :: Int32 - -- ^ User defined event code. - ,userEventData1 :: Ptr () - -- ^ User defined data pointer. - ,userEventData2 :: Ptr () - -- ^ User defined data pointer. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | A video driver dependent system event -data SysWMEventData = - SysWMEventData {sysWMEventMsg :: Raw.SysWMmsg} - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Finger touch event information. -data TouchFingerEventData = - TouchFingerEventData {touchFingerEventTouchID :: Raw.TouchID - -- ^ The touch device index. - ,touchFingerEventFingerID :: Raw.FingerID - -- ^ The finger index. - ,touchFingerEventPos :: Point V2 CFloat - -- ^ The location of the touch event, normalized between 0 and 1. - ,touchFingerEventRelMotion :: V2 CFloat - -- ^ The distance moved, normalized between -1 and 1. - ,touchFingerEventPressure :: CFloat - -- ^ The quantity of the pressure applied, normalized between 0 and 1. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Multiple finger gesture event information -data MultiGestureEventData = - MultiGestureEventData {multiGestureEventTouchID :: Raw.TouchID - -- ^ The touch device index. - ,multiGestureEventDTheta :: CFloat - -- ^ The amount that the fingers rotated during this motion. - ,multiGestureEventDDist :: CFloat - -- ^ The amount that the fingers pinched during this motion. - ,multiGestureEventPos :: Point V2 CFloat - -- ^ The normalized center of the gesture. - ,multiGestureEventNumFingers :: Word16 - -- ^ The number of fingers used in this gesture. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | Complex gesture event information. -data DollarGestureEventData = - DollarGestureEventData {dollarGestureEventTouchID :: Raw.TouchID - -- ^ The touch device index. - ,dollarGestureEventGestureID :: Raw.GestureID - -- ^ The unique id of the closest gesture to the performed stroke. - ,dollarGestureEventNumFingers :: Word32 - -- ^ The number of fingers used to draw the stroke. - ,dollarGestureEventError :: CFloat - -- ^ The difference between the gesture template and the actual performed gesture (lower errors correspond to closer matches). - ,dollarGestureEventPos :: Point V2 CFloat - -- ^ The normalized center of the gesture. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | An event used to request a file open by the system -data DropEventData = - DropEventData {dropEventFile :: CString - -- ^ The file name. - } - deriving (Eq,Ord,Generic,Show,Typeable) - --- | The clipboard changed. -data ClipboardUpdateEventData = - ClipboardUpdateEventData - deriving (Eq,Ord,Generic,Show,Typeable) - --- | SDL reported an unknown event type. -data UnknownEventData = - UnknownEventData {unknownEventType :: Word32 - -- ^ The unknown event code. - } - deriving (Eq,Ord,Generic,Show,Typeable) - -data InputMotion = Released | Pressed - deriving (Bounded, Enum, Eq, Ord, Read, Data, Generic, Show, Typeable) - -ccharStringToText :: [CChar] -> Text -ccharStringToText = Text.decodeUtf8 . BSC8.pack . map castCCharToChar - -fromRawKeysym :: Raw.Keysym -> Keysym -fromRawKeysym (Raw.Keysym scancode keycode modifier) = - Keysym scancode' keycode' modifier' - where scancode' = fromNumber scancode - keycode' = fromNumber keycode - modifier' = fromNumber (fromIntegral modifier) - -convertRaw :: Raw.Event -> IO Event -convertRaw (Raw.WindowEvent t ts a b c d) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts - (case b of - Raw.SDL_WINDOWEVENT_SHOWN -> - WindowShownEvent (WindowShownEventData w') - Raw.SDL_WINDOWEVENT_HIDDEN -> - WindowHiddenEvent (WindowHiddenEventData w') - Raw.SDL_WINDOWEVENT_EXPOSED -> - WindowExposedEvent (WindowExposedEventData w') - Raw.SDL_WINDOWEVENT_MOVED -> - WindowMovedEvent - (WindowMovedEventData w' - (P (V2 c d))) - Raw.SDL_WINDOWEVENT_RESIZED -> - WindowResizedEvent - (WindowResizedEventData w' - (V2 c d)) - Raw.SDL_WINDOWEVENT_SIZE_CHANGED -> - WindowSizeChangedEvent (WindowSizeChangedEventData w') - Raw.SDL_WINDOWEVENT_MINIMIZED -> - WindowMinimizedEvent (WindowMinimizedEventData w') - Raw.SDL_WINDOWEVENT_MAXIMIZED -> - WindowMaximizedEvent (WindowMaximizedEventData w') - Raw.SDL_WINDOWEVENT_RESTORED -> - WindowRestoredEvent (WindowRestoredEventData w') - Raw.SDL_WINDOWEVENT_ENTER -> - WindowGainedMouseFocusEvent (WindowGainedMouseFocusEventData w') - Raw.SDL_WINDOWEVENT_LEAVE -> - WindowLostMouseFocusEvent (WindowLostMouseFocusEventData w') - Raw.SDL_WINDOWEVENT_FOCUS_GAINED -> - WindowGainedKeyboardFocusEvent (WindowGainedKeyboardFocusEventData w') - Raw.SDL_WINDOWEVENT_FOCUS_LOST -> - WindowLostKeyboardFocusEvent (WindowLostKeyboardFocusEventData w') - Raw.SDL_WINDOWEVENT_CLOSE -> - WindowClosedEvent (WindowClosedEventData w') - _ -> - UnknownEvent (UnknownEventData t))) -convertRaw (Raw.KeyboardEvent Raw.SDL_KEYDOWN ts a _ c d) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts - (KeyboardEvent - (KeyboardEventData w' - Pressed - (c /= 0) - (fromRawKeysym d)))) -convertRaw (Raw.KeyboardEvent Raw.SDL_KEYUP ts a _ c d) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts - (KeyboardEvent - (KeyboardEventData w' - Released - (c /= 0) - (fromRawKeysym d)))) -convertRaw (Raw.KeyboardEvent _ _ _ _ _ _) = error "convertRaw: Unknown keyboard motion" -convertRaw (Raw.TextEditingEvent _ ts a b c d) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts - (TextEditingEvent - (TextEditingEventData w' - (ccharStringToText b) - c - d))) -convertRaw (Raw.TextInputEvent _ ts a b) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts - (TextInputEvent - (TextInputEventData w' - (ccharStringToText b)))) -convertRaw (Raw.MouseMotionEvent _ ts a b c d e f g) = - do w' <- fmap Window (Raw.getWindowFromID a) - let buttons = - catMaybes [(Raw.SDL_BUTTON_LMASK `test` c) ButtonLeft - ,(Raw.SDL_BUTTON_RMASK `test` c) ButtonRight - ,(Raw.SDL_BUTTON_MMASK `test` c) ButtonMiddle - ,(Raw.SDL_BUTTON_X1MASK `test` c) ButtonX1 - ,(Raw.SDL_BUTTON_X2MASK `test` c) ButtonX2] - return (Event ts - (MouseMotionEvent - (MouseMotionEventData w' - (fromNumber b) - buttons - (P (V2 d e)) - (V2 f g)))) - where mask `test` x = - if mask .&. x /= 0 - then Just - else const Nothing -convertRaw (Raw.MouseButtonEvent t ts a b c _ e f g) = - do w' <- fmap Window (Raw.getWindowFromID a) - let motion - | t == Raw.SDL_MOUSEBUTTONUP = Released - | t == Raw.SDL_MOUSEBUTTONDOWN = Pressed - | otherwise = error "convertRaw: Unexpected mouse button motion" - button - | c == Raw.SDL_BUTTON_LEFT = ButtonLeft - | c == Raw.SDL_BUTTON_MIDDLE = ButtonMiddle - | c == Raw.SDL_BUTTON_RIGHT = ButtonRight - | c == Raw.SDL_BUTTON_X1 = ButtonX1 - | c == Raw.SDL_BUTTON_X2 = ButtonX2 - | otherwise = ButtonExtra $ fromIntegral c - return (Event ts - (MouseButtonEvent - (MouseButtonEventData w' - motion - (fromNumber b) - button - e - (P (V2 f g))))) -convertRaw (Raw.MouseWheelEvent _ ts a b c d) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts - (MouseWheelEvent - (MouseWheelEventData w' - (fromNumber b) - (V2 c d)))) -convertRaw (Raw.JoyAxisEvent _ ts a b c) = - return (Event ts (JoyAxisEvent (JoyAxisEventData a b c))) -convertRaw (Raw.JoyBallEvent _ ts a b c d) = - return (Event ts - (JoyBallEvent - (JoyBallEventData a - b - (V2 c d)))) -convertRaw (Raw.JoyHatEvent _ ts a b c) = - return (Event ts (JoyHatEvent (JoyHatEventData a b c))) -convertRaw (Raw.JoyButtonEvent _ ts a b c) = - return (Event ts (JoyButtonEvent (JoyButtonEventData a b c))) -convertRaw (Raw.JoyDeviceEvent _ ts a) = - return (Event ts (JoyDeviceEvent (JoyDeviceEventData a))) -convertRaw (Raw.ControllerAxisEvent _ ts a b c) = - return (Event ts (ControllerAxisEvent (ControllerAxisEventData a b c))) -convertRaw (Raw.ControllerButtonEvent _ ts a b c) = - return (Event ts (ControllerButtonEvent (ControllerButtonEventData a b c))) -convertRaw (Raw.ControllerDeviceEvent _ ts a) = - return (Event ts (ControllerDeviceEvent (ControllerDeviceEventData a))) -convertRaw (Raw.QuitEvent _ ts) = - return (Event ts QuitEvent) -convertRaw (Raw.UserEvent _ ts a b c d) = - do w' <- fmap Window (Raw.getWindowFromID a) - return (Event ts (UserEvent (UserEventData w' b c d))) -convertRaw (Raw.SysWMEvent _ ts a) = - return (Event ts (SysWMEvent (SysWMEventData a))) -convertRaw (Raw.TouchFingerEvent _ ts a b c d e f g) = - return (Event ts - (TouchFingerEvent - (TouchFingerEventData a - b - (P (V2 c d)) - (V2 e f) - g))) -convertRaw (Raw.MultiGestureEvent _ ts a b c d e f) = - return (Event ts - (MultiGestureEvent - (MultiGestureEventData a - b - c - (P (V2 d e)) - f))) -convertRaw (Raw.DollarGestureEvent _ ts a b c d e f) = - return (Event ts - (DollarGestureEvent - (DollarGestureEventData a - b - c - d - (P (V2 e f))))) -convertRaw (Raw.DropEvent _ ts a) = - return (Event ts (DropEvent (DropEventData a))) -convertRaw (Raw.ClipboardUpdateEvent _ ts) = - return (Event ts (ClipboardUpdateEvent ClipboardUpdateEventData)) -convertRaw (Raw.UnknownEvent t ts) = - return (Event ts (UnknownEvent (UnknownEventData t))) - --- | Poll for currently pending events. You can only call this function in the thread that set the video mode. -pollEvent :: MonadIO m => m (Maybe Event) -pollEvent = liftIO $ alloca $ \e -> do - n <- Raw.pollEvent e - if n == 0 - then return Nothing - else fmap Just (peek e >>= convertRaw) - --- | Clear the event queue by polling for all pending events. -pollEvents :: (Functor m, MonadIO m) => m [Event] -pollEvents = - do e <- pollEvent - case e of - Nothing -> return [] - Just e' -> (e' :) <$> pollEvents - --- | Run a monadic computation, accumulating over all known 'Event's. --- --- This can be useful when used with a state monad, allowing you to fold all events together. -mapEvents :: MonadIO m => (Event -> m ()) -> m () -mapEvents h = do - event' <- pollEvent - case event' of - Just event -> h event >> mapEvents h - Nothing -> return () - --- | Wait indefinitely for the next available event. -waitEvent :: MonadIO m => m Event -waitEvent = liftIO $ alloca $ \e -> do - SDLEx.throwIfNeg_ "SDL.Events.waitEvent" "SDL_WaitEvent" $ - Raw.waitEvent e - peek e >>= convertRaw - --- | Wait until the specified timeout for the next available amount. -waitEventTimeout :: MonadIO m - => CInt -- ^ The maximum amount of time to wait, in milliseconds. - -> m (Maybe Event) -waitEventTimeout timeout = liftIO $ alloca $ \e -> do - n <- Raw.waitEventTimeout e timeout - if n == 0 - then return Nothing - else fmap Just (peek e >>= convertRaw) - --- | Pump the event loop, gathering events from the input devices. --- --- This function updates the event queue and internal input device state. --- --- This should only be run in the thread that initialized the video subsystem, and for extra safety, you should consider only doing those things on the main thread in any case. --- --- 'pumpEvents' gathers all the pending input information from devices and places it in the event queue. Without calls to 'pumpEvents' no events would ever be placed on the queue. Often the need for calls to 'pumpEvents' is hidden from the user since 'pollEvent' and 'waitEvent' implicitly call 'pumpEvents'. However, if you are not polling or waiting for events (e.g. you are filtering them), then you must call 'pumpEvents' to force an event queue update. --- --- See @@ for C documentation. -pumpEvents :: MonadIO m => m () -pumpEvents = Raw.pumpEvents +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +-- | "SDL.Event" exports an interface for working with the SDL event model. Event handling allows your application to receive input from the user. Internally, SDL stores all the events waiting to be handled in an event queue. Using functions like 'pollEvent' and 'waitEvent' you can observe and handle waiting input events. +-- +-- The event queue itself is composed of a series of 'Event' values, one for each waiting event. 'Event' values are read from the queue with the 'pollEvent' function and it is then up to the application to process the information stored with them. +module SDL.Event + ( -- * Polling events + pollEvent + , pollEvents + , mapEvents + , pumpEvents + , waitEvent + , waitEventTimeout + -- * Event data + , Event(..) + , EventPayload(..) + -- ** Window events + , WindowShownEventData(..) + , WindowHiddenEventData(..) + , WindowExposedEventData(..) + , WindowMovedEventData(..) + , WindowResizedEventData(..) + , WindowSizeChangedEventData(..) + , WindowMinimizedEventData(..) + , WindowMaximizedEventData(..) + , WindowRestoredEventData(..) + , WindowGainedMouseFocusEventData(..) + , WindowLostMouseFocusEventData(..) + , WindowGainedKeyboardFocusEventData(..) + , WindowLostKeyboardFocusEventData(..) + , WindowClosedEventData(..) + , SysWMEventData(..) + -- ** Keyboard events + , KeyboardEventData(..) + , TextEditingEventData(..) + , TextInputEventData(..) + -- ** Mouse events + , MouseMotionEventData(..) + , MouseButtonEventData(..) + , MouseWheelEventData(..) + -- ** Joystick events + , JoyAxisEventData(..) + , JoyBallEventData(..) + , JoyHatEventData(..) + , JoyButtonEventData(..) + , JoyDeviceEventData(..) + -- ** Controller events + , ControllerAxisEventData(..) + , ControllerButtonEventData(..) + , ControllerDeviceEventData(..) + -- ** User events + , UserEventData(..) + -- ** Touch events + , TouchFingerEventData(..) + -- ** Gesture events + , MultiGestureEventData(..) + , DollarGestureEventData(..) + -- ** Drag and drop events + , DropEventData(..) + -- ** Clipboard events + , ClipboardUpdateEventData(..) + -- ** Unknown events + , UnknownEventData(..) + -- * Auxiliary event data + , InputMotion(..) + , MouseButton(..) + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Data (Data) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Data.Typeable +import Foreign +import Foreign.C +import GHC.Generics (Generic) +import Linear +import Linear.Affine (Point(P)) +import SDL.Input.Keyboard +import SDL.Input.Mouse +import SDL.Internal.Numbered +import SDL.Internal.Types (Window(Window)) +import qualified Data.ByteString.Char8 as BSC8 +import qualified Data.Text.Encoding as Text +import qualified SDL.Exception as SDLEx +import qualified SDL.Raw as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +-- | A single SDL event. This event occured at 'eventTimestamp' and carries data under 'eventPayload'. +data Event = Event + { eventTimestamp :: Word32 + -- ^ The time the event occured. + , eventPayload :: EventPayload + -- ^ Data pertaining to this event. + } deriving (Eq, Ord, Generic, Show, Typeable) + +-- | An enumeration of all possible SDL event types. This data type pairs up event types with +-- their payload, where possible. +data EventPayload + = WindowShownEvent WindowShownEventData + | WindowHiddenEvent WindowHiddenEventData + | WindowExposedEvent WindowExposedEventData + | WindowMovedEvent WindowMovedEventData + | WindowResizedEvent WindowResizedEventData + | WindowSizeChangedEvent WindowSizeChangedEventData + | WindowMinimizedEvent WindowMinimizedEventData + | WindowMaximizedEvent WindowMaximizedEventData + | WindowRestoredEvent WindowRestoredEventData + | WindowGainedMouseFocusEvent WindowGainedMouseFocusEventData + | WindowLostMouseFocusEvent WindowLostMouseFocusEventData + | WindowGainedKeyboardFocusEvent WindowGainedKeyboardFocusEventData + | WindowLostKeyboardFocusEvent WindowLostKeyboardFocusEventData + | WindowClosedEvent WindowClosedEventData + | KeyboardEvent KeyboardEventData + | TextEditingEvent TextEditingEventData + | TextInputEvent TextInputEventData + | MouseMotionEvent MouseMotionEventData + | MouseButtonEvent MouseButtonEventData + | MouseWheelEvent MouseWheelEventData + | JoyAxisEvent JoyAxisEventData + | JoyBallEvent JoyBallEventData + | JoyHatEvent JoyHatEventData + | JoyButtonEvent JoyButtonEventData + | JoyDeviceEvent JoyDeviceEventData + | ControllerAxisEvent ControllerAxisEventData + | ControllerButtonEvent ControllerButtonEventData + | ControllerDeviceEvent ControllerDeviceEventData + | QuitEvent + | UserEvent UserEventData + | SysWMEvent SysWMEventData + | TouchFingerEvent TouchFingerEventData + | MultiGestureEvent MultiGestureEventData + | DollarGestureEvent DollarGestureEventData + | DropEvent DropEventData + | ClipboardUpdateEvent ClipboardUpdateEventData + | UnknownEvent UnknownEventData + deriving (Eq, Ord, Generic, Show, Typeable) + +-- | A window has been shown. +data WindowShownEventData = + WindowShownEventData {windowShownEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A window has been hidden. +data WindowHiddenEventData = + WindowHiddenEventData {windowHiddenEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A part of a window has been exposed - where exposure means to become visible (for example, an overlapping window no longer overlaps with the window). +data WindowExposedEventData = + WindowExposedEventData {windowExposedEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A 'Window' has been moved. +data WindowMovedEventData = + WindowMovedEventData {windowMovedEventWindow :: Window + -- ^ The associated 'Window'. + ,windowMovedEventPosition :: Point V2 Int32 + -- ^ The new position of the 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Window has been resized. This is event is always preceded by 'WindowSizeChangedEvent'. +data WindowResizedEventData = + WindowResizedEventData {windowResizedEventWindow :: Window + -- ^ The associated 'Window'. + ,windowResizedEventSize :: V2 Int32 + -- ^ The new size of the 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window size has changed, either as a result of an API call or through the system or user changing the window size; this event is followed by 'WindowResizedEvent' if the size was changed by an external event, i.e. the user or the window manager. +data WindowSizeChangedEventData = + WindowSizeChangedEventData {windowSizeChangedEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has been minimized. +data WindowMinimizedEventData = + WindowMinimizedEventData {windowMinimizedEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has been maximized. +data WindowMaximizedEventData = + WindowMaximizedEventData {windowMaximizedEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has been restored to normal size and position. +data WindowRestoredEventData = + WindowRestoredEventData {windowRestoredEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has gained mouse focus. +data WindowGainedMouseFocusEventData = + WindowGainedMouseFocusEventData {windowGainedMouseFocusEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has lost mouse focus. +data WindowLostMouseFocusEventData = + WindowLostMouseFocusEventData {windowLostMouseFocusEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has gained keyboard focus. +data WindowGainedKeyboardFocusEventData = + WindowGainedKeyboardFocusEventData {windowGainedKeyboardFocusEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window has lost keyboard focus. +data WindowLostKeyboardFocusEventData = + WindowLostKeyboardFocusEventData {windowLostKeyboardFocusEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The window manager requests that the window be closed. +data WindowClosedEventData = + WindowClosedEventData {windowClosedEventWindow :: Window + -- ^ The associated 'Window'. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A keyboard key has been pressed or released. +data KeyboardEventData = + KeyboardEventData {keyboardEventWindow :: Window + -- ^ The associated 'Window'. + ,keyboardEventKeyMotion :: InputMotion + -- ^ Whether the key was pressed or released. + ,keyboardEventRepeat :: Bool + -- ^ 'True' if this is a repeating key press from the user holding the key down. + ,keyboardEventKeysym :: Keysym + -- ^ A description of the key that this event pertains to. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Keyboard text editing event information. +data TextEditingEventData = + TextEditingEventData {textEditingEventWindow :: Window + -- ^ The associated 'Window'. + ,textEditingEventText :: Text + -- ^ The editing text. + ,textEditingEventStart :: Int32 + -- ^ The location to begin editing from. + ,textEditingEventLength :: Int32 + -- ^ The number of characters to edit from the start point. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Keyboard text input event information. +data TextInputEventData = + TextInputEventData {textInputEventWindow :: Window + -- ^ The associated 'Window'. + ,textInputEventText :: Text + -- ^ The input text. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A mouse or pointer device was moved. +data MouseMotionEventData = + MouseMotionEventData {mouseMotionEventWindow :: Window + -- ^ The associated 'Window'. + ,mouseMotionEventWhich :: MouseDevice + -- ^ The 'MouseDevice' that was moved. + ,mouseMotionEventState :: [MouseButton] + -- ^ A collection of 'MouseButton's that are currently held down. + ,mouseMotionEventPos :: Point V2 Int32 + -- ^ The new position of the mouse. + ,mouseMotionEventRelMotion :: V2 Int32 + -- ^ The relative mouse motion of the mouse. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A mouse or pointer device button was pressed or released. +data MouseButtonEventData = + MouseButtonEventData {mouseButtonEventWindow :: Window + -- ^ The associated 'Window'. + ,mouseButtonEventMotion :: InputMotion + -- ^ Whether the button was pressed or released. + ,mouseButtonEventWhich :: MouseDevice + -- ^ The 'MouseDevice' whose button was pressed or released. + ,mouseButtonEventButton :: MouseButton + -- ^ The button that was pressed or released. + ,mouseButtonEventClicks :: Word8 + -- ^ The amount of clicks. 1 for a single-click, 2 for a double-click, etc. + ,mouseButtonEventPos :: Point V2 Int32 + -- ^ The coordinates of the mouse click. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Mouse wheel event information. +data MouseWheelEventData = + MouseWheelEventData {mouseWheelEventWindow :: Window + -- ^ The associated 'Window'. + ,mouseWheelEventWhich :: MouseDevice + -- ^ The 'MouseDevice' whose wheel was scrolled. + ,mouseWheelEventPos :: V2 Int32 + -- ^ The amount scrolled. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Joystick axis motion event information +data JoyAxisEventData = + JoyAxisEventData {joyAxisEventWhich :: Raw.JoystickID + -- ^ The instance id of the joystick that reported the event. + ,joyAxisEventAxis :: Word8 + -- ^ The index of the axis that changed. + ,joyAxisEventValue :: Int16 + -- ^ The current position of the axis, ranging between -32768 and 32767. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Joystick trackball motion event information. +data JoyBallEventData = + JoyBallEventData {joyBallEventWhich :: Raw.JoystickID + -- ^ The instance id of the joystick that reported the event. + ,joyBallEventBall :: Word8 + -- ^ The index of the trackball that changed. + ,joyBallEventRelMotion :: V2 Int16 + -- ^ The relative motion of the trackball. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Joystick hat position change event information +data JoyHatEventData = + JoyHatEventData {joyHatEventWhich :: Raw.JoystickID + -- ^ The instance id of the joystick that reported the event. + ,joyHatEventHat :: Word8 + -- ^ The index of the hat that changed. + ,joyHatEventValue :: Word8 + -- ^ The new position of the hat. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Joystick button event information. +data JoyButtonEventData = + JoyButtonEventData {joyButtonEventWhich :: Raw.JoystickID + -- ^ The instance id of the joystick that reported the event. + ,joyButtonEventButton :: Word8 + -- ^ The index of the button that changed. + ,joyButtonEventState :: Word8 + -- ^ The state of the button. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Joystick device event information. +data JoyDeviceEventData = + JoyDeviceEventData {joyDeviceEventWhich :: Int32 + -- ^ The instance id of the joystick that reported the event. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Game controller axis motion event information. +data ControllerAxisEventData = + ControllerAxisEventData {controllerAxisEventWhich :: Raw.JoystickID + -- ^ The joystick instance ID that reported the event. + ,controllerAxisEventAxis :: Word8 + -- ^ The index of the axis. + ,controllerAxisEventValue :: Int16 + -- ^ The axis value ranging between -32768 and 32767. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Game controller button event information +data ControllerButtonEventData = + ControllerButtonEventData {controllerButtonEventWhich :: Raw.JoystickID + -- ^ The joystick instance ID that reported the event. + ,controllerButtonEventButton :: Word8 + -- ^ The controller button. + ,controllerButtonEventState :: Word8 + -- ^ The state of the button. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Controller device event information +data ControllerDeviceEventData = + ControllerDeviceEventData {controllerDeviceEventWhich :: Int32 + -- ^ The joystick instance ID that reported the event. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Event data for application-defined events. +data UserEventData = + UserEventData {userEventWindow :: Window + -- ^ The associated 'Window'. + ,userEventCode :: Int32 + -- ^ User defined event code. + ,userEventData1 :: Ptr () + -- ^ User defined data pointer. + ,userEventData2 :: Ptr () + -- ^ User defined data pointer. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | A video driver dependent system event +data SysWMEventData = + SysWMEventData {sysWMEventMsg :: Raw.SysWMmsg} + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Finger touch event information. +data TouchFingerEventData = + TouchFingerEventData {touchFingerEventTouchID :: Raw.TouchID + -- ^ The touch device index. + ,touchFingerEventFingerID :: Raw.FingerID + -- ^ The finger index. + ,touchFingerEventPos :: Point V2 CFloat + -- ^ The location of the touch event, normalized between 0 and 1. + ,touchFingerEventRelMotion :: V2 CFloat + -- ^ The distance moved, normalized between -1 and 1. + ,touchFingerEventPressure :: CFloat + -- ^ The quantity of the pressure applied, normalized between 0 and 1. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Multiple finger gesture event information +data MultiGestureEventData = + MultiGestureEventData {multiGestureEventTouchID :: Raw.TouchID + -- ^ The touch device index. + ,multiGestureEventDTheta :: CFloat + -- ^ The amount that the fingers rotated during this motion. + ,multiGestureEventDDist :: CFloat + -- ^ The amount that the fingers pinched during this motion. + ,multiGestureEventPos :: Point V2 CFloat + -- ^ The normalized center of the gesture. + ,multiGestureEventNumFingers :: Word16 + -- ^ The number of fingers used in this gesture. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | Complex gesture event information. +data DollarGestureEventData = + DollarGestureEventData {dollarGestureEventTouchID :: Raw.TouchID + -- ^ The touch device index. + ,dollarGestureEventGestureID :: Raw.GestureID + -- ^ The unique id of the closest gesture to the performed stroke. + ,dollarGestureEventNumFingers :: Word32 + -- ^ The number of fingers used to draw the stroke. + ,dollarGestureEventError :: CFloat + -- ^ The difference between the gesture template and the actual performed gesture (lower errors correspond to closer matches). + ,dollarGestureEventPos :: Point V2 CFloat + -- ^ The normalized center of the gesture. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | An event used to request a file open by the system +data DropEventData = + DropEventData {dropEventFile :: CString + -- ^ The file name. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | The clipboard changed. +data ClipboardUpdateEventData = + ClipboardUpdateEventData + deriving (Eq,Ord,Generic,Show,Typeable) + +-- | SDL reported an unknown event type. +data UnknownEventData = + UnknownEventData {unknownEventType :: Word32 + -- ^ The unknown event code. + } + deriving (Eq,Ord,Generic,Show,Typeable) + +data InputMotion = Released | Pressed + deriving (Bounded, Enum, Eq, Ord, Read, Data, Generic, Show, Typeable) + +ccharStringToText :: [CChar] -> Text +ccharStringToText = Text.decodeUtf8 . BSC8.pack . map castCCharToChar + +fromRawKeysym :: Raw.Keysym -> Keysym +fromRawKeysym (Raw.Keysym scancode keycode modifier) = + Keysym scancode' keycode' modifier' + where scancode' = fromNumber scancode + keycode' = fromNumber keycode + modifier' = fromNumber (fromIntegral modifier) + +convertRaw :: Raw.Event -> IO Event +convertRaw (Raw.WindowEvent t ts a b c d) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts + (case b of + Raw.SDL_WINDOWEVENT_SHOWN -> + WindowShownEvent (WindowShownEventData w') + Raw.SDL_WINDOWEVENT_HIDDEN -> + WindowHiddenEvent (WindowHiddenEventData w') + Raw.SDL_WINDOWEVENT_EXPOSED -> + WindowExposedEvent (WindowExposedEventData w') + Raw.SDL_WINDOWEVENT_MOVED -> + WindowMovedEvent + (WindowMovedEventData w' + (P (V2 c d))) + Raw.SDL_WINDOWEVENT_RESIZED -> + WindowResizedEvent + (WindowResizedEventData w' + (V2 c d)) + Raw.SDL_WINDOWEVENT_SIZE_CHANGED -> + WindowSizeChangedEvent (WindowSizeChangedEventData w') + Raw.SDL_WINDOWEVENT_MINIMIZED -> + WindowMinimizedEvent (WindowMinimizedEventData w') + Raw.SDL_WINDOWEVENT_MAXIMIZED -> + WindowMaximizedEvent (WindowMaximizedEventData w') + Raw.SDL_WINDOWEVENT_RESTORED -> + WindowRestoredEvent (WindowRestoredEventData w') + Raw.SDL_WINDOWEVENT_ENTER -> + WindowGainedMouseFocusEvent (WindowGainedMouseFocusEventData w') + Raw.SDL_WINDOWEVENT_LEAVE -> + WindowLostMouseFocusEvent (WindowLostMouseFocusEventData w') + Raw.SDL_WINDOWEVENT_FOCUS_GAINED -> + WindowGainedKeyboardFocusEvent (WindowGainedKeyboardFocusEventData w') + Raw.SDL_WINDOWEVENT_FOCUS_LOST -> + WindowLostKeyboardFocusEvent (WindowLostKeyboardFocusEventData w') + Raw.SDL_WINDOWEVENT_CLOSE -> + WindowClosedEvent (WindowClosedEventData w') + _ -> + UnknownEvent (UnknownEventData t))) +convertRaw (Raw.KeyboardEvent Raw.SDL_KEYDOWN ts a _ c d) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts + (KeyboardEvent + (KeyboardEventData w' + Pressed + (c /= 0) + (fromRawKeysym d)))) +convertRaw (Raw.KeyboardEvent Raw.SDL_KEYUP ts a _ c d) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts + (KeyboardEvent + (KeyboardEventData w' + Released + (c /= 0) + (fromRawKeysym d)))) +convertRaw (Raw.KeyboardEvent _ _ _ _ _ _) = error "convertRaw: Unknown keyboard motion" +convertRaw (Raw.TextEditingEvent _ ts a b c d) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts + (TextEditingEvent + (TextEditingEventData w' + (ccharStringToText b) + c + d))) +convertRaw (Raw.TextInputEvent _ ts a b) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts + (TextInputEvent + (TextInputEventData w' + (ccharStringToText b)))) +convertRaw (Raw.MouseMotionEvent _ ts a b c d e f g) = + do w' <- fmap Window (Raw.getWindowFromID a) + let buttons = + catMaybes [(Raw.SDL_BUTTON_LMASK `test` c) ButtonLeft + ,(Raw.SDL_BUTTON_RMASK `test` c) ButtonRight + ,(Raw.SDL_BUTTON_MMASK `test` c) ButtonMiddle + ,(Raw.SDL_BUTTON_X1MASK `test` c) ButtonX1 + ,(Raw.SDL_BUTTON_X2MASK `test` c) ButtonX2] + return (Event ts + (MouseMotionEvent + (MouseMotionEventData w' + (fromNumber b) + buttons + (P (V2 d e)) + (V2 f g)))) + where mask `test` x = + if mask .&. x /= 0 + then Just + else const Nothing +convertRaw (Raw.MouseButtonEvent t ts a b c _ e f g) = + do w' <- fmap Window (Raw.getWindowFromID a) + let motion + | t == Raw.SDL_MOUSEBUTTONUP = Released + | t == Raw.SDL_MOUSEBUTTONDOWN = Pressed + | otherwise = error "convertRaw: Unexpected mouse button motion" + button + | c == Raw.SDL_BUTTON_LEFT = ButtonLeft + | c == Raw.SDL_BUTTON_MIDDLE = ButtonMiddle + | c == Raw.SDL_BUTTON_RIGHT = ButtonRight + | c == Raw.SDL_BUTTON_X1 = ButtonX1 + | c == Raw.SDL_BUTTON_X2 = ButtonX2 + | otherwise = ButtonExtra $ fromIntegral c + return (Event ts + (MouseButtonEvent + (MouseButtonEventData w' + motion + (fromNumber b) + button + e + (P (V2 f g))))) +convertRaw (Raw.MouseWheelEvent _ ts a b c d) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts + (MouseWheelEvent + (MouseWheelEventData w' + (fromNumber b) + (V2 c d)))) +convertRaw (Raw.JoyAxisEvent _ ts a b c) = + return (Event ts (JoyAxisEvent (JoyAxisEventData a b c))) +convertRaw (Raw.JoyBallEvent _ ts a b c d) = + return (Event ts + (JoyBallEvent + (JoyBallEventData a + b + (V2 c d)))) +convertRaw (Raw.JoyHatEvent _ ts a b c) = + return (Event ts (JoyHatEvent (JoyHatEventData a b c))) +convertRaw (Raw.JoyButtonEvent _ ts a b c) = + return (Event ts (JoyButtonEvent (JoyButtonEventData a b c))) +convertRaw (Raw.JoyDeviceEvent _ ts a) = + return (Event ts (JoyDeviceEvent (JoyDeviceEventData a))) +convertRaw (Raw.ControllerAxisEvent _ ts a b c) = + return (Event ts (ControllerAxisEvent (ControllerAxisEventData a b c))) +convertRaw (Raw.ControllerButtonEvent _ ts a b c) = + return (Event ts (ControllerButtonEvent (ControllerButtonEventData a b c))) +convertRaw (Raw.ControllerDeviceEvent _ ts a) = + return (Event ts (ControllerDeviceEvent (ControllerDeviceEventData a))) +convertRaw (Raw.QuitEvent _ ts) = + return (Event ts QuitEvent) +convertRaw (Raw.UserEvent _ ts a b c d) = + do w' <- fmap Window (Raw.getWindowFromID a) + return (Event ts (UserEvent (UserEventData w' b c d))) +convertRaw (Raw.SysWMEvent _ ts a) = + return (Event ts (SysWMEvent (SysWMEventData a))) +convertRaw (Raw.TouchFingerEvent _ ts a b c d e f g) = + return (Event ts + (TouchFingerEvent + (TouchFingerEventData a + b + (P (V2 c d)) + (V2 e f) + g))) +convertRaw (Raw.MultiGestureEvent _ ts a b c d e f) = + return (Event ts + (MultiGestureEvent + (MultiGestureEventData a + b + c + (P (V2 d e)) + f))) +convertRaw (Raw.DollarGestureEvent _ ts a b c d e f) = + return (Event ts + (DollarGestureEvent + (DollarGestureEventData a + b + c + d + (P (V2 e f))))) +convertRaw (Raw.DropEvent _ ts a) = + return (Event ts (DropEvent (DropEventData a))) +convertRaw (Raw.ClipboardUpdateEvent _ ts) = + return (Event ts (ClipboardUpdateEvent ClipboardUpdateEventData)) +convertRaw (Raw.UnknownEvent t ts) = + return (Event ts (UnknownEvent (UnknownEventData t))) + +-- | Poll for currently pending events. You can only call this function in the thread that set the video mode. +pollEvent :: MonadIO m => m (Maybe Event) +pollEvent = liftIO $ alloca $ \e -> do + n <- Raw.pollEvent e + if n == 0 + then return Nothing + else fmap Just (peek e >>= convertRaw) + +-- | Clear the event queue by polling for all pending events. +pollEvents :: (Functor m, MonadIO m) => m [Event] +pollEvents = + do e <- pollEvent + case e of + Nothing -> return [] + Just e' -> (e' :) <$> pollEvents + +-- | Run a monadic computation, accumulating over all known 'Event's. +-- +-- This can be useful when used with a state monad, allowing you to fold all events together. +mapEvents :: MonadIO m => (Event -> m ()) -> m () +mapEvents h = do + event' <- pollEvent + case event' of + Just event -> h event >> mapEvents h + Nothing -> return () + +-- | Wait indefinitely for the next available event. +waitEvent :: MonadIO m => m Event +waitEvent = liftIO $ alloca $ \e -> do + SDLEx.throwIfNeg_ "SDL.Events.waitEvent" "SDL_WaitEvent" $ + Raw.waitEvent e + peek e >>= convertRaw + +-- | Wait until the specified timeout for the next available amount. +waitEventTimeout :: MonadIO m + => CInt -- ^ The maximum amount of time to wait, in milliseconds. + -> m (Maybe Event) +waitEventTimeout timeout = liftIO $ alloca $ \e -> do + n <- Raw.waitEventTimeout e timeout + if n == 0 + then return Nothing + else fmap Just (peek e >>= convertRaw) + +-- | Pump the event loop, gathering events from the input devices. +-- +-- This function updates the event queue and internal input device state. +-- +-- This should only be run in the thread that initialized the video subsystem, and for extra safety, you should consider only doing those things on the main thread in any case. +-- +-- 'pumpEvents' gathers all the pending input information from devices and places it in the event queue. Without calls to 'pumpEvents' no events would ever be placed on the queue. Often the need for calls to 'pumpEvents' is hidden from the user since 'pollEvent' and 'waitEvent' implicitly call 'pumpEvents'. However, if you are not polling or waiting for events (e.g. you are filtering them), then you must call 'pumpEvents' to force an event queue update. +-- +-- See @@ for C documentation. +pumpEvents :: MonadIO m => m () +pumpEvents = Raw.pumpEvents diff --git a/src/SDL/Exception.hs b/src/SDL/Exception.hs --- a/src/SDL/Exception.hs +++ b/src/SDL/Exception.hs @@ -1,107 +1,107 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} - -module SDL.Exception - ( SDLException(..) - , fromC - , getError - , throwIf - , throwIf_ - , throwIf0 - , throwIfNeg - , throwIfNeg_ - , throwIfNot0 - , throwIfNot0_ - , throwIfNull - ) where - -import Control.Exception -import Control.Monad -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Data (Data) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import Data.Typeable (Typeable) -import Foreign (Ptr, nullPtr) -import GHC.Generics (Generic) -import qualified Data.ByteString as BS -import qualified Data.Text.Encoding as Text -import qualified SDL.Raw as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- | Error details about a failure to call an SDL routine. Almost all functions in this library have the --- ability to produce exceptions of this type. Inspection should help you learn more about what has --- gone wrong. -data SDLException - = -- | A call to a low-level SDL C function failed unexpectedly. - SDLCallFailed - {sdlExceptionCaller :: !Text - -- ^ The Haskell routine that was trying to call a C function - ,sdlFunction :: !Text - -- ^ The C function that was called and produced an error - ,sdlExceptionError :: !Text - -- ^ SDL's understanding of what has gone wrong - } - | -- | An SDL C function was called with an unexpected argument. - SDLUnexpectedArgument - {sdlExceptionCaller :: !Text - -- ^ The Haskell routine that was trying to call a C function - ,sdlFunction :: !Text - -- ^ The C function that was called and produced an error - ,sdlUnknownValue :: !String - -- ^ The argument that SDL failed to understand - } - | -- | A hint was attempted to be set, but SDL does not know about this hint. - SDLUnknownHintValue - {sdlHint :: !String - -- ^ The hint that could not be set - ,sdlUnknownValue :: !String - -- ^ The value that could not be set - } - deriving (Data,Eq,Generic,Ord,Read,Show,Typeable) - -instance Exception SDLException - -getError :: MonadIO m => m Text -getError = liftIO $ do - cstr <- Raw.getError - Text.decodeUtf8 <$> BS.packCString cstr - -throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a -throwIf f caller funName m = do - a <- m - liftIO $ when (f a) $ - (SDLCallFailed caller funName <$> getError) >>= throwIO - return a - -throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m () -throwIf_ f caller funName m = throwIf f caller funName m >> return () - -throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a -throwIfNeg = throwIf (< 0) - -throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m () -throwIfNeg_ = throwIf_ (< 0) - -throwIfNull :: (MonadIO m) => Text -> Text -> m (Ptr a) -> m (Ptr a) -throwIfNull = throwIf (== nullPtr) - -throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a -throwIf0 = throwIf (== 0) - -throwIfNot0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a -throwIfNot0 = throwIf (/= 0) - -throwIfNot0_ :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m () -throwIfNot0_ = throwIf_ (/= 0) - -fromC :: Show a => Text -> Text -> (a -> Maybe b) -> a -> b -fromC caller funName f x = - fromMaybe (throw (SDLUnexpectedArgument caller - funName - (show x))) - (f x) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + +module SDL.Exception + ( SDLException(..) + , fromC + , getError + , throwIf + , throwIf_ + , throwIf0 + , throwIfNeg + , throwIfNeg_ + , throwIfNot0 + , throwIfNot0_ + , throwIfNull + ) where + +import Control.Exception +import Control.Monad +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Data (Data) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Typeable (Typeable) +import Foreign (Ptr, nullPtr) +import GHC.Generics (Generic) +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as Text +import qualified SDL.Raw as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +-- | Error details about a failure to call an SDL routine. Almost all functions in this library have the +-- ability to produce exceptions of this type. Inspection should help you learn more about what has +-- gone wrong. +data SDLException + = -- | A call to a low-level SDL C function failed unexpectedly. + SDLCallFailed + {sdlExceptionCaller :: !Text + -- ^ The Haskell routine that was trying to call a C function + ,sdlFunction :: !Text + -- ^ The C function that was called and produced an error + ,sdlExceptionError :: !Text + -- ^ SDL's understanding of what has gone wrong + } + | -- | An SDL C function was called with an unexpected argument. + SDLUnexpectedArgument + {sdlExceptionCaller :: !Text + -- ^ The Haskell routine that was trying to call a C function + ,sdlFunction :: !Text + -- ^ The C function that was called and produced an error + ,sdlUnknownValue :: !String + -- ^ The argument that SDL failed to understand + } + | -- | A hint was attempted to be set, but SDL does not know about this hint. + SDLUnknownHintValue + {sdlHint :: !String + -- ^ The hint that could not be set + ,sdlUnknownValue :: !String + -- ^ The value that could not be set + } + deriving (Data,Eq,Generic,Ord,Read,Show,Typeable) + +instance Exception SDLException + +getError :: MonadIO m => m Text +getError = liftIO $ do + cstr <- Raw.getError + Text.decodeUtf8 <$> BS.packCString cstr + +throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a +throwIf f caller funName m = do + a <- m + liftIO $ when (f a) $ + (SDLCallFailed caller funName <$> getError) >>= throwIO + return a + +throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m () +throwIf_ f caller funName m = throwIf f caller funName m >> return () + +throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a +throwIfNeg = throwIf (< 0) + +throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m () +throwIfNeg_ = throwIf_ (< 0) + +throwIfNull :: (MonadIO m) => Text -> Text -> m (Ptr a) -> m (Ptr a) +throwIfNull = throwIf (== nullPtr) + +throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a +throwIf0 = throwIf (== 0) + +throwIfNot0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a +throwIfNot0 = throwIf (/= 0) + +throwIfNot0_ :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m () +throwIfNot0_ = throwIf_ (/= 0) + +fromC :: Show a => Text -> Text -> (a -> Maybe b) -> a -> b +fromC caller funName f x = + fromMaybe (throw (SDLUnexpectedArgument caller + funName + (show x))) + (f x) diff --git a/src/SDL/Filesystem.hs b/src/SDL/Filesystem.hs --- a/src/SDL/Filesystem.hs +++ b/src/SDL/Filesystem.hs @@ -1,51 +1,51 @@ -{-# LANGUAGE CPP#-} -{-# LANGUAGE OverloadedStrings #-} - -module SDL.Filesystem - ( -- * Filesystem Paths - getBasePath - , getPrefPath -) where - -import Control.Exception -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Text (Text) -import Foreign.Marshal.Alloc -import SDL.Exception -import qualified Data.ByteString as BS -import qualified Data.Text.Encoding as Text -import qualified SDL.Raw.Filesystem as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- | An absolute path to the application data directory. --- --- The path is guaranteed to end with a path separator. --- --- Throws 'SDLException' on failure, or if the platform does not implement this --- functionality. -getBasePath :: MonadIO m => m Text -getBasePath = liftIO $ mask_ $ do - cpath <- throwIfNull "SDL.Filesystem.getBasePath" "SDL_GetBasePath" - Raw.getBasePath - finally (Text.decodeUtf8 <$> BS.packCString cpath) (free cpath) - --- | A path to a unique per user and per application directory for the given --- organization and application name, intended for writing preferences and --- other personal files. --- --- The path is guaranteed to end with a path separator. --- --- You should assume the path returned by this function is the only safe place --- to write files to. --- --- Throws 'SDLException' on failure. -getPrefPath :: MonadIO m => Text -> Text -> m Text -getPrefPath organization application = liftIO $ mask_ $ do - cpath <- throwIfNull "SDL.Filesystem.getPrefPath" "SDL_GetPrefPath" $ - BS.useAsCString (Text.encodeUtf8 organization) $ \org -> - BS.useAsCString (Text.encodeUtf8 application) $ \app -> - Raw.getPrefPath org app - finally (Text.decodeUtf8 <$> BS.packCString cpath) (free cpath) +{-# LANGUAGE CPP#-} +{-# LANGUAGE OverloadedStrings #-} + +module SDL.Filesystem + ( -- * Filesystem Paths + getBasePath + , getPrefPath +) where + +import Control.Exception +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Text (Text) +import Foreign.Marshal.Alloc +import SDL.Exception +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as Text +import qualified SDL.Raw.Filesystem as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +-- | An absolute path to the application data directory. +-- +-- The path is guaranteed to end with a path separator. +-- +-- Throws 'SDLException' on failure, or if the platform does not implement this +-- functionality. +getBasePath :: MonadIO m => m Text +getBasePath = liftIO $ mask_ $ do + cpath <- throwIfNull "SDL.Filesystem.getBasePath" "SDL_GetBasePath" + Raw.getBasePath + finally (Text.decodeUtf8 <$> BS.packCString cpath) (free cpath) + +-- | A path to a unique per user and per application directory for the given +-- organization and application name, intended for writing preferences and +-- other personal files. +-- +-- The path is guaranteed to end with a path separator. +-- +-- You should assume the path returned by this function is the only safe place +-- to write files to. +-- +-- Throws 'SDLException' on failure. +getPrefPath :: MonadIO m => Text -> Text -> m Text +getPrefPath organization application = liftIO $ mask_ $ do + cpath <- throwIfNull "SDL.Filesystem.getPrefPath" "SDL_GetPrefPath" $ + BS.useAsCString (Text.encodeUtf8 organization) $ \org -> + BS.useAsCString (Text.encodeUtf8 application) $ \app -> + Raw.getPrefPath org app + finally (Text.decodeUtf8 <$> BS.packCString cpath) (free cpath) diff --git a/src/SDL/Hint.hs b/src/SDL/Hint.hs --- a/src/SDL/Hint.hs +++ b/src/SDL/Hint.hs @@ -1,354 +1,354 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module SDL.Hint ( - -- * Getting and setting hints - Hint(..), - setHintWithPriority, - HintPriority(..), - clearHints, - - -- * Hint Information - -- ** 'HintAccelerometerAsJoystick' - AccelerometerJoystickOptions(..), - - -- ** 'HintFramebufferAcceleration' - FramebufferAccelerationOptions(..), - - -- ** 'HintMacCTRLClick' - MacCTRLClickOptions(..), - - -- ** 'HintMouseRelativeModeWarp' - MouseModeWarpOptions(..), - - -- ** 'HintRenderDriver' - RenderDrivers(..), - - -- ** 'HintRenderOpenGLShaders' - RenderOpenGLShaderOptions(..), - - -- ** 'HintRenderScaleQuality' - RenderScaleQuality(..), - - -- ** 'HintRenderVSync' - RenderVSyncOptions(..), - - -- ** 'HintVideoWinD3DCompiler' - VideoWinD3DCompilerOptions(..) - ) where - -import Control.Exception -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Data (Data) -import Data.Maybe (fromMaybe) -import Data.StateVar -import Data.Typeable -import Foreign.C -import GHC.Generics (Generic) -import SDL.Exception -import qualified SDL.Raw as Raw - --- | A hint that specifies whether the Android\/iOS built-in accelerometer should --- be listed as a joystick device, rather than listing actual joysticks only. --- By default SDL will list real joysticks along with the accelerometer as if it --- were a 3 axis joystick. -data AccelerometerJoystickOptions - = AccelerometerNotJoystick - -- ^ List only real joysticks and accept input from them - | AccelerometerIsJoystick - -- ^ List real joysticks along with the accelerometer as if it were a 3 axis - -- joystick (the default) - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies how 3D acceleration is used to accelerate the SDL --- screen surface. By default SDL tries to make a best guess whether to use --- acceleration or not on each platform. -data FramebufferAccelerationOptions - = Disable3D -- ^ Disable 3D acceleration - | Enable3DDefault -- ^ Enable 3D acceleration, using the default renderer - | Enable3DDirect3D -- ^ Enable 3D acceleration using Direct3D - | Enable3DOpenGL -- ^ Enable 3D acceleration using OpenGL - | Enable3DOpenGLES -- ^ Enable 3D acceleration using OpenGLES - | Enable3DOpenGLES2 -- ^ Enable 3D acceleration using OpenGLES2 - | Enable3DSoftware -- ^ Enable 3D acceleration using software rendering - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies whether ctrl+click should generate a right-click event --- on Mac. By default holding ctrl while left clicking will not generate a right --- click event when on Mac. -data MacCTRLClickOptions - = NoRightClick -- ^ Disable emulating right click - | EmulateRightClick -- ^ Enable emulating right click - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies whether relative mouse mode is implemented using mouse --- warping. By default SDL will use raw input for relative mouse mode -data MouseModeWarpOptions - = MouseRawInput -- ^ Relative mouse mode uses the raw input - | MouseWarping -- ^ Relative mouse mode uses mouse warping - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies which render driver to use. By default the first one --- in the list that is available on the current platform is chosen. -data RenderDrivers - = Direct3D - | OpenGL - | OpenGLES - | OpenGLES2 - | Software - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies whether the OpenGL render driver uses shaders. --- By default shaders are used if OpenGL supports them. -data RenderOpenGLShaderOptions - = DisableShaders -- ^ Disable shaders - | EnableShaders -- ^ Enable shaders, if they are available - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies scaling quality. By default nearest pixel sampling is --- used. -data RenderScaleQuality - = ScaleNearest -- ^ Nearest pixel sampling - | ScaleLinear -- ^ linear filtering (supported by OpenGL and Direct3D) - | ScaleBest -- ^ Anisotropic filtering (supported by Direct3D) - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies whether sync to vertical refresh is enabled or --- disabled to avoid tearing. By default SDL uses the flag passed into calls --- to create renderers. -data RenderVSyncOptions - = DisableVSync - | EnableVSync - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A hint that specifies which shader compiler to preload when using the Chrome --- ANGLE binaries. By default @d3dcompiler_46.dll@ will be used. -data VideoWinD3DCompilerOptions - = D3DVistaOrLater -- ^ Use @d3dcompiler_46.dll@, best for Vista or later - | D3DXPSupport -- ^ Use @d3dcompiler_43.dll@ for XP support - | D3DNone -- ^ Do not load any library, useful if you compiled ANGLE from source and included the compiler in your binaries - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | The 'Hint' type exports a well-typed interface to SDL's concept of --- . This type has instances for --- both 'HasGetter' and 'HasSetter', allowing you to get and set hints. Note that --- the 'HasSetter' interface is fairly relaxed - if a hint cannot be set, the --- failure will be silently discarded. For more feedback and control when setting --- hints, see 'setHintWithPriority'. -data Hint :: * -> * where - HintAccelerometerAsJoystick :: Hint AccelerometerJoystickOptions - HintFramebufferAcceleration :: Hint FramebufferAccelerationOptions - HintMacCTRLClick :: Hint MacCTRLClickOptions - HintMouseRelativeModeWarp :: Hint MouseModeWarpOptions - HintRenderDriver :: Hint RenderDrivers - HintRenderOpenGLShaders :: Hint RenderOpenGLShaderOptions - HintRenderScaleQuality :: Hint RenderScaleQuality - HintRenderVSync :: Hint RenderVSyncOptions - HintVideoWinD3DCompiler :: Hint VideoWinD3DCompilerOptions - -instance HasSetter (Hint v) v where - hint $= v = - _setHint (\name value -> - void (Raw.setHint name value)) - hint - v - --- | How to deal with setting hints when an existing override or environment --- variable is present. -data HintPriority - = DefaultPriority -- ^ Low priority, used for default values - | NormalPriority -- ^ Medium priority - | OverridePriority -- ^ High priority - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | Set the value of a hint, applying priority rules for when there is a --- conflict. Ordinarily, a hint will not be set if there is an existing override --- hint or environment variable that takes precedence. -setHintWithPriority :: MonadIO m => HintPriority -> Hint v -> v -> m Bool -setHintWithPriority prio = - _setHint (\name value -> - Raw.setHintWithPriority - name - value - (case prio of - DefaultPriority -> Raw.SDL_HINT_DEFAULT - NormalPriority -> Raw.SDL_HINT_NORMAL - OverridePriority -> Raw.SDL_HINT_OVERRIDE)) - -_setHint :: MonadIO m => (CString -> CString -> IO a) -> Hint v -> v -> m a -_setHint f h@HintAccelerometerAsJoystick v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - AccelerometerNotJoystick -> "0" - AccelerometerIsJoystick -> "1") - (f hint) - -_setHint f h@HintFramebufferAcceleration v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - Disable3D -> "0" - Enable3DDefault -> "1" - Enable3DDirect3D -> "direct3d" - Enable3DOpenGL -> "opengl" - Enable3DOpenGLES -> "opengles" - Enable3DOpenGLES2 -> "opengles2" - Enable3DSoftware -> "software" - ) - (f hint) - -_setHint f h@HintMacCTRLClick v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - NoRightClick -> "0" - EmulateRightClick -> "1") - (f hint) - -_setHint f h@HintMouseRelativeModeWarp v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - MouseRawInput -> "0" - MouseWarping -> "1") - (f hint) - -_setHint f h@HintRenderDriver v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - Direct3D -> "direct3d" - OpenGL -> "opengl" - OpenGLES -> "opengles" - OpenGLES2 -> "opengles2" - Software -> "software") - (f hint) - -_setHint f h@HintRenderOpenGLShaders v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - DisableShaders -> "0" - EnableShaders -> "1") - (f hint) - -_setHint f h@HintRenderScaleQuality v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - ScaleNearest -> "0" - ScaleLinear -> "1" - ScaleBest -> "2") - (f hint) - -_setHint f h@HintRenderVSync v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - DisableVSync -> "0" - EnableVSync -> "1") - (f hint) - -_setHint f h@HintVideoWinD3DCompiler v = liftIO $ - withCString (hintToString h) $ \hint -> - withCString - (case v of - D3DVistaOrLater -> "d3dcompiler_46.dll" - D3DXPSupport -> "d3dcompiler_43.dll" - D3DNone -> "none") - (f hint) - --- | Retrieve and map the current value associated with the given hint. -mapHint :: MonadIO m => Hint v -> (String -> Maybe v) -> m v -mapHint h f = liftIO $ - withCString (hintToString h) $ \hint -> do - strResult <- peekCString =<< Raw.getHint hint - return $! fromMaybe - (throw (SDLUnknownHintValue (hintToString h) strResult)) - (f strResult) - -instance HasGetter (Hint v) v where - get h@HintAccelerometerAsJoystick = - mapHint h (\case - "0" -> Just AccelerometerNotJoystick - "1" -> Just AccelerometerIsJoystick - _ -> Nothing) - - get h@HintFramebufferAcceleration = - mapHint h (\case - "0" -> Just Disable3D - "1" -> Just Enable3DDefault - "direct3d" -> Just Enable3DDirect3D - "opengl" -> Just Enable3DOpenGL - "opengles" -> Just Enable3DOpenGLES - "opengles2" -> Just Enable3DOpenGLES2 - "software" -> Just Enable3DSoftware - _ -> Nothing) - - get h@HintMacCTRLClick = - mapHint h (\case - "0" -> Just NoRightClick - "1" -> Just EmulateRightClick - _ -> Nothing) - - get h@HintMouseRelativeModeWarp = - mapHint h (\case - "0" -> Just MouseRawInput - "1" -> Just MouseWarping - _ -> Nothing) - - get h@HintRenderDriver = - mapHint h (\case - "direct3d" -> Just Direct3D - "opengl" -> Just OpenGL - "opengles" -> Just OpenGLES - "opengles2" -> Just OpenGLES2 - "software" -> Just Software - _ -> Nothing) - - get h@HintRenderOpenGLShaders = - mapHint h (\case - "0" -> Just DisableShaders - "1" -> Just EnableShaders - _ -> Nothing) - - get h@HintRenderScaleQuality = - mapHint h (\case - "0" -> Just ScaleNearest - "1" -> Just ScaleLinear - "2" -> Just ScaleBest - _ -> Nothing) - - get h@HintRenderVSync = - mapHint h (\case - "0" -> Just DisableVSync - "1" -> Just EnableVSync - _ -> Nothing) - - get h@HintVideoWinD3DCompiler = - mapHint h (\case - "d3dcompiler_46.dll" -> Just D3DVistaOrLater - "d3dcompiler_43.dll" -> Just D3DXPSupport - "none" -> Just D3DNone - _ -> Nothing) - -hintToString :: Hint v -> String -hintToString HintAccelerometerAsJoystick = "SDL_HINT_ACCELEROMETER_AS_JOYSTICK" -hintToString HintFramebufferAcceleration = "SDL_HINT_FRAMEBUFFER_ACCELERATION" -hintToString HintMacCTRLClick = "SDL_HINT_MAC_CTRL_CLICK_EMULATE_RIGHT_CLICK" -hintToString HintMouseRelativeModeWarp = "SDL_HINT_MOUSE_RELATIVE_MODE_WARP" -hintToString HintRenderDriver = "SDL_HINT_RENDER_DRIVER" -hintToString HintRenderOpenGLShaders = "SDL_HINT_RENDER_OPENGL_SHADERS" -hintToString HintRenderScaleQuality = "SDL_HINT_RENDER_SCALE_QUALITY" -hintToString HintRenderVSync = "SDL_HINT_RENDER_VSYNC" -hintToString HintVideoWinD3DCompiler = "SDL_HINT_VIDEO_WIN_D3DCOMPILER" - -clearHints :: MonadIO m => m () -clearHints = Raw.clearHints +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module SDL.Hint ( + -- * Getting and setting hints + Hint(..), + setHintWithPriority, + HintPriority(..), + clearHints, + + -- * Hint Information + -- ** 'HintAccelerometerAsJoystick' + AccelerometerJoystickOptions(..), + + -- ** 'HintFramebufferAcceleration' + FramebufferAccelerationOptions(..), + + -- ** 'HintMacCTRLClick' + MacCTRLClickOptions(..), + + -- ** 'HintMouseRelativeModeWarp' + MouseModeWarpOptions(..), + + -- ** 'HintRenderDriver' + RenderDrivers(..), + + -- ** 'HintRenderOpenGLShaders' + RenderOpenGLShaderOptions(..), + + -- ** 'HintRenderScaleQuality' + RenderScaleQuality(..), + + -- ** 'HintRenderVSync' + RenderVSyncOptions(..), + + -- ** 'HintVideoWinD3DCompiler' + VideoWinD3DCompilerOptions(..) + ) where + +import Control.Exception +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Data (Data) +import Data.Maybe (fromMaybe) +import Data.StateVar +import Data.Typeable +import Foreign.C +import GHC.Generics (Generic) +import SDL.Exception +import qualified SDL.Raw as Raw + +-- | A hint that specifies whether the Android\/iOS built-in accelerometer should +-- be listed as a joystick device, rather than listing actual joysticks only. +-- By default SDL will list real joysticks along with the accelerometer as if it +-- were a 3 axis joystick. +data AccelerometerJoystickOptions + = AccelerometerNotJoystick + -- ^ List only real joysticks and accept input from them + | AccelerometerIsJoystick + -- ^ List real joysticks along with the accelerometer as if it were a 3 axis + -- joystick (the default) + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies how 3D acceleration is used to accelerate the SDL +-- screen surface. By default SDL tries to make a best guess whether to use +-- acceleration or not on each platform. +data FramebufferAccelerationOptions + = Disable3D -- ^ Disable 3D acceleration + | Enable3DDefault -- ^ Enable 3D acceleration, using the default renderer + | Enable3DDirect3D -- ^ Enable 3D acceleration using Direct3D + | Enable3DOpenGL -- ^ Enable 3D acceleration using OpenGL + | Enable3DOpenGLES -- ^ Enable 3D acceleration using OpenGLES + | Enable3DOpenGLES2 -- ^ Enable 3D acceleration using OpenGLES2 + | Enable3DSoftware -- ^ Enable 3D acceleration using software rendering + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies whether ctrl+click should generate a right-click event +-- on Mac. By default holding ctrl while left clicking will not generate a right +-- click event when on Mac. +data MacCTRLClickOptions + = NoRightClick -- ^ Disable emulating right click + | EmulateRightClick -- ^ Enable emulating right click + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies whether relative mouse mode is implemented using mouse +-- warping. By default SDL will use raw input for relative mouse mode +data MouseModeWarpOptions + = MouseRawInput -- ^ Relative mouse mode uses the raw input + | MouseWarping -- ^ Relative mouse mode uses mouse warping + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies which render driver to use. By default the first one +-- in the list that is available on the current platform is chosen. +data RenderDrivers + = Direct3D + | OpenGL + | OpenGLES + | OpenGLES2 + | Software + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies whether the OpenGL render driver uses shaders. +-- By default shaders are used if OpenGL supports them. +data RenderOpenGLShaderOptions + = DisableShaders -- ^ Disable shaders + | EnableShaders -- ^ Enable shaders, if they are available + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies scaling quality. By default nearest pixel sampling is +-- used. +data RenderScaleQuality + = ScaleNearest -- ^ Nearest pixel sampling + | ScaleLinear -- ^ linear filtering (supported by OpenGL and Direct3D) + | ScaleBest -- ^ Anisotropic filtering (supported by Direct3D) + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies whether sync to vertical refresh is enabled or +-- disabled to avoid tearing. By default SDL uses the flag passed into calls +-- to create renderers. +data RenderVSyncOptions + = DisableVSync + | EnableVSync + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A hint that specifies which shader compiler to preload when using the Chrome +-- ANGLE binaries. By default @d3dcompiler_46.dll@ will be used. +data VideoWinD3DCompilerOptions + = D3DVistaOrLater -- ^ Use @d3dcompiler_46.dll@, best for Vista or later + | D3DXPSupport -- ^ Use @d3dcompiler_43.dll@ for XP support + | D3DNone -- ^ Do not load any library, useful if you compiled ANGLE from source and included the compiler in your binaries + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | The 'Hint' type exports a well-typed interface to SDL's concept of +-- . This type has instances for +-- both 'HasGetter' and 'HasSetter', allowing you to get and set hints. Note that +-- the 'HasSetter' interface is fairly relaxed - if a hint cannot be set, the +-- failure will be silently discarded. For more feedback and control when setting +-- hints, see 'setHintWithPriority'. +data Hint :: * -> * where + HintAccelerometerAsJoystick :: Hint AccelerometerJoystickOptions + HintFramebufferAcceleration :: Hint FramebufferAccelerationOptions + HintMacCTRLClick :: Hint MacCTRLClickOptions + HintMouseRelativeModeWarp :: Hint MouseModeWarpOptions + HintRenderDriver :: Hint RenderDrivers + HintRenderOpenGLShaders :: Hint RenderOpenGLShaderOptions + HintRenderScaleQuality :: Hint RenderScaleQuality + HintRenderVSync :: Hint RenderVSyncOptions + HintVideoWinD3DCompiler :: Hint VideoWinD3DCompilerOptions + +instance HasSetter (Hint v) v where + hint $= v = + _setHint (\name value -> + void (Raw.setHint name value)) + hint + v + +-- | How to deal with setting hints when an existing override or environment +-- variable is present. +data HintPriority + = DefaultPriority -- ^ Low priority, used for default values + | NormalPriority -- ^ Medium priority + | OverridePriority -- ^ High priority + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | Set the value of a hint, applying priority rules for when there is a +-- conflict. Ordinarily, a hint will not be set if there is an existing override +-- hint or environment variable that takes precedence. +setHintWithPriority :: MonadIO m => HintPriority -> Hint v -> v -> m Bool +setHintWithPriority prio = + _setHint (\name value -> + Raw.setHintWithPriority + name + value + (case prio of + DefaultPriority -> Raw.SDL_HINT_DEFAULT + NormalPriority -> Raw.SDL_HINT_NORMAL + OverridePriority -> Raw.SDL_HINT_OVERRIDE)) + +_setHint :: MonadIO m => (CString -> CString -> IO a) -> Hint v -> v -> m a +_setHint f h@HintAccelerometerAsJoystick v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + AccelerometerNotJoystick -> "0" + AccelerometerIsJoystick -> "1") + (f hint) + +_setHint f h@HintFramebufferAcceleration v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + Disable3D -> "0" + Enable3DDefault -> "1" + Enable3DDirect3D -> "direct3d" + Enable3DOpenGL -> "opengl" + Enable3DOpenGLES -> "opengles" + Enable3DOpenGLES2 -> "opengles2" + Enable3DSoftware -> "software" + ) + (f hint) + +_setHint f h@HintMacCTRLClick v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + NoRightClick -> "0" + EmulateRightClick -> "1") + (f hint) + +_setHint f h@HintMouseRelativeModeWarp v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + MouseRawInput -> "0" + MouseWarping -> "1") + (f hint) + +_setHint f h@HintRenderDriver v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + Direct3D -> "direct3d" + OpenGL -> "opengl" + OpenGLES -> "opengles" + OpenGLES2 -> "opengles2" + Software -> "software") + (f hint) + +_setHint f h@HintRenderOpenGLShaders v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + DisableShaders -> "0" + EnableShaders -> "1") + (f hint) + +_setHint f h@HintRenderScaleQuality v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + ScaleNearest -> "0" + ScaleLinear -> "1" + ScaleBest -> "2") + (f hint) + +_setHint f h@HintRenderVSync v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + DisableVSync -> "0" + EnableVSync -> "1") + (f hint) + +_setHint f h@HintVideoWinD3DCompiler v = liftIO $ + withCString (hintToString h) $ \hint -> + withCString + (case v of + D3DVistaOrLater -> "d3dcompiler_46.dll" + D3DXPSupport -> "d3dcompiler_43.dll" + D3DNone -> "none") + (f hint) + +-- | Retrieve and map the current value associated with the given hint. +mapHint :: MonadIO m => Hint v -> (String -> Maybe v) -> m v +mapHint h f = liftIO $ + withCString (hintToString h) $ \hint -> do + strResult <- peekCString =<< Raw.getHint hint + return $! fromMaybe + (throw (SDLUnknownHintValue (hintToString h) strResult)) + (f strResult) + +instance HasGetter (Hint v) v where + get h@HintAccelerometerAsJoystick = + mapHint h (\case + "0" -> Just AccelerometerNotJoystick + "1" -> Just AccelerometerIsJoystick + _ -> Nothing) + + get h@HintFramebufferAcceleration = + mapHint h (\case + "0" -> Just Disable3D + "1" -> Just Enable3DDefault + "direct3d" -> Just Enable3DDirect3D + "opengl" -> Just Enable3DOpenGL + "opengles" -> Just Enable3DOpenGLES + "opengles2" -> Just Enable3DOpenGLES2 + "software" -> Just Enable3DSoftware + _ -> Nothing) + + get h@HintMacCTRLClick = + mapHint h (\case + "0" -> Just NoRightClick + "1" -> Just EmulateRightClick + _ -> Nothing) + + get h@HintMouseRelativeModeWarp = + mapHint h (\case + "0" -> Just MouseRawInput + "1" -> Just MouseWarping + _ -> Nothing) + + get h@HintRenderDriver = + mapHint h (\case + "direct3d" -> Just Direct3D + "opengl" -> Just OpenGL + "opengles" -> Just OpenGLES + "opengles2" -> Just OpenGLES2 + "software" -> Just Software + _ -> Nothing) + + get h@HintRenderOpenGLShaders = + mapHint h (\case + "0" -> Just DisableShaders + "1" -> Just EnableShaders + _ -> Nothing) + + get h@HintRenderScaleQuality = + mapHint h (\case + "0" -> Just ScaleNearest + "1" -> Just ScaleLinear + "2" -> Just ScaleBest + _ -> Nothing) + + get h@HintRenderVSync = + mapHint h (\case + "0" -> Just DisableVSync + "1" -> Just EnableVSync + _ -> Nothing) + + get h@HintVideoWinD3DCompiler = + mapHint h (\case + "d3dcompiler_46.dll" -> Just D3DVistaOrLater + "d3dcompiler_43.dll" -> Just D3DXPSupport + "none" -> Just D3DNone + _ -> Nothing) + +hintToString :: Hint v -> String +hintToString HintAccelerometerAsJoystick = "SDL_HINT_ACCELEROMETER_AS_JOYSTICK" +hintToString HintFramebufferAcceleration = "SDL_HINT_FRAMEBUFFER_ACCELERATION" +hintToString HintMacCTRLClick = "SDL_HINT_MAC_CTRL_CLICK_EMULATE_RIGHT_CLICK" +hintToString HintMouseRelativeModeWarp = "SDL_HINT_MOUSE_RELATIVE_MODE_WARP" +hintToString HintRenderDriver = "SDL_HINT_RENDER_DRIVER" +hintToString HintRenderOpenGLShaders = "SDL_HINT_RENDER_OPENGL_SHADERS" +hintToString HintRenderScaleQuality = "SDL_HINT_RENDER_SCALE_QUALITY" +hintToString HintRenderVSync = "SDL_HINT_RENDER_VSYNC" +hintToString HintVideoWinD3DCompiler = "SDL_HINT_VIDEO_WIN_D3DCOMPILER" + +clearHints :: MonadIO m => m () +clearHints = Raw.clearHints diff --git a/src/SDL/Init.hs b/src/SDL/Init.hs --- a/src/SDL/Init.hs +++ b/src/SDL/Init.hs @@ -1,80 +1,80 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} - -module SDL.Init - ( initialize - , initializeAll - , InitFlag(..) - , quit - , version - ) where - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bitmask (foldFlags) -import Data.Data (Data) -import Data.Typeable -import Data.Word -import Foreign.Marshal.Alloc -import Foreign.Storable -import GHC.Generics -import SDL.Exception -import SDL.Internal.Numbered -import qualified SDL.Raw as Raw - -#if !MIN_VERSION_base(4,8,0) -import Data.Foldable -#endif - -{-# DEPRECATED InitEverything "Instead of initialize [InitEverything], use initializeAll" #-} -data InitFlag - = InitTimer - | InitAudio - | InitVideo - | InitJoystick - | InitHaptic - | InitGameController - | InitEvents - | InitEverything - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - -instance ToNumber InitFlag Word32 where - toNumber InitTimer = Raw.SDL_INIT_TIMER - toNumber InitAudio = Raw.SDL_INIT_AUDIO - toNumber InitVideo = Raw.SDL_INIT_VIDEO - toNumber InitJoystick = Raw.SDL_INIT_JOYSTICK - toNumber InitHaptic = Raw.SDL_INIT_HAPTIC - toNumber InitGameController = Raw.SDL_INIT_GAMECONTROLLER - toNumber InitEvents = Raw.SDL_INIT_EVENTS - toNumber InitEverything = Raw.SDL_INIT_EVERYTHING - --- | Initializes SDL and the given subsystems. Do not call any SDL functions --- prior to this one, unless otherwise documented that you may do so. --- --- You may call this function again with additional subsystems to initialize. --- --- Throws 'SDLEx.SDLException' if initialization fails. -initialize :: (Foldable f, Functor m, MonadIO m) => f InitFlag -> m () -initialize flags = - throwIfNeg_ "SDL.Init.init" "SDL_Init" $ - Raw.init (foldFlags toNumber flags) - --- | Equivalent to @'initialize' ['minBound' .. 'maxBound']@. -initializeAll :: (Functor m, MonadIO m) => m () -initializeAll = initialize [minBound .. maxBound] - --- | Quit and shutdown SDL, freeing any resources that may have been in use. --- Do not call any SDL functions after you've called this function, unless --- otherwise documented that you may do so. -quit :: MonadIO m => m () -quit = Raw.quit - --- | The major, minor, and patch versions of the SDL library linked with. --- Does not require initialization. -version :: (Integral a, MonadIO m) => m (a, a, a) -version = liftIO $ do - Raw.Version major minor patch <- alloca $ \v -> Raw.getVersion v >> peek v - return (fromIntegral major, fromIntegral minor, fromIntegral patch) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module SDL.Init + ( initialize + , initializeAll + , InitFlag(..) + , quit + , version + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bitmask (foldFlags) +import Data.Data (Data) +import Data.Typeable +import Data.Word +import Foreign.Marshal.Alloc +import Foreign.Storable +import GHC.Generics +import SDL.Exception +import SDL.Internal.Numbered +import qualified SDL.Raw as Raw + +#if !MIN_VERSION_base(4,8,0) +import Data.Foldable +#endif + +{-# DEPRECATED InitEverything "Instead of initialize [InitEverything], use initializeAll" #-} +data InitFlag + = InitTimer + | InitAudio + | InitVideo + | InitJoystick + | InitHaptic + | InitGameController + | InitEvents + | InitEverything + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +instance ToNumber InitFlag Word32 where + toNumber InitTimer = Raw.SDL_INIT_TIMER + toNumber InitAudio = Raw.SDL_INIT_AUDIO + toNumber InitVideo = Raw.SDL_INIT_VIDEO + toNumber InitJoystick = Raw.SDL_INIT_JOYSTICK + toNumber InitHaptic = Raw.SDL_INIT_HAPTIC + toNumber InitGameController = Raw.SDL_INIT_GAMECONTROLLER + toNumber InitEvents = Raw.SDL_INIT_EVENTS + toNumber InitEverything = Raw.SDL_INIT_EVERYTHING + +-- | Initializes SDL and the given subsystems. Do not call any SDL functions +-- prior to this one, unless otherwise documented that you may do so. +-- +-- You may call this function again with additional subsystems to initialize. +-- +-- Throws 'SDLEx.SDLException' if initialization fails. +initialize :: (Foldable f, Functor m, MonadIO m) => f InitFlag -> m () +initialize flags = + throwIfNeg_ "SDL.Init.init" "SDL_Init" $ + Raw.init (foldFlags toNumber flags) + +-- | Equivalent to @'initialize' ['minBound' .. 'maxBound']@. +initializeAll :: (Functor m, MonadIO m) => m () +initializeAll = initialize [minBound .. maxBound] + +-- | Quit and shutdown SDL, freeing any resources that may have been in use. +-- Do not call any SDL functions after you've called this function, unless +-- otherwise documented that you may do so. +quit :: MonadIO m => m () +quit = Raw.quit + +-- | The major, minor, and patch versions of the SDL library linked with. +-- Does not require initialization. +version :: (Integral a, MonadIO m) => m (a, a, a) +version = liftIO $ do + Raw.Version major minor patch <- alloca $ \v -> Raw.getVersion v >> peek v + return (fromIntegral major, fromIntegral minor, fromIntegral patch) diff --git a/src/SDL/Input.hs b/src/SDL/Input.hs --- a/src/SDL/Input.hs +++ b/src/SDL/Input.hs @@ -1,10 +1,10 @@ -module SDL.Input - ( module SDL.Input.Joystick - , module SDL.Input.Keyboard - , module SDL.Input.Mouse - ) where - - -import SDL.Input.Joystick -import SDL.Input.Keyboard -import SDL.Input.Mouse +module SDL.Input + ( module SDL.Input.Joystick + , module SDL.Input.Keyboard + , module SDL.Input.Mouse + ) where + + +import SDL.Input.Joystick +import SDL.Input.Keyboard +import SDL.Input.Mouse diff --git a/src/SDL/Input/Joystick.hs b/src/SDL/Input/Joystick.hs --- a/src/SDL/Input/Joystick.hs +++ b/src/SDL/Input/Joystick.hs @@ -1,148 +1,148 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} - -module SDL.Input.Joystick - ( numJoysticks - , availableJoysticks - , JoystickDevice(..) - - , openJoystick - , closeJoystick - - , getJoystickID - , Joystick - , buttonPressed - , ballDelta - , axisPosition - , numAxes - , numButtons - , numBalls - ) where - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Int -import Data.Text (Text) -import Data.Traversable (for) -import Data.Typeable -import Foreign.C.Types -import Foreign.Marshal.Alloc -import Foreign.Storable -import GHC.Generics (Generic) -import Linear -import SDL.Exception -import SDL.Internal.Types -import qualified Data.ByteString as BS -import qualified Data.Text.Encoding as Text -import qualified Data.Vector as V -import qualified SDL.Raw as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- | A description of joystick that can be opened using 'openJoystick'. To retrieve a list of --- connected joysticks, use 'availableJoysticks'. -data JoystickDevice = JoystickDevice - { joystickDeviceName :: Text - , joystickDeviceId :: CInt - } deriving (Eq, Generic, Read, Ord, Show, Typeable) - --- | Count the number of joysticks attached to the system. --- --- See @@ for C documentation. -numJoysticks :: MonadIO m => m (CInt) -numJoysticks = throwIfNeg "SDL.Input.Joystick.availableJoysticks" "SDL_NumJoysticks" Raw.numJoysticks - --- | Enumerate all connected joysticks, retrieving a description of each. -availableJoysticks :: MonadIO m => m (V.Vector JoystickDevice) -availableJoysticks = liftIO $ do - n <- numJoysticks - fmap (V.fromList) $ - for [0 .. (n - 1)] $ \i -> do - cstr <- - throwIfNull "SDL.Input.Joystick.availableJoysticks" "SDL_JoystickNameForIndex" $ - Raw.joystickNameForIndex i - name <- Text.decodeUtf8 <$> BS.packCString cstr - return (JoystickDevice name i) - --- | Open a joystick so that you can start receiving events from interaction with this joystick. --- --- See @@ for C documentation. -openJoystick :: (Functor m,MonadIO m) - => JoystickDevice -- ^ The device to open. Use 'availableJoysticks' to find 'JoystickDevices's - -> m Joystick -openJoystick (JoystickDevice _ x) = - fmap Joystick $ - throwIfNull "SDL.Input.Joystick.openJoystick" "SDL_OpenJoystick" $ - Raw.joystickOpen x - --- | Close a joystick previously opened with 'openJoystick'. --- --- See @@ for C documentation. -closeJoystick :: MonadIO m => Joystick -> m () -closeJoystick (Joystick j) = Raw.joystickClose j - --- | Get the instance ID of an opened joystick. The instance ID is used to identify the joystick --- in future SDL events. --- --- See @@ for C documentation. -getJoystickID :: MonadIO m => Joystick -> m (Int32) -getJoystickID (Joystick j) = - throwIfNeg "SDL.Input.Joystick.getJoystickID" "SDL_JoystickInstanceID" $ - Raw.joystickInstanceID j - --- | Determine if a given button is currently held. --- --- See @@ for C documentation. -buttonPressed :: (Functor m,MonadIO m) - => Joystick - -> CInt -- ^ The index of the button. You can use 'numButtons' to determine how many buttons a given joystick has. - -> m Bool -buttonPressed (Joystick j) buttonIndex = (== 1) <$> Raw.joystickGetButton j buttonIndex - --- | Get the ball axis change since the last poll. --- --- See @@ for C documentation. -ballDelta :: MonadIO m - => Joystick - -> CInt -- ^ The index of the joystick ball. You can use 'numBalls' to determine how many balls a given joystick has. - -> m (V2 CInt) -ballDelta (Joystick j) ballIndex = liftIO $ - alloca $ \xptr -> - alloca $ \yptr -> do - throwIfNeg_ "SDL.Input.Joystick.ballDelta" "SDL_JoystickGetBall" $ - Raw.joystickGetBall j ballIndex xptr yptr - - V2 <$> peek xptr <*> peek yptr - --- | Get the current state of an axis control on a joystick. --- --- Returns a 16-bit signed integer representing the current position of the axis. The state is a value ranging from -32768 to 32767. --- --- On most modern joysticks the x-axis is usually represented by axis 0 and the y-axis by axis 1. The value returned by 'axisPosition' is a signed integer (-32768 to 32767) representing the current position of the axis. It may be necessary to impose certain tolerances on these values to account for jitter. --- --- Some joysticks use axes 2 and 3 for extra buttons. --- --- See @@ for C documentation. -axisPosition :: MonadIO m => Joystick -> CInt -> m Int16 -axisPosition (Joystick j) axisIndex = Raw.joystickGetAxis j axisIndex - --- | Get the number of general axis controls on a joystick. --- --- See @@ for C documentation. -numAxes :: (MonadIO m) => Joystick -> m CInt -numAxes (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numAxis" "SDL_JoystickNumAxes" (Raw.joystickNumAxes j) - --- | Get the number of buttons on a joystick. --- --- See @@ for C documentation. -numButtons :: (MonadIO m) => Joystick -> m CInt -numButtons (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numButtons" "SDL_JoystickNumButtons" (Raw.joystickNumButtons j) - --- | Get the number of trackballs on a joystick. --- --- See @@ for C documentation. -numBalls :: (MonadIO m) => Joystick -> m CInt -numBalls (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numBalls" "SDL_JoystickNumBalls" (Raw.joystickNumBalls j) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SDL.Input.Joystick + ( numJoysticks + , availableJoysticks + , JoystickDevice(..) + + , openJoystick + , closeJoystick + + , getJoystickID + , Joystick + , buttonPressed + , ballDelta + , axisPosition + , numAxes + , numButtons + , numBalls + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Int +import Data.Text (Text) +import Data.Traversable (for) +import Data.Typeable +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Storable +import GHC.Generics (Generic) +import Linear +import SDL.Exception +import SDL.Internal.Types +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as Text +import qualified Data.Vector as V +import qualified SDL.Raw as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +-- | A description of joystick that can be opened using 'openJoystick'. To retrieve a list of +-- connected joysticks, use 'availableJoysticks'. +data JoystickDevice = JoystickDevice + { joystickDeviceName :: Text + , joystickDeviceId :: CInt + } deriving (Eq, Generic, Read, Ord, Show, Typeable) + +-- | Count the number of joysticks attached to the system. +-- +-- See @@ for C documentation. +numJoysticks :: MonadIO m => m (CInt) +numJoysticks = throwIfNeg "SDL.Input.Joystick.availableJoysticks" "SDL_NumJoysticks" Raw.numJoysticks + +-- | Enumerate all connected joysticks, retrieving a description of each. +availableJoysticks :: MonadIO m => m (V.Vector JoystickDevice) +availableJoysticks = liftIO $ do + n <- numJoysticks + fmap (V.fromList) $ + for [0 .. (n - 1)] $ \i -> do + cstr <- + throwIfNull "SDL.Input.Joystick.availableJoysticks" "SDL_JoystickNameForIndex" $ + Raw.joystickNameForIndex i + name <- Text.decodeUtf8 <$> BS.packCString cstr + return (JoystickDevice name i) + +-- | Open a joystick so that you can start receiving events from interaction with this joystick. +-- +-- See @@ for C documentation. +openJoystick :: (Functor m,MonadIO m) + => JoystickDevice -- ^ The device to open. Use 'availableJoysticks' to find 'JoystickDevices's + -> m Joystick +openJoystick (JoystickDevice _ x) = + fmap Joystick $ + throwIfNull "SDL.Input.Joystick.openJoystick" "SDL_OpenJoystick" $ + Raw.joystickOpen x + +-- | Close a joystick previously opened with 'openJoystick'. +-- +-- See @@ for C documentation. +closeJoystick :: MonadIO m => Joystick -> m () +closeJoystick (Joystick j) = Raw.joystickClose j + +-- | Get the instance ID of an opened joystick. The instance ID is used to identify the joystick +-- in future SDL events. +-- +-- See @@ for C documentation. +getJoystickID :: MonadIO m => Joystick -> m (Int32) +getJoystickID (Joystick j) = + throwIfNeg "SDL.Input.Joystick.getJoystickID" "SDL_JoystickInstanceID" $ + Raw.joystickInstanceID j + +-- | Determine if a given button is currently held. +-- +-- See @@ for C documentation. +buttonPressed :: (Functor m,MonadIO m) + => Joystick + -> CInt -- ^ The index of the button. You can use 'numButtons' to determine how many buttons a given joystick has. + -> m Bool +buttonPressed (Joystick j) buttonIndex = (== 1) <$> Raw.joystickGetButton j buttonIndex + +-- | Get the ball axis change since the last poll. +-- +-- See @@ for C documentation. +ballDelta :: MonadIO m + => Joystick + -> CInt -- ^ The index of the joystick ball. You can use 'numBalls' to determine how many balls a given joystick has. + -> m (V2 CInt) +ballDelta (Joystick j) ballIndex = liftIO $ + alloca $ \xptr -> + alloca $ \yptr -> do + throwIfNeg_ "SDL.Input.Joystick.ballDelta" "SDL_JoystickGetBall" $ + Raw.joystickGetBall j ballIndex xptr yptr + + V2 <$> peek xptr <*> peek yptr + +-- | Get the current state of an axis control on a joystick. +-- +-- Returns a 16-bit signed integer representing the current position of the axis. The state is a value ranging from -32768 to 32767. +-- +-- On most modern joysticks the x-axis is usually represented by axis 0 and the y-axis by axis 1. The value returned by 'axisPosition' is a signed integer (-32768 to 32767) representing the current position of the axis. It may be necessary to impose certain tolerances on these values to account for jitter. +-- +-- Some joysticks use axes 2 and 3 for extra buttons. +-- +-- See @@ for C documentation. +axisPosition :: MonadIO m => Joystick -> CInt -> m Int16 +axisPosition (Joystick j) axisIndex = Raw.joystickGetAxis j axisIndex + +-- | Get the number of general axis controls on a joystick. +-- +-- See @@ for C documentation. +numAxes :: (MonadIO m) => Joystick -> m CInt +numAxes (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numAxis" "SDL_JoystickNumAxes" (Raw.joystickNumAxes j) + +-- | Get the number of buttons on a joystick. +-- +-- See @@ for C documentation. +numButtons :: (MonadIO m) => Joystick -> m CInt +numButtons (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numButtons" "SDL_JoystickNumButtons" (Raw.joystickNumButtons j) + +-- | Get the number of trackballs on a joystick. +-- +-- See @@ for C documentation. +numBalls :: (MonadIO m) => Joystick -> m CInt +numBalls (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numBalls" "SDL_JoystickNumBalls" (Raw.joystickNumBalls j) diff --git a/src/SDL/Input/Keyboard.hs b/src/SDL/Input/Keyboard.hs --- a/src/SDL/Input/Keyboard.hs +++ b/src/SDL/Input/Keyboard.hs @@ -1,166 +1,166 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module SDL.Input.Keyboard - ( -- * Keyboard Modifiers - getModState - , KeyModifier(..) - - , getKeyboardState - - -- * Text Input - , startTextInput - , stopTextInput - - -- * Screen Keyboard - , hasScreenKeyboardSupport - , isScreenKeyboardShown - - -- * Scancodes - , getScancodeName - , Scancode(..) - - -- * Keycodes - , Keycode(..) - - -- * Keysym - , Keysym(..) - - -- * Keycodes and Scancodes - , module SDL.Input.Keyboard.Codes -) where - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bits -import Data.Data (Data) -import Data.Typeable -import Data.Word -import Foreign.C.String -import Foreign.Marshal.Alloc -import Foreign.Marshal.Array -import Foreign.Storable -import GHC.Generics (Generic) -import SDL.Input.Keyboard.Codes -import SDL.Internal.Numbered -import SDL.Internal.Types -import qualified Data.Vector as V -import qualified SDL.Raw.Enum as Raw -import qualified SDL.Raw.Event as Raw -import qualified SDL.Raw.Types as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- | Get the current key modifier state for the keyboard. The key modifier state is a mask special keys that are held down. --- --- See @@ for C documentation. -getModState :: (Functor m, MonadIO m) => m KeyModifier -getModState = fromNumber <$> Raw.getModState - --- | Information about which keys are currently held down. Use 'getModState' to generate this information. -data KeyModifier = KeyModifier - { keyModifierLeftShift :: Bool - , keyModifierRightShift :: Bool - , keyModifierLeftCtrl :: Bool - , keyModifierRightCtrl :: Bool - , keyModifierLeftAlt :: Bool - , keyModifierRightAlt :: Bool - , keyModifierLeftGUI :: Bool - , keyModifierRightGUI :: Bool - , keyModifierNumLock :: Bool - , keyModifierCapsLock :: Bool - , keyModifierAltGr :: Bool - } deriving (Data, Eq, Ord, Read, Generic, Show, Typeable) - -instance FromNumber KeyModifier Word32 where - fromNumber m' = let m = m' in KeyModifier - { keyModifierLeftShift = m .&. Raw.KMOD_LSHIFT > 0 - , keyModifierRightShift = m .&. Raw.KMOD_RSHIFT > 0 - , keyModifierLeftCtrl = m .&. Raw.KMOD_LCTRL > 0 - , keyModifierRightCtrl = m .&. Raw.KMOD_RCTRL > 0 - , keyModifierLeftAlt = m .&. Raw.KMOD_LALT > 0 - , keyModifierRightAlt = m .&. Raw.KMOD_RALT > 0 - , keyModifierLeftGUI = m .&. Raw.KMOD_LGUI > 0 - , keyModifierRightGUI = m .&. Raw.KMOD_RGUI > 0 - , keyModifierNumLock = m .&. Raw.KMOD_NUM > 0 - , keyModifierCapsLock = m .&. Raw.KMOD_CAPS > 0 - , keyModifierAltGr = m .&. Raw.KMOD_MODE > 0 - } - -instance ToNumber KeyModifier Word32 where - toNumber m = foldr (.|.) 0 - [ if keyModifierLeftShift m then Raw.KMOD_LSHIFT else 0 - , if keyModifierRightShift m then Raw.KMOD_RSHIFT else 0 - , if keyModifierLeftCtrl m then Raw.KMOD_LCTRL else 0 - , if keyModifierRightCtrl m then Raw.KMOD_RCTRL else 0 - , if keyModifierLeftAlt m then Raw.KMOD_LALT else 0 - , if keyModifierRightAlt m then Raw.KMOD_RALT else 0 - , if keyModifierLeftGUI m then Raw.KMOD_LGUI else 0 - , if keyModifierRightGUI m then Raw.KMOD_RGUI else 0 - , if keyModifierNumLock m then Raw.KMOD_NUM else 0 - , if keyModifierCapsLock m then Raw.KMOD_CAPS else 0 - , if keyModifierAltGr m then Raw.KMOD_MODE else 0 - ] - --- | Set the rectangle used to type text inputs and start accepting text input --- events. --- --- See @@ for C documentation. -startTextInput :: MonadIO m => Raw.Rect -> m () -startTextInput rect = liftIO $ do - alloca $ \ptr -> do - poke ptr rect - Raw.setTextInputRect ptr - Raw.startTextInput - --- | Stop receiving any text input events. --- --- See @@ for C documentation. -stopTextInput :: MonadIO m => m () -stopTextInput = Raw.stopTextInput - --- | Check whether the platform has screen keyboard support. --- --- See @@ for C documentation. -hasScreenKeyboardSupport :: MonadIO m => m Bool -hasScreenKeyboardSupport = Raw.hasScreenKeyboardSupport - --- | Check whether the screen keyboard is shown for the given window. --- --- See @@ for C documentation. -isScreenKeyboardShown :: MonadIO m => Window -> m Bool -isScreenKeyboardShown (Window w) = Raw.isScreenKeyboardShown w - --- | Get a human-readable name for a scancode. If the scancode doesn't have a name this function returns the empty string. --- --- See @@ for C documentation. -getScancodeName :: MonadIO m => Scancode -> m String -getScancodeName scancode = liftIO $ do - name <- Raw.getScancodeName $ toNumber scancode - peekCString name - --- | Information about a key press or key release event. -data Keysym = Keysym - { keysymScancode :: Scancode - -- ^ The keyboard 'Scancode' - , keysymKeycode :: Keycode - -- ^ SDL's virtual key representation for this key - , keysymModifier :: KeyModifier - -- ^ A set of modifiers that were held at the time this data was generated - } deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) - --- | Get a snapshot of the current state of the keyboard. --- --- This computation generates a mapping from 'Scancode' to 'Bool' - evaluating the function at specific 'Scancode's will inform you as to whether or not that key was held down when 'getKeyboardState' was called. --- --- See @@ for C documentation. -getKeyboardState :: MonadIO m => m (Scancode -> Bool) -getKeyboardState = liftIO $ do - alloca $ \nkeys -> do - keyptr <- Raw.getKeyboardState nkeys - n <- peek nkeys - keys <- V.fromList <$> peekArray (fromIntegral n) keyptr - return $ \scancode -> 1 == keys V.! fromIntegral (toNumber scancode) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module SDL.Input.Keyboard + ( -- * Keyboard Modifiers + getModState + , KeyModifier(..) + + , getKeyboardState + + -- * Text Input + , startTextInput + , stopTextInput + + -- * Screen Keyboard + , hasScreenKeyboardSupport + , isScreenKeyboardShown + + -- * Scancodes + , getScancodeName + , Scancode(..) + + -- * Keycodes + , Keycode(..) + + -- * Keysym + , Keysym(..) + + -- * Keycodes and Scancodes + , module SDL.Input.Keyboard.Codes +) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bits +import Data.Data (Data) +import Data.Typeable +import Data.Word +import Foreign.C.String +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Storable +import GHC.Generics (Generic) +import SDL.Input.Keyboard.Codes +import SDL.Internal.Numbered +import SDL.Internal.Types +import qualified Data.Vector as V +import qualified SDL.Raw.Enum as Raw +import qualified SDL.Raw.Event as Raw +import qualified SDL.Raw.Types as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +-- | Get the current key modifier state for the keyboard. The key modifier state is a mask special keys that are held down. +-- +-- See @@ for C documentation. +getModState :: (Functor m, MonadIO m) => m KeyModifier +getModState = fromNumber <$> Raw.getModState + +-- | Information about which keys are currently held down. Use 'getModState' to generate this information. +data KeyModifier = KeyModifier + { keyModifierLeftShift :: Bool + , keyModifierRightShift :: Bool + , keyModifierLeftCtrl :: Bool + , keyModifierRightCtrl :: Bool + , keyModifierLeftAlt :: Bool + , keyModifierRightAlt :: Bool + , keyModifierLeftGUI :: Bool + , keyModifierRightGUI :: Bool + , keyModifierNumLock :: Bool + , keyModifierCapsLock :: Bool + , keyModifierAltGr :: Bool + } deriving (Data, Eq, Ord, Read, Generic, Show, Typeable) + +instance FromNumber KeyModifier Word32 where + fromNumber m' = let m = m' in KeyModifier + { keyModifierLeftShift = m .&. Raw.KMOD_LSHIFT > 0 + , keyModifierRightShift = m .&. Raw.KMOD_RSHIFT > 0 + , keyModifierLeftCtrl = m .&. Raw.KMOD_LCTRL > 0 + , keyModifierRightCtrl = m .&. Raw.KMOD_RCTRL > 0 + , keyModifierLeftAlt = m .&. Raw.KMOD_LALT > 0 + , keyModifierRightAlt = m .&. Raw.KMOD_RALT > 0 + , keyModifierLeftGUI = m .&. Raw.KMOD_LGUI > 0 + , keyModifierRightGUI = m .&. Raw.KMOD_RGUI > 0 + , keyModifierNumLock = m .&. Raw.KMOD_NUM > 0 + , keyModifierCapsLock = m .&. Raw.KMOD_CAPS > 0 + , keyModifierAltGr = m .&. Raw.KMOD_MODE > 0 + } + +instance ToNumber KeyModifier Word32 where + toNumber m = foldr (.|.) 0 + [ if keyModifierLeftShift m then Raw.KMOD_LSHIFT else 0 + , if keyModifierRightShift m then Raw.KMOD_RSHIFT else 0 + , if keyModifierLeftCtrl m then Raw.KMOD_LCTRL else 0 + , if keyModifierRightCtrl m then Raw.KMOD_RCTRL else 0 + , if keyModifierLeftAlt m then Raw.KMOD_LALT else 0 + , if keyModifierRightAlt m then Raw.KMOD_RALT else 0 + , if keyModifierLeftGUI m then Raw.KMOD_LGUI else 0 + , if keyModifierRightGUI m then Raw.KMOD_RGUI else 0 + , if keyModifierNumLock m then Raw.KMOD_NUM else 0 + , if keyModifierCapsLock m then Raw.KMOD_CAPS else 0 + , if keyModifierAltGr m then Raw.KMOD_MODE else 0 + ] + +-- | Set the rectangle used to type text inputs and start accepting text input +-- events. +-- +-- See @@ for C documentation. +startTextInput :: MonadIO m => Raw.Rect -> m () +startTextInput rect = liftIO $ do + alloca $ \ptr -> do + poke ptr rect + Raw.setTextInputRect ptr + Raw.startTextInput + +-- | Stop receiving any text input events. +-- +-- See @@ for C documentation. +stopTextInput :: MonadIO m => m () +stopTextInput = Raw.stopTextInput + +-- | Check whether the platform has screen keyboard support. +-- +-- See @@ for C documentation. +hasScreenKeyboardSupport :: MonadIO m => m Bool +hasScreenKeyboardSupport = Raw.hasScreenKeyboardSupport + +-- | Check whether the screen keyboard is shown for the given window. +-- +-- See @@ for C documentation. +isScreenKeyboardShown :: MonadIO m => Window -> m Bool +isScreenKeyboardShown (Window w) = Raw.isScreenKeyboardShown w + +-- | Get a human-readable name for a scancode. If the scancode doesn't have a name this function returns the empty string. +-- +-- See @@ for C documentation. +getScancodeName :: MonadIO m => Scancode -> m String +getScancodeName scancode = liftIO $ do + name <- Raw.getScancodeName $ toNumber scancode + peekCString name + +-- | Information about a key press or key release event. +data Keysym = Keysym + { keysymScancode :: Scancode + -- ^ The keyboard 'Scancode' + , keysymKeycode :: Keycode + -- ^ SDL's virtual key representation for this key + , keysymModifier :: KeyModifier + -- ^ A set of modifiers that were held at the time this data was generated + } deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) + +-- | Get a snapshot of the current state of the keyboard. +-- +-- This computation generates a mapping from 'Scancode' to 'Bool' - evaluating the function at specific 'Scancode's will inform you as to whether or not that key was held down when 'getKeyboardState' was called. +-- +-- See @@ for C documentation. +getKeyboardState :: MonadIO m => m (Scancode -> Bool) +getKeyboardState = liftIO $ do + alloca $ \nkeys -> do + keyptr <- Raw.getKeyboardState nkeys + n <- peek nkeys + keys <- V.fromList <$> peekArray (fromIntegral n) keyptr + return $ \scancode -> 1 == keys V.! fromIntegral (toNumber scancode) diff --git a/src/SDL/Input/Keyboard/Codes.hs b/src/SDL/Input/Keyboard/Codes.hs --- a/src/SDL/Input/Keyboard/Codes.hs +++ b/src/SDL/Input/Keyboard/Codes.hs @@ -1,1011 +1,1011 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PatternSynonyms #-} - -{-| - -An enumeration of scancodes and keycodes, allowing you to pattern match on keyboard keys. - -This module uses a relatively new GHC feature called @PatternSynonyms@ in order to provide pattern -matches over the underlying 'Scancode' or 'Keycode'. We do this so that you are also able to -work with vendor-specific or otherwise unknown codes. - --} - -module SDL.Input.Keyboard.Codes - (-- * Scancodes - -- | Scancodes are codes that correspond to the physical position of a key, independent of the current keyboard layout. - -- Scancodes are meant to be layout-independent. Think of this as \"the user pressed the Q key as it would be on a US QWERTY keyboard\" regardless of whether this is actually a European keyboard or a Dvorak keyboard or whatever. The scancode is always the same key position. - -- 'Scancode' makes sense when you want key presses based on their location on a keyboard - for example, the traditional \"WASD\" layout used in first-person shooters. - Scancode(..), - pattern ScancodeUnknown, - pattern ScancodeA, - pattern ScancodeB, - pattern ScancodeC, - pattern ScancodeD, - pattern ScancodeE, - pattern ScancodeF, - pattern ScancodeG, - pattern ScancodeH, - pattern ScancodeI, - pattern ScancodeJ, - pattern ScancodeK, - pattern ScancodeL, - pattern ScancodeM, - pattern ScancodeN, - pattern ScancodeO, - pattern ScancodeP, - pattern ScancodeQ, - pattern ScancodeR, - pattern ScancodeS, - pattern ScancodeT, - pattern ScancodeU, - pattern ScancodeV, - pattern ScancodeW, - pattern ScancodeX, - pattern ScancodeY, - pattern ScancodeZ, - pattern Scancode1, - pattern Scancode2, - pattern Scancode3, - pattern Scancode4, - pattern Scancode5, - pattern Scancode6, - pattern Scancode7, - pattern Scancode8, - pattern Scancode9, - pattern Scancode0, - pattern ScancodeReturn, - pattern ScancodeEscape, - pattern ScancodeBackspace, - pattern ScancodeTab, - pattern ScancodeSpace, - pattern ScancodeMinus, - pattern ScancodeEquals, - pattern ScancodeLeftBracket, - pattern ScancodeRightBracket, - pattern ScancodeBackslash, - pattern ScancodeNonUSHash, - pattern ScancodeSemicolon, - pattern ScancodeApostrophe, - pattern ScancodeGrave, - pattern ScancodeComma, - pattern ScancodePeriod, - pattern ScancodeSlash, - pattern ScancodeCapsLock, - pattern ScancodeF1, - pattern ScancodeF2, - pattern ScancodeF3, - pattern ScancodeF4, - pattern ScancodeF5, - pattern ScancodeF6, - pattern ScancodeF7, - pattern ScancodeF8, - pattern ScancodeF9, - pattern ScancodeF10, - pattern ScancodeF11, - pattern ScancodeF12, - pattern ScancodePrintScreen, - pattern ScancodeScrollLock, - pattern ScancodePause, - pattern ScancodeInsert, - pattern ScancodeHome, - pattern ScancodePageUp, - pattern ScancodeDelete, - pattern ScancodeEnd, - pattern ScancodePageDown, - pattern ScancodeRight, - pattern ScancodeLeft, - pattern ScancodeDown, - pattern ScancodeUp, - pattern ScancodeNumLockClear, - pattern ScancodeKPDivide, - pattern ScancodeKPMultiply, - pattern ScancodeKPMinus, - pattern ScancodeKPPlus, - pattern ScancodeKPEnter, - pattern ScancodeKP1, - pattern ScancodeKP2, - pattern ScancodeKP3, - pattern ScancodeKP4, - pattern ScancodeKP5, - pattern ScancodeKP6, - pattern ScancodeKP7, - pattern ScancodeKP8, - pattern ScancodeKP9, - pattern ScancodeKP0, - pattern ScancodeKPPeriod, - pattern ScancodeNonUSBackslash, - pattern ScancodeApplication, - pattern ScancodePower, - pattern ScancodeKPEquals, - pattern ScancodeF13, - pattern ScancodeF14, - pattern ScancodeF15, - pattern ScancodeF16, - pattern ScancodeF17, - pattern ScancodeF18, - pattern ScancodeF19, - pattern ScancodeF20, - pattern ScancodeF21, - pattern ScancodeF22, - pattern ScancodeF23, - pattern ScancodeF24, - pattern ScancodeExecute, - pattern ScancodeHelp, - pattern ScancodeMenu, - pattern ScancodeSelect, - pattern ScancodeStop, - pattern ScancodeAgain, - pattern ScancodeUndo, - pattern ScancodeCut, - pattern ScancodeCopy, - pattern ScancodePaste, - pattern ScancodeFind, - pattern ScancodeMute, - pattern ScancodeVolumeUp, - pattern ScancodeVolumeDown, - pattern ScancodeKPComma, - pattern ScancodeKPEqualsAS400, - pattern ScancodeInternational1, - pattern ScancodeInternational2, - pattern ScancodeInternational3, - pattern ScancodeInternational4, - pattern ScancodeInternational5, - pattern ScancodeInternational6, - pattern ScancodeInternational7, - pattern ScancodeInternational8, - pattern ScancodeInternational9, - pattern ScancodeLang1, - pattern ScancodeLang2, - pattern ScancodeLang3, - pattern ScancodeLang4, - pattern ScancodeLang5, - pattern ScancodeLang6, - pattern ScancodeLang7, - pattern ScancodeLang8, - pattern ScancodeLang9, - pattern ScancodeAltErase, - pattern ScancodeSysReq, - pattern ScancodeCancel, - pattern ScancodeClear, - pattern ScancodePrior, - pattern ScancodeReturn2, - pattern ScancodeSeparator, - pattern ScancodeOut, - pattern ScancodeOper, - pattern ScancodeClearAgain, - pattern ScancodeCrSel, - pattern ScancodeExSel, - pattern ScancodeKP00, - pattern ScancodeKP000, - pattern ScancodeThousandsSeparator, - pattern ScancodeDecimalSeparator, - pattern ScancodeCurrencyUnit, - pattern ScancodeCurrencySubunit, - pattern ScancodeLeftParen, - pattern ScancodeRightParen, - pattern ScancodeLeftBrace, - pattern ScancodeRightBrace, - pattern ScancodeKPTab, - pattern ScancodeKPBackspace, - pattern ScancodeKPA, - pattern ScancodeKPB, - pattern ScancodeKPC, - pattern ScancodeKPD, - pattern ScancodeKPE, - pattern ScancodeKPF, - pattern ScancodeKPXOR, - pattern ScancodeKPPower, - pattern ScancodeKPPercent, - pattern ScancodeKPLess, - pattern ScancodeKPGreater, - pattern ScancodeKPAmpersand, - pattern ScancodeKPDblAmpersand, - pattern ScancodeKPVerticalBar, - pattern ScancodeKPDblVerticalBar, - pattern ScancodeKPColon, - pattern ScancodeKPHash, - pattern ScancodeKPSpace, - pattern ScancodeKPAt, - pattern ScancodeKPExclam, - pattern ScancodeKPMemStore, - pattern ScancodeKPMemRecall, - pattern ScancodeKPMemClear, - pattern ScancodeKPMemAdd, - pattern ScancodeKPMemSubtract, - pattern ScancodeKPMemMultiply, - pattern ScancodeKPMemDivide, - pattern ScancodeKPPlusMinus, - pattern ScancodeKPClear, - pattern ScancodeKPClearEntry, - pattern ScancodeKPBinary, - pattern ScancodeKPOctal, - pattern ScancodeKPDecimal, - pattern ScancodeKPHexadecimal, - pattern ScancodeLCtrl, - pattern ScancodeLShift, - pattern ScancodeLAlt, - pattern ScancodeLGUI, - pattern ScancodeRCtrl, - pattern ScancodeRShift, - pattern ScancodeRAlt, - pattern ScancodeRGUI, - pattern ScancodeMode, - pattern ScancodeAudioNext, - pattern ScancodeAudioPrev, - pattern ScancodeAudioStop, - pattern ScancodeAudioPlay, - pattern ScancodeAudioMute, - pattern ScancodeMediaSelect, - pattern ScancodeWWW, - pattern ScancodeMail, - pattern ScancodeCalculator, - pattern ScancodeComputer, - pattern ScancodeACSearch, - pattern ScancodeACHome, - pattern ScancodeACBack, - pattern ScancodeACForward, - pattern ScancodeACStop, - pattern ScancodeACRefresh, - pattern ScancodeACBookmarks, - pattern ScancodeBrightnessDown, - pattern ScancodeBrightnessUp, - pattern ScancodeDisplaySwitch, - pattern ScancodeKBDIllumToggle, - pattern ScancodeKBDIllumDown, - pattern ScancodeKBDIllumUp, - pattern ScancodeEject, - pattern ScancodeSleep, - pattern ScancodeApp1, - pattern ScancodeApp2, - - -- * Keycode - -- | Keycodes are layout-dependent codes, in that the code you receive can change for the same physical key depending on the users keyboard layout. - -- Think of this as "the user pressed the key that is labelled 'Q' on a specific keyboard." - -- 'Keycode' makes sense when you are anticipating the user to press either keys that match some mneumonic, or they are entering text. - Keycode(..), - pattern KeycodeUnknown, - pattern KeycodeReturn, - pattern KeycodeEscape, - pattern KeycodeBackspace, - pattern KeycodeTab, - pattern KeycodeSpace, - pattern KeycodeExclaim, - pattern KeycodeQuoteDbl, - pattern KeycodeHash, - pattern KeycodePercent, - pattern KeycodeDollar, - pattern KeycodeAmpersand, - pattern KeycodeQuote, - pattern KeycodeLeftParen, - pattern KeycodeRightParen, - pattern KeycodeAsterisk, - pattern KeycodePlus, - pattern KeycodeComma, - pattern KeycodeMinus, - pattern KeycodePeriod, - pattern KeycodeSlash, - pattern Keycode0, - pattern Keycode1, - pattern Keycode2, - pattern Keycode3, - pattern Keycode4, - pattern Keycode5, - pattern Keycode6, - pattern Keycode7, - pattern Keycode8, - pattern Keycode9, - pattern KeycodeColon, - pattern KeycodeSemicolon, - pattern KeycodeLess, - pattern KeycodeEquals, - pattern KeycodeGreater, - pattern KeycodeQuestion, - pattern KeycodeAt, - pattern KeycodeLeftBracket, - pattern KeycodeBackslash, - pattern KeycodeRightBracket, - pattern KeycodeCaret, - pattern KeycodeUnderscore, - pattern KeycodeBackquote, - pattern KeycodeA, - pattern KeycodeB, - pattern KeycodeC, - pattern KeycodeD, - pattern KeycodeE, - pattern KeycodeF, - pattern KeycodeG, - pattern KeycodeH, - pattern KeycodeI, - pattern KeycodeJ, - pattern KeycodeK, - pattern KeycodeL, - pattern KeycodeM, - pattern KeycodeN, - pattern KeycodeO, - pattern KeycodeP, - pattern KeycodeQ, - pattern KeycodeR, - pattern KeycodeS, - pattern KeycodeT, - pattern KeycodeU, - pattern KeycodeV, - pattern KeycodeW, - pattern KeycodeX, - pattern KeycodeY, - pattern KeycodeZ, - pattern KeycodeCapsLock, - pattern KeycodeF1, - pattern KeycodeF2, - pattern KeycodeF3, - pattern KeycodeF4, - pattern KeycodeF5, - pattern KeycodeF6, - pattern KeycodeF7, - pattern KeycodeF8, - pattern KeycodeF9, - pattern KeycodeF10, - pattern KeycodeF11, - pattern KeycodeF12, - pattern KeycodePrintScreen, - pattern KeycodeScrollLock, - pattern KeycodePause, - pattern KeycodeInsert, - pattern KeycodeHome, - pattern KeycodePageUp, - pattern KeycodeDelete, - pattern KeycodeEnd, - pattern KeycodePageDown, - pattern KeycodeRight, - pattern KeycodeLeft, - pattern KeycodeDown, - pattern KeycodeUp, - pattern KeycodeNumLockClear, - pattern KeycodeKPDivide, - pattern KeycodeKPMultiply, - pattern KeycodeKPMinus, - pattern KeycodeKPPlus, - pattern KeycodeKPEnter, - pattern KeycodeKP1, - pattern KeycodeKP2, - pattern KeycodeKP3, - pattern KeycodeKP4, - pattern KeycodeKP5, - pattern KeycodeKP6, - pattern KeycodeKP7, - pattern KeycodeKP8, - pattern KeycodeKP9, - pattern KeycodeKP0, - pattern KeycodeKPPeriod, - pattern KeycodeApplication, - pattern KeycodePower, - pattern KeycodeKPEquals, - pattern KeycodeF13, - pattern KeycodeF14, - pattern KeycodeF15, - pattern KeycodeF16, - pattern KeycodeF17, - pattern KeycodeF18, - pattern KeycodeF19, - pattern KeycodeF20, - pattern KeycodeF21, - pattern KeycodeF22, - pattern KeycodeF23, - pattern KeycodeF24, - pattern KeycodeExecute, - pattern KeycodeHelp, - pattern KeycodeMenu, - pattern KeycodeSelect, - pattern KeycodeStop, - pattern KeycodeAgain, - pattern KeycodeUndo, - pattern KeycodeCut, - pattern KeycodeCopy, - pattern KeycodePaste, - pattern KeycodeFind, - pattern KeycodeMute, - pattern KeycodeVolumeUp, - pattern KeycodeVolumeDown, - pattern KeycodeKPComma, - pattern KeycodeKPEqualsAS400, - pattern KeycodeAltErase, - pattern KeycodeSysReq, - pattern KeycodeCancel, - pattern KeycodeClear, - pattern KeycodePrior, - pattern KeycodeReturn2, - pattern KeycodeSeparator, - pattern KeycodeOut, - pattern KeycodeOper, - pattern KeycodeClearAgain, - pattern KeycodeCrSel, - pattern KeycodeExSel, - pattern KeycodeKP00, - pattern KeycodeKP000, - pattern KeycodeThousandsSeparator, - pattern KeycodeDecimalSeparator, - pattern KeycodeCurrencyUnit, - pattern KeycodeCurrencySubunit, - pattern KeycodeKPLeftParen, - pattern KeycodeKPRightParen, - pattern KeycodeKPLeftBrace, - pattern KeycodeKPRightBrace, - pattern KeycodeKPTab, - pattern KeycodeKPBackspace, - pattern KeycodeKPA, - pattern KeycodeKPB, - pattern KeycodeKPC, - pattern KeycodeKPD, - pattern KeycodeKPE, - pattern KeycodeKPF, - pattern KeycodeKPXor, - pattern KeycodeKPPower, - pattern KeycodeKPPercent, - pattern KeycodeKPLess, - pattern KeycodeKPGreater, - pattern KeycodeKPAmpersand, - pattern KeycodeKPDblAmpersand, - pattern KeycodeKPVerticalBar, - pattern KeycodeKPDblVerticalBar, - pattern KeycodeKPColon, - pattern KeycodeKPHash, - pattern KeycodeKPSpace, - pattern KeycodeKPAt, - pattern KeycodeKPExclam, - pattern KeycodeKPMemStore, - pattern KeycodeKPMemRecall, - pattern KeycodeKPMemClear, - pattern KeycodeKPMemAdd, - pattern KeycodeKPMemSubtract, - pattern KeycodeKPMemMultiply, - pattern KeycodeKPMemDivide, - pattern KeycodeKPPlusMinus, - pattern KeycodeKPClear, - pattern KeycodeKPClearEntry, - pattern KeycodeKPBinary, - pattern KeycodeKPOctal, - pattern KeycodeKPDecimal, - pattern KeycodeKPHexadecimal, - pattern KeycodeLCtrl, - pattern KeycodeLShift, - pattern KeycodeLAlt, - pattern KeycodeLGUI, - pattern KeycodeRCtrl, - pattern KeycodeRShift, - pattern KeycodeRAlt, - pattern KeycodeRGUI, - pattern KeycodeMode, - pattern KeycodeAudioNext, - pattern KeycodeAudioPrev, - pattern KeycodeAudioStop, - pattern KeycodeAudioPlay, - pattern KeycodeAudioMute, - pattern KeycodeMediaSelect, - pattern KeycodeWWW, - pattern KeycodeMail, - pattern KeycodeCalculator, - pattern KeycodeComputer, - pattern KeycodeACSearch, - pattern KeycodeACHome, - pattern KeycodeACBack, - pattern KeycodeACForward, - pattern KeycodeACStop, - pattern KeycodeACRefresh, - pattern KeycodeACBookmarks, - pattern KeycodeBrightnessDown, - pattern KeycodeBrightnessUp, - pattern KeycodeDisplaySwitch, - pattern KeycodeKbdIllumToggle, - pattern KeycodeKbdIllumDown, - pattern KeycodeKbdIllumUp, - pattern KeycodeEject, - pattern KeycodeSleep) - - where - -import GHC.Generics (Generic) -import Data.Data (Data) -import Data.Int -import Data.Typeable -import Data.Word -import SDL.Internal.Numbered -import qualified SDL.Raw.Enum as Raw - -newtype Scancode = Scancode { unwrapScancode :: Word32 } - deriving (Bounded, Data, Eq, Ord, Read, Generic, Show, Typeable) - -pattern ScancodeUnknown = Scancode Raw.SDL_SCANCODE_UNKNOWN -pattern ScancodeA = Scancode Raw.SDL_SCANCODE_A -pattern ScancodeB = Scancode Raw.SDL_SCANCODE_B -pattern ScancodeC = Scancode Raw.SDL_SCANCODE_C -pattern ScancodeD = Scancode Raw.SDL_SCANCODE_D -pattern ScancodeE = Scancode Raw.SDL_SCANCODE_E -pattern ScancodeF = Scancode Raw.SDL_SCANCODE_F -pattern ScancodeG = Scancode Raw.SDL_SCANCODE_G -pattern ScancodeH = Scancode Raw.SDL_SCANCODE_H -pattern ScancodeI = Scancode Raw.SDL_SCANCODE_I -pattern ScancodeJ = Scancode Raw.SDL_SCANCODE_J -pattern ScancodeK = Scancode Raw.SDL_SCANCODE_K -pattern ScancodeL = Scancode Raw.SDL_SCANCODE_L -pattern ScancodeM = Scancode Raw.SDL_SCANCODE_M -pattern ScancodeN = Scancode Raw.SDL_SCANCODE_N -pattern ScancodeO = Scancode Raw.SDL_SCANCODE_O -pattern ScancodeP = Scancode Raw.SDL_SCANCODE_P -pattern ScancodeQ = Scancode Raw.SDL_SCANCODE_Q -pattern ScancodeR = Scancode Raw.SDL_SCANCODE_R -pattern ScancodeS = Scancode Raw.SDL_SCANCODE_S -pattern ScancodeT = Scancode Raw.SDL_SCANCODE_T -pattern ScancodeU = Scancode Raw.SDL_SCANCODE_U -pattern ScancodeV = Scancode Raw.SDL_SCANCODE_V -pattern ScancodeW = Scancode Raw.SDL_SCANCODE_W -pattern ScancodeX = Scancode Raw.SDL_SCANCODE_X -pattern ScancodeY = Scancode Raw.SDL_SCANCODE_Y -pattern ScancodeZ = Scancode Raw.SDL_SCANCODE_Z -pattern Scancode1 = Scancode Raw.SDL_SCANCODE_1 -pattern Scancode2 = Scancode Raw.SDL_SCANCODE_2 -pattern Scancode3 = Scancode Raw.SDL_SCANCODE_3 -pattern Scancode4 = Scancode Raw.SDL_SCANCODE_4 -pattern Scancode5 = Scancode Raw.SDL_SCANCODE_5 -pattern Scancode6 = Scancode Raw.SDL_SCANCODE_6 -pattern Scancode7 = Scancode Raw.SDL_SCANCODE_7 -pattern Scancode8 = Scancode Raw.SDL_SCANCODE_8 -pattern Scancode9 = Scancode Raw.SDL_SCANCODE_9 -pattern Scancode0 = Scancode Raw.SDL_SCANCODE_0 -pattern ScancodeReturn = Scancode Raw.SDL_SCANCODE_RETURN -pattern ScancodeEscape = Scancode Raw.SDL_SCANCODE_ESCAPE -pattern ScancodeBackspace = Scancode Raw.SDL_SCANCODE_BACKSPACE -pattern ScancodeTab = Scancode Raw.SDL_SCANCODE_TAB -pattern ScancodeSpace = Scancode Raw.SDL_SCANCODE_SPACE -pattern ScancodeMinus = Scancode Raw.SDL_SCANCODE_MINUS -pattern ScancodeEquals = Scancode Raw.SDL_SCANCODE_EQUALS -pattern ScancodeLeftBracket = Scancode Raw.SDL_SCANCODE_LEFTBRACKET -pattern ScancodeRightBracket = Scancode Raw.SDL_SCANCODE_RIGHTBRACKET -pattern ScancodeBackslash = Scancode Raw.SDL_SCANCODE_BACKSLASH -pattern ScancodeNonUSHash = Scancode Raw.SDL_SCANCODE_NONUSHASH -pattern ScancodeSemicolon = Scancode Raw.SDL_SCANCODE_SEMICOLON -pattern ScancodeApostrophe = Scancode Raw.SDL_SCANCODE_APOSTROPHE -pattern ScancodeGrave = Scancode Raw.SDL_SCANCODE_GRAVE -pattern ScancodeComma = Scancode Raw.SDL_SCANCODE_COMMA -pattern ScancodePeriod = Scancode Raw.SDL_SCANCODE_PERIOD -pattern ScancodeSlash = Scancode Raw.SDL_SCANCODE_SLASH -pattern ScancodeCapsLock = Scancode Raw.SDL_SCANCODE_CAPSLOCK -pattern ScancodeF1 = Scancode Raw.SDL_SCANCODE_F1 -pattern ScancodeF2 = Scancode Raw.SDL_SCANCODE_F2 -pattern ScancodeF3 = Scancode Raw.SDL_SCANCODE_F3 -pattern ScancodeF4 = Scancode Raw.SDL_SCANCODE_F4 -pattern ScancodeF5 = Scancode Raw.SDL_SCANCODE_F5 -pattern ScancodeF6 = Scancode Raw.SDL_SCANCODE_F6 -pattern ScancodeF7 = Scancode Raw.SDL_SCANCODE_F7 -pattern ScancodeF8 = Scancode Raw.SDL_SCANCODE_F8 -pattern ScancodeF9 = Scancode Raw.SDL_SCANCODE_F9 -pattern ScancodeF10 = Scancode Raw.SDL_SCANCODE_F10 -pattern ScancodeF11 = Scancode Raw.SDL_SCANCODE_F11 -pattern ScancodeF12 = Scancode Raw.SDL_SCANCODE_F12 -pattern ScancodePrintScreen = Scancode Raw.SDL_SCANCODE_PRINTSCREEN -pattern ScancodeScrollLock = Scancode Raw.SDL_SCANCODE_SCROLLLOCK -pattern ScancodePause = Scancode Raw.SDL_SCANCODE_PAUSE -pattern ScancodeInsert = Scancode Raw.SDL_SCANCODE_INSERT -pattern ScancodeHome = Scancode Raw.SDL_SCANCODE_HOME -pattern ScancodePageUp = Scancode Raw.SDL_SCANCODE_PAGEUP -pattern ScancodeDelete = Scancode Raw.SDL_SCANCODE_DELETE -pattern ScancodeEnd = Scancode Raw.SDL_SCANCODE_END -pattern ScancodePageDown = Scancode Raw.SDL_SCANCODE_PAGEDOWN -pattern ScancodeRight = Scancode Raw.SDL_SCANCODE_RIGHT -pattern ScancodeLeft = Scancode Raw.SDL_SCANCODE_LEFT -pattern ScancodeDown = Scancode Raw.SDL_SCANCODE_DOWN -pattern ScancodeUp = Scancode Raw.SDL_SCANCODE_UP -pattern ScancodeNumLockClear = Scancode Raw.SDL_SCANCODE_NUMLOCKCLEAR -pattern ScancodeKPDivide = Scancode Raw.SDL_SCANCODE_KP_DIVIDE -pattern ScancodeKPMultiply = Scancode Raw.SDL_SCANCODE_KP_MULTIPLY -pattern ScancodeKPMinus = Scancode Raw.SDL_SCANCODE_KP_MINUS -pattern ScancodeKPPlus = Scancode Raw.SDL_SCANCODE_KP_PLUS -pattern ScancodeKPEnter = Scancode Raw.SDL_SCANCODE_KP_ENTER -pattern ScancodeKP1 = Scancode Raw.SDL_SCANCODE_KP_1 -pattern ScancodeKP2 = Scancode Raw.SDL_SCANCODE_KP_2 -pattern ScancodeKP3 = Scancode Raw.SDL_SCANCODE_KP_3 -pattern ScancodeKP4 = Scancode Raw.SDL_SCANCODE_KP_4 -pattern ScancodeKP5 = Scancode Raw.SDL_SCANCODE_KP_5 -pattern ScancodeKP6 = Scancode Raw.SDL_SCANCODE_KP_6 -pattern ScancodeKP7 = Scancode Raw.SDL_SCANCODE_KP_7 -pattern ScancodeKP8 = Scancode Raw.SDL_SCANCODE_KP_8 -pattern ScancodeKP9 = Scancode Raw.SDL_SCANCODE_KP_9 -pattern ScancodeKP0 = Scancode Raw.SDL_SCANCODE_KP_0 -pattern ScancodeKPPeriod = Scancode Raw.SDL_SCANCODE_KP_PERIOD -pattern ScancodeNonUSBackslash = Scancode Raw.SDL_SCANCODE_NONUSBACKSLASH -pattern ScancodeApplication = Scancode Raw.SDL_SCANCODE_APPLICATION -pattern ScancodePower = Scancode Raw.SDL_SCANCODE_POWER -pattern ScancodeKPEquals = Scancode Raw.SDL_SCANCODE_KP_EQUALS -pattern ScancodeF13 = Scancode Raw.SDL_SCANCODE_F13 -pattern ScancodeF14 = Scancode Raw.SDL_SCANCODE_F14 -pattern ScancodeF15 = Scancode Raw.SDL_SCANCODE_F15 -pattern ScancodeF16 = Scancode Raw.SDL_SCANCODE_F16 -pattern ScancodeF17 = Scancode Raw.SDL_SCANCODE_F17 -pattern ScancodeF18 = Scancode Raw.SDL_SCANCODE_F18 -pattern ScancodeF19 = Scancode Raw.SDL_SCANCODE_F19 -pattern ScancodeF20 = Scancode Raw.SDL_SCANCODE_F20 -pattern ScancodeF21 = Scancode Raw.SDL_SCANCODE_F21 -pattern ScancodeF22 = Scancode Raw.SDL_SCANCODE_F22 -pattern ScancodeF23 = Scancode Raw.SDL_SCANCODE_F23 -pattern ScancodeF24 = Scancode Raw.SDL_SCANCODE_F24 -pattern ScancodeExecute = Scancode Raw.SDL_SCANCODE_EXECUTE -pattern ScancodeHelp = Scancode Raw.SDL_SCANCODE_HELP -pattern ScancodeMenu = Scancode Raw.SDL_SCANCODE_MENU -pattern ScancodeSelect = Scancode Raw.SDL_SCANCODE_SELECT -pattern ScancodeStop = Scancode Raw.SDL_SCANCODE_STOP -pattern ScancodeAgain = Scancode Raw.SDL_SCANCODE_AGAIN -pattern ScancodeUndo = Scancode Raw.SDL_SCANCODE_UNDO -pattern ScancodeCut = Scancode Raw.SDL_SCANCODE_CUT -pattern ScancodeCopy = Scancode Raw.SDL_SCANCODE_COPY -pattern ScancodePaste = Scancode Raw.SDL_SCANCODE_PASTE -pattern ScancodeFind = Scancode Raw.SDL_SCANCODE_FIND -pattern ScancodeMute = Scancode Raw.SDL_SCANCODE_MUTE -pattern ScancodeVolumeUp = Scancode Raw.SDL_SCANCODE_VOLUMEUP -pattern ScancodeVolumeDown = Scancode Raw.SDL_SCANCODE_VOLUMEDOWN -pattern ScancodeKPComma = Scancode Raw.SDL_SCANCODE_KP_COMMA -pattern ScancodeKPEqualsAS400 = Scancode Raw.SDL_SCANCODE_KP_EQUALSAS400 -pattern ScancodeInternational1 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL1 -pattern ScancodeInternational2 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL2 -pattern ScancodeInternational3 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL3 -pattern ScancodeInternational4 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL4 -pattern ScancodeInternational5 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL5 -pattern ScancodeInternational6 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL6 -pattern ScancodeInternational7 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL7 -pattern ScancodeInternational8 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL8 -pattern ScancodeInternational9 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL9 -pattern ScancodeLang1 = Scancode Raw.SDL_SCANCODE_LANG1 -pattern ScancodeLang2 = Scancode Raw.SDL_SCANCODE_LANG2 -pattern ScancodeLang3 = Scancode Raw.SDL_SCANCODE_LANG3 -pattern ScancodeLang4 = Scancode Raw.SDL_SCANCODE_LANG4 -pattern ScancodeLang5 = Scancode Raw.SDL_SCANCODE_LANG5 -pattern ScancodeLang6 = Scancode Raw.SDL_SCANCODE_LANG6 -pattern ScancodeLang7 = Scancode Raw.SDL_SCANCODE_LANG7 -pattern ScancodeLang8 = Scancode Raw.SDL_SCANCODE_LANG8 -pattern ScancodeLang9 = Scancode Raw.SDL_SCANCODE_LANG9 -pattern ScancodeAltErase = Scancode Raw.SDL_SCANCODE_ALTERASE -pattern ScancodeSysReq = Scancode Raw.SDL_SCANCODE_SYSREQ -pattern ScancodeCancel = Scancode Raw.SDL_SCANCODE_CANCEL -pattern ScancodeClear = Scancode Raw.SDL_SCANCODE_CLEAR -pattern ScancodePrior = Scancode Raw.SDL_SCANCODE_PRIOR -pattern ScancodeReturn2 = Scancode Raw.SDL_SCANCODE_RETURN2 -pattern ScancodeSeparator = Scancode Raw.SDL_SCANCODE_SEPARATOR -pattern ScancodeOut = Scancode Raw.SDL_SCANCODE_OUT -pattern ScancodeOper = Scancode Raw.SDL_SCANCODE_OPER -pattern ScancodeClearAgain = Scancode Raw.SDL_SCANCODE_CLEARAGAIN -pattern ScancodeCrSel = Scancode Raw.SDL_SCANCODE_CRSEL -pattern ScancodeExSel = Scancode Raw.SDL_SCANCODE_EXSEL -pattern ScancodeKP00 = Scancode Raw.SDL_SCANCODE_KP_00 -pattern ScancodeKP000 = Scancode Raw.SDL_SCANCODE_KP_000 -pattern ScancodeThousandsSeparator = Scancode Raw.SDL_SCANCODE_THOUSANDSSEPARATOR -pattern ScancodeDecimalSeparator = Scancode Raw.SDL_SCANCODE_DECIMALSEPARATOR -pattern ScancodeCurrencyUnit = Scancode Raw.SDL_SCANCODE_CURRENCYUNIT -pattern ScancodeCurrencySubunit = Scancode Raw.SDL_SCANCODE_CURRENCYSUBUNIT -pattern ScancodeLeftParen = Scancode Raw.SDL_SCANCODE_KP_LEFTPAREN -pattern ScancodeRightParen = Scancode Raw.SDL_SCANCODE_KP_RIGHTPAREN -pattern ScancodeLeftBrace = Scancode Raw.SDL_SCANCODE_KP_LEFTBRACE -pattern ScancodeRightBrace = Scancode Raw.SDL_SCANCODE_KP_RIGHTBRACE -pattern ScancodeKPTab = Scancode Raw.SDL_SCANCODE_KP_TAB -pattern ScancodeKPBackspace = Scancode Raw.SDL_SCANCODE_KP_BACKSPACE -pattern ScancodeKPA = Scancode Raw.SDL_SCANCODE_KP_A -pattern ScancodeKPB = Scancode Raw.SDL_SCANCODE_KP_B -pattern ScancodeKPC = Scancode Raw.SDL_SCANCODE_KP_C -pattern ScancodeKPD = Scancode Raw.SDL_SCANCODE_KP_D -pattern ScancodeKPE = Scancode Raw.SDL_SCANCODE_KP_E -pattern ScancodeKPF = Scancode Raw.SDL_SCANCODE_KP_F -pattern ScancodeKPXOR = Scancode Raw.SDL_SCANCODE_KP_XOR -pattern ScancodeKPPower = Scancode Raw.SDL_SCANCODE_KP_POWER -pattern ScancodeKPPercent = Scancode Raw.SDL_SCANCODE_KP_PERCENT -pattern ScancodeKPLess = Scancode Raw.SDL_SCANCODE_KP_LESS -pattern ScancodeKPGreater = Scancode Raw.SDL_SCANCODE_KP_GREATER -pattern ScancodeKPAmpersand = Scancode Raw.SDL_SCANCODE_KP_AMPERSAND -pattern ScancodeKPDblAmpersand = Scancode Raw.SDL_SCANCODE_KP_DBLAMPERSAND -pattern ScancodeKPVerticalBar = Scancode Raw.SDL_SCANCODE_KP_VERTICALBAR -pattern ScancodeKPDblVerticalBar = Scancode Raw.SDL_SCANCODE_KP_DBLVERTICALBAR -pattern ScancodeKPColon = Scancode Raw.SDL_SCANCODE_KP_COLON -pattern ScancodeKPHash = Scancode Raw.SDL_SCANCODE_KP_HASH -pattern ScancodeKPSpace = Scancode Raw.SDL_SCANCODE_KP_SPACE -pattern ScancodeKPAt = Scancode Raw.SDL_SCANCODE_KP_AT -pattern ScancodeKPExclam = Scancode Raw.SDL_SCANCODE_KP_EXCLAM -pattern ScancodeKPMemStore = Scancode Raw.SDL_SCANCODE_KP_MEMSTORE -pattern ScancodeKPMemRecall = Scancode Raw.SDL_SCANCODE_KP_MEMRECALL -pattern ScancodeKPMemClear = Scancode Raw.SDL_SCANCODE_KP_MEMCLEAR -pattern ScancodeKPMemAdd = Scancode Raw.SDL_SCANCODE_KP_MEMADD -pattern ScancodeKPMemSubtract = Scancode Raw.SDL_SCANCODE_KP_MEMSUBTRACT -pattern ScancodeKPMemMultiply = Scancode Raw.SDL_SCANCODE_KP_MEMMULTIPLY -pattern ScancodeKPMemDivide = Scancode Raw.SDL_SCANCODE_KP_MEMDIVIDE -pattern ScancodeKPPlusMinus = Scancode Raw.SDL_SCANCODE_KP_PLUSMINUS -pattern ScancodeKPClear = Scancode Raw.SDL_SCANCODE_KP_CLEAR -pattern ScancodeKPClearEntry = Scancode Raw.SDL_SCANCODE_KP_CLEARENTRY -pattern ScancodeKPBinary = Scancode Raw.SDL_SCANCODE_KP_BINARY -pattern ScancodeKPOctal = Scancode Raw.SDL_SCANCODE_KP_OCTAL -pattern ScancodeKPDecimal = Scancode Raw.SDL_SCANCODE_KP_DECIMAL -pattern ScancodeKPHexadecimal = Scancode Raw.SDL_SCANCODE_KP_HEXADECIMAL -pattern ScancodeLCtrl = Scancode Raw.SDL_SCANCODE_LCTRL -pattern ScancodeLShift = Scancode Raw.SDL_SCANCODE_LSHIFT -pattern ScancodeLAlt = Scancode Raw.SDL_SCANCODE_LALT -pattern ScancodeLGUI = Scancode Raw.SDL_SCANCODE_LGUI -pattern ScancodeRCtrl = Scancode Raw.SDL_SCANCODE_RCTRL -pattern ScancodeRShift = Scancode Raw.SDL_SCANCODE_RSHIFT -pattern ScancodeRAlt = Scancode Raw.SDL_SCANCODE_RALT -pattern ScancodeRGUI = Scancode Raw.SDL_SCANCODE_RGUI -pattern ScancodeMode = Scancode Raw.SDL_SCANCODE_MODE -pattern ScancodeAudioNext = Scancode Raw.SDL_SCANCODE_AUDIONEXT -pattern ScancodeAudioPrev = Scancode Raw.SDL_SCANCODE_AUDIOPREV -pattern ScancodeAudioStop = Scancode Raw.SDL_SCANCODE_AUDIOSTOP -pattern ScancodeAudioPlay = Scancode Raw.SDL_SCANCODE_AUDIOPLAY -pattern ScancodeAudioMute = Scancode Raw.SDL_SCANCODE_AUDIOMUTE -pattern ScancodeMediaSelect = Scancode Raw.SDL_SCANCODE_MEDIASELECT -pattern ScancodeWWW = Scancode Raw.SDL_SCANCODE_WWW -pattern ScancodeMail = Scancode Raw.SDL_SCANCODE_MAIL -pattern ScancodeCalculator = Scancode Raw.SDL_SCANCODE_CALCULATOR -pattern ScancodeComputer = Scancode Raw.SDL_SCANCODE_COMPUTER -pattern ScancodeACSearch = Scancode Raw.SDL_SCANCODE_AC_SEARCH -pattern ScancodeACHome = Scancode Raw.SDL_SCANCODE_AC_HOME -pattern ScancodeACBack = Scancode Raw.SDL_SCANCODE_AC_BACK -pattern ScancodeACForward = Scancode Raw.SDL_SCANCODE_AC_FORWARD -pattern ScancodeACStop = Scancode Raw.SDL_SCANCODE_AC_STOP -pattern ScancodeACRefresh = Scancode Raw.SDL_SCANCODE_AC_REFRESH -pattern ScancodeACBookmarks = Scancode Raw.SDL_SCANCODE_AC_BOOKMARKS -pattern ScancodeBrightnessDown = Scancode Raw.SDL_SCANCODE_BRIGHTNESSDOWN -pattern ScancodeBrightnessUp = Scancode Raw.SDL_SCANCODE_BRIGHTNESSUP -pattern ScancodeDisplaySwitch = Scancode Raw.SDL_SCANCODE_DISPLAYSWITCH -pattern ScancodeKBDIllumToggle = Scancode Raw.SDL_SCANCODE_KBDILLUMTOGGLE -pattern ScancodeKBDIllumDown = Scancode Raw.SDL_SCANCODE_KBDILLUMDOWN -pattern ScancodeKBDIllumUp = Scancode Raw.SDL_SCANCODE_KBDILLUMUP -pattern ScancodeEject = Scancode Raw.SDL_SCANCODE_EJECT -pattern ScancodeSleep = Scancode Raw.SDL_SCANCODE_SLEEP -pattern ScancodeApp1 = Scancode Raw.SDL_SCANCODE_APP1 -pattern ScancodeApp2 = Scancode Raw.SDL_SCANCODE_APP2 - -instance FromNumber Scancode Word32 where - fromNumber = Scancode - -instance ToNumber Scancode Word32 where - toNumber = unwrapScancode - -newtype Keycode = Keycode { unwrapKeycode :: Int32 } - deriving (Bounded, Data, Eq, Ord, Read, Generic, Show, Typeable) - -pattern KeycodeUnknown = Keycode Raw.SDLK_UNKNOWN -pattern KeycodeReturn = Keycode Raw.SDLK_RETURN -pattern KeycodeEscape = Keycode Raw.SDLK_ESCAPE -pattern KeycodeBackspace = Keycode Raw.SDLK_BACKSPACE -pattern KeycodeTab = Keycode Raw.SDLK_TAB -pattern KeycodeSpace = Keycode Raw.SDLK_SPACE -pattern KeycodeExclaim = Keycode Raw.SDLK_EXCLAIM -pattern KeycodeQuoteDbl = Keycode Raw.SDLK_QUOTEDBL -pattern KeycodeHash = Keycode Raw.SDLK_HASH -pattern KeycodePercent = Keycode Raw.SDLK_PERCENT -pattern KeycodeDollar = Keycode Raw.SDLK_DOLLAR -pattern KeycodeAmpersand = Keycode Raw.SDLK_AMPERSAND -pattern KeycodeQuote = Keycode Raw.SDLK_QUOTE -pattern KeycodeLeftParen = Keycode Raw.SDLK_LEFTPAREN -pattern KeycodeRightParen = Keycode Raw.SDLK_RIGHTPAREN -pattern KeycodeAsterisk = Keycode Raw.SDLK_ASTERISK -pattern KeycodePlus = Keycode Raw.SDLK_PLUS -pattern KeycodeComma = Keycode Raw.SDLK_COMMA -pattern KeycodeMinus = Keycode Raw.SDLK_MINUS -pattern KeycodePeriod = Keycode Raw.SDLK_PERIOD -pattern KeycodeSlash = Keycode Raw.SDLK_SLASH -pattern Keycode0 = Keycode Raw.SDLK_0 -pattern Keycode1 = Keycode Raw.SDLK_1 -pattern Keycode2 = Keycode Raw.SDLK_2 -pattern Keycode3 = Keycode Raw.SDLK_3 -pattern Keycode4 = Keycode Raw.SDLK_4 -pattern Keycode5 = Keycode Raw.SDLK_5 -pattern Keycode6 = Keycode Raw.SDLK_6 -pattern Keycode7 = Keycode Raw.SDLK_7 -pattern Keycode8 = Keycode Raw.SDLK_8 -pattern Keycode9 = Keycode Raw.SDLK_9 -pattern KeycodeColon = Keycode Raw.SDLK_COLON -pattern KeycodeSemicolon = Keycode Raw.SDLK_SEMICOLON -pattern KeycodeLess = Keycode Raw.SDLK_LESS -pattern KeycodeEquals = Keycode Raw.SDLK_EQUALS -pattern KeycodeGreater = Keycode Raw.SDLK_GREATER -pattern KeycodeQuestion = Keycode Raw.SDLK_QUESTION -pattern KeycodeAt = Keycode Raw.SDLK_AT -pattern KeycodeLeftBracket = Keycode Raw.SDLK_LEFTBRACKET -pattern KeycodeBackslash = Keycode Raw.SDLK_BACKSLASH -pattern KeycodeRightBracket = Keycode Raw.SDLK_RIGHTBRACKET -pattern KeycodeCaret = Keycode Raw.SDLK_CARET -pattern KeycodeUnderscore = Keycode Raw.SDLK_UNDERSCORE -pattern KeycodeBackquote = Keycode Raw.SDLK_BACKQUOTE -pattern KeycodeA = Keycode Raw.SDLK_a -pattern KeycodeB = Keycode Raw.SDLK_b -pattern KeycodeC = Keycode Raw.SDLK_c -pattern KeycodeD = Keycode Raw.SDLK_d -pattern KeycodeE = Keycode Raw.SDLK_e -pattern KeycodeF = Keycode Raw.SDLK_f -pattern KeycodeG = Keycode Raw.SDLK_g -pattern KeycodeH = Keycode Raw.SDLK_h -pattern KeycodeI = Keycode Raw.SDLK_i -pattern KeycodeJ = Keycode Raw.SDLK_j -pattern KeycodeK = Keycode Raw.SDLK_k -pattern KeycodeL = Keycode Raw.SDLK_l -pattern KeycodeM = Keycode Raw.SDLK_m -pattern KeycodeN = Keycode Raw.SDLK_n -pattern KeycodeO = Keycode Raw.SDLK_o -pattern KeycodeP = Keycode Raw.SDLK_p -pattern KeycodeQ = Keycode Raw.SDLK_q -pattern KeycodeR = Keycode Raw.SDLK_r -pattern KeycodeS = Keycode Raw.SDLK_s -pattern KeycodeT = Keycode Raw.SDLK_t -pattern KeycodeU = Keycode Raw.SDLK_u -pattern KeycodeV = Keycode Raw.SDLK_v -pattern KeycodeW = Keycode Raw.SDLK_w -pattern KeycodeX = Keycode Raw.SDLK_x -pattern KeycodeY = Keycode Raw.SDLK_y -pattern KeycodeZ = Keycode Raw.SDLK_z -pattern KeycodeCapsLock = Keycode Raw.SDLK_CAPSLOCK -pattern KeycodeF1 = Keycode Raw.SDLK_F1 -pattern KeycodeF2 = Keycode Raw.SDLK_F2 -pattern KeycodeF3 = Keycode Raw.SDLK_F3 -pattern KeycodeF4 = Keycode Raw.SDLK_F4 -pattern KeycodeF5 = Keycode Raw.SDLK_F5 -pattern KeycodeF6 = Keycode Raw.SDLK_F6 -pattern KeycodeF7 = Keycode Raw.SDLK_F7 -pattern KeycodeF8 = Keycode Raw.SDLK_F8 -pattern KeycodeF9 = Keycode Raw.SDLK_F9 -pattern KeycodeF10 = Keycode Raw.SDLK_F10 -pattern KeycodeF11 = Keycode Raw.SDLK_F11 -pattern KeycodeF12 = Keycode Raw.SDLK_F12 -pattern KeycodePrintScreen = Keycode Raw.SDLK_PRINTSCREEN -pattern KeycodeScrollLock = Keycode Raw.SDLK_SCROLLLOCK -pattern KeycodePause = Keycode Raw.SDLK_PAUSE -pattern KeycodeInsert = Keycode Raw.SDLK_INSERT -pattern KeycodeHome = Keycode Raw.SDLK_HOME -pattern KeycodePageUp = Keycode Raw.SDLK_PAGEUP -pattern KeycodeDelete = Keycode Raw.SDLK_DELETE -pattern KeycodeEnd = Keycode Raw.SDLK_END -pattern KeycodePageDown = Keycode Raw.SDLK_PAGEDOWN -pattern KeycodeRight = Keycode Raw.SDLK_RIGHT -pattern KeycodeLeft = Keycode Raw.SDLK_LEFT -pattern KeycodeDown = Keycode Raw.SDLK_DOWN -pattern KeycodeUp = Keycode Raw.SDLK_UP -pattern KeycodeNumLockClear = Keycode Raw.SDLK_NUMLOCKCLEAR -pattern KeycodeKPDivide = Keycode Raw.SDLK_KP_DIVIDE -pattern KeycodeKPMultiply = Keycode Raw.SDLK_KP_MULTIPLY -pattern KeycodeKPMinus = Keycode Raw.SDLK_KP_MINUS -pattern KeycodeKPPlus = Keycode Raw.SDLK_KP_PLUS -pattern KeycodeKPEnter = Keycode Raw.SDLK_KP_ENTER -pattern KeycodeKP1 = Keycode Raw.SDLK_KP_1 -pattern KeycodeKP2 = Keycode Raw.SDLK_KP_2 -pattern KeycodeKP3 = Keycode Raw.SDLK_KP_3 -pattern KeycodeKP4 = Keycode Raw.SDLK_KP_4 -pattern KeycodeKP5 = Keycode Raw.SDLK_KP_5 -pattern KeycodeKP6 = Keycode Raw.SDLK_KP_6 -pattern KeycodeKP7 = Keycode Raw.SDLK_KP_7 -pattern KeycodeKP8 = Keycode Raw.SDLK_KP_8 -pattern KeycodeKP9 = Keycode Raw.SDLK_KP_9 -pattern KeycodeKP0 = Keycode Raw.SDLK_KP_0 -pattern KeycodeKPPeriod = Keycode Raw.SDLK_KP_PERIOD -pattern KeycodeApplication = Keycode Raw.SDLK_APPLICATION -pattern KeycodePower = Keycode Raw.SDLK_POWER -pattern KeycodeKPEquals = Keycode Raw.SDLK_KP_EQUALS -pattern KeycodeF13 = Keycode Raw.SDLK_F13 -pattern KeycodeF14 = Keycode Raw.SDLK_F14 -pattern KeycodeF15 = Keycode Raw.SDLK_F15 -pattern KeycodeF16 = Keycode Raw.SDLK_F16 -pattern KeycodeF17 = Keycode Raw.SDLK_F17 -pattern KeycodeF18 = Keycode Raw.SDLK_F18 -pattern KeycodeF19 = Keycode Raw.SDLK_F19 -pattern KeycodeF20 = Keycode Raw.SDLK_F20 -pattern KeycodeF21 = Keycode Raw.SDLK_F21 -pattern KeycodeF22 = Keycode Raw.SDLK_F22 -pattern KeycodeF23 = Keycode Raw.SDLK_F23 -pattern KeycodeF24 = Keycode Raw.SDLK_F24 -pattern KeycodeExecute = Keycode Raw.SDLK_EXECUTE -pattern KeycodeHelp = Keycode Raw.SDLK_HELP -pattern KeycodeMenu = Keycode Raw.SDLK_MENU -pattern KeycodeSelect = Keycode Raw.SDLK_SELECT -pattern KeycodeStop = Keycode Raw.SDLK_STOP -pattern KeycodeAgain = Keycode Raw.SDLK_AGAIN -pattern KeycodeUndo = Keycode Raw.SDLK_UNDO -pattern KeycodeCut = Keycode Raw.SDLK_CUT -pattern KeycodeCopy = Keycode Raw.SDLK_COPY -pattern KeycodePaste = Keycode Raw.SDLK_PASTE -pattern KeycodeFind = Keycode Raw.SDLK_FIND -pattern KeycodeMute = Keycode Raw.SDLK_MUTE -pattern KeycodeVolumeUp = Keycode Raw.SDLK_VOLUMEUP -pattern KeycodeVolumeDown = Keycode Raw.SDLK_VOLUMEDOWN -pattern KeycodeKPComma = Keycode Raw.SDLK_KP_COMMA -pattern KeycodeKPEqualsAS400 = Keycode Raw.SDLK_KP_EQUALSAS400 -pattern KeycodeAltErase = Keycode Raw.SDLK_ALTERASE -pattern KeycodeSysReq = Keycode Raw.SDLK_SYSREQ -pattern KeycodeCancel = Keycode Raw.SDLK_CANCEL -pattern KeycodeClear = Keycode Raw.SDLK_CLEAR -pattern KeycodePrior = Keycode Raw.SDLK_PRIOR -pattern KeycodeReturn2 = Keycode Raw.SDLK_RETURN2 -pattern KeycodeSeparator = Keycode Raw.SDLK_SEPARATOR -pattern KeycodeOut = Keycode Raw.SDLK_OUT -pattern KeycodeOper = Keycode Raw.SDLK_OPER -pattern KeycodeClearAgain = Keycode Raw.SDLK_CLEARAGAIN -pattern KeycodeCrSel = Keycode Raw.SDLK_CRSEL -pattern KeycodeExSel = Keycode Raw.SDLK_EXSEL -pattern KeycodeKP00 = Keycode Raw.SDLK_KP_00 -pattern KeycodeKP000 = Keycode Raw.SDLK_KP_000 -pattern KeycodeThousandsSeparator = Keycode Raw.SDLK_THOUSANDSSEPARATOR -pattern KeycodeDecimalSeparator = Keycode Raw.SDLK_DECIMALSEPARATOR -pattern KeycodeCurrencyUnit = Keycode Raw.SDLK_CURRENCYUNIT -pattern KeycodeCurrencySubunit = Keycode Raw.SDLK_CURRENCYSUBUNIT -pattern KeycodeKPLeftParen = Keycode Raw.SDLK_KP_LEFTPAREN -pattern KeycodeKPRightParen = Keycode Raw.SDLK_KP_RIGHTPAREN -pattern KeycodeKPLeftBrace = Keycode Raw.SDLK_KP_LEFTBRACE -pattern KeycodeKPRightBrace = Keycode Raw.SDLK_KP_RIGHTBRACE -pattern KeycodeKPTab = Keycode Raw.SDLK_KP_TAB -pattern KeycodeKPBackspace = Keycode Raw.SDLK_KP_BACKSPACE -pattern KeycodeKPA = Keycode Raw.SDLK_KP_A -pattern KeycodeKPB = Keycode Raw.SDLK_KP_B -pattern KeycodeKPC = Keycode Raw.SDLK_KP_C -pattern KeycodeKPD = Keycode Raw.SDLK_KP_D -pattern KeycodeKPE = Keycode Raw.SDLK_KP_E -pattern KeycodeKPF = Keycode Raw.SDLK_KP_F -pattern KeycodeKPXor = Keycode Raw.SDLK_KP_XOR -pattern KeycodeKPPower = Keycode Raw.SDLK_KP_POWER -pattern KeycodeKPPercent = Keycode Raw.SDLK_KP_PERCENT -pattern KeycodeKPLess = Keycode Raw.SDLK_KP_LESS -pattern KeycodeKPGreater = Keycode Raw.SDLK_KP_GREATER -pattern KeycodeKPAmpersand = Keycode Raw.SDLK_KP_AMPERSAND -pattern KeycodeKPDblAmpersand = Keycode Raw.SDLK_KP_DBLAMPERSAND -pattern KeycodeKPVerticalBar = Keycode Raw.SDLK_KP_VERTICALBAR -pattern KeycodeKPDblVerticalBar = Keycode Raw.SDLK_KP_DBLVERTICALBAR -pattern KeycodeKPColon = Keycode Raw.SDLK_KP_COLON -pattern KeycodeKPHash = Keycode Raw.SDLK_KP_HASH -pattern KeycodeKPSpace = Keycode Raw.SDLK_KP_SPACE -pattern KeycodeKPAt = Keycode Raw.SDLK_KP_AT -pattern KeycodeKPExclam = Keycode Raw.SDLK_KP_EXCLAM -pattern KeycodeKPMemStore = Keycode Raw.SDLK_KP_MEMSTORE -pattern KeycodeKPMemRecall = Keycode Raw.SDLK_KP_MEMRECALL -pattern KeycodeKPMemClear = Keycode Raw.SDLK_KP_MEMCLEAR -pattern KeycodeKPMemAdd = Keycode Raw.SDLK_KP_MEMADD -pattern KeycodeKPMemSubtract = Keycode Raw.SDLK_KP_MEMSUBTRACT -pattern KeycodeKPMemMultiply = Keycode Raw.SDLK_KP_MEMMULTIPLY -pattern KeycodeKPMemDivide = Keycode Raw.SDLK_KP_MEMDIVIDE -pattern KeycodeKPPlusMinus = Keycode Raw.SDLK_KP_PLUSMINUS -pattern KeycodeKPClear = Keycode Raw.SDLK_KP_CLEAR -pattern KeycodeKPClearEntry = Keycode Raw.SDLK_KP_CLEARENTRY -pattern KeycodeKPBinary = Keycode Raw.SDLK_KP_BINARY -pattern KeycodeKPOctal = Keycode Raw.SDLK_KP_OCTAL -pattern KeycodeKPDecimal = Keycode Raw.SDLK_KP_DECIMAL -pattern KeycodeKPHexadecimal = Keycode Raw.SDLK_KP_HEXADECIMAL -pattern KeycodeLCtrl = Keycode Raw.SDLK_LCTRL -pattern KeycodeLShift = Keycode Raw.SDLK_LSHIFT -pattern KeycodeLAlt = Keycode Raw.SDLK_LALT -pattern KeycodeLGUI = Keycode Raw.SDLK_LGUI -pattern KeycodeRCtrl = Keycode Raw.SDLK_RCTRL -pattern KeycodeRShift = Keycode Raw.SDLK_RSHIFT -pattern KeycodeRAlt = Keycode Raw.SDLK_RALT -pattern KeycodeRGUI = Keycode Raw.SDLK_RGUI -pattern KeycodeMode = Keycode Raw.SDLK_MODE -pattern KeycodeAudioNext = Keycode Raw.SDLK_AUDIONEXT -pattern KeycodeAudioPrev = Keycode Raw.SDLK_AUDIOPREV -pattern KeycodeAudioStop = Keycode Raw.SDLK_AUDIOSTOP -pattern KeycodeAudioPlay = Keycode Raw.SDLK_AUDIOPLAY -pattern KeycodeAudioMute = Keycode Raw.SDLK_AUDIOMUTE -pattern KeycodeMediaSelect = Keycode Raw.SDLK_MEDIASELECT -pattern KeycodeWWW = Keycode Raw.SDLK_WWW -pattern KeycodeMail = Keycode Raw.SDLK_MAIL -pattern KeycodeCalculator = Keycode Raw.SDLK_CALCULATOR -pattern KeycodeComputer = Keycode Raw.SDLK_COMPUTER -pattern KeycodeACSearch = Keycode Raw.SDLK_AC_SEARCH -pattern KeycodeACHome = Keycode Raw.SDLK_AC_HOME -pattern KeycodeACBack = Keycode Raw.SDLK_AC_BACK -pattern KeycodeACForward = Keycode Raw.SDLK_AC_FORWARD -pattern KeycodeACStop = Keycode Raw.SDLK_AC_STOP -pattern KeycodeACRefresh = Keycode Raw.SDLK_AC_REFRESH -pattern KeycodeACBookmarks = Keycode Raw.SDLK_AC_BOOKMARKS -pattern KeycodeBrightnessDown = Keycode Raw.SDLK_BRIGHTNESSDOWN -pattern KeycodeBrightnessUp = Keycode Raw.SDLK_BRIGHTNESSUP -pattern KeycodeDisplaySwitch = Keycode Raw.SDLK_DISPLAYSWITCH -pattern KeycodeKbdIllumToggle = Keycode Raw.SDLK_KBDILLUMTOGGLE -pattern KeycodeKbdIllumDown = Keycode Raw.SDLK_KBDILLUMDOWN -pattern KeycodeKbdIllumUp = Keycode Raw.SDLK_KBDILLUMUP -pattern KeycodeEject = Keycode Raw.SDLK_EJECT -pattern KeycodeSleep = Keycode Raw.SDLK_SLEEP - -instance FromNumber Keycode Int32 where - fromNumber = Keycode - -instance ToNumber Keycode Int32 where - toNumber = unwrapKeycode +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} + +{-| + +An enumeration of scancodes and keycodes, allowing you to pattern match on keyboard keys. + +This module uses a relatively new GHC feature called @PatternSynonyms@ in order to provide pattern +matches over the underlying 'Scancode' or 'Keycode'. We do this so that you are also able to +work with vendor-specific or otherwise unknown codes. + +-} + +module SDL.Input.Keyboard.Codes + (-- * Scancodes + -- | Scancodes are codes that correspond to the physical position of a key, independent of the current keyboard layout. + -- Scancodes are meant to be layout-independent. Think of this as \"the user pressed the Q key as it would be on a US QWERTY keyboard\" regardless of whether this is actually a European keyboard or a Dvorak keyboard or whatever. The scancode is always the same key position. + -- 'Scancode' makes sense when you want key presses based on their location on a keyboard - for example, the traditional \"WASD\" layout used in first-person shooters. + Scancode(..), + pattern ScancodeUnknown, + pattern ScancodeA, + pattern ScancodeB, + pattern ScancodeC, + pattern ScancodeD, + pattern ScancodeE, + pattern ScancodeF, + pattern ScancodeG, + pattern ScancodeH, + pattern ScancodeI, + pattern ScancodeJ, + pattern ScancodeK, + pattern ScancodeL, + pattern ScancodeM, + pattern ScancodeN, + pattern ScancodeO, + pattern ScancodeP, + pattern ScancodeQ, + pattern ScancodeR, + pattern ScancodeS, + pattern ScancodeT, + pattern ScancodeU, + pattern ScancodeV, + pattern ScancodeW, + pattern ScancodeX, + pattern ScancodeY, + pattern ScancodeZ, + pattern Scancode1, + pattern Scancode2, + pattern Scancode3, + pattern Scancode4, + pattern Scancode5, + pattern Scancode6, + pattern Scancode7, + pattern Scancode8, + pattern Scancode9, + pattern Scancode0, + pattern ScancodeReturn, + pattern ScancodeEscape, + pattern ScancodeBackspace, + pattern ScancodeTab, + pattern ScancodeSpace, + pattern ScancodeMinus, + pattern ScancodeEquals, + pattern ScancodeLeftBracket, + pattern ScancodeRightBracket, + pattern ScancodeBackslash, + pattern ScancodeNonUSHash, + pattern ScancodeSemicolon, + pattern ScancodeApostrophe, + pattern ScancodeGrave, + pattern ScancodeComma, + pattern ScancodePeriod, + pattern ScancodeSlash, + pattern ScancodeCapsLock, + pattern ScancodeF1, + pattern ScancodeF2, + pattern ScancodeF3, + pattern ScancodeF4, + pattern ScancodeF5, + pattern ScancodeF6, + pattern ScancodeF7, + pattern ScancodeF8, + pattern ScancodeF9, + pattern ScancodeF10, + pattern ScancodeF11, + pattern ScancodeF12, + pattern ScancodePrintScreen, + pattern ScancodeScrollLock, + pattern ScancodePause, + pattern ScancodeInsert, + pattern ScancodeHome, + pattern ScancodePageUp, + pattern ScancodeDelete, + pattern ScancodeEnd, + pattern ScancodePageDown, + pattern ScancodeRight, + pattern ScancodeLeft, + pattern ScancodeDown, + pattern ScancodeUp, + pattern ScancodeNumLockClear, + pattern ScancodeKPDivide, + pattern ScancodeKPMultiply, + pattern ScancodeKPMinus, + pattern ScancodeKPPlus, + pattern ScancodeKPEnter, + pattern ScancodeKP1, + pattern ScancodeKP2, + pattern ScancodeKP3, + pattern ScancodeKP4, + pattern ScancodeKP5, + pattern ScancodeKP6, + pattern ScancodeKP7, + pattern ScancodeKP8, + pattern ScancodeKP9, + pattern ScancodeKP0, + pattern ScancodeKPPeriod, + pattern ScancodeNonUSBackslash, + pattern ScancodeApplication, + pattern ScancodePower, + pattern ScancodeKPEquals, + pattern ScancodeF13, + pattern ScancodeF14, + pattern ScancodeF15, + pattern ScancodeF16, + pattern ScancodeF17, + pattern ScancodeF18, + pattern ScancodeF19, + pattern ScancodeF20, + pattern ScancodeF21, + pattern ScancodeF22, + pattern ScancodeF23, + pattern ScancodeF24, + pattern ScancodeExecute, + pattern ScancodeHelp, + pattern ScancodeMenu, + pattern ScancodeSelect, + pattern ScancodeStop, + pattern ScancodeAgain, + pattern ScancodeUndo, + pattern ScancodeCut, + pattern ScancodeCopy, + pattern ScancodePaste, + pattern ScancodeFind, + pattern ScancodeMute, + pattern ScancodeVolumeUp, + pattern ScancodeVolumeDown, + pattern ScancodeKPComma, + pattern ScancodeKPEqualsAS400, + pattern ScancodeInternational1, + pattern ScancodeInternational2, + pattern ScancodeInternational3, + pattern ScancodeInternational4, + pattern ScancodeInternational5, + pattern ScancodeInternational6, + pattern ScancodeInternational7, + pattern ScancodeInternational8, + pattern ScancodeInternational9, + pattern ScancodeLang1, + pattern ScancodeLang2, + pattern ScancodeLang3, + pattern ScancodeLang4, + pattern ScancodeLang5, + pattern ScancodeLang6, + pattern ScancodeLang7, + pattern ScancodeLang8, + pattern ScancodeLang9, + pattern ScancodeAltErase, + pattern ScancodeSysReq, + pattern ScancodeCancel, + pattern ScancodeClear, + pattern ScancodePrior, + pattern ScancodeReturn2, + pattern ScancodeSeparator, + pattern ScancodeOut, + pattern ScancodeOper, + pattern ScancodeClearAgain, + pattern ScancodeCrSel, + pattern ScancodeExSel, + pattern ScancodeKP00, + pattern ScancodeKP000, + pattern ScancodeThousandsSeparator, + pattern ScancodeDecimalSeparator, + pattern ScancodeCurrencyUnit, + pattern ScancodeCurrencySubunit, + pattern ScancodeLeftParen, + pattern ScancodeRightParen, + pattern ScancodeLeftBrace, + pattern ScancodeRightBrace, + pattern ScancodeKPTab, + pattern ScancodeKPBackspace, + pattern ScancodeKPA, + pattern ScancodeKPB, + pattern ScancodeKPC, + pattern ScancodeKPD, + pattern ScancodeKPE, + pattern ScancodeKPF, + pattern ScancodeKPXOR, + pattern ScancodeKPPower, + pattern ScancodeKPPercent, + pattern ScancodeKPLess, + pattern ScancodeKPGreater, + pattern ScancodeKPAmpersand, + pattern ScancodeKPDblAmpersand, + pattern ScancodeKPVerticalBar, + pattern ScancodeKPDblVerticalBar, + pattern ScancodeKPColon, + pattern ScancodeKPHash, + pattern ScancodeKPSpace, + pattern ScancodeKPAt, + pattern ScancodeKPExclam, + pattern ScancodeKPMemStore, + pattern ScancodeKPMemRecall, + pattern ScancodeKPMemClear, + pattern ScancodeKPMemAdd, + pattern ScancodeKPMemSubtract, + pattern ScancodeKPMemMultiply, + pattern ScancodeKPMemDivide, + pattern ScancodeKPPlusMinus, + pattern ScancodeKPClear, + pattern ScancodeKPClearEntry, + pattern ScancodeKPBinary, + pattern ScancodeKPOctal, + pattern ScancodeKPDecimal, + pattern ScancodeKPHexadecimal, + pattern ScancodeLCtrl, + pattern ScancodeLShift, + pattern ScancodeLAlt, + pattern ScancodeLGUI, + pattern ScancodeRCtrl, + pattern ScancodeRShift, + pattern ScancodeRAlt, + pattern ScancodeRGUI, + pattern ScancodeMode, + pattern ScancodeAudioNext, + pattern ScancodeAudioPrev, + pattern ScancodeAudioStop, + pattern ScancodeAudioPlay, + pattern ScancodeAudioMute, + pattern ScancodeMediaSelect, + pattern ScancodeWWW, + pattern ScancodeMail, + pattern ScancodeCalculator, + pattern ScancodeComputer, + pattern ScancodeACSearch, + pattern ScancodeACHome, + pattern ScancodeACBack, + pattern ScancodeACForward, + pattern ScancodeACStop, + pattern ScancodeACRefresh, + pattern ScancodeACBookmarks, + pattern ScancodeBrightnessDown, + pattern ScancodeBrightnessUp, + pattern ScancodeDisplaySwitch, + pattern ScancodeKBDIllumToggle, + pattern ScancodeKBDIllumDown, + pattern ScancodeKBDIllumUp, + pattern ScancodeEject, + pattern ScancodeSleep, + pattern ScancodeApp1, + pattern ScancodeApp2, + + -- * Keycode + -- | Keycodes are layout-dependent codes, in that the code you receive can change for the same physical key depending on the users keyboard layout. + -- Think of this as "the user pressed the key that is labelled 'Q' on a specific keyboard." + -- 'Keycode' makes sense when you are anticipating the user to press either keys that match some mneumonic, or they are entering text. + Keycode(..), + pattern KeycodeUnknown, + pattern KeycodeReturn, + pattern KeycodeEscape, + pattern KeycodeBackspace, + pattern KeycodeTab, + pattern KeycodeSpace, + pattern KeycodeExclaim, + pattern KeycodeQuoteDbl, + pattern KeycodeHash, + pattern KeycodePercent, + pattern KeycodeDollar, + pattern KeycodeAmpersand, + pattern KeycodeQuote, + pattern KeycodeLeftParen, + pattern KeycodeRightParen, + pattern KeycodeAsterisk, + pattern KeycodePlus, + pattern KeycodeComma, + pattern KeycodeMinus, + pattern KeycodePeriod, + pattern KeycodeSlash, + pattern Keycode0, + pattern Keycode1, + pattern Keycode2, + pattern Keycode3, + pattern Keycode4, + pattern Keycode5, + pattern Keycode6, + pattern Keycode7, + pattern Keycode8, + pattern Keycode9, + pattern KeycodeColon, + pattern KeycodeSemicolon, + pattern KeycodeLess, + pattern KeycodeEquals, + pattern KeycodeGreater, + pattern KeycodeQuestion, + pattern KeycodeAt, + pattern KeycodeLeftBracket, + pattern KeycodeBackslash, + pattern KeycodeRightBracket, + pattern KeycodeCaret, + pattern KeycodeUnderscore, + pattern KeycodeBackquote, + pattern KeycodeA, + pattern KeycodeB, + pattern KeycodeC, + pattern KeycodeD, + pattern KeycodeE, + pattern KeycodeF, + pattern KeycodeG, + pattern KeycodeH, + pattern KeycodeI, + pattern KeycodeJ, + pattern KeycodeK, + pattern KeycodeL, + pattern KeycodeM, + pattern KeycodeN, + pattern KeycodeO, + pattern KeycodeP, + pattern KeycodeQ, + pattern KeycodeR, + pattern KeycodeS, + pattern KeycodeT, + pattern KeycodeU, + pattern KeycodeV, + pattern KeycodeW, + pattern KeycodeX, + pattern KeycodeY, + pattern KeycodeZ, + pattern KeycodeCapsLock, + pattern KeycodeF1, + pattern KeycodeF2, + pattern KeycodeF3, + pattern KeycodeF4, + pattern KeycodeF5, + pattern KeycodeF6, + pattern KeycodeF7, + pattern KeycodeF8, + pattern KeycodeF9, + pattern KeycodeF10, + pattern KeycodeF11, + pattern KeycodeF12, + pattern KeycodePrintScreen, + pattern KeycodeScrollLock, + pattern KeycodePause, + pattern KeycodeInsert, + pattern KeycodeHome, + pattern KeycodePageUp, + pattern KeycodeDelete, + pattern KeycodeEnd, + pattern KeycodePageDown, + pattern KeycodeRight, + pattern KeycodeLeft, + pattern KeycodeDown, + pattern KeycodeUp, + pattern KeycodeNumLockClear, + pattern KeycodeKPDivide, + pattern KeycodeKPMultiply, + pattern KeycodeKPMinus, + pattern KeycodeKPPlus, + pattern KeycodeKPEnter, + pattern KeycodeKP1, + pattern KeycodeKP2, + pattern KeycodeKP3, + pattern KeycodeKP4, + pattern KeycodeKP5, + pattern KeycodeKP6, + pattern KeycodeKP7, + pattern KeycodeKP8, + pattern KeycodeKP9, + pattern KeycodeKP0, + pattern KeycodeKPPeriod, + pattern KeycodeApplication, + pattern KeycodePower, + pattern KeycodeKPEquals, + pattern KeycodeF13, + pattern KeycodeF14, + pattern KeycodeF15, + pattern KeycodeF16, + pattern KeycodeF17, + pattern KeycodeF18, + pattern KeycodeF19, + pattern KeycodeF20, + pattern KeycodeF21, + pattern KeycodeF22, + pattern KeycodeF23, + pattern KeycodeF24, + pattern KeycodeExecute, + pattern KeycodeHelp, + pattern KeycodeMenu, + pattern KeycodeSelect, + pattern KeycodeStop, + pattern KeycodeAgain, + pattern KeycodeUndo, + pattern KeycodeCut, + pattern KeycodeCopy, + pattern KeycodePaste, + pattern KeycodeFind, + pattern KeycodeMute, + pattern KeycodeVolumeUp, + pattern KeycodeVolumeDown, + pattern KeycodeKPComma, + pattern KeycodeKPEqualsAS400, + pattern KeycodeAltErase, + pattern KeycodeSysReq, + pattern KeycodeCancel, + pattern KeycodeClear, + pattern KeycodePrior, + pattern KeycodeReturn2, + pattern KeycodeSeparator, + pattern KeycodeOut, + pattern KeycodeOper, + pattern KeycodeClearAgain, + pattern KeycodeCrSel, + pattern KeycodeExSel, + pattern KeycodeKP00, + pattern KeycodeKP000, + pattern KeycodeThousandsSeparator, + pattern KeycodeDecimalSeparator, + pattern KeycodeCurrencyUnit, + pattern KeycodeCurrencySubunit, + pattern KeycodeKPLeftParen, + pattern KeycodeKPRightParen, + pattern KeycodeKPLeftBrace, + pattern KeycodeKPRightBrace, + pattern KeycodeKPTab, + pattern KeycodeKPBackspace, + pattern KeycodeKPA, + pattern KeycodeKPB, + pattern KeycodeKPC, + pattern KeycodeKPD, + pattern KeycodeKPE, + pattern KeycodeKPF, + pattern KeycodeKPXor, + pattern KeycodeKPPower, + pattern KeycodeKPPercent, + pattern KeycodeKPLess, + pattern KeycodeKPGreater, + pattern KeycodeKPAmpersand, + pattern KeycodeKPDblAmpersand, + pattern KeycodeKPVerticalBar, + pattern KeycodeKPDblVerticalBar, + pattern KeycodeKPColon, + pattern KeycodeKPHash, + pattern KeycodeKPSpace, + pattern KeycodeKPAt, + pattern KeycodeKPExclam, + pattern KeycodeKPMemStore, + pattern KeycodeKPMemRecall, + pattern KeycodeKPMemClear, + pattern KeycodeKPMemAdd, + pattern KeycodeKPMemSubtract, + pattern KeycodeKPMemMultiply, + pattern KeycodeKPMemDivide, + pattern KeycodeKPPlusMinus, + pattern KeycodeKPClear, + pattern KeycodeKPClearEntry, + pattern KeycodeKPBinary, + pattern KeycodeKPOctal, + pattern KeycodeKPDecimal, + pattern KeycodeKPHexadecimal, + pattern KeycodeLCtrl, + pattern KeycodeLShift, + pattern KeycodeLAlt, + pattern KeycodeLGUI, + pattern KeycodeRCtrl, + pattern KeycodeRShift, + pattern KeycodeRAlt, + pattern KeycodeRGUI, + pattern KeycodeMode, + pattern KeycodeAudioNext, + pattern KeycodeAudioPrev, + pattern KeycodeAudioStop, + pattern KeycodeAudioPlay, + pattern KeycodeAudioMute, + pattern KeycodeMediaSelect, + pattern KeycodeWWW, + pattern KeycodeMail, + pattern KeycodeCalculator, + pattern KeycodeComputer, + pattern KeycodeACSearch, + pattern KeycodeACHome, + pattern KeycodeACBack, + pattern KeycodeACForward, + pattern KeycodeACStop, + pattern KeycodeACRefresh, + pattern KeycodeACBookmarks, + pattern KeycodeBrightnessDown, + pattern KeycodeBrightnessUp, + pattern KeycodeDisplaySwitch, + pattern KeycodeKbdIllumToggle, + pattern KeycodeKbdIllumDown, + pattern KeycodeKbdIllumUp, + pattern KeycodeEject, + pattern KeycodeSleep) + + where + +import GHC.Generics (Generic) +import Data.Data (Data) +import Data.Int +import Data.Typeable +import Data.Word +import SDL.Internal.Numbered +import qualified SDL.Raw.Enum as Raw + +newtype Scancode = Scancode { unwrapScancode :: Word32 } + deriving (Bounded, Data, Eq, Ord, Read, Generic, Show, Typeable) + +pattern ScancodeUnknown = Scancode Raw.SDL_SCANCODE_UNKNOWN +pattern ScancodeA = Scancode Raw.SDL_SCANCODE_A +pattern ScancodeB = Scancode Raw.SDL_SCANCODE_B +pattern ScancodeC = Scancode Raw.SDL_SCANCODE_C +pattern ScancodeD = Scancode Raw.SDL_SCANCODE_D +pattern ScancodeE = Scancode Raw.SDL_SCANCODE_E +pattern ScancodeF = Scancode Raw.SDL_SCANCODE_F +pattern ScancodeG = Scancode Raw.SDL_SCANCODE_G +pattern ScancodeH = Scancode Raw.SDL_SCANCODE_H +pattern ScancodeI = Scancode Raw.SDL_SCANCODE_I +pattern ScancodeJ = Scancode Raw.SDL_SCANCODE_J +pattern ScancodeK = Scancode Raw.SDL_SCANCODE_K +pattern ScancodeL = Scancode Raw.SDL_SCANCODE_L +pattern ScancodeM = Scancode Raw.SDL_SCANCODE_M +pattern ScancodeN = Scancode Raw.SDL_SCANCODE_N +pattern ScancodeO = Scancode Raw.SDL_SCANCODE_O +pattern ScancodeP = Scancode Raw.SDL_SCANCODE_P +pattern ScancodeQ = Scancode Raw.SDL_SCANCODE_Q +pattern ScancodeR = Scancode Raw.SDL_SCANCODE_R +pattern ScancodeS = Scancode Raw.SDL_SCANCODE_S +pattern ScancodeT = Scancode Raw.SDL_SCANCODE_T +pattern ScancodeU = Scancode Raw.SDL_SCANCODE_U +pattern ScancodeV = Scancode Raw.SDL_SCANCODE_V +pattern ScancodeW = Scancode Raw.SDL_SCANCODE_W +pattern ScancodeX = Scancode Raw.SDL_SCANCODE_X +pattern ScancodeY = Scancode Raw.SDL_SCANCODE_Y +pattern ScancodeZ = Scancode Raw.SDL_SCANCODE_Z +pattern Scancode1 = Scancode Raw.SDL_SCANCODE_1 +pattern Scancode2 = Scancode Raw.SDL_SCANCODE_2 +pattern Scancode3 = Scancode Raw.SDL_SCANCODE_3 +pattern Scancode4 = Scancode Raw.SDL_SCANCODE_4 +pattern Scancode5 = Scancode Raw.SDL_SCANCODE_5 +pattern Scancode6 = Scancode Raw.SDL_SCANCODE_6 +pattern Scancode7 = Scancode Raw.SDL_SCANCODE_7 +pattern Scancode8 = Scancode Raw.SDL_SCANCODE_8 +pattern Scancode9 = Scancode Raw.SDL_SCANCODE_9 +pattern Scancode0 = Scancode Raw.SDL_SCANCODE_0 +pattern ScancodeReturn = Scancode Raw.SDL_SCANCODE_RETURN +pattern ScancodeEscape = Scancode Raw.SDL_SCANCODE_ESCAPE +pattern ScancodeBackspace = Scancode Raw.SDL_SCANCODE_BACKSPACE +pattern ScancodeTab = Scancode Raw.SDL_SCANCODE_TAB +pattern ScancodeSpace = Scancode Raw.SDL_SCANCODE_SPACE +pattern ScancodeMinus = Scancode Raw.SDL_SCANCODE_MINUS +pattern ScancodeEquals = Scancode Raw.SDL_SCANCODE_EQUALS +pattern ScancodeLeftBracket = Scancode Raw.SDL_SCANCODE_LEFTBRACKET +pattern ScancodeRightBracket = Scancode Raw.SDL_SCANCODE_RIGHTBRACKET +pattern ScancodeBackslash = Scancode Raw.SDL_SCANCODE_BACKSLASH +pattern ScancodeNonUSHash = Scancode Raw.SDL_SCANCODE_NONUSHASH +pattern ScancodeSemicolon = Scancode Raw.SDL_SCANCODE_SEMICOLON +pattern ScancodeApostrophe = Scancode Raw.SDL_SCANCODE_APOSTROPHE +pattern ScancodeGrave = Scancode Raw.SDL_SCANCODE_GRAVE +pattern ScancodeComma = Scancode Raw.SDL_SCANCODE_COMMA +pattern ScancodePeriod = Scancode Raw.SDL_SCANCODE_PERIOD +pattern ScancodeSlash = Scancode Raw.SDL_SCANCODE_SLASH +pattern ScancodeCapsLock = Scancode Raw.SDL_SCANCODE_CAPSLOCK +pattern ScancodeF1 = Scancode Raw.SDL_SCANCODE_F1 +pattern ScancodeF2 = Scancode Raw.SDL_SCANCODE_F2 +pattern ScancodeF3 = Scancode Raw.SDL_SCANCODE_F3 +pattern ScancodeF4 = Scancode Raw.SDL_SCANCODE_F4 +pattern ScancodeF5 = Scancode Raw.SDL_SCANCODE_F5 +pattern ScancodeF6 = Scancode Raw.SDL_SCANCODE_F6 +pattern ScancodeF7 = Scancode Raw.SDL_SCANCODE_F7 +pattern ScancodeF8 = Scancode Raw.SDL_SCANCODE_F8 +pattern ScancodeF9 = Scancode Raw.SDL_SCANCODE_F9 +pattern ScancodeF10 = Scancode Raw.SDL_SCANCODE_F10 +pattern ScancodeF11 = Scancode Raw.SDL_SCANCODE_F11 +pattern ScancodeF12 = Scancode Raw.SDL_SCANCODE_F12 +pattern ScancodePrintScreen = Scancode Raw.SDL_SCANCODE_PRINTSCREEN +pattern ScancodeScrollLock = Scancode Raw.SDL_SCANCODE_SCROLLLOCK +pattern ScancodePause = Scancode Raw.SDL_SCANCODE_PAUSE +pattern ScancodeInsert = Scancode Raw.SDL_SCANCODE_INSERT +pattern ScancodeHome = Scancode Raw.SDL_SCANCODE_HOME +pattern ScancodePageUp = Scancode Raw.SDL_SCANCODE_PAGEUP +pattern ScancodeDelete = Scancode Raw.SDL_SCANCODE_DELETE +pattern ScancodeEnd = Scancode Raw.SDL_SCANCODE_END +pattern ScancodePageDown = Scancode Raw.SDL_SCANCODE_PAGEDOWN +pattern ScancodeRight = Scancode Raw.SDL_SCANCODE_RIGHT +pattern ScancodeLeft = Scancode Raw.SDL_SCANCODE_LEFT +pattern ScancodeDown = Scancode Raw.SDL_SCANCODE_DOWN +pattern ScancodeUp = Scancode Raw.SDL_SCANCODE_UP +pattern ScancodeNumLockClear = Scancode Raw.SDL_SCANCODE_NUMLOCKCLEAR +pattern ScancodeKPDivide = Scancode Raw.SDL_SCANCODE_KP_DIVIDE +pattern ScancodeKPMultiply = Scancode Raw.SDL_SCANCODE_KP_MULTIPLY +pattern ScancodeKPMinus = Scancode Raw.SDL_SCANCODE_KP_MINUS +pattern ScancodeKPPlus = Scancode Raw.SDL_SCANCODE_KP_PLUS +pattern ScancodeKPEnter = Scancode Raw.SDL_SCANCODE_KP_ENTER +pattern ScancodeKP1 = Scancode Raw.SDL_SCANCODE_KP_1 +pattern ScancodeKP2 = Scancode Raw.SDL_SCANCODE_KP_2 +pattern ScancodeKP3 = Scancode Raw.SDL_SCANCODE_KP_3 +pattern ScancodeKP4 = Scancode Raw.SDL_SCANCODE_KP_4 +pattern ScancodeKP5 = Scancode Raw.SDL_SCANCODE_KP_5 +pattern ScancodeKP6 = Scancode Raw.SDL_SCANCODE_KP_6 +pattern ScancodeKP7 = Scancode Raw.SDL_SCANCODE_KP_7 +pattern ScancodeKP8 = Scancode Raw.SDL_SCANCODE_KP_8 +pattern ScancodeKP9 = Scancode Raw.SDL_SCANCODE_KP_9 +pattern ScancodeKP0 = Scancode Raw.SDL_SCANCODE_KP_0 +pattern ScancodeKPPeriod = Scancode Raw.SDL_SCANCODE_KP_PERIOD +pattern ScancodeNonUSBackslash = Scancode Raw.SDL_SCANCODE_NONUSBACKSLASH +pattern ScancodeApplication = Scancode Raw.SDL_SCANCODE_APPLICATION +pattern ScancodePower = Scancode Raw.SDL_SCANCODE_POWER +pattern ScancodeKPEquals = Scancode Raw.SDL_SCANCODE_KP_EQUALS +pattern ScancodeF13 = Scancode Raw.SDL_SCANCODE_F13 +pattern ScancodeF14 = Scancode Raw.SDL_SCANCODE_F14 +pattern ScancodeF15 = Scancode Raw.SDL_SCANCODE_F15 +pattern ScancodeF16 = Scancode Raw.SDL_SCANCODE_F16 +pattern ScancodeF17 = Scancode Raw.SDL_SCANCODE_F17 +pattern ScancodeF18 = Scancode Raw.SDL_SCANCODE_F18 +pattern ScancodeF19 = Scancode Raw.SDL_SCANCODE_F19 +pattern ScancodeF20 = Scancode Raw.SDL_SCANCODE_F20 +pattern ScancodeF21 = Scancode Raw.SDL_SCANCODE_F21 +pattern ScancodeF22 = Scancode Raw.SDL_SCANCODE_F22 +pattern ScancodeF23 = Scancode Raw.SDL_SCANCODE_F23 +pattern ScancodeF24 = Scancode Raw.SDL_SCANCODE_F24 +pattern ScancodeExecute = Scancode Raw.SDL_SCANCODE_EXECUTE +pattern ScancodeHelp = Scancode Raw.SDL_SCANCODE_HELP +pattern ScancodeMenu = Scancode Raw.SDL_SCANCODE_MENU +pattern ScancodeSelect = Scancode Raw.SDL_SCANCODE_SELECT +pattern ScancodeStop = Scancode Raw.SDL_SCANCODE_STOP +pattern ScancodeAgain = Scancode Raw.SDL_SCANCODE_AGAIN +pattern ScancodeUndo = Scancode Raw.SDL_SCANCODE_UNDO +pattern ScancodeCut = Scancode Raw.SDL_SCANCODE_CUT +pattern ScancodeCopy = Scancode Raw.SDL_SCANCODE_COPY +pattern ScancodePaste = Scancode Raw.SDL_SCANCODE_PASTE +pattern ScancodeFind = Scancode Raw.SDL_SCANCODE_FIND +pattern ScancodeMute = Scancode Raw.SDL_SCANCODE_MUTE +pattern ScancodeVolumeUp = Scancode Raw.SDL_SCANCODE_VOLUMEUP +pattern ScancodeVolumeDown = Scancode Raw.SDL_SCANCODE_VOLUMEDOWN +pattern ScancodeKPComma = Scancode Raw.SDL_SCANCODE_KP_COMMA +pattern ScancodeKPEqualsAS400 = Scancode Raw.SDL_SCANCODE_KP_EQUALSAS400 +pattern ScancodeInternational1 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL1 +pattern ScancodeInternational2 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL2 +pattern ScancodeInternational3 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL3 +pattern ScancodeInternational4 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL4 +pattern ScancodeInternational5 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL5 +pattern ScancodeInternational6 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL6 +pattern ScancodeInternational7 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL7 +pattern ScancodeInternational8 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL8 +pattern ScancodeInternational9 = Scancode Raw.SDL_SCANCODE_INTERNATIONAL9 +pattern ScancodeLang1 = Scancode Raw.SDL_SCANCODE_LANG1 +pattern ScancodeLang2 = Scancode Raw.SDL_SCANCODE_LANG2 +pattern ScancodeLang3 = Scancode Raw.SDL_SCANCODE_LANG3 +pattern ScancodeLang4 = Scancode Raw.SDL_SCANCODE_LANG4 +pattern ScancodeLang5 = Scancode Raw.SDL_SCANCODE_LANG5 +pattern ScancodeLang6 = Scancode Raw.SDL_SCANCODE_LANG6 +pattern ScancodeLang7 = Scancode Raw.SDL_SCANCODE_LANG7 +pattern ScancodeLang8 = Scancode Raw.SDL_SCANCODE_LANG8 +pattern ScancodeLang9 = Scancode Raw.SDL_SCANCODE_LANG9 +pattern ScancodeAltErase = Scancode Raw.SDL_SCANCODE_ALTERASE +pattern ScancodeSysReq = Scancode Raw.SDL_SCANCODE_SYSREQ +pattern ScancodeCancel = Scancode Raw.SDL_SCANCODE_CANCEL +pattern ScancodeClear = Scancode Raw.SDL_SCANCODE_CLEAR +pattern ScancodePrior = Scancode Raw.SDL_SCANCODE_PRIOR +pattern ScancodeReturn2 = Scancode Raw.SDL_SCANCODE_RETURN2 +pattern ScancodeSeparator = Scancode Raw.SDL_SCANCODE_SEPARATOR +pattern ScancodeOut = Scancode Raw.SDL_SCANCODE_OUT +pattern ScancodeOper = Scancode Raw.SDL_SCANCODE_OPER +pattern ScancodeClearAgain = Scancode Raw.SDL_SCANCODE_CLEARAGAIN +pattern ScancodeCrSel = Scancode Raw.SDL_SCANCODE_CRSEL +pattern ScancodeExSel = Scancode Raw.SDL_SCANCODE_EXSEL +pattern ScancodeKP00 = Scancode Raw.SDL_SCANCODE_KP_00 +pattern ScancodeKP000 = Scancode Raw.SDL_SCANCODE_KP_000 +pattern ScancodeThousandsSeparator = Scancode Raw.SDL_SCANCODE_THOUSANDSSEPARATOR +pattern ScancodeDecimalSeparator = Scancode Raw.SDL_SCANCODE_DECIMALSEPARATOR +pattern ScancodeCurrencyUnit = Scancode Raw.SDL_SCANCODE_CURRENCYUNIT +pattern ScancodeCurrencySubunit = Scancode Raw.SDL_SCANCODE_CURRENCYSUBUNIT +pattern ScancodeLeftParen = Scancode Raw.SDL_SCANCODE_KP_LEFTPAREN +pattern ScancodeRightParen = Scancode Raw.SDL_SCANCODE_KP_RIGHTPAREN +pattern ScancodeLeftBrace = Scancode Raw.SDL_SCANCODE_KP_LEFTBRACE +pattern ScancodeRightBrace = Scancode Raw.SDL_SCANCODE_KP_RIGHTBRACE +pattern ScancodeKPTab = Scancode Raw.SDL_SCANCODE_KP_TAB +pattern ScancodeKPBackspace = Scancode Raw.SDL_SCANCODE_KP_BACKSPACE +pattern ScancodeKPA = Scancode Raw.SDL_SCANCODE_KP_A +pattern ScancodeKPB = Scancode Raw.SDL_SCANCODE_KP_B +pattern ScancodeKPC = Scancode Raw.SDL_SCANCODE_KP_C +pattern ScancodeKPD = Scancode Raw.SDL_SCANCODE_KP_D +pattern ScancodeKPE = Scancode Raw.SDL_SCANCODE_KP_E +pattern ScancodeKPF = Scancode Raw.SDL_SCANCODE_KP_F +pattern ScancodeKPXOR = Scancode Raw.SDL_SCANCODE_KP_XOR +pattern ScancodeKPPower = Scancode Raw.SDL_SCANCODE_KP_POWER +pattern ScancodeKPPercent = Scancode Raw.SDL_SCANCODE_KP_PERCENT +pattern ScancodeKPLess = Scancode Raw.SDL_SCANCODE_KP_LESS +pattern ScancodeKPGreater = Scancode Raw.SDL_SCANCODE_KP_GREATER +pattern ScancodeKPAmpersand = Scancode Raw.SDL_SCANCODE_KP_AMPERSAND +pattern ScancodeKPDblAmpersand = Scancode Raw.SDL_SCANCODE_KP_DBLAMPERSAND +pattern ScancodeKPVerticalBar = Scancode Raw.SDL_SCANCODE_KP_VERTICALBAR +pattern ScancodeKPDblVerticalBar = Scancode Raw.SDL_SCANCODE_KP_DBLVERTICALBAR +pattern ScancodeKPColon = Scancode Raw.SDL_SCANCODE_KP_COLON +pattern ScancodeKPHash = Scancode Raw.SDL_SCANCODE_KP_HASH +pattern ScancodeKPSpace = Scancode Raw.SDL_SCANCODE_KP_SPACE +pattern ScancodeKPAt = Scancode Raw.SDL_SCANCODE_KP_AT +pattern ScancodeKPExclam = Scancode Raw.SDL_SCANCODE_KP_EXCLAM +pattern ScancodeKPMemStore = Scancode Raw.SDL_SCANCODE_KP_MEMSTORE +pattern ScancodeKPMemRecall = Scancode Raw.SDL_SCANCODE_KP_MEMRECALL +pattern ScancodeKPMemClear = Scancode Raw.SDL_SCANCODE_KP_MEMCLEAR +pattern ScancodeKPMemAdd = Scancode Raw.SDL_SCANCODE_KP_MEMADD +pattern ScancodeKPMemSubtract = Scancode Raw.SDL_SCANCODE_KP_MEMSUBTRACT +pattern ScancodeKPMemMultiply = Scancode Raw.SDL_SCANCODE_KP_MEMMULTIPLY +pattern ScancodeKPMemDivide = Scancode Raw.SDL_SCANCODE_KP_MEMDIVIDE +pattern ScancodeKPPlusMinus = Scancode Raw.SDL_SCANCODE_KP_PLUSMINUS +pattern ScancodeKPClear = Scancode Raw.SDL_SCANCODE_KP_CLEAR +pattern ScancodeKPClearEntry = Scancode Raw.SDL_SCANCODE_KP_CLEARENTRY +pattern ScancodeKPBinary = Scancode Raw.SDL_SCANCODE_KP_BINARY +pattern ScancodeKPOctal = Scancode Raw.SDL_SCANCODE_KP_OCTAL +pattern ScancodeKPDecimal = Scancode Raw.SDL_SCANCODE_KP_DECIMAL +pattern ScancodeKPHexadecimal = Scancode Raw.SDL_SCANCODE_KP_HEXADECIMAL +pattern ScancodeLCtrl = Scancode Raw.SDL_SCANCODE_LCTRL +pattern ScancodeLShift = Scancode Raw.SDL_SCANCODE_LSHIFT +pattern ScancodeLAlt = Scancode Raw.SDL_SCANCODE_LALT +pattern ScancodeLGUI = Scancode Raw.SDL_SCANCODE_LGUI +pattern ScancodeRCtrl = Scancode Raw.SDL_SCANCODE_RCTRL +pattern ScancodeRShift = Scancode Raw.SDL_SCANCODE_RSHIFT +pattern ScancodeRAlt = Scancode Raw.SDL_SCANCODE_RALT +pattern ScancodeRGUI = Scancode Raw.SDL_SCANCODE_RGUI +pattern ScancodeMode = Scancode Raw.SDL_SCANCODE_MODE +pattern ScancodeAudioNext = Scancode Raw.SDL_SCANCODE_AUDIONEXT +pattern ScancodeAudioPrev = Scancode Raw.SDL_SCANCODE_AUDIOPREV +pattern ScancodeAudioStop = Scancode Raw.SDL_SCANCODE_AUDIOSTOP +pattern ScancodeAudioPlay = Scancode Raw.SDL_SCANCODE_AUDIOPLAY +pattern ScancodeAudioMute = Scancode Raw.SDL_SCANCODE_AUDIOMUTE +pattern ScancodeMediaSelect = Scancode Raw.SDL_SCANCODE_MEDIASELECT +pattern ScancodeWWW = Scancode Raw.SDL_SCANCODE_WWW +pattern ScancodeMail = Scancode Raw.SDL_SCANCODE_MAIL +pattern ScancodeCalculator = Scancode Raw.SDL_SCANCODE_CALCULATOR +pattern ScancodeComputer = Scancode Raw.SDL_SCANCODE_COMPUTER +pattern ScancodeACSearch = Scancode Raw.SDL_SCANCODE_AC_SEARCH +pattern ScancodeACHome = Scancode Raw.SDL_SCANCODE_AC_HOME +pattern ScancodeACBack = Scancode Raw.SDL_SCANCODE_AC_BACK +pattern ScancodeACForward = Scancode Raw.SDL_SCANCODE_AC_FORWARD +pattern ScancodeACStop = Scancode Raw.SDL_SCANCODE_AC_STOP +pattern ScancodeACRefresh = Scancode Raw.SDL_SCANCODE_AC_REFRESH +pattern ScancodeACBookmarks = Scancode Raw.SDL_SCANCODE_AC_BOOKMARKS +pattern ScancodeBrightnessDown = Scancode Raw.SDL_SCANCODE_BRIGHTNESSDOWN +pattern ScancodeBrightnessUp = Scancode Raw.SDL_SCANCODE_BRIGHTNESSUP +pattern ScancodeDisplaySwitch = Scancode Raw.SDL_SCANCODE_DISPLAYSWITCH +pattern ScancodeKBDIllumToggle = Scancode Raw.SDL_SCANCODE_KBDILLUMTOGGLE +pattern ScancodeKBDIllumDown = Scancode Raw.SDL_SCANCODE_KBDILLUMDOWN +pattern ScancodeKBDIllumUp = Scancode Raw.SDL_SCANCODE_KBDILLUMUP +pattern ScancodeEject = Scancode Raw.SDL_SCANCODE_EJECT +pattern ScancodeSleep = Scancode Raw.SDL_SCANCODE_SLEEP +pattern ScancodeApp1 = Scancode Raw.SDL_SCANCODE_APP1 +pattern ScancodeApp2 = Scancode Raw.SDL_SCANCODE_APP2 + +instance FromNumber Scancode Word32 where + fromNumber = Scancode + +instance ToNumber Scancode Word32 where + toNumber = unwrapScancode + +newtype Keycode = Keycode { unwrapKeycode :: Int32 } + deriving (Bounded, Data, Eq, Ord, Read, Generic, Show, Typeable) + +pattern KeycodeUnknown = Keycode Raw.SDLK_UNKNOWN +pattern KeycodeReturn = Keycode Raw.SDLK_RETURN +pattern KeycodeEscape = Keycode Raw.SDLK_ESCAPE +pattern KeycodeBackspace = Keycode Raw.SDLK_BACKSPACE +pattern KeycodeTab = Keycode Raw.SDLK_TAB +pattern KeycodeSpace = Keycode Raw.SDLK_SPACE +pattern KeycodeExclaim = Keycode Raw.SDLK_EXCLAIM +pattern KeycodeQuoteDbl = Keycode Raw.SDLK_QUOTEDBL +pattern KeycodeHash = Keycode Raw.SDLK_HASH +pattern KeycodePercent = Keycode Raw.SDLK_PERCENT +pattern KeycodeDollar = Keycode Raw.SDLK_DOLLAR +pattern KeycodeAmpersand = Keycode Raw.SDLK_AMPERSAND +pattern KeycodeQuote = Keycode Raw.SDLK_QUOTE +pattern KeycodeLeftParen = Keycode Raw.SDLK_LEFTPAREN +pattern KeycodeRightParen = Keycode Raw.SDLK_RIGHTPAREN +pattern KeycodeAsterisk = Keycode Raw.SDLK_ASTERISK +pattern KeycodePlus = Keycode Raw.SDLK_PLUS +pattern KeycodeComma = Keycode Raw.SDLK_COMMA +pattern KeycodeMinus = Keycode Raw.SDLK_MINUS +pattern KeycodePeriod = Keycode Raw.SDLK_PERIOD +pattern KeycodeSlash = Keycode Raw.SDLK_SLASH +pattern Keycode0 = Keycode Raw.SDLK_0 +pattern Keycode1 = Keycode Raw.SDLK_1 +pattern Keycode2 = Keycode Raw.SDLK_2 +pattern Keycode3 = Keycode Raw.SDLK_3 +pattern Keycode4 = Keycode Raw.SDLK_4 +pattern Keycode5 = Keycode Raw.SDLK_5 +pattern Keycode6 = Keycode Raw.SDLK_6 +pattern Keycode7 = Keycode Raw.SDLK_7 +pattern Keycode8 = Keycode Raw.SDLK_8 +pattern Keycode9 = Keycode Raw.SDLK_9 +pattern KeycodeColon = Keycode Raw.SDLK_COLON +pattern KeycodeSemicolon = Keycode Raw.SDLK_SEMICOLON +pattern KeycodeLess = Keycode Raw.SDLK_LESS +pattern KeycodeEquals = Keycode Raw.SDLK_EQUALS +pattern KeycodeGreater = Keycode Raw.SDLK_GREATER +pattern KeycodeQuestion = Keycode Raw.SDLK_QUESTION +pattern KeycodeAt = Keycode Raw.SDLK_AT +pattern KeycodeLeftBracket = Keycode Raw.SDLK_LEFTBRACKET +pattern KeycodeBackslash = Keycode Raw.SDLK_BACKSLASH +pattern KeycodeRightBracket = Keycode Raw.SDLK_RIGHTBRACKET +pattern KeycodeCaret = Keycode Raw.SDLK_CARET +pattern KeycodeUnderscore = Keycode Raw.SDLK_UNDERSCORE +pattern KeycodeBackquote = Keycode Raw.SDLK_BACKQUOTE +pattern KeycodeA = Keycode Raw.SDLK_a +pattern KeycodeB = Keycode Raw.SDLK_b +pattern KeycodeC = Keycode Raw.SDLK_c +pattern KeycodeD = Keycode Raw.SDLK_d +pattern KeycodeE = Keycode Raw.SDLK_e +pattern KeycodeF = Keycode Raw.SDLK_f +pattern KeycodeG = Keycode Raw.SDLK_g +pattern KeycodeH = Keycode Raw.SDLK_h +pattern KeycodeI = Keycode Raw.SDLK_i +pattern KeycodeJ = Keycode Raw.SDLK_j +pattern KeycodeK = Keycode Raw.SDLK_k +pattern KeycodeL = Keycode Raw.SDLK_l +pattern KeycodeM = Keycode Raw.SDLK_m +pattern KeycodeN = Keycode Raw.SDLK_n +pattern KeycodeO = Keycode Raw.SDLK_o +pattern KeycodeP = Keycode Raw.SDLK_p +pattern KeycodeQ = Keycode Raw.SDLK_q +pattern KeycodeR = Keycode Raw.SDLK_r +pattern KeycodeS = Keycode Raw.SDLK_s +pattern KeycodeT = Keycode Raw.SDLK_t +pattern KeycodeU = Keycode Raw.SDLK_u +pattern KeycodeV = Keycode Raw.SDLK_v +pattern KeycodeW = Keycode Raw.SDLK_w +pattern KeycodeX = Keycode Raw.SDLK_x +pattern KeycodeY = Keycode Raw.SDLK_y +pattern KeycodeZ = Keycode Raw.SDLK_z +pattern KeycodeCapsLock = Keycode Raw.SDLK_CAPSLOCK +pattern KeycodeF1 = Keycode Raw.SDLK_F1 +pattern KeycodeF2 = Keycode Raw.SDLK_F2 +pattern KeycodeF3 = Keycode Raw.SDLK_F3 +pattern KeycodeF4 = Keycode Raw.SDLK_F4 +pattern KeycodeF5 = Keycode Raw.SDLK_F5 +pattern KeycodeF6 = Keycode Raw.SDLK_F6 +pattern KeycodeF7 = Keycode Raw.SDLK_F7 +pattern KeycodeF8 = Keycode Raw.SDLK_F8 +pattern KeycodeF9 = Keycode Raw.SDLK_F9 +pattern KeycodeF10 = Keycode Raw.SDLK_F10 +pattern KeycodeF11 = Keycode Raw.SDLK_F11 +pattern KeycodeF12 = Keycode Raw.SDLK_F12 +pattern KeycodePrintScreen = Keycode Raw.SDLK_PRINTSCREEN +pattern KeycodeScrollLock = Keycode Raw.SDLK_SCROLLLOCK +pattern KeycodePause = Keycode Raw.SDLK_PAUSE +pattern KeycodeInsert = Keycode Raw.SDLK_INSERT +pattern KeycodeHome = Keycode Raw.SDLK_HOME +pattern KeycodePageUp = Keycode Raw.SDLK_PAGEUP +pattern KeycodeDelete = Keycode Raw.SDLK_DELETE +pattern KeycodeEnd = Keycode Raw.SDLK_END +pattern KeycodePageDown = Keycode Raw.SDLK_PAGEDOWN +pattern KeycodeRight = Keycode Raw.SDLK_RIGHT +pattern KeycodeLeft = Keycode Raw.SDLK_LEFT +pattern KeycodeDown = Keycode Raw.SDLK_DOWN +pattern KeycodeUp = Keycode Raw.SDLK_UP +pattern KeycodeNumLockClear = Keycode Raw.SDLK_NUMLOCKCLEAR +pattern KeycodeKPDivide = Keycode Raw.SDLK_KP_DIVIDE +pattern KeycodeKPMultiply = Keycode Raw.SDLK_KP_MULTIPLY +pattern KeycodeKPMinus = Keycode Raw.SDLK_KP_MINUS +pattern KeycodeKPPlus = Keycode Raw.SDLK_KP_PLUS +pattern KeycodeKPEnter = Keycode Raw.SDLK_KP_ENTER +pattern KeycodeKP1 = Keycode Raw.SDLK_KP_1 +pattern KeycodeKP2 = Keycode Raw.SDLK_KP_2 +pattern KeycodeKP3 = Keycode Raw.SDLK_KP_3 +pattern KeycodeKP4 = Keycode Raw.SDLK_KP_4 +pattern KeycodeKP5 = Keycode Raw.SDLK_KP_5 +pattern KeycodeKP6 = Keycode Raw.SDLK_KP_6 +pattern KeycodeKP7 = Keycode Raw.SDLK_KP_7 +pattern KeycodeKP8 = Keycode Raw.SDLK_KP_8 +pattern KeycodeKP9 = Keycode Raw.SDLK_KP_9 +pattern KeycodeKP0 = Keycode Raw.SDLK_KP_0 +pattern KeycodeKPPeriod = Keycode Raw.SDLK_KP_PERIOD +pattern KeycodeApplication = Keycode Raw.SDLK_APPLICATION +pattern KeycodePower = Keycode Raw.SDLK_POWER +pattern KeycodeKPEquals = Keycode Raw.SDLK_KP_EQUALS +pattern KeycodeF13 = Keycode Raw.SDLK_F13 +pattern KeycodeF14 = Keycode Raw.SDLK_F14 +pattern KeycodeF15 = Keycode Raw.SDLK_F15 +pattern KeycodeF16 = Keycode Raw.SDLK_F16 +pattern KeycodeF17 = Keycode Raw.SDLK_F17 +pattern KeycodeF18 = Keycode Raw.SDLK_F18 +pattern KeycodeF19 = Keycode Raw.SDLK_F19 +pattern KeycodeF20 = Keycode Raw.SDLK_F20 +pattern KeycodeF21 = Keycode Raw.SDLK_F21 +pattern KeycodeF22 = Keycode Raw.SDLK_F22 +pattern KeycodeF23 = Keycode Raw.SDLK_F23 +pattern KeycodeF24 = Keycode Raw.SDLK_F24 +pattern KeycodeExecute = Keycode Raw.SDLK_EXECUTE +pattern KeycodeHelp = Keycode Raw.SDLK_HELP +pattern KeycodeMenu = Keycode Raw.SDLK_MENU +pattern KeycodeSelect = Keycode Raw.SDLK_SELECT +pattern KeycodeStop = Keycode Raw.SDLK_STOP +pattern KeycodeAgain = Keycode Raw.SDLK_AGAIN +pattern KeycodeUndo = Keycode Raw.SDLK_UNDO +pattern KeycodeCut = Keycode Raw.SDLK_CUT +pattern KeycodeCopy = Keycode Raw.SDLK_COPY +pattern KeycodePaste = Keycode Raw.SDLK_PASTE +pattern KeycodeFind = Keycode Raw.SDLK_FIND +pattern KeycodeMute = Keycode Raw.SDLK_MUTE +pattern KeycodeVolumeUp = Keycode Raw.SDLK_VOLUMEUP +pattern KeycodeVolumeDown = Keycode Raw.SDLK_VOLUMEDOWN +pattern KeycodeKPComma = Keycode Raw.SDLK_KP_COMMA +pattern KeycodeKPEqualsAS400 = Keycode Raw.SDLK_KP_EQUALSAS400 +pattern KeycodeAltErase = Keycode Raw.SDLK_ALTERASE +pattern KeycodeSysReq = Keycode Raw.SDLK_SYSREQ +pattern KeycodeCancel = Keycode Raw.SDLK_CANCEL +pattern KeycodeClear = Keycode Raw.SDLK_CLEAR +pattern KeycodePrior = Keycode Raw.SDLK_PRIOR +pattern KeycodeReturn2 = Keycode Raw.SDLK_RETURN2 +pattern KeycodeSeparator = Keycode Raw.SDLK_SEPARATOR +pattern KeycodeOut = Keycode Raw.SDLK_OUT +pattern KeycodeOper = Keycode Raw.SDLK_OPER +pattern KeycodeClearAgain = Keycode Raw.SDLK_CLEARAGAIN +pattern KeycodeCrSel = Keycode Raw.SDLK_CRSEL +pattern KeycodeExSel = Keycode Raw.SDLK_EXSEL +pattern KeycodeKP00 = Keycode Raw.SDLK_KP_00 +pattern KeycodeKP000 = Keycode Raw.SDLK_KP_000 +pattern KeycodeThousandsSeparator = Keycode Raw.SDLK_THOUSANDSSEPARATOR +pattern KeycodeDecimalSeparator = Keycode Raw.SDLK_DECIMALSEPARATOR +pattern KeycodeCurrencyUnit = Keycode Raw.SDLK_CURRENCYUNIT +pattern KeycodeCurrencySubunit = Keycode Raw.SDLK_CURRENCYSUBUNIT +pattern KeycodeKPLeftParen = Keycode Raw.SDLK_KP_LEFTPAREN +pattern KeycodeKPRightParen = Keycode Raw.SDLK_KP_RIGHTPAREN +pattern KeycodeKPLeftBrace = Keycode Raw.SDLK_KP_LEFTBRACE +pattern KeycodeKPRightBrace = Keycode Raw.SDLK_KP_RIGHTBRACE +pattern KeycodeKPTab = Keycode Raw.SDLK_KP_TAB +pattern KeycodeKPBackspace = Keycode Raw.SDLK_KP_BACKSPACE +pattern KeycodeKPA = Keycode Raw.SDLK_KP_A +pattern KeycodeKPB = Keycode Raw.SDLK_KP_B +pattern KeycodeKPC = Keycode Raw.SDLK_KP_C +pattern KeycodeKPD = Keycode Raw.SDLK_KP_D +pattern KeycodeKPE = Keycode Raw.SDLK_KP_E +pattern KeycodeKPF = Keycode Raw.SDLK_KP_F +pattern KeycodeKPXor = Keycode Raw.SDLK_KP_XOR +pattern KeycodeKPPower = Keycode Raw.SDLK_KP_POWER +pattern KeycodeKPPercent = Keycode Raw.SDLK_KP_PERCENT +pattern KeycodeKPLess = Keycode Raw.SDLK_KP_LESS +pattern KeycodeKPGreater = Keycode Raw.SDLK_KP_GREATER +pattern KeycodeKPAmpersand = Keycode Raw.SDLK_KP_AMPERSAND +pattern KeycodeKPDblAmpersand = Keycode Raw.SDLK_KP_DBLAMPERSAND +pattern KeycodeKPVerticalBar = Keycode Raw.SDLK_KP_VERTICALBAR +pattern KeycodeKPDblVerticalBar = Keycode Raw.SDLK_KP_DBLVERTICALBAR +pattern KeycodeKPColon = Keycode Raw.SDLK_KP_COLON +pattern KeycodeKPHash = Keycode Raw.SDLK_KP_HASH +pattern KeycodeKPSpace = Keycode Raw.SDLK_KP_SPACE +pattern KeycodeKPAt = Keycode Raw.SDLK_KP_AT +pattern KeycodeKPExclam = Keycode Raw.SDLK_KP_EXCLAM +pattern KeycodeKPMemStore = Keycode Raw.SDLK_KP_MEMSTORE +pattern KeycodeKPMemRecall = Keycode Raw.SDLK_KP_MEMRECALL +pattern KeycodeKPMemClear = Keycode Raw.SDLK_KP_MEMCLEAR +pattern KeycodeKPMemAdd = Keycode Raw.SDLK_KP_MEMADD +pattern KeycodeKPMemSubtract = Keycode Raw.SDLK_KP_MEMSUBTRACT +pattern KeycodeKPMemMultiply = Keycode Raw.SDLK_KP_MEMMULTIPLY +pattern KeycodeKPMemDivide = Keycode Raw.SDLK_KP_MEMDIVIDE +pattern KeycodeKPPlusMinus = Keycode Raw.SDLK_KP_PLUSMINUS +pattern KeycodeKPClear = Keycode Raw.SDLK_KP_CLEAR +pattern KeycodeKPClearEntry = Keycode Raw.SDLK_KP_CLEARENTRY +pattern KeycodeKPBinary = Keycode Raw.SDLK_KP_BINARY +pattern KeycodeKPOctal = Keycode Raw.SDLK_KP_OCTAL +pattern KeycodeKPDecimal = Keycode Raw.SDLK_KP_DECIMAL +pattern KeycodeKPHexadecimal = Keycode Raw.SDLK_KP_HEXADECIMAL +pattern KeycodeLCtrl = Keycode Raw.SDLK_LCTRL +pattern KeycodeLShift = Keycode Raw.SDLK_LSHIFT +pattern KeycodeLAlt = Keycode Raw.SDLK_LALT +pattern KeycodeLGUI = Keycode Raw.SDLK_LGUI +pattern KeycodeRCtrl = Keycode Raw.SDLK_RCTRL +pattern KeycodeRShift = Keycode Raw.SDLK_RSHIFT +pattern KeycodeRAlt = Keycode Raw.SDLK_RALT +pattern KeycodeRGUI = Keycode Raw.SDLK_RGUI +pattern KeycodeMode = Keycode Raw.SDLK_MODE +pattern KeycodeAudioNext = Keycode Raw.SDLK_AUDIONEXT +pattern KeycodeAudioPrev = Keycode Raw.SDLK_AUDIOPREV +pattern KeycodeAudioStop = Keycode Raw.SDLK_AUDIOSTOP +pattern KeycodeAudioPlay = Keycode Raw.SDLK_AUDIOPLAY +pattern KeycodeAudioMute = Keycode Raw.SDLK_AUDIOMUTE +pattern KeycodeMediaSelect = Keycode Raw.SDLK_MEDIASELECT +pattern KeycodeWWW = Keycode Raw.SDLK_WWW +pattern KeycodeMail = Keycode Raw.SDLK_MAIL +pattern KeycodeCalculator = Keycode Raw.SDLK_CALCULATOR +pattern KeycodeComputer = Keycode Raw.SDLK_COMPUTER +pattern KeycodeACSearch = Keycode Raw.SDLK_AC_SEARCH +pattern KeycodeACHome = Keycode Raw.SDLK_AC_HOME +pattern KeycodeACBack = Keycode Raw.SDLK_AC_BACK +pattern KeycodeACForward = Keycode Raw.SDLK_AC_FORWARD +pattern KeycodeACStop = Keycode Raw.SDLK_AC_STOP +pattern KeycodeACRefresh = Keycode Raw.SDLK_AC_REFRESH +pattern KeycodeACBookmarks = Keycode Raw.SDLK_AC_BOOKMARKS +pattern KeycodeBrightnessDown = Keycode Raw.SDLK_BRIGHTNESSDOWN +pattern KeycodeBrightnessUp = Keycode Raw.SDLK_BRIGHTNESSUP +pattern KeycodeDisplaySwitch = Keycode Raw.SDLK_DISPLAYSWITCH +pattern KeycodeKbdIllumToggle = Keycode Raw.SDLK_KBDILLUMTOGGLE +pattern KeycodeKbdIllumDown = Keycode Raw.SDLK_KBDILLUMDOWN +pattern KeycodeKbdIllumUp = Keycode Raw.SDLK_KBDILLUMUP +pattern KeycodeEject = Keycode Raw.SDLK_EJECT +pattern KeycodeSleep = Keycode Raw.SDLK_SLEEP + +instance FromNumber Keycode Int32 where + fromNumber = Keycode + +instance ToNumber Keycode Int32 where + toNumber = unwrapKeycode diff --git a/src/SDL/Input/Mouse.hs b/src/SDL/Input/Mouse.hs --- a/src/SDL/Input/Mouse.hs +++ b/src/SDL/Input/Mouse.hs @@ -1,245 +1,245 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} - -module SDL.Input.Mouse - ( -- * Relative Mouse Mode - LocationMode(..) - , setMouseLocationMode - , getMouseLocationMode - , setRelativeMouseMode --deprecated - , getRelativeMouseMode --deprecated - - -- * Mouse and Touch Input - , MouseButton(..) - , MouseDevice(..) - - -- * Mouse State - , getModalMouseLocation - , getMouseLocation --deprecated - , getAbsoluteMouseLocation - , getRelativeMouseLocation - , getMouseButtons - - -- * Warping the Mouse - , WarpMouseOrigin - , warpMouse - - -- * Cursor Visibility - , cursorVisible - - -- * Cursor Shape - , Cursor - , activeCursor - , createCursor - , freeCursor - , createColorCursor - ) where - -import Control.Monad (void) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bits -import Data.Bool -import Data.Data (Data) -import Data.StateVar -import Data.Typeable -import Data.Word -import Foreign.C -import Foreign.Marshal.Alloc -import Foreign.Ptr -import Foreign.Storable -import GHC.Generics (Generic) -import Linear -import Linear.Affine -import SDL.Exception -import SDL.Internal.Numbered -import SDL.Internal.Types (Window(Window)) -import SDL.Video.Renderer (Surface(Surface)) -import qualified Data.Vector.Storable as V -import qualified SDL.Raw.Enum as Raw -import qualified SDL.Raw.Event as Raw -import qualified SDL.Raw.Types as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -data LocationMode = AbsoluteLocation | RelativeLocation deriving Eq - --- | Sets the current relative mouse mode. --- --- When relative mouse mode is enabled, cursor is hidden and mouse position --- will not change. However, you will be delivered relative mouse position --- change events. -setMouseLocationMode :: (Functor m, MonadIO m) => LocationMode -> m LocationMode -setMouseLocationMode mode = - Raw.setRelativeMouseMode (mode == RelativeLocation) >> getMouseLocationMode - --- | Check which mouse location mode is currently active. -getMouseLocationMode :: MonadIO m => m LocationMode -getMouseLocationMode = do - relativeMode <- Raw.getRelativeMouseMode - return $ if relativeMode then RelativeLocation else AbsoluteLocation - --- | Return proper mouse location depending on mouse mode -getModalMouseLocation :: MonadIO m => m (LocationMode, Point V2 CInt) -getModalMouseLocation = do - mode <- getMouseLocationMode - location <- case mode of - RelativeLocation -> getRelativeMouseLocation - _ -> getAbsoluteMouseLocation - return (mode, location) - --- deprecated -setRelativeMouseMode :: (Functor m, MonadIO m) => Bool -> m () -{-# DEPRECATED setRelativeMouseMode "Use setMouseLocationMode instead" #-} -setRelativeMouseMode enable = - throwIfNeg_ "SDL.Input.Mouse" "SDL_SetRelativeMouseMode" $ - Raw.setRelativeMouseMode enable - ---deprecated -getRelativeMouseMode :: MonadIO m => m Bool -{-# DEPRECATED getRelativeMouseMode "Use getMouseLocationMode instead" #-} -getRelativeMouseMode = Raw.getRelativeMouseMode - ---deprecated -getMouseLocation :: MonadIO m => m (Point V2 CInt) -{-# DEPRECATED getMouseLocation "Use getAbsoluteMouseLocation instead, or getModalMouseLocation to match future behavior." #-} -getMouseLocation = getAbsoluteMouseLocation - -data MouseButton - = ButtonLeft - | ButtonMiddle - | ButtonRight - | ButtonX1 - | ButtonX2 - | ButtonExtra !Int -- ^ An unknown mouse button. - deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) - --- | Identifies what kind of mouse-like device this is. -data MouseDevice - = Mouse !Int -- ^ An actual mouse. The number identifies which mouse. - | Touch -- ^ Some sort of touch device. - deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) - -instance FromNumber MouseDevice Word32 where - fromNumber n' = case n' of - Raw.SDL_TOUCH_MOUSEID -> Touch - n -> Mouse $ fromIntegral n - -data WarpMouseOrigin - = WarpInWindow Window - -- ^ Move the mouse pointer within a given 'Window'. - | WarpCurrentFocus - -- ^ Move the mouse pointer within whichever 'Window' currently has focus. - -- WarpGlobal -- Needs 2.0.4 - deriving (Data, Eq, Generic, Ord, Show, Typeable) - --- | Move the current location of a mouse pointer. The 'WarpMouseOrigin' specifies the origin for the given warp coordinates. -warpMouse :: MonadIO m => WarpMouseOrigin -> Point V2 CInt -> m () -warpMouse (WarpInWindow (Window w)) (P (V2 x y)) = Raw.warpMouseInWindow w x y -warpMouse WarpCurrentFocus (P (V2 x y)) = Raw.warpMouseInWindow nullPtr x y - --- | Get or set whether the cursor is currently visible. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -cursorVisible :: StateVar Bool -cursorVisible = makeStateVar getCursorVisible setCursorVisible - where - -- The usage of 'void' is OK here - Raw.showCursor just returns the old state. - setCursorVisible :: (Functor m, MonadIO m) => Bool -> m () - setCursorVisible True = void $ Raw.showCursor 1 - setCursorVisible False = void $ Raw.showCursor 0 - - getCursorVisible :: (Functor m, MonadIO m) => m Bool - getCursorVisible = (== 1) <$> Raw.showCursor (-1) - --- | Retrieve the current location of the mouse, relative to the currently focused window. -getAbsoluteMouseLocation :: MonadIO m => m (Point V2 CInt) -getAbsoluteMouseLocation = liftIO $ - alloca $ \x -> - alloca $ \y -> do - _ <- Raw.getMouseState x y -- We don't deal with button states here - P <$> (V2 <$> peek x <*> peek y) - --- | Retrieve mouse motion -getRelativeMouseLocation :: MonadIO m => m (Point V2 CInt) -getRelativeMouseLocation = liftIO $ - alloca $ \x -> - alloca $ \y -> do - _ <- Raw.getRelativeMouseState x y - P <$> (V2 <$> peek x <*> peek y) - - --- | Retrieve a mapping of which buttons are currently held down. -getMouseButtons :: MonadIO m => m (MouseButton -> Bool) -getMouseButtons = liftIO $ - convert <$> Raw.getMouseState nullPtr nullPtr - where - convert w b = w `testBit` index - where - index = case b of - ButtonLeft -> 0 - ButtonMiddle -> 1 - ButtonRight -> 2 - ButtonX1 -> 3 - ButtonX2 -> 4 - ButtonExtra i -> i - -newtype Cursor = Cursor { unwrapCursor :: Raw.Cursor } - deriving (Eq, Typeable) - --- | Get or set the currently active cursor. You can create new 'Cursor's with 'createCursor'. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -activeCursor :: StateVar Cursor -activeCursor = makeStateVar getCursor setCursor - where - getCursor :: MonadIO m => m Cursor - getCursor = liftIO . fmap Cursor $ - throwIfNull "SDL.Input.Mouse.getCursor" "SDL_getCursor" - Raw.getCursor - - setCursor :: MonadIO m => Cursor -> m () - setCursor = Raw.setCursor . unwrapCursor - --- | Create a cursor using the specified bitmap data and mask (in MSB format). --- --- -createCursor :: MonadIO m - => V.Vector Bool -- ^ Whether this part of the cursor is black. Use 'False' for white and 'True' for black. - -> V.Vector Bool -- ^ Whether or not pixels are visible. Use 'True' for visible and 'False' for transparent. - -> V2 CInt -- ^ The width and height of the cursor. - -> Point V2 CInt -- ^ The X- and Y-axis location of the upper left corner of the cursor relative to the actual mouse position - -> m Cursor -createCursor dta msk (V2 w h) (P (V2 hx hy)) = - liftIO . fmap Cursor $ - throwIfNull "SDL.Input.Mouse.createCursor" "SDL_createCursor" $ - V.unsafeWith (V.map (bool 0 1) dta) $ \unsafeDta -> - V.unsafeWith (V.map (bool 0 1) msk) $ \unsafeMsk -> - Raw.createCursor unsafeDta unsafeMsk w h hx hy - --- | Free a cursor created with 'createCursor' and 'createColorCusor'. --- --- See @@ for C documentation. -freeCursor :: MonadIO m => Cursor -> m () -freeCursor = Raw.freeCursor . unwrapCursor - --- | Create a color cursor. --- --- See @@ for C documentation. -createColorCursor :: MonadIO m - => Surface - -> Point V2 CInt -- ^ The location of the cursor hot spot - -> m Cursor -createColorCursor (Surface surfPtr _) (P (V2 hx hy)) = - liftIO . fmap Cursor $ - throwIfNull "SDL.Input.Mouse.createColorCursor" "SDL_createColorCursor" $ - Raw.createColorCursor surfPtr hx hy +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} + +module SDL.Input.Mouse + ( -- * Relative Mouse Mode + LocationMode(..) + , setMouseLocationMode + , getMouseLocationMode + , setRelativeMouseMode --deprecated + , getRelativeMouseMode --deprecated + + -- * Mouse and Touch Input + , MouseButton(..) + , MouseDevice(..) + + -- * Mouse State + , getModalMouseLocation + , getMouseLocation --deprecated + , getAbsoluteMouseLocation + , getRelativeMouseLocation + , getMouseButtons + + -- * Warping the Mouse + , WarpMouseOrigin + , warpMouse + + -- * Cursor Visibility + , cursorVisible + + -- * Cursor Shape + , Cursor + , activeCursor + , createCursor + , freeCursor + , createColorCursor + ) where + +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bits +import Data.Bool +import Data.Data (Data) +import Data.StateVar +import Data.Typeable +import Data.Word +import Foreign.C +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import GHC.Generics (Generic) +import Linear +import Linear.Affine +import SDL.Exception +import SDL.Internal.Numbered +import SDL.Internal.Types (Window(Window)) +import SDL.Video.Renderer (Surface(Surface)) +import qualified Data.Vector.Storable as V +import qualified SDL.Raw.Enum as Raw +import qualified SDL.Raw.Event as Raw +import qualified SDL.Raw.Types as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +data LocationMode = AbsoluteLocation | RelativeLocation deriving Eq + +-- | Sets the current relative mouse mode. +-- +-- When relative mouse mode is enabled, cursor is hidden and mouse position +-- will not change. However, you will be delivered relative mouse position +-- change events. +setMouseLocationMode :: (Functor m, MonadIO m) => LocationMode -> m LocationMode +setMouseLocationMode mode = + Raw.setRelativeMouseMode (mode == RelativeLocation) >> getMouseLocationMode + +-- | Check which mouse location mode is currently active. +getMouseLocationMode :: MonadIO m => m LocationMode +getMouseLocationMode = do + relativeMode <- Raw.getRelativeMouseMode + return $ if relativeMode then RelativeLocation else AbsoluteLocation + +-- | Return proper mouse location depending on mouse mode +getModalMouseLocation :: MonadIO m => m (LocationMode, Point V2 CInt) +getModalMouseLocation = do + mode <- getMouseLocationMode + location <- case mode of + RelativeLocation -> getRelativeMouseLocation + _ -> getAbsoluteMouseLocation + return (mode, location) + +-- deprecated +setRelativeMouseMode :: (Functor m, MonadIO m) => Bool -> m () +{-# DEPRECATED setRelativeMouseMode "Use setMouseLocationMode instead" #-} +setRelativeMouseMode enable = + throwIfNeg_ "SDL.Input.Mouse" "SDL_SetRelativeMouseMode" $ + Raw.setRelativeMouseMode enable + +--deprecated +getRelativeMouseMode :: MonadIO m => m Bool +{-# DEPRECATED getRelativeMouseMode "Use getMouseLocationMode instead" #-} +getRelativeMouseMode = Raw.getRelativeMouseMode + +--deprecated +getMouseLocation :: MonadIO m => m (Point V2 CInt) +{-# DEPRECATED getMouseLocation "Use getAbsoluteMouseLocation instead, or getModalMouseLocation to match future behavior." #-} +getMouseLocation = getAbsoluteMouseLocation + +data MouseButton + = ButtonLeft + | ButtonMiddle + | ButtonRight + | ButtonX1 + | ButtonX2 + | ButtonExtra !Int -- ^ An unknown mouse button. + deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) + +-- | Identifies what kind of mouse-like device this is. +data MouseDevice + = Mouse !Int -- ^ An actual mouse. The number identifies which mouse. + | Touch -- ^ Some sort of touch device. + deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) + +instance FromNumber MouseDevice Word32 where + fromNumber n' = case n' of + Raw.SDL_TOUCH_MOUSEID -> Touch + n -> Mouse $ fromIntegral n + +data WarpMouseOrigin + = WarpInWindow Window + -- ^ Move the mouse pointer within a given 'Window'. + | WarpCurrentFocus + -- ^ Move the mouse pointer within whichever 'Window' currently has focus. + -- WarpGlobal -- Needs 2.0.4 + deriving (Data, Eq, Generic, Ord, Show, Typeable) + +-- | Move the current location of a mouse pointer. The 'WarpMouseOrigin' specifies the origin for the given warp coordinates. +warpMouse :: MonadIO m => WarpMouseOrigin -> Point V2 CInt -> m () +warpMouse (WarpInWindow (Window w)) (P (V2 x y)) = Raw.warpMouseInWindow w x y +warpMouse WarpCurrentFocus (P (V2 x y)) = Raw.warpMouseInWindow nullPtr x y + +-- | Get or set whether the cursor is currently visible. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +cursorVisible :: StateVar Bool +cursorVisible = makeStateVar getCursorVisible setCursorVisible + where + -- The usage of 'void' is OK here - Raw.showCursor just returns the old state. + setCursorVisible :: (Functor m, MonadIO m) => Bool -> m () + setCursorVisible True = void $ Raw.showCursor 1 + setCursorVisible False = void $ Raw.showCursor 0 + + getCursorVisible :: (Functor m, MonadIO m) => m Bool + getCursorVisible = (== 1) <$> Raw.showCursor (-1) + +-- | Retrieve the current location of the mouse, relative to the currently focused window. +getAbsoluteMouseLocation :: MonadIO m => m (Point V2 CInt) +getAbsoluteMouseLocation = liftIO $ + alloca $ \x -> + alloca $ \y -> do + _ <- Raw.getMouseState x y -- We don't deal with button states here + P <$> (V2 <$> peek x <*> peek y) + +-- | Retrieve mouse motion +getRelativeMouseLocation :: MonadIO m => m (Point V2 CInt) +getRelativeMouseLocation = liftIO $ + alloca $ \x -> + alloca $ \y -> do + _ <- Raw.getRelativeMouseState x y + P <$> (V2 <$> peek x <*> peek y) + + +-- | Retrieve a mapping of which buttons are currently held down. +getMouseButtons :: MonadIO m => m (MouseButton -> Bool) +getMouseButtons = liftIO $ + convert <$> Raw.getMouseState nullPtr nullPtr + where + convert w b = w `testBit` index + where + index = case b of + ButtonLeft -> 0 + ButtonMiddle -> 1 + ButtonRight -> 2 + ButtonX1 -> 3 + ButtonX2 -> 4 + ButtonExtra i -> i + +newtype Cursor = Cursor { unwrapCursor :: Raw.Cursor } + deriving (Eq, Typeable) + +-- | Get or set the currently active cursor. You can create new 'Cursor's with 'createCursor'. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +activeCursor :: StateVar Cursor +activeCursor = makeStateVar getCursor setCursor + where + getCursor :: MonadIO m => m Cursor + getCursor = liftIO . fmap Cursor $ + throwIfNull "SDL.Input.Mouse.getCursor" "SDL_getCursor" + Raw.getCursor + + setCursor :: MonadIO m => Cursor -> m () + setCursor = Raw.setCursor . unwrapCursor + +-- | Create a cursor using the specified bitmap data and mask (in MSB format). +-- +-- +createCursor :: MonadIO m + => V.Vector Bool -- ^ Whether this part of the cursor is black. Use 'False' for white and 'True' for black. + -> V.Vector Bool -- ^ Whether or not pixels are visible. Use 'True' for visible and 'False' for transparent. + -> V2 CInt -- ^ The width and height of the cursor. + -> Point V2 CInt -- ^ The X- and Y-axis location of the upper left corner of the cursor relative to the actual mouse position + -> m Cursor +createCursor dta msk (V2 w h) (P (V2 hx hy)) = + liftIO . fmap Cursor $ + throwIfNull "SDL.Input.Mouse.createCursor" "SDL_createCursor" $ + V.unsafeWith (V.map (bool 0 1) dta) $ \unsafeDta -> + V.unsafeWith (V.map (bool 0 1) msk) $ \unsafeMsk -> + Raw.createCursor unsafeDta unsafeMsk w h hx hy + +-- | Free a cursor created with 'createCursor' and 'createColorCusor'. +-- +-- See @@ for C documentation. +freeCursor :: MonadIO m => Cursor -> m () +freeCursor = Raw.freeCursor . unwrapCursor + +-- | Create a color cursor. +-- +-- See @@ for C documentation. +createColorCursor :: MonadIO m + => Surface + -> Point V2 CInt -- ^ The location of the cursor hot spot + -> m Cursor +createColorCursor (Surface surfPtr _) (P (V2 hx hy)) = + liftIO . fmap Cursor $ + throwIfNull "SDL.Input.Mouse.createColorCursor" "SDL_createColorCursor" $ + Raw.createColorCursor surfPtr hx hy diff --git a/src/SDL/Internal/Numbered.hs b/src/SDL/Internal/Numbered.hs --- a/src/SDL/Internal/Numbered.hs +++ b/src/SDL/Internal/Numbered.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE FunctionalDependencies #-} -module SDL.Internal.Numbered - ( FromNumber(..) - , ToNumber(..) - ) where - -class (Integral b) => FromNumber a b | a -> b where - fromNumber :: b -> a - -class (Integral b) => ToNumber a b | a -> b where - toNumber :: a -> b +{-# LANGUAGE FunctionalDependencies #-} +module SDL.Internal.Numbered + ( FromNumber(..) + , ToNumber(..) + ) where + +class (Integral b) => FromNumber a b | a -> b where + fromNumber :: b -> a + +class (Integral b) => ToNumber a b | a -> b where + toNumber :: a -> b diff --git a/src/SDL/Internal/Types.hs b/src/SDL/Internal/Types.hs --- a/src/SDL/Internal/Types.hs +++ b/src/SDL/Internal/Types.hs @@ -1,23 +1,23 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -module SDL.Internal.Types - ( Joystick(..) - , Window(..) - , Renderer(..) - ) where - -import Data.Data (Data) -import Data.Typeable -import GHC.Generics (Generic) - -import qualified SDL.Raw as Raw - -newtype Joystick = Joystick { joystickPtr :: Raw.Joystick } - deriving (Data, Eq, Generic, Ord, Show, Typeable) - -newtype Window = Window (Raw.Window) - deriving (Data, Eq, Generic, Ord, Show, Typeable) - --- | An SDL rendering device. This can be created with 'SDL.Video.createRenderer'. -newtype Renderer = Renderer Raw.Renderer - deriving (Data, Eq, Generic, Ord, Show, Typeable) +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module SDL.Internal.Types + ( Joystick(..) + , Window(..) + , Renderer(..) + ) where + +import Data.Data (Data) +import Data.Typeable +import GHC.Generics (Generic) + +import qualified SDL.Raw as Raw + +newtype Joystick = Joystick { joystickPtr :: Raw.Joystick } + deriving (Data, Eq, Generic, Ord, Show, Typeable) + +newtype Window = Window (Raw.Window) + deriving (Data, Eq, Generic, Ord, Show, Typeable) + +-- | An SDL rendering device. This can be created with 'SDL.Video.createRenderer'. +newtype Renderer = Renderer Raw.Renderer + deriving (Data, Eq, Generic, Ord, Show, Typeable) diff --git a/src/SDL/Power.hs b/src/SDL/Power.hs --- a/src/SDL/Power.hs +++ b/src/SDL/Power.hs @@ -1,70 +1,70 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -module SDL.Power - ( -- * Power Status - getPowerInfo - , PowerState(..) - , BatteryState(..) - , Charge(..) - ) where - -import Control.Applicative -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Data (Data) -import Data.Typeable -import Foreign.C.Types -import Foreign.Marshal.Alloc -import Foreign.Marshal.Utils -import Foreign.Storable -import GHC.Generics (Generic) - -import qualified SDL.Raw as Raw - --- | Current power supply details. --- --- Throws 'SDLException' if the current power state can not be determined. --- --- See @@ for C documentation. -getPowerInfo :: (Functor m, MonadIO m) => m PowerState -getPowerInfo = - liftIO $ - alloca $ \secsPtr -> - alloca $ \pctPtr -> do - state <- Raw.getPowerInfo secsPtr pctPtr - let peekCharge = liftA2 Charge (maybePeek peek secsPtr) (maybePeek peek pctPtr) - case state of - Raw.SDL_POWERSTATE_ON_BATTERY -> fmap (Battery Draining) peekCharge - Raw.SDL_POWERSTATE_CHARGING -> fmap (Battery Charging) peekCharge - Raw.SDL_POWERSTATE_CHARGED -> fmap (Battery Charged) peekCharge - Raw.SDL_POWERSTATE_NO_BATTERY -> pure Mains - _ -> pure UnknownPowerState - --- | Information about the power supply for the user's environment -data PowerState - = Battery BatteryState Charge - -- ^ The user is on a battery powered device. See 'BatteryState' for charge information, and 'Charge' for charge information - | Mains - -- ^ The user is on a device connected to the mains. - | UnknownPowerState - -- ^ SDL could not determine the power for the device. - deriving (Eq, Generic, Ord, Read, Show, Typeable) - --- | Information on battery consumption for battery powered devices -data BatteryState - = Draining - -- ^ The battery is currently being drained. - | Charged - -- ^ The battery is fully charged. - | Charging - -- ^ The device is plugged in and the battery is charging. - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | Information about how much charge a battery has. -data Charge = - Charge {chargeSecondsLeft :: Maybe CInt -- ^ How many seconds of battery life is left - ,chargePercent :: Maybe CInt -- ^ The percentage of battery charged - } - deriving (Eq, Generic, Ord, Read, Show, Typeable) +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +module SDL.Power + ( -- * Power Status + getPowerInfo + , PowerState(..) + , BatteryState(..) + , Charge(..) + ) where + +import Control.Applicative +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Data (Data) +import Data.Typeable +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Storable +import GHC.Generics (Generic) + +import qualified SDL.Raw as Raw + +-- | Current power supply details. +-- +-- Throws 'SDLException' if the current power state can not be determined. +-- +-- See @@ for C documentation. +getPowerInfo :: (Functor m, MonadIO m) => m PowerState +getPowerInfo = + liftIO $ + alloca $ \secsPtr -> + alloca $ \pctPtr -> do + state <- Raw.getPowerInfo secsPtr pctPtr + let peekCharge = liftA2 Charge (maybePeek peek secsPtr) (maybePeek peek pctPtr) + case state of + Raw.SDL_POWERSTATE_ON_BATTERY -> fmap (Battery Draining) peekCharge + Raw.SDL_POWERSTATE_CHARGING -> fmap (Battery Charging) peekCharge + Raw.SDL_POWERSTATE_CHARGED -> fmap (Battery Charged) peekCharge + Raw.SDL_POWERSTATE_NO_BATTERY -> pure Mains + _ -> pure UnknownPowerState + +-- | Information about the power supply for the user's environment +data PowerState + = Battery BatteryState Charge + -- ^ The user is on a battery powered device. See 'BatteryState' for charge information, and 'Charge' for charge information + | Mains + -- ^ The user is on a device connected to the mains. + | UnknownPowerState + -- ^ SDL could not determine the power for the device. + deriving (Eq, Generic, Ord, Read, Show, Typeable) + +-- | Information on battery consumption for battery powered devices +data BatteryState + = Draining + -- ^ The battery is currently being drained. + | Charged + -- ^ The battery is fully charged. + | Charging + -- ^ The device is plugged in and the battery is charging. + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | Information about how much charge a battery has. +data Charge = + Charge {chargeSecondsLeft :: Maybe CInt -- ^ How many seconds of battery life is left + ,chargePercent :: Maybe CInt -- ^ The percentage of battery charged + } + deriving (Eq, Generic, Ord, Read, Show, Typeable) diff --git a/src/SDL/Raw.hs b/src/SDL/Raw.hs --- a/src/SDL/Raw.hs +++ b/src/SDL/Raw.hs @@ -1,31 +1,31 @@ --- | Raw low-level FFI bindings to the sdl2 C library. Ease of use is not a --- design factor, use "SDL" instead if you can. -module SDL.Raw ( - module SDL.Raw.Audio, - module SDL.Raw.Basic, - module SDL.Raw.Enum, - module SDL.Raw.Error, - module SDL.Raw.Event, - module SDL.Raw.Filesystem, - module SDL.Raw.Haptic, - module SDL.Raw.Platform, - module SDL.Raw.Power, - module SDL.Raw.Thread, - module SDL.Raw.Timer, - module SDL.Raw.Types, - module SDL.Raw.Video -) where - -import SDL.Raw.Audio -import SDL.Raw.Basic -import SDL.Raw.Enum -import SDL.Raw.Error -import SDL.Raw.Event -import SDL.Raw.Filesystem -import SDL.Raw.Haptic -import SDL.Raw.Platform -import SDL.Raw.Power -import SDL.Raw.Thread -import SDL.Raw.Timer -import SDL.Raw.Types -import SDL.Raw.Video +-- | Raw low-level FFI bindings to the sdl2 C library. Ease of use is not a +-- design factor, use "SDL" instead if you can. +module SDL.Raw ( + module SDL.Raw.Audio, + module SDL.Raw.Basic, + module SDL.Raw.Enum, + module SDL.Raw.Error, + module SDL.Raw.Event, + module SDL.Raw.Filesystem, + module SDL.Raw.Haptic, + module SDL.Raw.Platform, + module SDL.Raw.Power, + module SDL.Raw.Thread, + module SDL.Raw.Timer, + module SDL.Raw.Types, + module SDL.Raw.Video +) where + +import SDL.Raw.Audio +import SDL.Raw.Basic +import SDL.Raw.Enum +import SDL.Raw.Error +import SDL.Raw.Event +import SDL.Raw.Filesystem +import SDL.Raw.Haptic +import SDL.Raw.Platform +import SDL.Raw.Power +import SDL.Raw.Thread +import SDL.Raw.Timer +import SDL.Raw.Types +import SDL.Raw.Video diff --git a/src/SDL/Raw/Audio.hs b/src/SDL/Raw/Audio.hs --- a/src/SDL/Raw/Audio.hs +++ b/src/SDL/Raw/Audio.hs @@ -1,170 +1,170 @@ -module SDL.Raw.Audio ( - -- * Audio Device Management, Playing and Recording - audioInit, - audioQuit, - buildAudioCVT, - closeAudio, - closeAudioDevice, - convertAudio, - freeWAV, - getAudioDeviceName, - getAudioDeviceStatus, - getAudioDriver, - getAudioStatus, - getCurrentAudioDriver, - getNumAudioDevices, - getNumAudioDrivers, - loadWAV, - loadWAV_RW, - lockAudio, - lockAudioDevice, - mixAudio, - mixAudioFormat, - openAudio, - openAudioDevice, - pauseAudio, - pauseAudioDevice, - unlockAudio, - unlockAudioDevice -) where - -import Control.Monad.IO.Class -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Enum -import SDL.Raw.Filesystem -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_AudioInit" audioInitFFI :: CString -> IO CInt -foreign import ccall "SDL.h SDL_AudioQuit" audioQuitFFI :: IO () -foreign import ccall "SDL.h SDL_BuildAudioCVT" buildAudioCVTFFI :: Ptr AudioCVT -> AudioFormat -> Word8 -> CInt -> AudioFormat -> Word8 -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_CloseAudio" closeAudioFFI :: IO () -foreign import ccall "SDL.h SDL_CloseAudioDevice" closeAudioDeviceFFI :: AudioDeviceID -> IO () -foreign import ccall "SDL.h SDL_ConvertAudio" convertAudioFFI :: Ptr AudioCVT -> IO CInt -foreign import ccall "SDL.h SDL_FreeWAV" freeWAVFFI :: Ptr Word8 -> IO () -foreign import ccall "SDL.h SDL_GetAudioDeviceName" getAudioDeviceNameFFI :: CInt -> CInt -> IO CString -foreign import ccall "SDL.h SDL_GetAudioDeviceStatus" getAudioDeviceStatusFFI :: AudioDeviceID -> IO AudioStatus -foreign import ccall "SDL.h SDL_GetAudioDriver" getAudioDriverFFI :: CInt -> IO CString -foreign import ccall "SDL.h SDL_GetAudioStatus" getAudioStatusFFI :: IO AudioStatus -foreign import ccall "SDL.h SDL_GetCurrentAudioDriver" getCurrentAudioDriverFFI :: IO CString -foreign import ccall "SDL.h SDL_GetNumAudioDevices" getNumAudioDevicesFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_GetNumAudioDrivers" getNumAudioDriversFFI :: IO CInt -foreign import ccall "SDL.h SDL_LoadWAV_RW" loadWAV_RWFFI :: Ptr RWops -> CInt -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> IO (Ptr AudioSpec) -foreign import ccall "SDL.h SDL_LockAudio" lockAudioFFI :: IO () -foreign import ccall "SDL.h SDL_LockAudioDevice" lockAudioDeviceFFI :: AudioDeviceID -> IO () -foreign import ccall "SDL.h SDL_MixAudio" mixAudioFFI :: Ptr Word8 -> Ptr Word8 -> Word32 -> CInt -> IO () -foreign import ccall "SDL.h SDL_MixAudioFormat" mixAudioFormatFFI :: Ptr Word8 -> Ptr Word8 -> AudioFormat -> Word32 -> CInt -> IO () -foreign import ccall "SDL.h SDL_OpenAudio" openAudioFFI :: Ptr AudioSpec -> Ptr AudioSpec -> IO CInt -foreign import ccall "SDL.h SDL_OpenAudioDevice" openAudioDeviceFFI :: CString -> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> IO AudioDeviceID -foreign import ccall "SDL.h SDL_PauseAudio" pauseAudioFFI :: CInt -> IO () -foreign import ccall "SDL.h SDL_PauseAudioDevice" pauseAudioDeviceFFI :: AudioDeviceID -> CInt -> IO () -foreign import ccall "SDL.h SDL_UnlockAudio" unlockAudioFFI :: IO () -foreign import ccall "SDL.h SDL_UnlockAudioDevice" unlockAudioDeviceFFI :: AudioDeviceID -> IO () - -audioInit :: MonadIO m => CString -> m CInt -audioInit v1 = liftIO $ audioInitFFI v1 -{-# INLINE audioInit #-} - -audioQuit :: MonadIO m => m () -audioQuit = liftIO audioQuitFFI -{-# INLINE audioQuit #-} - -buildAudioCVT :: MonadIO m => Ptr AudioCVT -> AudioFormat -> Word8 -> CInt -> AudioFormat -> Word8 -> CInt -> m CInt -buildAudioCVT v1 v2 v3 v4 v5 v6 v7 = liftIO $ buildAudioCVTFFI v1 v2 v3 v4 v5 v6 v7 -{-# INLINE buildAudioCVT #-} - -closeAudio :: MonadIO m => m () -closeAudio = liftIO closeAudioFFI -{-# INLINE closeAudio #-} - -closeAudioDevice :: MonadIO m => AudioDeviceID -> m () -closeAudioDevice v1 = liftIO $ closeAudioDeviceFFI v1 -{-# INLINE closeAudioDevice #-} - -convertAudio :: MonadIO m => Ptr AudioCVT -> m CInt -convertAudio v1 = liftIO $ convertAudioFFI v1 -{-# INLINE convertAudio #-} - -freeWAV :: MonadIO m => Ptr Word8 -> m () -freeWAV v1 = liftIO $ freeWAVFFI v1 -{-# INLINE freeWAV #-} - -getAudioDeviceName :: MonadIO m => CInt -> CInt -> m CString -getAudioDeviceName v1 v2 = liftIO $ getAudioDeviceNameFFI v1 v2 -{-# INLINE getAudioDeviceName #-} - -getAudioDeviceStatus :: MonadIO m => AudioDeviceID -> m AudioStatus -getAudioDeviceStatus v1 = liftIO $ getAudioDeviceStatusFFI v1 -{-# INLINE getAudioDeviceStatus #-} - -getAudioDriver :: MonadIO m => CInt -> m CString -getAudioDriver v1 = liftIO $ getAudioDriverFFI v1 -{-# INLINE getAudioDriver #-} - -getAudioStatus :: MonadIO m => m AudioStatus -getAudioStatus = liftIO getAudioStatusFFI -{-# INLINE getAudioStatus #-} - -getCurrentAudioDriver :: MonadIO m => m CString -getCurrentAudioDriver = liftIO getCurrentAudioDriverFFI -{-# INLINE getCurrentAudioDriver #-} - -getNumAudioDevices :: MonadIO m => CInt -> m CInt -getNumAudioDevices v1 = liftIO $ getNumAudioDevicesFFI v1 -{-# INLINE getNumAudioDevices #-} - -getNumAudioDrivers :: MonadIO m => m CInt -getNumAudioDrivers = liftIO getNumAudioDriversFFI -{-# INLINE getNumAudioDrivers #-} - -loadWAV :: MonadIO m => CString -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> m (Ptr AudioSpec) -loadWAV file spec audio_buf audio_len = liftIO $ do - rw <- withCString "rb" $ rwFromFile file - loadWAV_RW rw 1 spec audio_buf audio_len -{-# INLINE loadWAV #-} - -loadWAV_RW :: MonadIO m => Ptr RWops -> CInt -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> m (Ptr AudioSpec) -loadWAV_RW v1 v2 v3 v4 v5 = liftIO $ loadWAV_RWFFI v1 v2 v3 v4 v5 -{-# INLINE loadWAV_RW #-} - -lockAudio :: MonadIO m => m () -lockAudio = liftIO lockAudioFFI -{-# INLINE lockAudio #-} - -lockAudioDevice :: MonadIO m => AudioDeviceID -> m () -lockAudioDevice v1 = liftIO $ lockAudioDeviceFFI v1 -{-# INLINE lockAudioDevice #-} - -mixAudio :: MonadIO m => Ptr Word8 -> Ptr Word8 -> Word32 -> CInt -> m () -mixAudio v1 v2 v3 v4 = liftIO $ mixAudioFFI v1 v2 v3 v4 -{-# INLINE mixAudio #-} - -mixAudioFormat :: MonadIO m => Ptr Word8 -> Ptr Word8 -> AudioFormat -> Word32 -> CInt -> m () -mixAudioFormat v1 v2 v3 v4 v5 = liftIO $ mixAudioFormatFFI v1 v2 v3 v4 v5 -{-# INLINE mixAudioFormat #-} - -openAudio :: MonadIO m => Ptr AudioSpec -> Ptr AudioSpec -> m CInt -openAudio v1 v2 = liftIO $ openAudioFFI v1 v2 -{-# INLINE openAudio #-} - -openAudioDevice :: MonadIO m => CString -> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> m AudioDeviceID -openAudioDevice v1 v2 v3 v4 v5 = liftIO $ openAudioDeviceFFI v1 v2 v3 v4 v5 -{-# INLINE openAudioDevice #-} - -pauseAudio :: MonadIO m => CInt -> m () -pauseAudio v1 = liftIO $ pauseAudioFFI v1 -{-# INLINE pauseAudio #-} - -pauseAudioDevice :: MonadIO m => AudioDeviceID -> CInt -> m () -pauseAudioDevice v1 v2 = liftIO $ pauseAudioDeviceFFI v1 v2 -{-# INLINE pauseAudioDevice #-} - -unlockAudio :: MonadIO m => m () -unlockAudio = liftIO unlockAudioFFI -{-# INLINE unlockAudio #-} - -unlockAudioDevice :: MonadIO m => AudioDeviceID -> m () -unlockAudioDevice v1 = liftIO $ unlockAudioDeviceFFI v1 -{-# INLINE unlockAudioDevice #-} +module SDL.Raw.Audio ( + -- * Audio Device Management, Playing and Recording + audioInit, + audioQuit, + buildAudioCVT, + closeAudio, + closeAudioDevice, + convertAudio, + freeWAV, + getAudioDeviceName, + getAudioDeviceStatus, + getAudioDriver, + getAudioStatus, + getCurrentAudioDriver, + getNumAudioDevices, + getNumAudioDrivers, + loadWAV, + loadWAV_RW, + lockAudio, + lockAudioDevice, + mixAudio, + mixAudioFormat, + openAudio, + openAudioDevice, + pauseAudio, + pauseAudioDevice, + unlockAudio, + unlockAudioDevice +) where + +import Control.Monad.IO.Class +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Enum +import SDL.Raw.Filesystem +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_AudioInit" audioInitFFI :: CString -> IO CInt +foreign import ccall "SDL.h SDL_AudioQuit" audioQuitFFI :: IO () +foreign import ccall "SDL.h SDL_BuildAudioCVT" buildAudioCVTFFI :: Ptr AudioCVT -> AudioFormat -> Word8 -> CInt -> AudioFormat -> Word8 -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_CloseAudio" closeAudioFFI :: IO () +foreign import ccall "SDL.h SDL_CloseAudioDevice" closeAudioDeviceFFI :: AudioDeviceID -> IO () +foreign import ccall "SDL.h SDL_ConvertAudio" convertAudioFFI :: Ptr AudioCVT -> IO CInt +foreign import ccall "SDL.h SDL_FreeWAV" freeWAVFFI :: Ptr Word8 -> IO () +foreign import ccall "SDL.h SDL_GetAudioDeviceName" getAudioDeviceNameFFI :: CInt -> CInt -> IO CString +foreign import ccall "SDL.h SDL_GetAudioDeviceStatus" getAudioDeviceStatusFFI :: AudioDeviceID -> IO AudioStatus +foreign import ccall "SDL.h SDL_GetAudioDriver" getAudioDriverFFI :: CInt -> IO CString +foreign import ccall "SDL.h SDL_GetAudioStatus" getAudioStatusFFI :: IO AudioStatus +foreign import ccall "SDL.h SDL_GetCurrentAudioDriver" getCurrentAudioDriverFFI :: IO CString +foreign import ccall "SDL.h SDL_GetNumAudioDevices" getNumAudioDevicesFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_GetNumAudioDrivers" getNumAudioDriversFFI :: IO CInt +foreign import ccall "SDL.h SDL_LoadWAV_RW" loadWAV_RWFFI :: Ptr RWops -> CInt -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> IO (Ptr AudioSpec) +foreign import ccall "SDL.h SDL_LockAudio" lockAudioFFI :: IO () +foreign import ccall "SDL.h SDL_LockAudioDevice" lockAudioDeviceFFI :: AudioDeviceID -> IO () +foreign import ccall "SDL.h SDL_MixAudio" mixAudioFFI :: Ptr Word8 -> Ptr Word8 -> Word32 -> CInt -> IO () +foreign import ccall "SDL.h SDL_MixAudioFormat" mixAudioFormatFFI :: Ptr Word8 -> Ptr Word8 -> AudioFormat -> Word32 -> CInt -> IO () +foreign import ccall "SDL.h SDL_OpenAudio" openAudioFFI :: Ptr AudioSpec -> Ptr AudioSpec -> IO CInt +foreign import ccall "SDL.h SDL_OpenAudioDevice" openAudioDeviceFFI :: CString -> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> IO AudioDeviceID +foreign import ccall "SDL.h SDL_PauseAudio" pauseAudioFFI :: CInt -> IO () +foreign import ccall "SDL.h SDL_PauseAudioDevice" pauseAudioDeviceFFI :: AudioDeviceID -> CInt -> IO () +foreign import ccall "SDL.h SDL_UnlockAudio" unlockAudioFFI :: IO () +foreign import ccall "SDL.h SDL_UnlockAudioDevice" unlockAudioDeviceFFI :: AudioDeviceID -> IO () + +audioInit :: MonadIO m => CString -> m CInt +audioInit v1 = liftIO $ audioInitFFI v1 +{-# INLINE audioInit #-} + +audioQuit :: MonadIO m => m () +audioQuit = liftIO audioQuitFFI +{-# INLINE audioQuit #-} + +buildAudioCVT :: MonadIO m => Ptr AudioCVT -> AudioFormat -> Word8 -> CInt -> AudioFormat -> Word8 -> CInt -> m CInt +buildAudioCVT v1 v2 v3 v4 v5 v6 v7 = liftIO $ buildAudioCVTFFI v1 v2 v3 v4 v5 v6 v7 +{-# INLINE buildAudioCVT #-} + +closeAudio :: MonadIO m => m () +closeAudio = liftIO closeAudioFFI +{-# INLINE closeAudio #-} + +closeAudioDevice :: MonadIO m => AudioDeviceID -> m () +closeAudioDevice v1 = liftIO $ closeAudioDeviceFFI v1 +{-# INLINE closeAudioDevice #-} + +convertAudio :: MonadIO m => Ptr AudioCVT -> m CInt +convertAudio v1 = liftIO $ convertAudioFFI v1 +{-# INLINE convertAudio #-} + +freeWAV :: MonadIO m => Ptr Word8 -> m () +freeWAV v1 = liftIO $ freeWAVFFI v1 +{-# INLINE freeWAV #-} + +getAudioDeviceName :: MonadIO m => CInt -> CInt -> m CString +getAudioDeviceName v1 v2 = liftIO $ getAudioDeviceNameFFI v1 v2 +{-# INLINE getAudioDeviceName #-} + +getAudioDeviceStatus :: MonadIO m => AudioDeviceID -> m AudioStatus +getAudioDeviceStatus v1 = liftIO $ getAudioDeviceStatusFFI v1 +{-# INLINE getAudioDeviceStatus #-} + +getAudioDriver :: MonadIO m => CInt -> m CString +getAudioDriver v1 = liftIO $ getAudioDriverFFI v1 +{-# INLINE getAudioDriver #-} + +getAudioStatus :: MonadIO m => m AudioStatus +getAudioStatus = liftIO getAudioStatusFFI +{-# INLINE getAudioStatus #-} + +getCurrentAudioDriver :: MonadIO m => m CString +getCurrentAudioDriver = liftIO getCurrentAudioDriverFFI +{-# INLINE getCurrentAudioDriver #-} + +getNumAudioDevices :: MonadIO m => CInt -> m CInt +getNumAudioDevices v1 = liftIO $ getNumAudioDevicesFFI v1 +{-# INLINE getNumAudioDevices #-} + +getNumAudioDrivers :: MonadIO m => m CInt +getNumAudioDrivers = liftIO getNumAudioDriversFFI +{-# INLINE getNumAudioDrivers #-} + +loadWAV :: MonadIO m => CString -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> m (Ptr AudioSpec) +loadWAV file spec audio_buf audio_len = liftIO $ do + rw <- withCString "rb" $ rwFromFile file + loadWAV_RW rw 1 spec audio_buf audio_len +{-# INLINE loadWAV #-} + +loadWAV_RW :: MonadIO m => Ptr RWops -> CInt -> Ptr AudioSpec -> Ptr (Ptr Word8) -> Ptr Word32 -> m (Ptr AudioSpec) +loadWAV_RW v1 v2 v3 v4 v5 = liftIO $ loadWAV_RWFFI v1 v2 v3 v4 v5 +{-# INLINE loadWAV_RW #-} + +lockAudio :: MonadIO m => m () +lockAudio = liftIO lockAudioFFI +{-# INLINE lockAudio #-} + +lockAudioDevice :: MonadIO m => AudioDeviceID -> m () +lockAudioDevice v1 = liftIO $ lockAudioDeviceFFI v1 +{-# INLINE lockAudioDevice #-} + +mixAudio :: MonadIO m => Ptr Word8 -> Ptr Word8 -> Word32 -> CInt -> m () +mixAudio v1 v2 v3 v4 = liftIO $ mixAudioFFI v1 v2 v3 v4 +{-# INLINE mixAudio #-} + +mixAudioFormat :: MonadIO m => Ptr Word8 -> Ptr Word8 -> AudioFormat -> Word32 -> CInt -> m () +mixAudioFormat v1 v2 v3 v4 v5 = liftIO $ mixAudioFormatFFI v1 v2 v3 v4 v5 +{-# INLINE mixAudioFormat #-} + +openAudio :: MonadIO m => Ptr AudioSpec -> Ptr AudioSpec -> m CInt +openAudio v1 v2 = liftIO $ openAudioFFI v1 v2 +{-# INLINE openAudio #-} + +openAudioDevice :: MonadIO m => CString -> CInt -> Ptr AudioSpec -> Ptr AudioSpec -> CInt -> m AudioDeviceID +openAudioDevice v1 v2 v3 v4 v5 = liftIO $ openAudioDeviceFFI v1 v2 v3 v4 v5 +{-# INLINE openAudioDevice #-} + +pauseAudio :: MonadIO m => CInt -> m () +pauseAudio v1 = liftIO $ pauseAudioFFI v1 +{-# INLINE pauseAudio #-} + +pauseAudioDevice :: MonadIO m => AudioDeviceID -> CInt -> m () +pauseAudioDevice v1 v2 = liftIO $ pauseAudioDeviceFFI v1 v2 +{-# INLINE pauseAudioDevice #-} + +unlockAudio :: MonadIO m => m () +unlockAudio = liftIO unlockAudioFFI +{-# INLINE unlockAudio #-} + +unlockAudioDevice :: MonadIO m => AudioDeviceID -> m () +unlockAudioDevice v1 = liftIO $ unlockAudioDeviceFFI v1 +{-# INLINE unlockAudioDevice #-} diff --git a/src/SDL/Raw/Basic.hs b/src/SDL/Raw/Basic.hs --- a/src/SDL/Raw/Basic.hs +++ b/src/SDL/Raw/Basic.hs @@ -1,200 +1,200 @@ -module SDL.Raw.Basic ( - -- * Initialization and Shutdown - init, - initSubSystem, - quit, - quitSubSystem, - setMainReady, - wasInit, - - -- * Memory Management - free, - - -- * Configuration Variables - addHintCallback, - clearHints, - delHintCallback, - getHint, - setHint, - setHintWithPriority, - - -- * Log Handling - log, - logCritical, - logDebug, - logError, - logGetOutputFunction, - logGetPriority, - logInfo, - logMessage, - logResetPriorities, - logSetAllPriority, - logSetOutputFunction, - logSetPriority, - logVerbose, - logWarn, - - -- * Assertions - -- | Use Haskell's own assertion primitives rather than SDL's. - - -- * Querying SDL Version - getRevision, - getRevisionNumber, - getVersion -) where - -import Control.Monad.IO.Class -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Enum -import SDL.Raw.Types -import Prelude hiding (init, log) - -foreign import ccall "SDL.h SDL_Init" initFFI :: InitFlag -> IO CInt -foreign import ccall "SDL.h SDL_InitSubSystem" initSubSystemFFI :: InitFlag -> IO CInt -foreign import ccall "SDL.h SDL_Quit" quitFFI :: IO () -foreign import ccall "SDL.h SDL_QuitSubSystem" quitSubSystemFFI :: InitFlag -> IO () -foreign import ccall "SDL.h SDL_SetMainReady" setMainReadyFFI :: IO () -foreign import ccall "SDL.h SDL_WasInit" wasInitFFI :: InitFlag -> IO InitFlag - -foreign import ccall "SDL.h SDL_free" freeFFI :: Ptr () -> IO () - -foreign import ccall "SDL.h SDL_AddHintCallback" addHintCallbackFFI :: CString -> HintCallback -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_ClearHints" clearHintsFFI :: IO () -foreign import ccall "SDL.h SDL_DelHintCallback" delHintCallbackFFI :: CString -> HintCallback -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_GetHint" getHintFFI :: CString -> IO CString -foreign import ccall "SDL.h SDL_SetHint" setHintFFI :: CString -> CString -> IO Bool -foreign import ccall "SDL.h SDL_SetHintWithPriority" setHintWithPriorityFFI :: CString -> CString -> HintPriority -> IO Bool - -foreign import ccall "SDL.h SDL_LogGetOutputFunction" logGetOutputFunctionFFI :: Ptr LogOutputFunction -> Ptr (Ptr ()) -> IO () -foreign import ccall "SDL.h SDL_LogGetPriority" logGetPriorityFFI :: CInt -> IO LogPriority -foreign import ccall "sdlhelper.c SDLHelper_LogMessage" logMessageFFI :: CInt -> LogPriority -> CString -> IO () -foreign import ccall "SDL.h SDL_LogResetPriorities" logResetPrioritiesFFI :: IO () -foreign import ccall "SDL.h SDL_LogSetAllPriority" logSetAllPriorityFFI :: LogPriority -> IO () -foreign import ccall "SDL.h SDL_LogSetOutputFunction" logSetOutputFunctionFFI :: LogOutputFunction -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_LogSetPriority" logSetPriorityFFI :: CInt -> LogPriority -> IO () - -foreign import ccall "SDL.h SDL_GetRevision" getRevisionFFI :: IO CString -foreign import ccall "SDL.h SDL_GetRevisionNumber" getRevisionNumberFFI :: IO CInt -foreign import ccall "SDL.h SDL_GetVersion" getVersionFFI :: Ptr Version -> IO () - -init :: MonadIO m => InitFlag -> m CInt -init v1 = liftIO $ initFFI v1 -{-# INLINE init #-} - -initSubSystem :: MonadIO m => InitFlag -> m CInt -initSubSystem v1 = liftIO $ initSubSystemFFI v1 -{-# INLINE initSubSystem #-} - -quit :: MonadIO m => m () -quit = liftIO quitFFI -{-# INLINE quit #-} - -quitSubSystem :: MonadIO m => InitFlag -> m () -quitSubSystem v1 = liftIO $ quitSubSystemFFI v1 -{-# INLINE quitSubSystem #-} - -setMainReady :: MonadIO m => m () -setMainReady = liftIO setMainReadyFFI -{-# INLINE setMainReady #-} - -wasInit :: MonadIO m => InitFlag -> m InitFlag -wasInit v1 = liftIO $ wasInitFFI v1 -{-# INLINE wasInit #-} - -free :: MonadIO m => Ptr () -> m () -free v1 = liftIO $ freeFFI v1 -{-# INLINE free #-} - -addHintCallback :: MonadIO m => CString -> HintCallback -> Ptr () -> m () -addHintCallback v1 v2 v3 = liftIO $ addHintCallbackFFI v1 v2 v3 -{-# INLINE addHintCallback #-} - -clearHints :: MonadIO m => m () -clearHints = liftIO clearHintsFFI -{-# INLINE clearHints #-} - -delHintCallback :: MonadIO m => CString -> HintCallback -> Ptr () -> m () -delHintCallback v1 v2 v3 = liftIO $ delHintCallbackFFI v1 v2 v3 -{-# INLINE delHintCallback #-} - -getHint :: MonadIO m => CString -> m CString -getHint v1 = liftIO $ getHintFFI v1 -{-# INLINE getHint #-} - -setHint :: MonadIO m => CString -> CString -> m Bool -setHint v1 v2 = liftIO $ setHintFFI v1 v2 -{-# INLINE setHint #-} - -setHintWithPriority :: MonadIO m => CString -> CString -> HintPriority -> m Bool -setHintWithPriority v1 v2 v3 = liftIO $ setHintWithPriorityFFI v1 v2 v3 -{-# INLINE setHintWithPriority #-} - -log :: CString -> IO () -log = logMessage SDL_LOG_CATEGORY_APPLICATION SDL_LOG_PRIORITY_INFO -{-# INLINE log #-} - -logCritical :: CInt -> CString -> IO () -logCritical category = logMessage category SDL_LOG_PRIORITY_CRITICAL -{-# INLINE logCritical #-} - -logDebug :: CInt -> CString -> IO () -logDebug category = logMessage category SDL_LOG_PRIORITY_DEBUG -{-# INLINE logDebug #-} - -logError :: CInt -> CString -> IO () -logError category = logMessage category SDL_LOG_PRIORITY_ERROR -{-# INLINE logError #-} - -logGetOutputFunction :: MonadIO m => Ptr LogOutputFunction -> Ptr (Ptr ()) -> m () -logGetOutputFunction v1 v2 = liftIO $ logGetOutputFunctionFFI v1 v2 -{-# INLINE logGetOutputFunction #-} - -logGetPriority :: MonadIO m => CInt -> m LogPriority -logGetPriority v1 = liftIO $ logGetPriorityFFI v1 -{-# INLINE logGetPriority #-} - -logInfo :: CInt -> CString -> IO () -logInfo category = logMessage category SDL_LOG_PRIORITY_INFO -{-# INLINE logInfo #-} - -logMessage :: MonadIO m => CInt -> LogPriority -> CString -> m () -logMessage v1 v2 v3 = liftIO $ logMessageFFI v1 v2 v3 -{-# INLINE logMessage #-} - -logResetPriorities :: MonadIO m => m () -logResetPriorities = liftIO logResetPrioritiesFFI -{-# INLINE logResetPriorities #-} - -logSetAllPriority :: MonadIO m => LogPriority -> m () -logSetAllPriority v1 = liftIO $ logSetAllPriorityFFI v1 -{-# INLINE logSetAllPriority #-} - -logSetOutputFunction :: MonadIO m => LogOutputFunction -> Ptr () -> m () -logSetOutputFunction v1 v2 = liftIO $ logSetOutputFunctionFFI v1 v2 -{-# INLINE logSetOutputFunction #-} - -logSetPriority :: MonadIO m => CInt -> LogPriority -> m () -logSetPriority v1 v2 = liftIO $ logSetPriorityFFI v1 v2 -{-# INLINE logSetPriority #-} - -logVerbose :: CInt -> CString -> IO () -logVerbose category = logMessage category SDL_LOG_PRIORITY_VERBOSE -{-# INLINE logVerbose #-} - -logWarn :: CInt -> CString -> IO () -logWarn category = logMessage category SDL_LOG_PRIORITY_WARN -{-# INLINE logWarn #-} - -getRevision :: MonadIO m => m CString -getRevision = liftIO getRevisionFFI -{-# INLINE getRevision #-} - -getRevisionNumber :: MonadIO m => m CInt -getRevisionNumber = liftIO getRevisionNumberFFI -{-# INLINE getRevisionNumber #-} - -getVersion :: MonadIO m => Ptr Version -> m () -getVersion v1 = liftIO $ getVersionFFI v1 -{-# INLINE getVersion #-} +module SDL.Raw.Basic ( + -- * Initialization and Shutdown + init, + initSubSystem, + quit, + quitSubSystem, + setMainReady, + wasInit, + + -- * Memory Management + free, + + -- * Configuration Variables + addHintCallback, + clearHints, + delHintCallback, + getHint, + setHint, + setHintWithPriority, + + -- * Log Handling + log, + logCritical, + logDebug, + logError, + logGetOutputFunction, + logGetPriority, + logInfo, + logMessage, + logResetPriorities, + logSetAllPriority, + logSetOutputFunction, + logSetPriority, + logVerbose, + logWarn, + + -- * Assertions + -- | Use Haskell's own assertion primitives rather than SDL's. + + -- * Querying SDL Version + getRevision, + getRevisionNumber, + getVersion +) where + +import Control.Monad.IO.Class +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Enum +import SDL.Raw.Types +import Prelude hiding (init, log) + +foreign import ccall "SDL.h SDL_Init" initFFI :: InitFlag -> IO CInt +foreign import ccall "SDL.h SDL_InitSubSystem" initSubSystemFFI :: InitFlag -> IO CInt +foreign import ccall "SDL.h SDL_Quit" quitFFI :: IO () +foreign import ccall "SDL.h SDL_QuitSubSystem" quitSubSystemFFI :: InitFlag -> IO () +foreign import ccall "SDL.h SDL_SetMainReady" setMainReadyFFI :: IO () +foreign import ccall "SDL.h SDL_WasInit" wasInitFFI :: InitFlag -> IO InitFlag + +foreign import ccall "SDL.h SDL_free" freeFFI :: Ptr () -> IO () + +foreign import ccall "SDL.h SDL_AddHintCallback" addHintCallbackFFI :: CString -> HintCallback -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_ClearHints" clearHintsFFI :: IO () +foreign import ccall "SDL.h SDL_DelHintCallback" delHintCallbackFFI :: CString -> HintCallback -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_GetHint" getHintFFI :: CString -> IO CString +foreign import ccall "SDL.h SDL_SetHint" setHintFFI :: CString -> CString -> IO Bool +foreign import ccall "SDL.h SDL_SetHintWithPriority" setHintWithPriorityFFI :: CString -> CString -> HintPriority -> IO Bool + +foreign import ccall "SDL.h SDL_LogGetOutputFunction" logGetOutputFunctionFFI :: Ptr LogOutputFunction -> Ptr (Ptr ()) -> IO () +foreign import ccall "SDL.h SDL_LogGetPriority" logGetPriorityFFI :: CInt -> IO LogPriority +foreign import ccall "sdlhelper.c SDLHelper_LogMessage" logMessageFFI :: CInt -> LogPriority -> CString -> IO () +foreign import ccall "SDL.h SDL_LogResetPriorities" logResetPrioritiesFFI :: IO () +foreign import ccall "SDL.h SDL_LogSetAllPriority" logSetAllPriorityFFI :: LogPriority -> IO () +foreign import ccall "SDL.h SDL_LogSetOutputFunction" logSetOutputFunctionFFI :: LogOutputFunction -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_LogSetPriority" logSetPriorityFFI :: CInt -> LogPriority -> IO () + +foreign import ccall "SDL.h SDL_GetRevision" getRevisionFFI :: IO CString +foreign import ccall "SDL.h SDL_GetRevisionNumber" getRevisionNumberFFI :: IO CInt +foreign import ccall "SDL.h SDL_GetVersion" getVersionFFI :: Ptr Version -> IO () + +init :: MonadIO m => InitFlag -> m CInt +init v1 = liftIO $ initFFI v1 +{-# INLINE init #-} + +initSubSystem :: MonadIO m => InitFlag -> m CInt +initSubSystem v1 = liftIO $ initSubSystemFFI v1 +{-# INLINE initSubSystem #-} + +quit :: MonadIO m => m () +quit = liftIO quitFFI +{-# INLINE quit #-} + +quitSubSystem :: MonadIO m => InitFlag -> m () +quitSubSystem v1 = liftIO $ quitSubSystemFFI v1 +{-# INLINE quitSubSystem #-} + +setMainReady :: MonadIO m => m () +setMainReady = liftIO setMainReadyFFI +{-# INLINE setMainReady #-} + +wasInit :: MonadIO m => InitFlag -> m InitFlag +wasInit v1 = liftIO $ wasInitFFI v1 +{-# INLINE wasInit #-} + +free :: MonadIO m => Ptr () -> m () +free v1 = liftIO $ freeFFI v1 +{-# INLINE free #-} + +addHintCallback :: MonadIO m => CString -> HintCallback -> Ptr () -> m () +addHintCallback v1 v2 v3 = liftIO $ addHintCallbackFFI v1 v2 v3 +{-# INLINE addHintCallback #-} + +clearHints :: MonadIO m => m () +clearHints = liftIO clearHintsFFI +{-# INLINE clearHints #-} + +delHintCallback :: MonadIO m => CString -> HintCallback -> Ptr () -> m () +delHintCallback v1 v2 v3 = liftIO $ delHintCallbackFFI v1 v2 v3 +{-# INLINE delHintCallback #-} + +getHint :: MonadIO m => CString -> m CString +getHint v1 = liftIO $ getHintFFI v1 +{-# INLINE getHint #-} + +setHint :: MonadIO m => CString -> CString -> m Bool +setHint v1 v2 = liftIO $ setHintFFI v1 v2 +{-# INLINE setHint #-} + +setHintWithPriority :: MonadIO m => CString -> CString -> HintPriority -> m Bool +setHintWithPriority v1 v2 v3 = liftIO $ setHintWithPriorityFFI v1 v2 v3 +{-# INLINE setHintWithPriority #-} + +log :: CString -> IO () +log = logMessage SDL_LOG_CATEGORY_APPLICATION SDL_LOG_PRIORITY_INFO +{-# INLINE log #-} + +logCritical :: CInt -> CString -> IO () +logCritical category = logMessage category SDL_LOG_PRIORITY_CRITICAL +{-# INLINE logCritical #-} + +logDebug :: CInt -> CString -> IO () +logDebug category = logMessage category SDL_LOG_PRIORITY_DEBUG +{-# INLINE logDebug #-} + +logError :: CInt -> CString -> IO () +logError category = logMessage category SDL_LOG_PRIORITY_ERROR +{-# INLINE logError #-} + +logGetOutputFunction :: MonadIO m => Ptr LogOutputFunction -> Ptr (Ptr ()) -> m () +logGetOutputFunction v1 v2 = liftIO $ logGetOutputFunctionFFI v1 v2 +{-# INLINE logGetOutputFunction #-} + +logGetPriority :: MonadIO m => CInt -> m LogPriority +logGetPriority v1 = liftIO $ logGetPriorityFFI v1 +{-# INLINE logGetPriority #-} + +logInfo :: CInt -> CString -> IO () +logInfo category = logMessage category SDL_LOG_PRIORITY_INFO +{-# INLINE logInfo #-} + +logMessage :: MonadIO m => CInt -> LogPriority -> CString -> m () +logMessage v1 v2 v3 = liftIO $ logMessageFFI v1 v2 v3 +{-# INLINE logMessage #-} + +logResetPriorities :: MonadIO m => m () +logResetPriorities = liftIO logResetPrioritiesFFI +{-# INLINE logResetPriorities #-} + +logSetAllPriority :: MonadIO m => LogPriority -> m () +logSetAllPriority v1 = liftIO $ logSetAllPriorityFFI v1 +{-# INLINE logSetAllPriority #-} + +logSetOutputFunction :: MonadIO m => LogOutputFunction -> Ptr () -> m () +logSetOutputFunction v1 v2 = liftIO $ logSetOutputFunctionFFI v1 v2 +{-# INLINE logSetOutputFunction #-} + +logSetPriority :: MonadIO m => CInt -> LogPriority -> m () +logSetPriority v1 v2 = liftIO $ logSetPriorityFFI v1 v2 +{-# INLINE logSetPriority #-} + +logVerbose :: CInt -> CString -> IO () +logVerbose category = logMessage category SDL_LOG_PRIORITY_VERBOSE +{-# INLINE logVerbose #-} + +logWarn :: CInt -> CString -> IO () +logWarn category = logMessage category SDL_LOG_PRIORITY_WARN +{-# INLINE logWarn #-} + +getRevision :: MonadIO m => m CString +getRevision = liftIO getRevisionFFI +{-# INLINE getRevision #-} + +getRevisionNumber :: MonadIO m => m CInt +getRevisionNumber = liftIO getRevisionNumberFFI +{-# INLINE getRevisionNumber #-} + +getVersion :: MonadIO m => Ptr Version -> m () +getVersion v1 = liftIO $ getVersionFFI v1 +{-# INLINE getVersion #-} diff --git a/src/SDL/Raw/Enum.hsc b/src/SDL/Raw/Enum.hsc --- a/src/SDL/Raw/Enum.hsc +++ b/src/SDL/Raw/Enum.hsc @@ -1,1727 +1,1727 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PatternSynonyms #-} -module SDL.Raw.Enum ( - -- * Enumerations - - -- ** Audio Format - AudioFormat, - pattern SDL_AUDIO_S8, - pattern SDL_AUDIO_U8, - pattern SDL_AUDIO_S16LSB, - pattern SDL_AUDIO_S16MSB, - pattern SDL_AUDIO_S16SYS, - pattern SDL_AUDIO_U16LSB, - pattern SDL_AUDIO_U16MSB, - pattern SDL_AUDIO_U16SYS, - pattern SDL_AUDIO_S32LSB, - pattern SDL_AUDIO_S32MSB, - pattern SDL_AUDIO_S32SYS, - pattern SDL_AUDIO_F32LSB, - pattern SDL_AUDIO_F32MSB, - pattern SDL_AUDIO_F32SYS, - - -- ** Audio Status - AudioStatus, - pattern SDL_AUDIO_STOPPED, - pattern SDL_AUDIO_PLAYING, - pattern SDL_AUDIO_PAUSED, - - -- ** Blend Mode - BlendMode, - pattern SDL_BLENDMODE_NONE, - pattern SDL_BLENDMODE_BLEND, - pattern SDL_BLENDMODE_ADD, - pattern SDL_BLENDMODE_MOD, - - -- ** Endian Detetection - pattern SDL_BYTEORDER, - pattern SDL_LIL_ENDIAN, - pattern SDL_BIG_ENDIAN, - - -- ** Event Action - EventAction, - pattern SDL_ADDEVENT, - pattern SDL_PEEKEVENT, - pattern SDL_GETEVENT, - - -- ** Game Controller Axis - GameControllerAxis, - pattern SDL_CONTROLLER_AXIS_INVALID, - pattern SDL_CONTROLLER_AXIS_LEFTX, - pattern SDL_CONTROLLER_AXIS_LEFTY, - pattern SDL_CONTROLLER_AXIS_RIGHTX, - pattern SDL_CONTROLLER_AXIS_RIGHTY, - pattern SDL_CONTROLLER_AXIS_TRIGGERLEFT, - pattern SDL_CONTROLLER_AXIS_TRIGGERRIGHT, - pattern SDL_CONTROLLER_AXIS_MAX, - - -- ** Game Controller Button - GameControllerButton, - pattern SDL_CONTROLLER_BUTTON_INVALID, - pattern SDL_CONTROLLER_BUTTON_A, - pattern SDL_CONTROLLER_BUTTON_B, - pattern SDL_CONTROLLER_BUTTON_X, - pattern SDL_CONTROLLER_BUTTON_Y, - pattern SDL_CONTROLLER_BUTTON_BACK, - pattern SDL_CONTROLLER_BUTTON_GUIDE, - pattern SDL_CONTROLLER_BUTTON_START, - pattern SDL_CONTROLLER_BUTTON_LEFTSTICK, - pattern SDL_CONTROLLER_BUTTON_RIGHTSTICK, - pattern SDL_CONTROLLER_BUTTON_LEFTSHOULDER, - pattern SDL_CONTROLLER_BUTTON_RIGHTSHOULDER, - pattern SDL_CONTROLLER_BUTTON_DPAD_UP, - pattern SDL_CONTROLLER_BUTTON_DPAD_DOWN, - pattern SDL_CONTROLLER_BUTTON_DPAD_LEFT, - pattern SDL_CONTROLLER_BUTTON_DPAD_RIGHT, - pattern SDL_CONTROLLER_BUTTON_MAX, - - -- ** OpenGL Attribute - GLattr, - pattern SDL_GL_RED_SIZE, - pattern SDL_GL_GREEN_SIZE, - pattern SDL_GL_BLUE_SIZE, - pattern SDL_GL_ALPHA_SIZE, - pattern SDL_GL_BUFFER_SIZE, - pattern SDL_GL_DOUBLEBUFFER, - pattern SDL_GL_DEPTH_SIZE, - pattern SDL_GL_STENCIL_SIZE, - pattern SDL_GL_ACCUM_RED_SIZE, - pattern SDL_GL_ACCUM_GREEN_SIZE, - pattern SDL_GL_ACCUM_BLUE_SIZE, - pattern SDL_GL_ACCUM_ALPHA_SIZE, - pattern SDL_GL_STEREO, - pattern SDL_GL_MULTISAMPLEBUFFERS, - pattern SDL_GL_MULTISAMPLESAMPLES, - pattern SDL_GL_ACCELERATED_VISUAL, - pattern SDL_GL_RETAINED_BACKING, - pattern SDL_GL_CONTEXT_MAJOR_VERSION, - pattern SDL_GL_CONTEXT_MINOR_VERSION, - pattern SDL_GL_CONTEXT_EGL, - pattern SDL_GL_CONTEXT_FLAGS, - pattern SDL_GL_CONTEXT_PROFILE_MASK, - pattern SDL_GL_SHARE_WITH_CURRENT_CONTEXT, - pattern SDL_GL_FRAMEBUFFER_SRGB_CAPABLE, - - -- ** Hint Priority - HintPriority, - pattern SDL_HINT_DEFAULT, - pattern SDL_HINT_NORMAL, - pattern SDL_HINT_OVERRIDE, - - -- ** Initialization Flag - InitFlag, - pattern SDL_INIT_TIMER, - pattern SDL_INIT_AUDIO, - pattern SDL_INIT_VIDEO, - pattern SDL_INIT_JOYSTICK, - pattern SDL_INIT_HAPTIC, - pattern SDL_INIT_GAMECONTROLLER, - pattern SDL_INIT_EVENTS, - pattern SDL_INIT_NOPARACHUTE, - pattern SDL_INIT_EVERYTHING, - - -- ** Keycode - Keycode, - pattern SDLK_UNKNOWN, - pattern SDLK_RETURN, - pattern SDLK_ESCAPE, - pattern SDLK_BACKSPACE, - pattern SDLK_TAB, - pattern SDLK_SPACE, - pattern SDLK_EXCLAIM, - pattern SDLK_QUOTEDBL, - pattern SDLK_HASH, - pattern SDLK_PERCENT, - pattern SDLK_DOLLAR, - pattern SDLK_AMPERSAND, - pattern SDLK_QUOTE, - pattern SDLK_LEFTPAREN, - pattern SDLK_RIGHTPAREN, - pattern SDLK_ASTERISK, - pattern SDLK_PLUS, - pattern SDLK_COMMA, - pattern SDLK_MINUS, - pattern SDLK_PERIOD, - pattern SDLK_SLASH, - pattern SDLK_0, - pattern SDLK_1, - pattern SDLK_2, - pattern SDLK_3, - pattern SDLK_4, - pattern SDLK_5, - pattern SDLK_6, - pattern SDLK_7, - pattern SDLK_8, - pattern SDLK_9, - pattern SDLK_COLON, - pattern SDLK_SEMICOLON, - pattern SDLK_LESS, - pattern SDLK_EQUALS, - pattern SDLK_GREATER, - pattern SDLK_QUESTION, - pattern SDLK_AT, - pattern SDLK_LEFTBRACKET, - pattern SDLK_BACKSLASH, - pattern SDLK_RIGHTBRACKET, - pattern SDLK_CARET, - pattern SDLK_UNDERSCORE, - pattern SDLK_BACKQUOTE, - pattern SDLK_a, - pattern SDLK_b, - pattern SDLK_c, - pattern SDLK_d, - pattern SDLK_e, - pattern SDLK_f, - pattern SDLK_g, - pattern SDLK_h, - pattern SDLK_i, - pattern SDLK_j, - pattern SDLK_k, - pattern SDLK_l, - pattern SDLK_m, - pattern SDLK_n, - pattern SDLK_o, - pattern SDLK_p, - pattern SDLK_q, - pattern SDLK_r, - pattern SDLK_s, - pattern SDLK_t, - pattern SDLK_u, - pattern SDLK_v, - pattern SDLK_w, - pattern SDLK_x, - pattern SDLK_y, - pattern SDLK_z, - pattern SDLK_CAPSLOCK, - pattern SDLK_F1, - pattern SDLK_F2, - pattern SDLK_F3, - pattern SDLK_F4, - pattern SDLK_F5, - pattern SDLK_F6, - pattern SDLK_F7, - pattern SDLK_F8, - pattern SDLK_F9, - pattern SDLK_F10, - pattern SDLK_F11, - pattern SDLK_F12, - pattern SDLK_PRINTSCREEN, - pattern SDLK_SCROLLLOCK, - pattern SDLK_PAUSE, - pattern SDLK_INSERT, - pattern SDLK_HOME, - pattern SDLK_PAGEUP, - pattern SDLK_DELETE, - pattern SDLK_END, - pattern SDLK_PAGEDOWN, - pattern SDLK_RIGHT, - pattern SDLK_LEFT, - pattern SDLK_DOWN, - pattern SDLK_UP, - pattern SDLK_NUMLOCKCLEAR, - pattern SDLK_KP_DIVIDE, - pattern SDLK_KP_MULTIPLY, - pattern SDLK_KP_MINUS, - pattern SDLK_KP_PLUS, - pattern SDLK_KP_ENTER, - pattern SDLK_KP_1, - pattern SDLK_KP_2, - pattern SDLK_KP_3, - pattern SDLK_KP_4, - pattern SDLK_KP_5, - pattern SDLK_KP_6, - pattern SDLK_KP_7, - pattern SDLK_KP_8, - pattern SDLK_KP_9, - pattern SDLK_KP_0, - pattern SDLK_KP_PERIOD, - pattern SDLK_APPLICATION, - pattern SDLK_POWER, - pattern SDLK_KP_EQUALS, - pattern SDLK_F13, - pattern SDLK_F14, - pattern SDLK_F15, - pattern SDLK_F16, - pattern SDLK_F17, - pattern SDLK_F18, - pattern SDLK_F19, - pattern SDLK_F20, - pattern SDLK_F21, - pattern SDLK_F22, - pattern SDLK_F23, - pattern SDLK_F24, - pattern SDLK_EXECUTE, - pattern SDLK_HELP, - pattern SDLK_MENU, - pattern SDLK_SELECT, - pattern SDLK_STOP, - pattern SDLK_AGAIN, - pattern SDLK_UNDO, - pattern SDLK_CUT, - pattern SDLK_COPY, - pattern SDLK_PASTE, - pattern SDLK_FIND, - pattern SDLK_MUTE, - pattern SDLK_VOLUMEUP, - pattern SDLK_VOLUMEDOWN, - pattern SDLK_KP_COMMA, - pattern SDLK_KP_EQUALSAS400, - pattern SDLK_ALTERASE, - pattern SDLK_SYSREQ, - pattern SDLK_CANCEL, - pattern SDLK_CLEAR, - pattern SDLK_PRIOR, - pattern SDLK_RETURN2, - pattern SDLK_SEPARATOR, - pattern SDLK_OUT, - pattern SDLK_OPER, - pattern SDLK_CLEARAGAIN, - pattern SDLK_CRSEL, - pattern SDLK_EXSEL, - pattern SDLK_KP_00, - pattern SDLK_KP_000, - pattern SDLK_THOUSANDSSEPARATOR, - pattern SDLK_DECIMALSEPARATOR, - pattern SDLK_CURRENCYUNIT, - pattern SDLK_CURRENCYSUBUNIT, - pattern SDLK_KP_LEFTPAREN, - pattern SDLK_KP_RIGHTPAREN, - pattern SDLK_KP_LEFTBRACE, - pattern SDLK_KP_RIGHTBRACE, - pattern SDLK_KP_TAB, - pattern SDLK_KP_BACKSPACE, - pattern SDLK_KP_A, - pattern SDLK_KP_B, - pattern SDLK_KP_C, - pattern SDLK_KP_D, - pattern SDLK_KP_E, - pattern SDLK_KP_F, - pattern SDLK_KP_XOR, - pattern SDLK_KP_POWER, - pattern SDLK_KP_PERCENT, - pattern SDLK_KP_LESS, - pattern SDLK_KP_GREATER, - pattern SDLK_KP_AMPERSAND, - pattern SDLK_KP_DBLAMPERSAND, - pattern SDLK_KP_VERTICALBAR, - pattern SDLK_KP_DBLVERTICALBAR, - pattern SDLK_KP_COLON, - pattern SDLK_KP_HASH, - pattern SDLK_KP_SPACE, - pattern SDLK_KP_AT, - pattern SDLK_KP_EXCLAM, - pattern SDLK_KP_MEMSTORE, - pattern SDLK_KP_MEMRECALL, - pattern SDLK_KP_MEMCLEAR, - pattern SDLK_KP_MEMADD, - pattern SDLK_KP_MEMSUBTRACT, - pattern SDLK_KP_MEMMULTIPLY, - pattern SDLK_KP_MEMDIVIDE, - pattern SDLK_KP_PLUSMINUS, - pattern SDLK_KP_CLEAR, - pattern SDLK_KP_CLEARENTRY, - pattern SDLK_KP_BINARY, - pattern SDLK_KP_OCTAL, - pattern SDLK_KP_DECIMAL, - pattern SDLK_KP_HEXADECIMAL, - pattern SDLK_LCTRL, - pattern SDLK_LSHIFT, - pattern SDLK_LALT, - pattern SDLK_LGUI, - pattern SDLK_RCTRL, - pattern SDLK_RSHIFT, - pattern SDLK_RALT, - pattern SDLK_RGUI, - pattern SDLK_MODE, - pattern SDLK_AUDIONEXT, - pattern SDLK_AUDIOPREV, - pattern SDLK_AUDIOSTOP, - pattern SDLK_AUDIOPLAY, - pattern SDLK_AUDIOMUTE, - pattern SDLK_MEDIASELECT, - pattern SDLK_WWW, - pattern SDLK_MAIL, - pattern SDLK_CALCULATOR, - pattern SDLK_COMPUTER, - pattern SDLK_AC_SEARCH, - pattern SDLK_AC_HOME, - pattern SDLK_AC_BACK, - pattern SDLK_AC_FORWARD, - pattern SDLK_AC_STOP, - pattern SDLK_AC_REFRESH, - pattern SDLK_AC_BOOKMARKS, - pattern SDLK_BRIGHTNESSDOWN, - pattern SDLK_BRIGHTNESSUP, - pattern SDLK_DISPLAYSWITCH, - pattern SDLK_KBDILLUMTOGGLE, - pattern SDLK_KBDILLUMDOWN, - pattern SDLK_KBDILLUMUP, - pattern SDLK_EJECT, - pattern SDLK_SLEEP, - - -- ** Key Modifier - Keymod, - pattern KMOD_NONE, - pattern KMOD_LSHIFT, - pattern KMOD_RSHIFT, - pattern KMOD_SHIFT, - pattern KMOD_LCTRL, - pattern KMOD_RCTRL, - pattern KMOD_CTRL, - pattern KMOD_LALT, - pattern KMOD_RALT, - pattern KMOD_ALT, - pattern KMOD_LGUI, - pattern KMOD_RGUI, - pattern KMOD_GUI, - pattern KMOD_NUM, - pattern KMOD_CAPS, - pattern KMOD_MODE, - pattern KMOD_RESERVED, - - -- ** Log Priority - LogPriority, - pattern SDL_LOG_PRIORITY_VERBOSE, - pattern SDL_LOG_PRIORITY_DEBUG, - pattern SDL_LOG_PRIORITY_INFO, - pattern SDL_LOG_PRIORITY_WARN, - pattern SDL_LOG_PRIORITY_ERROR, - pattern SDL_LOG_PRIORITY_CRITICAL, - pattern SDL_NUM_LOG_PRIORITIES, - - -- ** Power State - PowerState, - pattern SDL_POWERSTATE_UNKNOWN, - pattern SDL_POWERSTATE_ON_BATTERY, - pattern SDL_POWERSTATE_NO_BATTERY, - pattern SDL_POWERSTATE_CHARGING, - pattern SDL_POWERSTATE_CHARGED, - - -- ** Renderer Flip - RendererFlip, - pattern SDL_FLIP_NONE, - pattern SDL_FLIP_HORIZONTAL, - pattern SDL_FLIP_VERTICAL, - - -- ** Scancode - Scancode, - pattern SDL_SCANCODE_UNKNOWN, - pattern SDL_SCANCODE_A, - pattern SDL_SCANCODE_B, - pattern SDL_SCANCODE_C, - pattern SDL_SCANCODE_D, - pattern SDL_SCANCODE_E, - pattern SDL_SCANCODE_F, - pattern SDL_SCANCODE_G, - pattern SDL_SCANCODE_H, - pattern SDL_SCANCODE_I, - pattern SDL_SCANCODE_J, - pattern SDL_SCANCODE_K, - pattern SDL_SCANCODE_L, - pattern SDL_SCANCODE_M, - pattern SDL_SCANCODE_N, - pattern SDL_SCANCODE_O, - pattern SDL_SCANCODE_P, - pattern SDL_SCANCODE_Q, - pattern SDL_SCANCODE_R, - pattern SDL_SCANCODE_S, - pattern SDL_SCANCODE_T, - pattern SDL_SCANCODE_U, - pattern SDL_SCANCODE_V, - pattern SDL_SCANCODE_W, - pattern SDL_SCANCODE_X, - pattern SDL_SCANCODE_Y, - pattern SDL_SCANCODE_Z, - pattern SDL_SCANCODE_1, - pattern SDL_SCANCODE_2, - pattern SDL_SCANCODE_3, - pattern SDL_SCANCODE_4, - pattern SDL_SCANCODE_5, - pattern SDL_SCANCODE_6, - pattern SDL_SCANCODE_7, - pattern SDL_SCANCODE_8, - pattern SDL_SCANCODE_9, - pattern SDL_SCANCODE_0, - pattern SDL_SCANCODE_RETURN, - pattern SDL_SCANCODE_ESCAPE, - pattern SDL_SCANCODE_BACKSPACE, - pattern SDL_SCANCODE_TAB, - pattern SDL_SCANCODE_SPACE, - pattern SDL_SCANCODE_MINUS, - pattern SDL_SCANCODE_EQUALS, - pattern SDL_SCANCODE_LEFTBRACKET, - pattern SDL_SCANCODE_RIGHTBRACKET, - pattern SDL_SCANCODE_BACKSLASH, - pattern SDL_SCANCODE_NONUSHASH, - pattern SDL_SCANCODE_SEMICOLON, - pattern SDL_SCANCODE_APOSTROPHE, - pattern SDL_SCANCODE_GRAVE, - pattern SDL_SCANCODE_COMMA, - pattern SDL_SCANCODE_PERIOD, - pattern SDL_SCANCODE_SLASH, - pattern SDL_SCANCODE_CAPSLOCK, - pattern SDL_SCANCODE_F1, - pattern SDL_SCANCODE_F2, - pattern SDL_SCANCODE_F3, - pattern SDL_SCANCODE_F4, - pattern SDL_SCANCODE_F5, - pattern SDL_SCANCODE_F6, - pattern SDL_SCANCODE_F7, - pattern SDL_SCANCODE_F8, - pattern SDL_SCANCODE_F9, - pattern SDL_SCANCODE_F10, - pattern SDL_SCANCODE_F11, - pattern SDL_SCANCODE_F12, - pattern SDL_SCANCODE_PRINTSCREEN, - pattern SDL_SCANCODE_SCROLLLOCK, - pattern SDL_SCANCODE_PAUSE, - pattern SDL_SCANCODE_INSERT, - pattern SDL_SCANCODE_HOME, - pattern SDL_SCANCODE_PAGEUP, - pattern SDL_SCANCODE_DELETE, - pattern SDL_SCANCODE_END, - pattern SDL_SCANCODE_PAGEDOWN, - pattern SDL_SCANCODE_RIGHT, - pattern SDL_SCANCODE_LEFT, - pattern SDL_SCANCODE_DOWN, - pattern SDL_SCANCODE_UP, - pattern SDL_SCANCODE_NUMLOCKCLEAR, - pattern SDL_SCANCODE_KP_DIVIDE, - pattern SDL_SCANCODE_KP_MULTIPLY, - pattern SDL_SCANCODE_KP_MINUS, - pattern SDL_SCANCODE_KP_PLUS, - pattern SDL_SCANCODE_KP_ENTER, - pattern SDL_SCANCODE_KP_1, - pattern SDL_SCANCODE_KP_2, - pattern SDL_SCANCODE_KP_3, - pattern SDL_SCANCODE_KP_4, - pattern SDL_SCANCODE_KP_5, - pattern SDL_SCANCODE_KP_6, - pattern SDL_SCANCODE_KP_7, - pattern SDL_SCANCODE_KP_8, - pattern SDL_SCANCODE_KP_9, - pattern SDL_SCANCODE_KP_0, - pattern SDL_SCANCODE_KP_PERIOD, - pattern SDL_SCANCODE_NONUSBACKSLASH, - pattern SDL_SCANCODE_APPLICATION, - pattern SDL_SCANCODE_POWER, - pattern SDL_SCANCODE_KP_EQUALS, - pattern SDL_SCANCODE_F13, - pattern SDL_SCANCODE_F14, - pattern SDL_SCANCODE_F15, - pattern SDL_SCANCODE_F16, - pattern SDL_SCANCODE_F17, - pattern SDL_SCANCODE_F18, - pattern SDL_SCANCODE_F19, - pattern SDL_SCANCODE_F20, - pattern SDL_SCANCODE_F21, - pattern SDL_SCANCODE_F22, - pattern SDL_SCANCODE_F23, - pattern SDL_SCANCODE_F24, - pattern SDL_SCANCODE_EXECUTE, - pattern SDL_SCANCODE_HELP, - pattern SDL_SCANCODE_MENU, - pattern SDL_SCANCODE_SELECT, - pattern SDL_SCANCODE_STOP, - pattern SDL_SCANCODE_AGAIN, - pattern SDL_SCANCODE_UNDO, - pattern SDL_SCANCODE_CUT, - pattern SDL_SCANCODE_COPY, - pattern SDL_SCANCODE_PASTE, - pattern SDL_SCANCODE_FIND, - pattern SDL_SCANCODE_MUTE, - pattern SDL_SCANCODE_VOLUMEUP, - pattern SDL_SCANCODE_VOLUMEDOWN, - pattern SDL_SCANCODE_KP_COMMA, - pattern SDL_SCANCODE_KP_EQUALSAS400, - pattern SDL_SCANCODE_INTERNATIONAL1, - pattern SDL_SCANCODE_INTERNATIONAL2, - pattern SDL_SCANCODE_INTERNATIONAL3, - pattern SDL_SCANCODE_INTERNATIONAL4, - pattern SDL_SCANCODE_INTERNATIONAL5, - pattern SDL_SCANCODE_INTERNATIONAL6, - pattern SDL_SCANCODE_INTERNATIONAL7, - pattern SDL_SCANCODE_INTERNATIONAL8, - pattern SDL_SCANCODE_INTERNATIONAL9, - pattern SDL_SCANCODE_LANG1, - pattern SDL_SCANCODE_LANG2, - pattern SDL_SCANCODE_LANG3, - pattern SDL_SCANCODE_LANG4, - pattern SDL_SCANCODE_LANG5, - pattern SDL_SCANCODE_LANG6, - pattern SDL_SCANCODE_LANG7, - pattern SDL_SCANCODE_LANG8, - pattern SDL_SCANCODE_LANG9, - pattern SDL_SCANCODE_ALTERASE, - pattern SDL_SCANCODE_SYSREQ, - pattern SDL_SCANCODE_CANCEL, - pattern SDL_SCANCODE_CLEAR, - pattern SDL_SCANCODE_PRIOR, - pattern SDL_SCANCODE_RETURN2, - pattern SDL_SCANCODE_SEPARATOR, - pattern SDL_SCANCODE_OUT, - pattern SDL_SCANCODE_OPER, - pattern SDL_SCANCODE_CLEARAGAIN, - pattern SDL_SCANCODE_CRSEL, - pattern SDL_SCANCODE_EXSEL, - pattern SDL_SCANCODE_KP_00, - pattern SDL_SCANCODE_KP_000, - pattern SDL_SCANCODE_THOUSANDSSEPARATOR, - pattern SDL_SCANCODE_DECIMALSEPARATOR, - pattern SDL_SCANCODE_CURRENCYUNIT, - pattern SDL_SCANCODE_CURRENCYSUBUNIT, - pattern SDL_SCANCODE_KP_LEFTPAREN, - pattern SDL_SCANCODE_KP_RIGHTPAREN, - pattern SDL_SCANCODE_KP_LEFTBRACE, - pattern SDL_SCANCODE_KP_RIGHTBRACE, - pattern SDL_SCANCODE_KP_TAB, - pattern SDL_SCANCODE_KP_BACKSPACE, - pattern SDL_SCANCODE_KP_A, - pattern SDL_SCANCODE_KP_B, - pattern SDL_SCANCODE_KP_C, - pattern SDL_SCANCODE_KP_D, - pattern SDL_SCANCODE_KP_E, - pattern SDL_SCANCODE_KP_F, - pattern SDL_SCANCODE_KP_XOR, - pattern SDL_SCANCODE_KP_POWER, - pattern SDL_SCANCODE_KP_PERCENT, - pattern SDL_SCANCODE_KP_LESS, - pattern SDL_SCANCODE_KP_GREATER, - pattern SDL_SCANCODE_KP_AMPERSAND, - pattern SDL_SCANCODE_KP_DBLAMPERSAND, - pattern SDL_SCANCODE_KP_VERTICALBAR, - pattern SDL_SCANCODE_KP_DBLVERTICALBAR, - pattern SDL_SCANCODE_KP_COLON, - pattern SDL_SCANCODE_KP_HASH, - pattern SDL_SCANCODE_KP_SPACE, - pattern SDL_SCANCODE_KP_AT, - pattern SDL_SCANCODE_KP_EXCLAM, - pattern SDL_SCANCODE_KP_MEMSTORE, - pattern SDL_SCANCODE_KP_MEMRECALL, - pattern SDL_SCANCODE_KP_MEMCLEAR, - pattern SDL_SCANCODE_KP_MEMADD, - pattern SDL_SCANCODE_KP_MEMSUBTRACT, - pattern SDL_SCANCODE_KP_MEMMULTIPLY, - pattern SDL_SCANCODE_KP_MEMDIVIDE, - pattern SDL_SCANCODE_KP_PLUSMINUS, - pattern SDL_SCANCODE_KP_CLEAR, - pattern SDL_SCANCODE_KP_CLEARENTRY, - pattern SDL_SCANCODE_KP_BINARY, - pattern SDL_SCANCODE_KP_OCTAL, - pattern SDL_SCANCODE_KP_DECIMAL, - pattern SDL_SCANCODE_KP_HEXADECIMAL, - pattern SDL_SCANCODE_LCTRL, - pattern SDL_SCANCODE_LSHIFT, - pattern SDL_SCANCODE_LALT, - pattern SDL_SCANCODE_LGUI, - pattern SDL_SCANCODE_RCTRL, - pattern SDL_SCANCODE_RSHIFT, - pattern SDL_SCANCODE_RALT, - pattern SDL_SCANCODE_RGUI, - pattern SDL_SCANCODE_MODE, - pattern SDL_SCANCODE_AUDIONEXT, - pattern SDL_SCANCODE_AUDIOPREV, - pattern SDL_SCANCODE_AUDIOSTOP, - pattern SDL_SCANCODE_AUDIOPLAY, - pattern SDL_SCANCODE_AUDIOMUTE, - pattern SDL_SCANCODE_MEDIASELECT, - pattern SDL_SCANCODE_WWW, - pattern SDL_SCANCODE_MAIL, - pattern SDL_SCANCODE_CALCULATOR, - pattern SDL_SCANCODE_COMPUTER, - pattern SDL_SCANCODE_AC_SEARCH, - pattern SDL_SCANCODE_AC_HOME, - pattern SDL_SCANCODE_AC_BACK, - pattern SDL_SCANCODE_AC_FORWARD, - pattern SDL_SCANCODE_AC_STOP, - pattern SDL_SCANCODE_AC_REFRESH, - pattern SDL_SCANCODE_AC_BOOKMARKS, - pattern SDL_SCANCODE_BRIGHTNESSDOWN, - pattern SDL_SCANCODE_BRIGHTNESSUP, - pattern SDL_SCANCODE_DISPLAYSWITCH, - pattern SDL_SCANCODE_KBDILLUMTOGGLE, - pattern SDL_SCANCODE_KBDILLUMDOWN, - pattern SDL_SCANCODE_KBDILLUMUP, - pattern SDL_SCANCODE_EJECT, - pattern SDL_SCANCODE_SLEEP, - pattern SDL_SCANCODE_APP1, - pattern SDL_SCANCODE_APP2, - pattern SDL_NUM_SCANCODES, - - pattern SDL_SYSTEM_CURSOR_ARROW, - pattern SDL_SYSTEM_CURSOR_IBEAM, - pattern SDL_SYSTEM_CURSOR_WAIT, - - -- ** System Cursor - SystemCursor, - pattern SDL_SYSTEM_CURSOR_CROSSHAIR, - pattern SDL_SYSTEM_CURSOR_WAITARROW, - pattern SDL_SYSTEM_CURSOR_SIZENWSE, - pattern SDL_SYSTEM_CURSOR_SIZENESW, - pattern SDL_SYSTEM_CURSOR_SIZEWE, - pattern SDL_SYSTEM_CURSOR_SIZENS, - pattern SDL_SYSTEM_CURSOR_SIZEALL, - pattern SDL_SYSTEM_CURSOR_NO, - pattern SDL_SYSTEM_CURSOR_HAND, - pattern SDL_NUM_SYSTEM_CURSORS, - - -- ** Thread Priority - ThreadPriority, - pattern SDL_THREAD_PRIORITY_LOW, - pattern SDL_THREAD_PRIORITY_NORMAL, - pattern SDL_THREAD_PRIORITY_HIGH, - - -- * Miscellaneous Enumerations - -- | These enumerations are not used directly by any SDL function, thus they have a polymorphic type. - - -- ** Audio Allowed Changes - pattern SDL_AUDIO_ALLOW_FREQUENCY_CHANGE, - pattern SDL_AUDIO_ALLOW_FORMAT_CHANGE, - pattern SDL_AUDIO_ALLOW_CHANNELS_CHANGE, - pattern SDL_AUDIO_ALLOW_ANY_CHANGE, - - -- ** Mouse Buttons - pattern SDL_BUTTON_LEFT, - pattern SDL_BUTTON_MIDDLE, - pattern SDL_BUTTON_RIGHT, - pattern SDL_BUTTON_X1, - pattern SDL_BUTTON_X2, - - -- ** Mouse Button Masks - pattern SDL_BUTTON_LMASK, - pattern SDL_BUTTON_MMASK, - pattern SDL_BUTTON_RMASK, - pattern SDL_BUTTON_X1MASK, - pattern SDL_BUTTON_X2MASK, - - -- ** Event Type - pattern SDL_FIRSTEVENT, - pattern SDL_QUIT, - pattern SDL_APP_TERMINATING, - pattern SDL_APP_LOWMEMORY, - pattern SDL_APP_WILLENTERBACKGROUND, - pattern SDL_APP_DIDENTERBACKGROUND, - pattern SDL_APP_WILLENTERFOREGROUND, - pattern SDL_APP_DIDENTERFOREGROUND, - pattern SDL_WINDOWEVENT, - pattern SDL_SYSWMEVENT, - pattern SDL_KEYDOWN, - pattern SDL_KEYUP, - pattern SDL_TEXTEDITING, - pattern SDL_TEXTINPUT, - pattern SDL_MOUSEMOTION, - pattern SDL_MOUSEBUTTONDOWN, - pattern SDL_MOUSEBUTTONUP, - pattern SDL_MOUSEWHEEL, - pattern SDL_JOYAXISMOTION, - pattern SDL_JOYBALLMOTION, - pattern SDL_JOYHATMOTION, - pattern SDL_JOYBUTTONDOWN, - pattern SDL_JOYBUTTONUP, - pattern SDL_JOYDEVICEADDED, - pattern SDL_JOYDEVICEREMOVED, - pattern SDL_CONTROLLERAXISMOTION, - pattern SDL_CONTROLLERBUTTONDOWN, - pattern SDL_CONTROLLERBUTTONUP, - pattern SDL_CONTROLLERDEVICEADDED, - pattern SDL_CONTROLLERDEVICEREMOVED, - pattern SDL_CONTROLLERDEVICEREMAPPED, - pattern SDL_FINGERDOWN, - pattern SDL_FINGERUP, - pattern SDL_FINGERMOTION, - pattern SDL_DOLLARGESTURE, - pattern SDL_DOLLARRECORD, - pattern SDL_MULTIGESTURE, - pattern SDL_CLIPBOARDUPDATE, - pattern SDL_DROPFILE, - pattern SDL_USEREVENT, - pattern SDL_LASTEVENT, - - -- ** Joystick Hat Position - pattern SDL_HAT_CENTERED, - pattern SDL_HAT_UP, - pattern SDL_HAT_RIGHT, - pattern SDL_HAT_DOWN, - pattern SDL_HAT_LEFT, - pattern SDL_HAT_RIGHTUP, - pattern SDL_HAT_RIGHTDOWN, - pattern SDL_HAT_LEFTUP, - pattern SDL_HAT_LEFTDOWN, - - -- ** Key States - pattern SDL_PRESSED, - pattern SDL_RELEASED, - - -- ** Log Category - pattern SDL_LOG_CATEGORY_APPLICATION, - pattern SDL_LOG_CATEGORY_ERROR, - pattern SDL_LOG_CATEGORY_ASSERT, - pattern SDL_LOG_CATEGORY_SYSTEM, - pattern SDL_LOG_CATEGORY_AUDIO, - pattern SDL_LOG_CATEGORY_VIDEO, - pattern SDL_LOG_CATEGORY_RENDER, - pattern SDL_LOG_CATEGORY_INPUT, - pattern SDL_LOG_CATEGORY_TEST, - pattern SDL_LOG_CATEGORY_CUSTOM, - - -- ** Message Box Flags - pattern SDL_MESSAGEBOX_ERROR, - pattern SDL_MESSAGEBOX_WARNING, - pattern SDL_MESSAGEBOX_INFORMATION, - - -- ** Message Box Button Flags - pattern SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT, - pattern SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT, - - -- ** OpenGL Profile - pattern SDL_GL_CONTEXT_PROFILE_CORE, - pattern SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, - pattern SDL_GL_CONTEXT_PROFILE_ES, - - -- ** OpenGL Context Flag - pattern SDL_GL_CONTEXT_DEBUG_FLAG, - pattern SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG, - pattern SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG, - pattern SDL_GL_CONTEXT_RESET_ISOLATION_FLAG, - - -- ** Pixel Formats - pattern SDL_PIXELFORMAT_UNKNOWN, - pattern SDL_PIXELFORMAT_INDEX1LSB, - pattern SDL_PIXELFORMAT_INDEX1MSB, - pattern SDL_PIXELFORMAT_INDEX4LSB, - pattern SDL_PIXELFORMAT_INDEX4MSB, - pattern SDL_PIXELFORMAT_INDEX8, - pattern SDL_PIXELFORMAT_RGB332, - pattern SDL_PIXELFORMAT_RGB444, - pattern SDL_PIXELFORMAT_RGB555, - pattern SDL_PIXELFORMAT_BGR555, - pattern SDL_PIXELFORMAT_ARGB4444, - pattern SDL_PIXELFORMAT_RGBA4444, - pattern SDL_PIXELFORMAT_ABGR4444, - pattern SDL_PIXELFORMAT_BGRA4444, - pattern SDL_PIXELFORMAT_ARGB1555, - pattern SDL_PIXELFORMAT_RGBA5551, - pattern SDL_PIXELFORMAT_ABGR1555, - pattern SDL_PIXELFORMAT_BGRA5551, - pattern SDL_PIXELFORMAT_RGB565, - pattern SDL_PIXELFORMAT_BGR565, - pattern SDL_PIXELFORMAT_RGB24, - pattern SDL_PIXELFORMAT_BGR24, - pattern SDL_PIXELFORMAT_RGB888, - pattern SDL_PIXELFORMAT_RGBX8888, - pattern SDL_PIXELFORMAT_BGR888, - pattern SDL_PIXELFORMAT_BGRX8888, - pattern SDL_PIXELFORMAT_ARGB8888, - pattern SDL_PIXELFORMAT_RGBA8888, - pattern SDL_PIXELFORMAT_ABGR8888, - pattern SDL_PIXELFORMAT_BGRA8888, - pattern SDL_PIXELFORMAT_ARGB2101010, - pattern SDL_PIXELFORMAT_YV12, - pattern SDL_PIXELFORMAT_IYUV, - pattern SDL_PIXELFORMAT_YUY2, - pattern SDL_PIXELFORMAT_UYVY, - pattern SDL_PIXELFORMAT_YVYU, - - -- ** Renderer Flags - pattern SDL_RENDERER_SOFTWARE, - pattern SDL_RENDERER_ACCELERATED, - pattern SDL_RENDERER_PRESENTVSYNC, - pattern SDL_RENDERER_TARGETTEXTURE, - - -- ** Texture Access - pattern SDL_TEXTUREACCESS_STATIC, - pattern SDL_TEXTUREACCESS_STREAMING, - pattern SDL_TEXTUREACCESS_TARGET, - - -- ** Texture Modulate - pattern SDL_TEXTUREMODULATE_NONE, - pattern SDL_TEXTUREMODULATE_COLOR, - pattern SDL_TEXTUREMODULATE_ALPHA, - - -- ** Touch - pattern SDL_TOUCH_MOUSEID, - - -- ** Window Event - pattern SDL_WINDOWEVENT_NONE, - pattern SDL_WINDOWEVENT_SHOWN, - pattern SDL_WINDOWEVENT_HIDDEN, - pattern SDL_WINDOWEVENT_EXPOSED, - pattern SDL_WINDOWEVENT_MOVED, - pattern SDL_WINDOWEVENT_RESIZED, - pattern SDL_WINDOWEVENT_SIZE_CHANGED, - pattern SDL_WINDOWEVENT_MINIMIZED, - pattern SDL_WINDOWEVENT_MAXIMIZED, - pattern SDL_WINDOWEVENT_RESTORED, - pattern SDL_WINDOWEVENT_ENTER, - pattern SDL_WINDOWEVENT_LEAVE, - pattern SDL_WINDOWEVENT_FOCUS_GAINED, - pattern SDL_WINDOWEVENT_FOCUS_LOST, - pattern SDL_WINDOWEVENT_CLOSE, - - -- ** Window Flags - pattern SDL_WINDOW_FULLSCREEN, - pattern SDL_WINDOW_OPENGL, - pattern SDL_WINDOW_SHOWN, - pattern SDL_WINDOW_HIDDEN, - pattern SDL_WINDOW_BORDERLESS, - pattern SDL_WINDOW_RESIZABLE, - pattern SDL_WINDOW_MINIMIZED, - pattern SDL_WINDOW_MAXIMIZED, - pattern SDL_WINDOW_INPUT_GRABBED, - pattern SDL_WINDOW_INPUT_FOCUS, - pattern SDL_WINDOW_MOUSE_FOCUS, - pattern SDL_WINDOW_FULLSCREEN_DESKTOP, - pattern SDL_WINDOW_FOREIGN, - pattern SDL_WINDOW_ALLOW_HIGHDPI, - - -- ** Window Positioning - pattern SDL_WINDOWPOS_UNDEFINED, - pattern SDL_WINDOWPOS_CENTERED, - - -- ** Haptic Event Types - pattern SDL_HAPTIC_CONSTANT -) where - -#include "SDL.h" - -import Data.Int -import Data.Word - -import Foreign.C.Types - -type AudioFormat = (#type SDL_AudioFormat) -type AudioStatus = (#type SDL_AudioStatus) -type BlendMode = (#type SDL_BlendMode) -type Endian = CInt -type EventAction = (#type SDL_eventaction) -type GameControllerAxis = (#type SDL_GameControllerAxis) -type GameControllerButton = (#type SDL_GameControllerButton) -type GLattr = (#type SDL_GLattr) -type HintPriority = (#type SDL_HintPriority) -type InitFlag = Word32 -type Keycode = (#type SDL_Keycode) -type Keymod = (#type SDL_Keymod) -type LogPriority = (#type SDL_LogPriority) -type PowerState = (#type SDL_PowerState) -type RendererFlip = (#type SDL_RendererFlip) -type Scancode = (#type SDL_Scancode) -type SystemCursor = (#type SDL_SystemCursor) -type ThreadPriority = (#type SDL_ThreadPriority) - -pattern SDL_AUDIO_S8 = (#const AUDIO_S8) :: AudioFormat -pattern SDL_AUDIO_U8 = (#const AUDIO_U8) :: AudioFormat -pattern SDL_AUDIO_S16LSB = (#const AUDIO_S16LSB) :: AudioFormat -pattern SDL_AUDIO_S16MSB = (#const AUDIO_S16MSB) :: AudioFormat -pattern SDL_AUDIO_S16SYS = (#const AUDIO_S16SYS) :: AudioFormat -pattern SDL_AUDIO_U16LSB = (#const AUDIO_U16LSB) :: AudioFormat -pattern SDL_AUDIO_U16MSB = (#const AUDIO_U16MSB) :: AudioFormat -pattern SDL_AUDIO_U16SYS = (#const AUDIO_U16SYS) :: AudioFormat -pattern SDL_AUDIO_S32LSB = (#const AUDIO_S32LSB) :: AudioFormat -pattern SDL_AUDIO_S32MSB = (#const AUDIO_S32MSB) :: AudioFormat -pattern SDL_AUDIO_S32SYS = (#const AUDIO_S32SYS) :: AudioFormat -pattern SDL_AUDIO_F32LSB = (#const AUDIO_F32LSB) :: AudioFormat -pattern SDL_AUDIO_F32MSB = (#const AUDIO_F32MSB) :: AudioFormat -pattern SDL_AUDIO_F32SYS = (#const AUDIO_F32SYS) :: AudioFormat - -pattern SDL_AUDIO_STOPPED = (#const SDL_AUDIO_STOPPED) :: AudioStatus -pattern SDL_AUDIO_PLAYING = (#const SDL_AUDIO_PLAYING) :: AudioStatus -pattern SDL_AUDIO_PAUSED = (#const SDL_AUDIO_PAUSED) :: AudioStatus - -pattern SDL_BLENDMODE_NONE = (#const SDL_BLENDMODE_NONE) :: BlendMode -pattern SDL_BLENDMODE_BLEND = (#const SDL_BLENDMODE_BLEND) :: BlendMode -pattern SDL_BLENDMODE_ADD = (#const SDL_BLENDMODE_ADD) :: BlendMode -pattern SDL_BLENDMODE_MOD = (#const SDL_BLENDMODE_MOD) :: BlendMode - -pattern SDL_BYTEORDER = (#const SDL_BYTEORDER) :: Endian -pattern SDL_LIL_ENDIAN = (#const SDL_LIL_ENDIAN) :: Endian -pattern SDL_BIG_ENDIAN = (#const SDL_BIG_ENDIAN) :: Endian - -pattern SDL_ADDEVENT = (#const SDL_ADDEVENT) :: EventAction -pattern SDL_PEEKEVENT = (#const SDL_PEEKEVENT) :: EventAction -pattern SDL_GETEVENT = (#const SDL_GETEVENT) :: EventAction - -pattern SDL_CONTROLLER_AXIS_INVALID = (#const SDL_CONTROLLER_AXIS_INVALID) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_LEFTX = (#const SDL_CONTROLLER_AXIS_LEFTX) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_LEFTY = (#const SDL_CONTROLLER_AXIS_LEFTY) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_RIGHTX = (#const SDL_CONTROLLER_AXIS_RIGHTX) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_RIGHTY = (#const SDL_CONTROLLER_AXIS_RIGHTY) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_TRIGGERLEFT = (#const SDL_CONTROLLER_AXIS_TRIGGERLEFT) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_TRIGGERRIGHT = (#const SDL_CONTROLLER_AXIS_TRIGGERRIGHT) :: GameControllerAxis -pattern SDL_CONTROLLER_AXIS_MAX = (#const SDL_CONTROLLER_AXIS_MAX) :: GameControllerAxis - -pattern SDL_CONTROLLER_BUTTON_INVALID = (#const SDL_CONTROLLER_BUTTON_INVALID) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_A = (#const SDL_CONTROLLER_BUTTON_A) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_B = (#const SDL_CONTROLLER_BUTTON_B) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_X = (#const SDL_CONTROLLER_BUTTON_X) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_Y = (#const SDL_CONTROLLER_BUTTON_Y) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_BACK = (#const SDL_CONTROLLER_BUTTON_BACK) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_GUIDE = (#const SDL_CONTROLLER_BUTTON_GUIDE) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_START = (#const SDL_CONTROLLER_BUTTON_START) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_LEFTSTICK = (#const SDL_CONTROLLER_BUTTON_LEFTSTICK) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_RIGHTSTICK = (#const SDL_CONTROLLER_BUTTON_RIGHTSTICK) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_LEFTSHOULDER = (#const SDL_CONTROLLER_BUTTON_LEFTSHOULDER) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_RIGHTSHOULDER = (#const SDL_CONTROLLER_BUTTON_RIGHTSHOULDER) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_DPAD_UP = (#const SDL_CONTROLLER_BUTTON_DPAD_UP) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_DPAD_DOWN = (#const SDL_CONTROLLER_BUTTON_DPAD_DOWN) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_DPAD_LEFT = (#const SDL_CONTROLLER_BUTTON_DPAD_LEFT) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_DPAD_RIGHT = (#const SDL_CONTROLLER_BUTTON_DPAD_RIGHT) :: GameControllerButton -pattern SDL_CONTROLLER_BUTTON_MAX = (#const SDL_CONTROLLER_BUTTON_MAX) :: GameControllerButton - -pattern SDL_GL_RED_SIZE = (#const SDL_GL_RED_SIZE) :: GLattr -pattern SDL_GL_GREEN_SIZE = (#const SDL_GL_GREEN_SIZE) :: GLattr -pattern SDL_GL_BLUE_SIZE = (#const SDL_GL_BLUE_SIZE) :: GLattr -pattern SDL_GL_ALPHA_SIZE = (#const SDL_GL_ALPHA_SIZE) :: GLattr -pattern SDL_GL_BUFFER_SIZE = (#const SDL_GL_BUFFER_SIZE) :: GLattr -pattern SDL_GL_DOUBLEBUFFER = (#const SDL_GL_DOUBLEBUFFER) :: GLattr -pattern SDL_GL_DEPTH_SIZE = (#const SDL_GL_DEPTH_SIZE) :: GLattr -pattern SDL_GL_STENCIL_SIZE = (#const SDL_GL_STENCIL_SIZE) :: GLattr -pattern SDL_GL_ACCUM_RED_SIZE = (#const SDL_GL_ACCUM_RED_SIZE) :: GLattr -pattern SDL_GL_ACCUM_GREEN_SIZE = (#const SDL_GL_ACCUM_GREEN_SIZE) :: GLattr -pattern SDL_GL_ACCUM_BLUE_SIZE = (#const SDL_GL_ACCUM_BLUE_SIZE) :: GLattr -pattern SDL_GL_ACCUM_ALPHA_SIZE = (#const SDL_GL_ACCUM_ALPHA_SIZE) :: GLattr -pattern SDL_GL_STEREO = (#const SDL_GL_STEREO) :: GLattr -pattern SDL_GL_MULTISAMPLEBUFFERS = (#const SDL_GL_MULTISAMPLEBUFFERS) :: GLattr -pattern SDL_GL_MULTISAMPLESAMPLES = (#const SDL_GL_MULTISAMPLESAMPLES) :: GLattr -pattern SDL_GL_ACCELERATED_VISUAL = (#const SDL_GL_ACCELERATED_VISUAL) :: GLattr -pattern SDL_GL_RETAINED_BACKING = (#const SDL_GL_RETAINED_BACKING) :: GLattr -pattern SDL_GL_CONTEXT_MAJOR_VERSION = (#const SDL_GL_CONTEXT_MAJOR_VERSION) :: GLattr -pattern SDL_GL_CONTEXT_MINOR_VERSION = (#const SDL_GL_CONTEXT_MINOR_VERSION) :: GLattr -pattern SDL_GL_CONTEXT_EGL = (#const SDL_GL_CONTEXT_EGL) :: GLattr -pattern SDL_GL_CONTEXT_FLAGS = (#const SDL_GL_CONTEXT_FLAGS) :: GLattr -pattern SDL_GL_CONTEXT_PROFILE_MASK = (#const SDL_GL_CONTEXT_PROFILE_MASK) :: GLattr -pattern SDL_GL_SHARE_WITH_CURRENT_CONTEXT = (#const SDL_GL_SHARE_WITH_CURRENT_CONTEXT) :: GLattr -pattern SDL_GL_FRAMEBUFFER_SRGB_CAPABLE = (#const SDL_GL_FRAMEBUFFER_SRGB_CAPABLE) :: GLattr - -pattern SDL_HINT_DEFAULT = (#const SDL_HINT_DEFAULT) :: HintPriority -pattern SDL_HINT_NORMAL = (#const SDL_HINT_NORMAL) :: HintPriority -pattern SDL_HINT_OVERRIDE = (#const SDL_HINT_OVERRIDE) :: HintPriority - -pattern SDL_INIT_TIMER = (#const SDL_INIT_TIMER) :: InitFlag -pattern SDL_INIT_AUDIO = (#const SDL_INIT_AUDIO) :: InitFlag -pattern SDL_INIT_VIDEO = (#const SDL_INIT_VIDEO) :: InitFlag -pattern SDL_INIT_JOYSTICK = (#const SDL_INIT_JOYSTICK) :: InitFlag -pattern SDL_INIT_HAPTIC = (#const SDL_INIT_HAPTIC) :: InitFlag -pattern SDL_INIT_GAMECONTROLLER = (#const SDL_INIT_GAMECONTROLLER) :: InitFlag -pattern SDL_INIT_EVENTS = (#const SDL_INIT_EVENTS) :: InitFlag -pattern SDL_INIT_NOPARACHUTE = (#const SDL_INIT_NOPARACHUTE) :: InitFlag -pattern SDL_INIT_EVERYTHING = (#const SDL_INIT_EVERYTHING) :: InitFlag - -pattern SDLK_UNKNOWN = (#const SDLK_UNKNOWN) :: Keycode -pattern SDLK_RETURN = (#const SDLK_RETURN) :: Keycode -pattern SDLK_ESCAPE = (#const SDLK_ESCAPE) :: Keycode -pattern SDLK_BACKSPACE = (#const SDLK_BACKSPACE) :: Keycode -pattern SDLK_TAB = (#const SDLK_TAB) :: Keycode -pattern SDLK_SPACE = (#const SDLK_SPACE) :: Keycode -pattern SDLK_EXCLAIM = (#const SDLK_EXCLAIM) :: Keycode -pattern SDLK_QUOTEDBL = (#const SDLK_QUOTEDBL) :: Keycode -pattern SDLK_HASH = (#const SDLK_HASH) :: Keycode -pattern SDLK_PERCENT = (#const SDLK_PERCENT) :: Keycode -pattern SDLK_DOLLAR = (#const SDLK_DOLLAR) :: Keycode -pattern SDLK_AMPERSAND = (#const SDLK_AMPERSAND) :: Keycode -pattern SDLK_QUOTE = (#const SDLK_QUOTE) :: Keycode -pattern SDLK_LEFTPAREN = (#const SDLK_LEFTPAREN) :: Keycode -pattern SDLK_RIGHTPAREN = (#const SDLK_RIGHTPAREN) :: Keycode -pattern SDLK_ASTERISK = (#const SDLK_ASTERISK) :: Keycode -pattern SDLK_PLUS = (#const SDLK_PLUS) :: Keycode -pattern SDLK_COMMA = (#const SDLK_COMMA) :: Keycode -pattern SDLK_MINUS = (#const SDLK_MINUS) :: Keycode -pattern SDLK_PERIOD = (#const SDLK_PERIOD) :: Keycode -pattern SDLK_SLASH = (#const SDLK_SLASH) :: Keycode -pattern SDLK_0 = (#const SDLK_0) :: Keycode -pattern SDLK_1 = (#const SDLK_1) :: Keycode -pattern SDLK_2 = (#const SDLK_2) :: Keycode -pattern SDLK_3 = (#const SDLK_3) :: Keycode -pattern SDLK_4 = (#const SDLK_4) :: Keycode -pattern SDLK_5 = (#const SDLK_5) :: Keycode -pattern SDLK_6 = (#const SDLK_6) :: Keycode -pattern SDLK_7 = (#const SDLK_7) :: Keycode -pattern SDLK_8 = (#const SDLK_8) :: Keycode -pattern SDLK_9 = (#const SDLK_9) :: Keycode -pattern SDLK_COLON = (#const SDLK_COLON) :: Keycode -pattern SDLK_SEMICOLON = (#const SDLK_SEMICOLON) :: Keycode -pattern SDLK_LESS = (#const SDLK_LESS) :: Keycode -pattern SDLK_EQUALS = (#const SDLK_EQUALS) :: Keycode -pattern SDLK_GREATER = (#const SDLK_GREATER) :: Keycode -pattern SDLK_QUESTION = (#const SDLK_QUESTION) :: Keycode -pattern SDLK_AT = (#const SDLK_AT) :: Keycode -pattern SDLK_LEFTBRACKET = (#const SDLK_LEFTBRACKET) :: Keycode -pattern SDLK_BACKSLASH = (#const SDLK_BACKSLASH) :: Keycode -pattern SDLK_RIGHTBRACKET = (#const SDLK_RIGHTBRACKET) :: Keycode -pattern SDLK_CARET = (#const SDLK_CARET) :: Keycode -pattern SDLK_UNDERSCORE = (#const SDLK_UNDERSCORE) :: Keycode -pattern SDLK_BACKQUOTE = (#const SDLK_BACKQUOTE) :: Keycode -pattern SDLK_a = (#const SDLK_a) :: Keycode -pattern SDLK_b = (#const SDLK_b) :: Keycode -pattern SDLK_c = (#const SDLK_c) :: Keycode -pattern SDLK_d = (#const SDLK_d) :: Keycode -pattern SDLK_e = (#const SDLK_e) :: Keycode -pattern SDLK_f = (#const SDLK_f) :: Keycode -pattern SDLK_g = (#const SDLK_g) :: Keycode -pattern SDLK_h = (#const SDLK_h) :: Keycode -pattern SDLK_i = (#const SDLK_i) :: Keycode -pattern SDLK_j = (#const SDLK_j) :: Keycode -pattern SDLK_k = (#const SDLK_k) :: Keycode -pattern SDLK_l = (#const SDLK_l) :: Keycode -pattern SDLK_m = (#const SDLK_m) :: Keycode -pattern SDLK_n = (#const SDLK_n) :: Keycode -pattern SDLK_o = (#const SDLK_o) :: Keycode -pattern SDLK_p = (#const SDLK_p) :: Keycode -pattern SDLK_q = (#const SDLK_q) :: Keycode -pattern SDLK_r = (#const SDLK_r) :: Keycode -pattern SDLK_s = (#const SDLK_s) :: Keycode -pattern SDLK_t = (#const SDLK_t) :: Keycode -pattern SDLK_u = (#const SDLK_u) :: Keycode -pattern SDLK_v = (#const SDLK_v) :: Keycode -pattern SDLK_w = (#const SDLK_w) :: Keycode -pattern SDLK_x = (#const SDLK_x) :: Keycode -pattern SDLK_y = (#const SDLK_y) :: Keycode -pattern SDLK_z = (#const SDLK_z) :: Keycode -pattern SDLK_CAPSLOCK = (#const SDLK_CAPSLOCK) :: Keycode -pattern SDLK_F1 = (#const SDLK_F1) :: Keycode -pattern SDLK_F2 = (#const SDLK_F2) :: Keycode -pattern SDLK_F3 = (#const SDLK_F3) :: Keycode -pattern SDLK_F4 = (#const SDLK_F4) :: Keycode -pattern SDLK_F5 = (#const SDLK_F5) :: Keycode -pattern SDLK_F6 = (#const SDLK_F6) :: Keycode -pattern SDLK_F7 = (#const SDLK_F7) :: Keycode -pattern SDLK_F8 = (#const SDLK_F8) :: Keycode -pattern SDLK_F9 = (#const SDLK_F9) :: Keycode -pattern SDLK_F10 = (#const SDLK_F10) :: Keycode -pattern SDLK_F11 = (#const SDLK_F11) :: Keycode -pattern SDLK_F12 = (#const SDLK_F12) :: Keycode -pattern SDLK_PRINTSCREEN = (#const SDLK_PRINTSCREEN) :: Keycode -pattern SDLK_SCROLLLOCK = (#const SDLK_SCROLLLOCK) :: Keycode -pattern SDLK_PAUSE = (#const SDLK_PAUSE) :: Keycode -pattern SDLK_INSERT = (#const SDLK_INSERT) :: Keycode -pattern SDLK_HOME = (#const SDLK_HOME) :: Keycode -pattern SDLK_PAGEUP = (#const SDLK_PAGEUP) :: Keycode -pattern SDLK_DELETE = (#const SDLK_DELETE) :: Keycode -pattern SDLK_END = (#const SDLK_END) :: Keycode -pattern SDLK_PAGEDOWN = (#const SDLK_PAGEDOWN) :: Keycode -pattern SDLK_RIGHT = (#const SDLK_RIGHT) :: Keycode -pattern SDLK_LEFT = (#const SDLK_LEFT) :: Keycode -pattern SDLK_DOWN = (#const SDLK_DOWN) :: Keycode -pattern SDLK_UP = (#const SDLK_UP) :: Keycode -pattern SDLK_NUMLOCKCLEAR = (#const SDLK_NUMLOCKCLEAR) :: Keycode -pattern SDLK_KP_DIVIDE = (#const SDLK_KP_DIVIDE) :: Keycode -pattern SDLK_KP_MULTIPLY = (#const SDLK_KP_MULTIPLY) :: Keycode -pattern SDLK_KP_MINUS = (#const SDLK_KP_MINUS) :: Keycode -pattern SDLK_KP_PLUS = (#const SDLK_KP_PLUS) :: Keycode -pattern SDLK_KP_ENTER = (#const SDLK_KP_ENTER) :: Keycode -pattern SDLK_KP_1 = (#const SDLK_KP_1) :: Keycode -pattern SDLK_KP_2 = (#const SDLK_KP_2) :: Keycode -pattern SDLK_KP_3 = (#const SDLK_KP_3) :: Keycode -pattern SDLK_KP_4 = (#const SDLK_KP_4) :: Keycode -pattern SDLK_KP_5 = (#const SDLK_KP_5) :: Keycode -pattern SDLK_KP_6 = (#const SDLK_KP_6) :: Keycode -pattern SDLK_KP_7 = (#const SDLK_KP_7) :: Keycode -pattern SDLK_KP_8 = (#const SDLK_KP_8) :: Keycode -pattern SDLK_KP_9 = (#const SDLK_KP_9) :: Keycode -pattern SDLK_KP_0 = (#const SDLK_KP_0) :: Keycode -pattern SDLK_KP_PERIOD = (#const SDLK_KP_PERIOD) :: Keycode -pattern SDLK_APPLICATION = (#const SDLK_APPLICATION) :: Keycode -pattern SDLK_POWER = (#const SDLK_POWER) :: Keycode -pattern SDLK_KP_EQUALS = (#const SDLK_KP_EQUALS) :: Keycode -pattern SDLK_F13 = (#const SDLK_F13) :: Keycode -pattern SDLK_F14 = (#const SDLK_F14) :: Keycode -pattern SDLK_F15 = (#const SDLK_F15) :: Keycode -pattern SDLK_F16 = (#const SDLK_F16) :: Keycode -pattern SDLK_F17 = (#const SDLK_F17) :: Keycode -pattern SDLK_F18 = (#const SDLK_F18) :: Keycode -pattern SDLK_F19 = (#const SDLK_F19) :: Keycode -pattern SDLK_F20 = (#const SDLK_F20) :: Keycode -pattern SDLK_F21 = (#const SDLK_F21) :: Keycode -pattern SDLK_F22 = (#const SDLK_F22) :: Keycode -pattern SDLK_F23 = (#const SDLK_F23) :: Keycode -pattern SDLK_F24 = (#const SDLK_F24) :: Keycode -pattern SDLK_EXECUTE = (#const SDLK_EXECUTE) :: Keycode -pattern SDLK_HELP = (#const SDLK_HELP) :: Keycode -pattern SDLK_MENU = (#const SDLK_MENU) :: Keycode -pattern SDLK_SELECT = (#const SDLK_SELECT) :: Keycode -pattern SDLK_STOP = (#const SDLK_STOP) :: Keycode -pattern SDLK_AGAIN = (#const SDLK_AGAIN) :: Keycode -pattern SDLK_UNDO = (#const SDLK_UNDO) :: Keycode -pattern SDLK_CUT = (#const SDLK_CUT) :: Keycode -pattern SDLK_COPY = (#const SDLK_COPY) :: Keycode -pattern SDLK_PASTE = (#const SDLK_PASTE) :: Keycode -pattern SDLK_FIND = (#const SDLK_FIND) :: Keycode -pattern SDLK_MUTE = (#const SDLK_MUTE) :: Keycode -pattern SDLK_VOLUMEUP = (#const SDLK_VOLUMEUP) :: Keycode -pattern SDLK_VOLUMEDOWN = (#const SDLK_VOLUMEDOWN) :: Keycode -pattern SDLK_KP_COMMA = (#const SDLK_KP_COMMA) :: Keycode -pattern SDLK_KP_EQUALSAS400 = (#const SDLK_KP_EQUALSAS400) :: Keycode -pattern SDLK_ALTERASE = (#const SDLK_ALTERASE) :: Keycode -pattern SDLK_SYSREQ = (#const SDLK_SYSREQ) :: Keycode -pattern SDLK_CANCEL = (#const SDLK_CANCEL) :: Keycode -pattern SDLK_CLEAR = (#const SDLK_CLEAR) :: Keycode -pattern SDLK_PRIOR = (#const SDLK_PRIOR) :: Keycode -pattern SDLK_RETURN2 = (#const SDLK_RETURN2) :: Keycode -pattern SDLK_SEPARATOR = (#const SDLK_SEPARATOR) :: Keycode -pattern SDLK_OUT = (#const SDLK_OUT) :: Keycode -pattern SDLK_OPER = (#const SDLK_OPER) :: Keycode -pattern SDLK_CLEARAGAIN = (#const SDLK_CLEARAGAIN) :: Keycode -pattern SDLK_CRSEL = (#const SDLK_CRSEL) :: Keycode -pattern SDLK_EXSEL = (#const SDLK_EXSEL) :: Keycode -pattern SDLK_KP_00 = (#const SDLK_KP_00) :: Keycode -pattern SDLK_KP_000 = (#const SDLK_KP_000) :: Keycode -pattern SDLK_THOUSANDSSEPARATOR = (#const SDLK_THOUSANDSSEPARATOR) :: Keycode -pattern SDLK_DECIMALSEPARATOR = (#const SDLK_DECIMALSEPARATOR) :: Keycode -pattern SDLK_CURRENCYUNIT = (#const SDLK_CURRENCYUNIT) :: Keycode -pattern SDLK_CURRENCYSUBUNIT = (#const SDLK_CURRENCYSUBUNIT) :: Keycode -pattern SDLK_KP_LEFTPAREN = (#const SDLK_KP_LEFTPAREN) :: Keycode -pattern SDLK_KP_RIGHTPAREN = (#const SDLK_KP_RIGHTPAREN) :: Keycode -pattern SDLK_KP_LEFTBRACE = (#const SDLK_KP_LEFTBRACE) :: Keycode -pattern SDLK_KP_RIGHTBRACE = (#const SDLK_KP_RIGHTBRACE) :: Keycode -pattern SDLK_KP_TAB = (#const SDLK_KP_TAB) :: Keycode -pattern SDLK_KP_BACKSPACE = (#const SDLK_KP_BACKSPACE) :: Keycode -pattern SDLK_KP_A = (#const SDLK_KP_A) :: Keycode -pattern SDLK_KP_B = (#const SDLK_KP_B) :: Keycode -pattern SDLK_KP_C = (#const SDLK_KP_C) :: Keycode -pattern SDLK_KP_D = (#const SDLK_KP_D) :: Keycode -pattern SDLK_KP_E = (#const SDLK_KP_E) :: Keycode -pattern SDLK_KP_F = (#const SDLK_KP_F) :: Keycode -pattern SDLK_KP_XOR = (#const SDLK_KP_XOR) :: Keycode -pattern SDLK_KP_POWER = (#const SDLK_KP_POWER) :: Keycode -pattern SDLK_KP_PERCENT = (#const SDLK_KP_PERCENT) :: Keycode -pattern SDLK_KP_LESS = (#const SDLK_KP_LESS) :: Keycode -pattern SDLK_KP_GREATER = (#const SDLK_KP_GREATER) :: Keycode -pattern SDLK_KP_AMPERSAND = (#const SDLK_KP_AMPERSAND) :: Keycode -pattern SDLK_KP_DBLAMPERSAND = (#const SDLK_KP_DBLAMPERSAND) :: Keycode -pattern SDLK_KP_VERTICALBAR = (#const SDLK_KP_VERTICALBAR) :: Keycode -pattern SDLK_KP_DBLVERTICALBAR = (#const SDLK_KP_DBLVERTICALBAR) :: Keycode -pattern SDLK_KP_COLON = (#const SDLK_KP_COLON) :: Keycode -pattern SDLK_KP_HASH = (#const SDLK_KP_HASH) :: Keycode -pattern SDLK_KP_SPACE = (#const SDLK_KP_SPACE) :: Keycode -pattern SDLK_KP_AT = (#const SDLK_KP_AT) :: Keycode -pattern SDLK_KP_EXCLAM = (#const SDLK_KP_EXCLAM) :: Keycode -pattern SDLK_KP_MEMSTORE = (#const SDLK_KP_MEMSTORE) :: Keycode -pattern SDLK_KP_MEMRECALL = (#const SDLK_KP_MEMRECALL) :: Keycode -pattern SDLK_KP_MEMCLEAR = (#const SDLK_KP_MEMCLEAR) :: Keycode -pattern SDLK_KP_MEMADD = (#const SDLK_KP_MEMADD) :: Keycode -pattern SDLK_KP_MEMSUBTRACT = (#const SDLK_KP_MEMSUBTRACT) :: Keycode -pattern SDLK_KP_MEMMULTIPLY = (#const SDLK_KP_MEMMULTIPLY) :: Keycode -pattern SDLK_KP_MEMDIVIDE = (#const SDLK_KP_MEMDIVIDE) :: Keycode -pattern SDLK_KP_PLUSMINUS = (#const SDLK_KP_PLUSMINUS) :: Keycode -pattern SDLK_KP_CLEAR = (#const SDLK_KP_CLEAR) :: Keycode -pattern SDLK_KP_CLEARENTRY = (#const SDLK_KP_CLEARENTRY) :: Keycode -pattern SDLK_KP_BINARY = (#const SDLK_KP_BINARY) :: Keycode -pattern SDLK_KP_OCTAL = (#const SDLK_KP_OCTAL) :: Keycode -pattern SDLK_KP_DECIMAL = (#const SDLK_KP_DECIMAL) :: Keycode -pattern SDLK_KP_HEXADECIMAL = (#const SDLK_KP_HEXADECIMAL) :: Keycode -pattern SDLK_LCTRL = (#const SDLK_LCTRL) :: Keycode -pattern SDLK_LSHIFT = (#const SDLK_LSHIFT) :: Keycode -pattern SDLK_LALT = (#const SDLK_LALT) :: Keycode -pattern SDLK_LGUI = (#const SDLK_LGUI) :: Keycode -pattern SDLK_RCTRL = (#const SDLK_RCTRL) :: Keycode -pattern SDLK_RSHIFT = (#const SDLK_RSHIFT) :: Keycode -pattern SDLK_RALT = (#const SDLK_RALT) :: Keycode -pattern SDLK_RGUI = (#const SDLK_RGUI) :: Keycode -pattern SDLK_MODE = (#const SDLK_MODE) :: Keycode -pattern SDLK_AUDIONEXT = (#const SDLK_AUDIONEXT) :: Keycode -pattern SDLK_AUDIOPREV = (#const SDLK_AUDIOPREV) :: Keycode -pattern SDLK_AUDIOSTOP = (#const SDLK_AUDIOSTOP) :: Keycode -pattern SDLK_AUDIOPLAY = (#const SDLK_AUDIOPLAY) :: Keycode -pattern SDLK_AUDIOMUTE = (#const SDLK_AUDIOMUTE) :: Keycode -pattern SDLK_MEDIASELECT = (#const SDLK_MEDIASELECT) :: Keycode -pattern SDLK_WWW = (#const SDLK_WWW) :: Keycode -pattern SDLK_MAIL = (#const SDLK_MAIL) :: Keycode -pattern SDLK_CALCULATOR = (#const SDLK_CALCULATOR) :: Keycode -pattern SDLK_COMPUTER = (#const SDLK_COMPUTER) :: Keycode -pattern SDLK_AC_SEARCH = (#const SDLK_AC_SEARCH) :: Keycode -pattern SDLK_AC_HOME = (#const SDLK_AC_HOME) :: Keycode -pattern SDLK_AC_BACK = (#const SDLK_AC_BACK) :: Keycode -pattern SDLK_AC_FORWARD = (#const SDLK_AC_FORWARD) :: Keycode -pattern SDLK_AC_STOP = (#const SDLK_AC_STOP) :: Keycode -pattern SDLK_AC_REFRESH = (#const SDLK_AC_REFRESH) :: Keycode -pattern SDLK_AC_BOOKMARKS = (#const SDLK_AC_BOOKMARKS) :: Keycode -pattern SDLK_BRIGHTNESSDOWN = (#const SDLK_BRIGHTNESSDOWN) :: Keycode -pattern SDLK_BRIGHTNESSUP = (#const SDLK_BRIGHTNESSUP) :: Keycode -pattern SDLK_DISPLAYSWITCH = (#const SDLK_DISPLAYSWITCH) :: Keycode -pattern SDLK_KBDILLUMTOGGLE = (#const SDLK_KBDILLUMTOGGLE) :: Keycode -pattern SDLK_KBDILLUMDOWN = (#const SDLK_KBDILLUMDOWN) :: Keycode -pattern SDLK_KBDILLUMUP = (#const SDLK_KBDILLUMUP) :: Keycode -pattern SDLK_EJECT = (#const SDLK_EJECT) :: Keycode -pattern SDLK_SLEEP = (#const SDLK_SLEEP) :: Keycode - -pattern KMOD_NONE = (#const KMOD_NONE) -pattern KMOD_LSHIFT = (#const KMOD_LSHIFT) -pattern KMOD_RSHIFT = (#const KMOD_RSHIFT) -pattern KMOD_SHIFT = (#const KMOD_SHIFT) -pattern KMOD_LCTRL = (#const KMOD_LCTRL) -pattern KMOD_RCTRL = (#const KMOD_RCTRL) -pattern KMOD_CTRL = (#const KMOD_CTRL) -pattern KMOD_LALT = (#const KMOD_LALT) -pattern KMOD_RALT = (#const KMOD_RALT) -pattern KMOD_ALT = (#const KMOD_ALT) -pattern KMOD_LGUI = (#const KMOD_LGUI) -pattern KMOD_RGUI = (#const KMOD_RGUI) -pattern KMOD_GUI = (#const KMOD_GUI) -pattern KMOD_NUM = (#const KMOD_NUM) -pattern KMOD_CAPS = (#const KMOD_CAPS) -pattern KMOD_MODE = (#const KMOD_MODE) -pattern KMOD_RESERVED = (#const KMOD_RESERVED) - -pattern SDL_LOG_PRIORITY_VERBOSE = (#const SDL_LOG_PRIORITY_VERBOSE) :: LogPriority -pattern SDL_LOG_PRIORITY_DEBUG = (#const SDL_LOG_PRIORITY_DEBUG) :: LogPriority -pattern SDL_LOG_PRIORITY_INFO = (#const SDL_LOG_PRIORITY_INFO) :: LogPriority -pattern SDL_LOG_PRIORITY_WARN = (#const SDL_LOG_PRIORITY_WARN) :: LogPriority -pattern SDL_LOG_PRIORITY_ERROR = (#const SDL_LOG_PRIORITY_ERROR) :: LogPriority -pattern SDL_LOG_PRIORITY_CRITICAL = (#const SDL_LOG_PRIORITY_CRITICAL) :: LogPriority -pattern SDL_NUM_LOG_PRIORITIES = (#const SDL_NUM_LOG_PRIORITIES) :: LogPriority - -pattern SDL_POWERSTATE_UNKNOWN = (#const SDL_POWERSTATE_UNKNOWN) :: PowerState -pattern SDL_POWERSTATE_ON_BATTERY = (#const SDL_POWERSTATE_ON_BATTERY) :: PowerState -pattern SDL_POWERSTATE_NO_BATTERY = (#const SDL_POWERSTATE_NO_BATTERY) :: PowerState -pattern SDL_POWERSTATE_CHARGING = (#const SDL_POWERSTATE_CHARGING) :: PowerState -pattern SDL_POWERSTATE_CHARGED = (#const SDL_POWERSTATE_CHARGED) :: PowerState - -pattern SDL_FLIP_NONE = (#const SDL_FLIP_NONE) :: RendererFlip -pattern SDL_FLIP_HORIZONTAL = (#const SDL_FLIP_HORIZONTAL) :: RendererFlip -pattern SDL_FLIP_VERTICAL = (#const SDL_FLIP_VERTICAL) :: RendererFlip - -pattern SDL_SCANCODE_UNKNOWN = (#const SDL_SCANCODE_UNKNOWN) :: Scancode -pattern SDL_SCANCODE_A = (#const SDL_SCANCODE_A) :: Scancode -pattern SDL_SCANCODE_B = (#const SDL_SCANCODE_B) :: Scancode -pattern SDL_SCANCODE_C = (#const SDL_SCANCODE_C) :: Scancode -pattern SDL_SCANCODE_D = (#const SDL_SCANCODE_D) :: Scancode -pattern SDL_SCANCODE_E = (#const SDL_SCANCODE_E) :: Scancode -pattern SDL_SCANCODE_F = (#const SDL_SCANCODE_F) :: Scancode -pattern SDL_SCANCODE_G = (#const SDL_SCANCODE_G) :: Scancode -pattern SDL_SCANCODE_H = (#const SDL_SCANCODE_H) :: Scancode -pattern SDL_SCANCODE_I = (#const SDL_SCANCODE_I) :: Scancode -pattern SDL_SCANCODE_J = (#const SDL_SCANCODE_J) :: Scancode -pattern SDL_SCANCODE_K = (#const SDL_SCANCODE_K) :: Scancode -pattern SDL_SCANCODE_L = (#const SDL_SCANCODE_L) :: Scancode -pattern SDL_SCANCODE_M = (#const SDL_SCANCODE_M) :: Scancode -pattern SDL_SCANCODE_N = (#const SDL_SCANCODE_N) :: Scancode -pattern SDL_SCANCODE_O = (#const SDL_SCANCODE_O) :: Scancode -pattern SDL_SCANCODE_P = (#const SDL_SCANCODE_P) :: Scancode -pattern SDL_SCANCODE_Q = (#const SDL_SCANCODE_Q) :: Scancode -pattern SDL_SCANCODE_R = (#const SDL_SCANCODE_R) :: Scancode -pattern SDL_SCANCODE_S = (#const SDL_SCANCODE_S) :: Scancode -pattern SDL_SCANCODE_T = (#const SDL_SCANCODE_T) :: Scancode -pattern SDL_SCANCODE_U = (#const SDL_SCANCODE_U) :: Scancode -pattern SDL_SCANCODE_V = (#const SDL_SCANCODE_V) :: Scancode -pattern SDL_SCANCODE_W = (#const SDL_SCANCODE_W) :: Scancode -pattern SDL_SCANCODE_X = (#const SDL_SCANCODE_X) :: Scancode -pattern SDL_SCANCODE_Y = (#const SDL_SCANCODE_Y) :: Scancode -pattern SDL_SCANCODE_Z = (#const SDL_SCANCODE_Z) :: Scancode -pattern SDL_SCANCODE_1 = (#const SDL_SCANCODE_1) :: Scancode -pattern SDL_SCANCODE_2 = (#const SDL_SCANCODE_2) :: Scancode -pattern SDL_SCANCODE_3 = (#const SDL_SCANCODE_3) :: Scancode -pattern SDL_SCANCODE_4 = (#const SDL_SCANCODE_4) :: Scancode -pattern SDL_SCANCODE_5 = (#const SDL_SCANCODE_5) :: Scancode -pattern SDL_SCANCODE_6 = (#const SDL_SCANCODE_6) :: Scancode -pattern SDL_SCANCODE_7 = (#const SDL_SCANCODE_7) :: Scancode -pattern SDL_SCANCODE_8 = (#const SDL_SCANCODE_8) :: Scancode -pattern SDL_SCANCODE_9 = (#const SDL_SCANCODE_9) :: Scancode -pattern SDL_SCANCODE_0 = (#const SDL_SCANCODE_0) :: Scancode -pattern SDL_SCANCODE_RETURN = (#const SDL_SCANCODE_RETURN) :: Scancode -pattern SDL_SCANCODE_ESCAPE = (#const SDL_SCANCODE_ESCAPE) :: Scancode -pattern SDL_SCANCODE_BACKSPACE = (#const SDL_SCANCODE_BACKSPACE) :: Scancode -pattern SDL_SCANCODE_TAB = (#const SDL_SCANCODE_TAB) :: Scancode -pattern SDL_SCANCODE_SPACE = (#const SDL_SCANCODE_SPACE) :: Scancode -pattern SDL_SCANCODE_MINUS = (#const SDL_SCANCODE_MINUS) :: Scancode -pattern SDL_SCANCODE_EQUALS = (#const SDL_SCANCODE_EQUALS) :: Scancode -pattern SDL_SCANCODE_LEFTBRACKET = (#const SDL_SCANCODE_LEFTBRACKET) :: Scancode -pattern SDL_SCANCODE_RIGHTBRACKET = (#const SDL_SCANCODE_RIGHTBRACKET) :: Scancode -pattern SDL_SCANCODE_BACKSLASH = (#const SDL_SCANCODE_BACKSLASH) :: Scancode -pattern SDL_SCANCODE_NONUSHASH = (#const SDL_SCANCODE_NONUSHASH) :: Scancode -pattern SDL_SCANCODE_SEMICOLON = (#const SDL_SCANCODE_SEMICOLON) :: Scancode -pattern SDL_SCANCODE_APOSTROPHE = (#const SDL_SCANCODE_APOSTROPHE) :: Scancode -pattern SDL_SCANCODE_GRAVE = (#const SDL_SCANCODE_GRAVE) :: Scancode -pattern SDL_SCANCODE_COMMA = (#const SDL_SCANCODE_COMMA) :: Scancode -pattern SDL_SCANCODE_PERIOD = (#const SDL_SCANCODE_PERIOD) :: Scancode -pattern SDL_SCANCODE_SLASH = (#const SDL_SCANCODE_SLASH) :: Scancode -pattern SDL_SCANCODE_CAPSLOCK = (#const SDL_SCANCODE_CAPSLOCK) :: Scancode -pattern SDL_SCANCODE_F1 = (#const SDL_SCANCODE_F1) :: Scancode -pattern SDL_SCANCODE_F2 = (#const SDL_SCANCODE_F2) :: Scancode -pattern SDL_SCANCODE_F3 = (#const SDL_SCANCODE_F3) :: Scancode -pattern SDL_SCANCODE_F4 = (#const SDL_SCANCODE_F4) :: Scancode -pattern SDL_SCANCODE_F5 = (#const SDL_SCANCODE_F5) :: Scancode -pattern SDL_SCANCODE_F6 = (#const SDL_SCANCODE_F6) :: Scancode -pattern SDL_SCANCODE_F7 = (#const SDL_SCANCODE_F7) :: Scancode -pattern SDL_SCANCODE_F8 = (#const SDL_SCANCODE_F8) :: Scancode -pattern SDL_SCANCODE_F9 = (#const SDL_SCANCODE_F9) :: Scancode -pattern SDL_SCANCODE_F10 = (#const SDL_SCANCODE_F10) :: Scancode -pattern SDL_SCANCODE_F11 = (#const SDL_SCANCODE_F11) :: Scancode -pattern SDL_SCANCODE_F12 = (#const SDL_SCANCODE_F12) :: Scancode -pattern SDL_SCANCODE_PRINTSCREEN = (#const SDL_SCANCODE_PRINTSCREEN) :: Scancode -pattern SDL_SCANCODE_SCROLLLOCK = (#const SDL_SCANCODE_SCROLLLOCK) :: Scancode -pattern SDL_SCANCODE_PAUSE = (#const SDL_SCANCODE_PAUSE) :: Scancode -pattern SDL_SCANCODE_INSERT = (#const SDL_SCANCODE_INSERT) :: Scancode -pattern SDL_SCANCODE_HOME = (#const SDL_SCANCODE_HOME) :: Scancode -pattern SDL_SCANCODE_PAGEUP = (#const SDL_SCANCODE_PAGEUP) :: Scancode -pattern SDL_SCANCODE_DELETE = (#const SDL_SCANCODE_DELETE) :: Scancode -pattern SDL_SCANCODE_END = (#const SDL_SCANCODE_END) :: Scancode -pattern SDL_SCANCODE_PAGEDOWN = (#const SDL_SCANCODE_PAGEDOWN) :: Scancode -pattern SDL_SCANCODE_RIGHT = (#const SDL_SCANCODE_RIGHT) :: Scancode -pattern SDL_SCANCODE_LEFT = (#const SDL_SCANCODE_LEFT) :: Scancode -pattern SDL_SCANCODE_DOWN = (#const SDL_SCANCODE_DOWN) :: Scancode -pattern SDL_SCANCODE_UP = (#const SDL_SCANCODE_UP) :: Scancode -pattern SDL_SCANCODE_NUMLOCKCLEAR = (#const SDL_SCANCODE_NUMLOCKCLEAR) :: Scancode -pattern SDL_SCANCODE_KP_DIVIDE = (#const SDL_SCANCODE_KP_DIVIDE) :: Scancode -pattern SDL_SCANCODE_KP_MULTIPLY = (#const SDL_SCANCODE_KP_MULTIPLY) :: Scancode -pattern SDL_SCANCODE_KP_MINUS = (#const SDL_SCANCODE_KP_MINUS) :: Scancode -pattern SDL_SCANCODE_KP_PLUS = (#const SDL_SCANCODE_KP_PLUS) :: Scancode -pattern SDL_SCANCODE_KP_ENTER = (#const SDL_SCANCODE_KP_ENTER) :: Scancode -pattern SDL_SCANCODE_KP_1 = (#const SDL_SCANCODE_KP_1) :: Scancode -pattern SDL_SCANCODE_KP_2 = (#const SDL_SCANCODE_KP_2) :: Scancode -pattern SDL_SCANCODE_KP_3 = (#const SDL_SCANCODE_KP_3) :: Scancode -pattern SDL_SCANCODE_KP_4 = (#const SDL_SCANCODE_KP_4) :: Scancode -pattern SDL_SCANCODE_KP_5 = (#const SDL_SCANCODE_KP_5) :: Scancode -pattern SDL_SCANCODE_KP_6 = (#const SDL_SCANCODE_KP_6) :: Scancode -pattern SDL_SCANCODE_KP_7 = (#const SDL_SCANCODE_KP_7) :: Scancode -pattern SDL_SCANCODE_KP_8 = (#const SDL_SCANCODE_KP_8) :: Scancode -pattern SDL_SCANCODE_KP_9 = (#const SDL_SCANCODE_KP_9) :: Scancode -pattern SDL_SCANCODE_KP_0 = (#const SDL_SCANCODE_KP_0) :: Scancode -pattern SDL_SCANCODE_KP_PERIOD = (#const SDL_SCANCODE_KP_PERIOD) :: Scancode -pattern SDL_SCANCODE_NONUSBACKSLASH = (#const SDL_SCANCODE_NONUSBACKSLASH) :: Scancode -pattern SDL_SCANCODE_APPLICATION = (#const SDL_SCANCODE_APPLICATION) :: Scancode -pattern SDL_SCANCODE_POWER = (#const SDL_SCANCODE_POWER) :: Scancode -pattern SDL_SCANCODE_KP_EQUALS = (#const SDL_SCANCODE_KP_EQUALS) :: Scancode -pattern SDL_SCANCODE_F13 = (#const SDL_SCANCODE_F13) :: Scancode -pattern SDL_SCANCODE_F14 = (#const SDL_SCANCODE_F14) :: Scancode -pattern SDL_SCANCODE_F15 = (#const SDL_SCANCODE_F15) :: Scancode -pattern SDL_SCANCODE_F16 = (#const SDL_SCANCODE_F16) :: Scancode -pattern SDL_SCANCODE_F17 = (#const SDL_SCANCODE_F17) :: Scancode -pattern SDL_SCANCODE_F18 = (#const SDL_SCANCODE_F18) :: Scancode -pattern SDL_SCANCODE_F19 = (#const SDL_SCANCODE_F19) :: Scancode -pattern SDL_SCANCODE_F20 = (#const SDL_SCANCODE_F20) :: Scancode -pattern SDL_SCANCODE_F21 = (#const SDL_SCANCODE_F21) :: Scancode -pattern SDL_SCANCODE_F22 = (#const SDL_SCANCODE_F22) :: Scancode -pattern SDL_SCANCODE_F23 = (#const SDL_SCANCODE_F23) :: Scancode -pattern SDL_SCANCODE_F24 = (#const SDL_SCANCODE_F24) :: Scancode -pattern SDL_SCANCODE_EXECUTE = (#const SDL_SCANCODE_EXECUTE) :: Scancode -pattern SDL_SCANCODE_HELP = (#const SDL_SCANCODE_HELP) :: Scancode -pattern SDL_SCANCODE_MENU = (#const SDL_SCANCODE_MENU) :: Scancode -pattern SDL_SCANCODE_SELECT = (#const SDL_SCANCODE_SELECT) :: Scancode -pattern SDL_SCANCODE_STOP = (#const SDL_SCANCODE_STOP) :: Scancode -pattern SDL_SCANCODE_AGAIN = (#const SDL_SCANCODE_AGAIN) :: Scancode -pattern SDL_SCANCODE_UNDO = (#const SDL_SCANCODE_UNDO) :: Scancode -pattern SDL_SCANCODE_CUT = (#const SDL_SCANCODE_CUT) :: Scancode -pattern SDL_SCANCODE_COPY = (#const SDL_SCANCODE_COPY) :: Scancode -pattern SDL_SCANCODE_PASTE = (#const SDL_SCANCODE_PASTE) :: Scancode -pattern SDL_SCANCODE_FIND = (#const SDL_SCANCODE_FIND) :: Scancode -pattern SDL_SCANCODE_MUTE = (#const SDL_SCANCODE_MUTE) :: Scancode -pattern SDL_SCANCODE_VOLUMEUP = (#const SDL_SCANCODE_VOLUMEUP) :: Scancode -pattern SDL_SCANCODE_VOLUMEDOWN = (#const SDL_SCANCODE_VOLUMEDOWN) :: Scancode -pattern SDL_SCANCODE_KP_COMMA = (#const SDL_SCANCODE_KP_COMMA) :: Scancode -pattern SDL_SCANCODE_KP_EQUALSAS400 = (#const SDL_SCANCODE_KP_EQUALSAS400) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL1 = (#const SDL_SCANCODE_INTERNATIONAL1) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL2 = (#const SDL_SCANCODE_INTERNATIONAL2) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL3 = (#const SDL_SCANCODE_INTERNATIONAL3) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL4 = (#const SDL_SCANCODE_INTERNATIONAL4) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL5 = (#const SDL_SCANCODE_INTERNATIONAL5) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL6 = (#const SDL_SCANCODE_INTERNATIONAL6) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL7 = (#const SDL_SCANCODE_INTERNATIONAL7) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL8 = (#const SDL_SCANCODE_INTERNATIONAL8) :: Scancode -pattern SDL_SCANCODE_INTERNATIONAL9 = (#const SDL_SCANCODE_INTERNATIONAL9) :: Scancode -pattern SDL_SCANCODE_LANG1 = (#const SDL_SCANCODE_LANG1) :: Scancode -pattern SDL_SCANCODE_LANG2 = (#const SDL_SCANCODE_LANG2) :: Scancode -pattern SDL_SCANCODE_LANG3 = (#const SDL_SCANCODE_LANG3) :: Scancode -pattern SDL_SCANCODE_LANG4 = (#const SDL_SCANCODE_LANG4) :: Scancode -pattern SDL_SCANCODE_LANG5 = (#const SDL_SCANCODE_LANG5) :: Scancode -pattern SDL_SCANCODE_LANG6 = (#const SDL_SCANCODE_LANG6) :: Scancode -pattern SDL_SCANCODE_LANG7 = (#const SDL_SCANCODE_LANG7) :: Scancode -pattern SDL_SCANCODE_LANG8 = (#const SDL_SCANCODE_LANG8) :: Scancode -pattern SDL_SCANCODE_LANG9 = (#const SDL_SCANCODE_LANG9) :: Scancode -pattern SDL_SCANCODE_ALTERASE = (#const SDL_SCANCODE_ALTERASE) :: Scancode -pattern SDL_SCANCODE_SYSREQ = (#const SDL_SCANCODE_SYSREQ) :: Scancode -pattern SDL_SCANCODE_CANCEL = (#const SDL_SCANCODE_CANCEL) :: Scancode -pattern SDL_SCANCODE_CLEAR = (#const SDL_SCANCODE_CLEAR) :: Scancode -pattern SDL_SCANCODE_PRIOR = (#const SDL_SCANCODE_PRIOR) :: Scancode -pattern SDL_SCANCODE_RETURN2 = (#const SDL_SCANCODE_RETURN2) :: Scancode -pattern SDL_SCANCODE_SEPARATOR = (#const SDL_SCANCODE_SEPARATOR) :: Scancode -pattern SDL_SCANCODE_OUT = (#const SDL_SCANCODE_OUT) :: Scancode -pattern SDL_SCANCODE_OPER = (#const SDL_SCANCODE_OPER) :: Scancode -pattern SDL_SCANCODE_CLEARAGAIN = (#const SDL_SCANCODE_CLEARAGAIN) :: Scancode -pattern SDL_SCANCODE_CRSEL = (#const SDL_SCANCODE_CRSEL) :: Scancode -pattern SDL_SCANCODE_EXSEL = (#const SDL_SCANCODE_EXSEL) :: Scancode -pattern SDL_SCANCODE_KP_00 = (#const SDL_SCANCODE_KP_00) :: Scancode -pattern SDL_SCANCODE_KP_000 = (#const SDL_SCANCODE_KP_000) :: Scancode -pattern SDL_SCANCODE_THOUSANDSSEPARATOR = (#const SDL_SCANCODE_THOUSANDSSEPARATOR) :: Scancode -pattern SDL_SCANCODE_DECIMALSEPARATOR = (#const SDL_SCANCODE_DECIMALSEPARATOR) :: Scancode -pattern SDL_SCANCODE_CURRENCYUNIT = (#const SDL_SCANCODE_CURRENCYUNIT) :: Scancode -pattern SDL_SCANCODE_CURRENCYSUBUNIT = (#const SDL_SCANCODE_CURRENCYSUBUNIT) :: Scancode -pattern SDL_SCANCODE_KP_LEFTPAREN = (#const SDL_SCANCODE_KP_LEFTPAREN) :: Scancode -pattern SDL_SCANCODE_KP_RIGHTPAREN = (#const SDL_SCANCODE_KP_RIGHTPAREN) :: Scancode -pattern SDL_SCANCODE_KP_LEFTBRACE = (#const SDL_SCANCODE_KP_LEFTBRACE) :: Scancode -pattern SDL_SCANCODE_KP_RIGHTBRACE = (#const SDL_SCANCODE_KP_RIGHTBRACE) :: Scancode -pattern SDL_SCANCODE_KP_TAB = (#const SDL_SCANCODE_KP_TAB) :: Scancode -pattern SDL_SCANCODE_KP_BACKSPACE = (#const SDL_SCANCODE_KP_BACKSPACE) :: Scancode -pattern SDL_SCANCODE_KP_A = (#const SDL_SCANCODE_KP_A) :: Scancode -pattern SDL_SCANCODE_KP_B = (#const SDL_SCANCODE_KP_B) :: Scancode -pattern SDL_SCANCODE_KP_C = (#const SDL_SCANCODE_KP_C) :: Scancode -pattern SDL_SCANCODE_KP_D = (#const SDL_SCANCODE_KP_D) :: Scancode -pattern SDL_SCANCODE_KP_E = (#const SDL_SCANCODE_KP_E) :: Scancode -pattern SDL_SCANCODE_KP_F = (#const SDL_SCANCODE_KP_F) :: Scancode -pattern SDL_SCANCODE_KP_XOR = (#const SDL_SCANCODE_KP_XOR) :: Scancode -pattern SDL_SCANCODE_KP_POWER = (#const SDL_SCANCODE_KP_POWER) :: Scancode -pattern SDL_SCANCODE_KP_PERCENT = (#const SDL_SCANCODE_KP_PERCENT) :: Scancode -pattern SDL_SCANCODE_KP_LESS = (#const SDL_SCANCODE_KP_LESS) :: Scancode -pattern SDL_SCANCODE_KP_GREATER = (#const SDL_SCANCODE_KP_GREATER) :: Scancode -pattern SDL_SCANCODE_KP_AMPERSAND = (#const SDL_SCANCODE_KP_AMPERSAND) :: Scancode -pattern SDL_SCANCODE_KP_DBLAMPERSAND = (#const SDL_SCANCODE_KP_DBLAMPERSAND) :: Scancode -pattern SDL_SCANCODE_KP_VERTICALBAR = (#const SDL_SCANCODE_KP_VERTICALBAR) :: Scancode -pattern SDL_SCANCODE_KP_DBLVERTICALBAR = (#const SDL_SCANCODE_KP_DBLVERTICALBAR) :: Scancode -pattern SDL_SCANCODE_KP_COLON = (#const SDL_SCANCODE_KP_COLON) :: Scancode -pattern SDL_SCANCODE_KP_HASH = (#const SDL_SCANCODE_KP_HASH) :: Scancode -pattern SDL_SCANCODE_KP_SPACE = (#const SDL_SCANCODE_KP_SPACE) :: Scancode -pattern SDL_SCANCODE_KP_AT = (#const SDL_SCANCODE_KP_AT) :: Scancode -pattern SDL_SCANCODE_KP_EXCLAM = (#const SDL_SCANCODE_KP_EXCLAM) :: Scancode -pattern SDL_SCANCODE_KP_MEMSTORE = (#const SDL_SCANCODE_KP_MEMSTORE) :: Scancode -pattern SDL_SCANCODE_KP_MEMRECALL = (#const SDL_SCANCODE_KP_MEMRECALL) :: Scancode -pattern SDL_SCANCODE_KP_MEMCLEAR = (#const SDL_SCANCODE_KP_MEMCLEAR) :: Scancode -pattern SDL_SCANCODE_KP_MEMADD = (#const SDL_SCANCODE_KP_MEMADD) :: Scancode -pattern SDL_SCANCODE_KP_MEMSUBTRACT = (#const SDL_SCANCODE_KP_MEMSUBTRACT) :: Scancode -pattern SDL_SCANCODE_KP_MEMMULTIPLY = (#const SDL_SCANCODE_KP_MEMMULTIPLY) :: Scancode -pattern SDL_SCANCODE_KP_MEMDIVIDE = (#const SDL_SCANCODE_KP_MEMDIVIDE) :: Scancode -pattern SDL_SCANCODE_KP_PLUSMINUS = (#const SDL_SCANCODE_KP_PLUSMINUS) :: Scancode -pattern SDL_SCANCODE_KP_CLEAR = (#const SDL_SCANCODE_KP_CLEAR) :: Scancode -pattern SDL_SCANCODE_KP_CLEARENTRY = (#const SDL_SCANCODE_KP_CLEARENTRY) :: Scancode -pattern SDL_SCANCODE_KP_BINARY = (#const SDL_SCANCODE_KP_BINARY) :: Scancode -pattern SDL_SCANCODE_KP_OCTAL = (#const SDL_SCANCODE_KP_OCTAL) :: Scancode -pattern SDL_SCANCODE_KP_DECIMAL = (#const SDL_SCANCODE_KP_DECIMAL) :: Scancode -pattern SDL_SCANCODE_KP_HEXADECIMAL = (#const SDL_SCANCODE_KP_HEXADECIMAL) :: Scancode -pattern SDL_SCANCODE_LCTRL = (#const SDL_SCANCODE_LCTRL) :: Scancode -pattern SDL_SCANCODE_LSHIFT = (#const SDL_SCANCODE_LSHIFT) :: Scancode -pattern SDL_SCANCODE_LALT = (#const SDL_SCANCODE_LALT) :: Scancode -pattern SDL_SCANCODE_LGUI = (#const SDL_SCANCODE_LGUI) :: Scancode -pattern SDL_SCANCODE_RCTRL = (#const SDL_SCANCODE_RCTRL) :: Scancode -pattern SDL_SCANCODE_RSHIFT = (#const SDL_SCANCODE_RSHIFT) :: Scancode -pattern SDL_SCANCODE_RALT = (#const SDL_SCANCODE_RALT) :: Scancode -pattern SDL_SCANCODE_RGUI = (#const SDL_SCANCODE_RGUI) :: Scancode -pattern SDL_SCANCODE_MODE = (#const SDL_SCANCODE_MODE) :: Scancode -pattern SDL_SCANCODE_AUDIONEXT = (#const SDL_SCANCODE_AUDIONEXT) :: Scancode -pattern SDL_SCANCODE_AUDIOPREV = (#const SDL_SCANCODE_AUDIOPREV) :: Scancode -pattern SDL_SCANCODE_AUDIOSTOP = (#const SDL_SCANCODE_AUDIOSTOP) :: Scancode -pattern SDL_SCANCODE_AUDIOPLAY = (#const SDL_SCANCODE_AUDIOPLAY) :: Scancode -pattern SDL_SCANCODE_AUDIOMUTE = (#const SDL_SCANCODE_AUDIOMUTE) :: Scancode -pattern SDL_SCANCODE_MEDIASELECT = (#const SDL_SCANCODE_MEDIASELECT) :: Scancode -pattern SDL_SCANCODE_WWW = (#const SDL_SCANCODE_WWW) :: Scancode -pattern SDL_SCANCODE_MAIL = (#const SDL_SCANCODE_MAIL) :: Scancode -pattern SDL_SCANCODE_CALCULATOR = (#const SDL_SCANCODE_CALCULATOR) :: Scancode -pattern SDL_SCANCODE_COMPUTER = (#const SDL_SCANCODE_COMPUTER) :: Scancode -pattern SDL_SCANCODE_AC_SEARCH = (#const SDL_SCANCODE_AC_SEARCH) :: Scancode -pattern SDL_SCANCODE_AC_HOME = (#const SDL_SCANCODE_AC_HOME) :: Scancode -pattern SDL_SCANCODE_AC_BACK = (#const SDL_SCANCODE_AC_BACK) :: Scancode -pattern SDL_SCANCODE_AC_FORWARD = (#const SDL_SCANCODE_AC_FORWARD) :: Scancode -pattern SDL_SCANCODE_AC_STOP = (#const SDL_SCANCODE_AC_STOP) :: Scancode -pattern SDL_SCANCODE_AC_REFRESH = (#const SDL_SCANCODE_AC_REFRESH) :: Scancode -pattern SDL_SCANCODE_AC_BOOKMARKS = (#const SDL_SCANCODE_AC_BOOKMARKS) :: Scancode -pattern SDL_SCANCODE_BRIGHTNESSDOWN = (#const SDL_SCANCODE_BRIGHTNESSDOWN) :: Scancode -pattern SDL_SCANCODE_BRIGHTNESSUP = (#const SDL_SCANCODE_BRIGHTNESSUP) :: Scancode -pattern SDL_SCANCODE_DISPLAYSWITCH = (#const SDL_SCANCODE_DISPLAYSWITCH) :: Scancode -pattern SDL_SCANCODE_KBDILLUMTOGGLE = (#const SDL_SCANCODE_KBDILLUMTOGGLE) :: Scancode -pattern SDL_SCANCODE_KBDILLUMDOWN = (#const SDL_SCANCODE_KBDILLUMDOWN) :: Scancode -pattern SDL_SCANCODE_KBDILLUMUP = (#const SDL_SCANCODE_KBDILLUMUP) :: Scancode -pattern SDL_SCANCODE_EJECT = (#const SDL_SCANCODE_EJECT) :: Scancode -pattern SDL_SCANCODE_SLEEP = (#const SDL_SCANCODE_SLEEP) :: Scancode -pattern SDL_SCANCODE_APP1 = (#const SDL_SCANCODE_APP1) :: Scancode -pattern SDL_SCANCODE_APP2 = (#const SDL_SCANCODE_APP2) :: Scancode -pattern SDL_NUM_SCANCODES = (#const SDL_NUM_SCANCODES) :: Scancode - -pattern SDL_SYSTEM_CURSOR_ARROW = (#const SDL_SYSTEM_CURSOR_ARROW) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_IBEAM = (#const SDL_SYSTEM_CURSOR_IBEAM) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_WAIT = (#const SDL_SYSTEM_CURSOR_WAIT) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_CROSSHAIR = (#const SDL_SYSTEM_CURSOR_CROSSHAIR) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_WAITARROW = (#const SDL_SYSTEM_CURSOR_WAITARROW) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_SIZENWSE = (#const SDL_SYSTEM_CURSOR_SIZENWSE) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_SIZENESW = (#const SDL_SYSTEM_CURSOR_SIZENESW) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_SIZEWE = (#const SDL_SYSTEM_CURSOR_SIZEWE) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_SIZENS = (#const SDL_SYSTEM_CURSOR_SIZENS) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_SIZEALL = (#const SDL_SYSTEM_CURSOR_SIZEALL) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_NO = (#const SDL_SYSTEM_CURSOR_NO) :: SystemCursor -pattern SDL_SYSTEM_CURSOR_HAND = (#const SDL_SYSTEM_CURSOR_HAND) :: SystemCursor -pattern SDL_NUM_SYSTEM_CURSORS = (#const SDL_NUM_SYSTEM_CURSORS) :: SystemCursor - -pattern SDL_THREAD_PRIORITY_LOW = (#const SDL_THREAD_PRIORITY_LOW) :: ThreadPriority -pattern SDL_THREAD_PRIORITY_NORMAL = (#const SDL_THREAD_PRIORITY_NORMAL) :: ThreadPriority -pattern SDL_THREAD_PRIORITY_HIGH = (#const SDL_THREAD_PRIORITY_HIGH) :: ThreadPriority - -pattern SDL_AUDIO_ALLOW_FREQUENCY_CHANGE = (#const SDL_AUDIO_ALLOW_FREQUENCY_CHANGE) -pattern SDL_AUDIO_ALLOW_FORMAT_CHANGE = (#const SDL_AUDIO_ALLOW_FORMAT_CHANGE) -pattern SDL_AUDIO_ALLOW_CHANNELS_CHANGE = (#const SDL_AUDIO_ALLOW_CHANNELS_CHANGE) -pattern SDL_AUDIO_ALLOW_ANY_CHANGE = (#const SDL_AUDIO_ALLOW_ANY_CHANGE) - -pattern SDL_BUTTON_LEFT = (#const SDL_BUTTON_LEFT) -pattern SDL_BUTTON_MIDDLE = (#const SDL_BUTTON_MIDDLE) -pattern SDL_BUTTON_RIGHT = (#const SDL_BUTTON_RIGHT) -pattern SDL_BUTTON_X1 = (#const SDL_BUTTON_X1) -pattern SDL_BUTTON_X2 = (#const SDL_BUTTON_X2) -pattern SDL_BUTTON_LMASK = (#const SDL_BUTTON_LMASK) -pattern SDL_BUTTON_MMASK = (#const SDL_BUTTON_MMASK) -pattern SDL_BUTTON_RMASK = (#const SDL_BUTTON_RMASK) -pattern SDL_BUTTON_X1MASK = (#const SDL_BUTTON_X1MASK) -pattern SDL_BUTTON_X2MASK = (#const SDL_BUTTON_X2MASK) - -pattern SDL_FIRSTEVENT = (#const SDL_FIRSTEVENT) -pattern SDL_QUIT = (#const SDL_QUIT) -pattern SDL_APP_TERMINATING = (#const SDL_APP_TERMINATING) -pattern SDL_APP_LOWMEMORY = (#const SDL_APP_LOWMEMORY) -pattern SDL_APP_WILLENTERBACKGROUND = (#const SDL_APP_WILLENTERBACKGROUND) -pattern SDL_APP_DIDENTERBACKGROUND = (#const SDL_APP_DIDENTERBACKGROUND) -pattern SDL_APP_WILLENTERFOREGROUND = (#const SDL_APP_WILLENTERFOREGROUND) -pattern SDL_APP_DIDENTERFOREGROUND = (#const SDL_APP_DIDENTERFOREGROUND) -pattern SDL_WINDOWEVENT = (#const SDL_WINDOWEVENT) -pattern SDL_SYSWMEVENT = (#const SDL_SYSWMEVENT) -pattern SDL_KEYDOWN = (#const SDL_KEYDOWN) -pattern SDL_KEYUP = (#const SDL_KEYUP) -pattern SDL_TEXTEDITING = (#const SDL_TEXTEDITING) -pattern SDL_TEXTINPUT = (#const SDL_TEXTINPUT) -pattern SDL_MOUSEMOTION = (#const SDL_MOUSEMOTION) -pattern SDL_MOUSEBUTTONDOWN = (#const SDL_MOUSEBUTTONDOWN) -pattern SDL_MOUSEBUTTONUP = (#const SDL_MOUSEBUTTONUP) -pattern SDL_MOUSEWHEEL = (#const SDL_MOUSEWHEEL) -pattern SDL_JOYAXISMOTION = (#const SDL_JOYAXISMOTION) -pattern SDL_JOYBALLMOTION = (#const SDL_JOYBALLMOTION) -pattern SDL_JOYHATMOTION = (#const SDL_JOYHATMOTION) -pattern SDL_JOYBUTTONDOWN = (#const SDL_JOYBUTTONDOWN) -pattern SDL_JOYBUTTONUP = (#const SDL_JOYBUTTONUP) -pattern SDL_JOYDEVICEADDED = (#const SDL_JOYDEVICEADDED) -pattern SDL_JOYDEVICEREMOVED = (#const SDL_JOYDEVICEREMOVED) -pattern SDL_CONTROLLERAXISMOTION = (#const SDL_CONTROLLERAXISMOTION) -pattern SDL_CONTROLLERBUTTONDOWN = (#const SDL_CONTROLLERBUTTONDOWN) -pattern SDL_CONTROLLERBUTTONUP = (#const SDL_CONTROLLERBUTTONUP) -pattern SDL_CONTROLLERDEVICEADDED = (#const SDL_CONTROLLERDEVICEADDED) -pattern SDL_CONTROLLERDEVICEREMOVED = (#const SDL_CONTROLLERDEVICEREMOVED) -pattern SDL_CONTROLLERDEVICEREMAPPED = (#const SDL_CONTROLLERDEVICEREMAPPED) -pattern SDL_FINGERDOWN = (#const SDL_FINGERDOWN) -pattern SDL_FINGERUP = (#const SDL_FINGERUP) -pattern SDL_FINGERMOTION = (#const SDL_FINGERMOTION) -pattern SDL_DOLLARGESTURE = (#const SDL_DOLLARGESTURE) -pattern SDL_DOLLARRECORD = (#const SDL_DOLLARRECORD) -pattern SDL_MULTIGESTURE = (#const SDL_MULTIGESTURE) -pattern SDL_CLIPBOARDUPDATE = (#const SDL_CLIPBOARDUPDATE) -pattern SDL_DROPFILE = (#const SDL_DROPFILE) -pattern SDL_USEREVENT = (#const SDL_USEREVENT) -pattern SDL_LASTEVENT = (#const SDL_LASTEVENT) - -pattern SDL_HAT_CENTERED = (#const SDL_HAT_CENTERED) -pattern SDL_HAT_UP = (#const SDL_HAT_UP) -pattern SDL_HAT_RIGHT = (#const SDL_HAT_RIGHT) -pattern SDL_HAT_DOWN = (#const SDL_HAT_DOWN) -pattern SDL_HAT_LEFT = (#const SDL_HAT_LEFT) -pattern SDL_HAT_RIGHTUP = (#const SDL_HAT_RIGHTUP) -pattern SDL_HAT_RIGHTDOWN = (#const SDL_HAT_RIGHTDOWN) -pattern SDL_HAT_LEFTUP = (#const SDL_HAT_LEFTUP) -pattern SDL_HAT_LEFTDOWN = (#const SDL_HAT_LEFTDOWN) - -pattern SDL_PRESSED = (#const SDL_PRESSED) -pattern SDL_RELEASED = (#const SDL_RELEASED) - -pattern SDL_LOG_CATEGORY_APPLICATION = (#const SDL_LOG_CATEGORY_APPLICATION) -pattern SDL_LOG_CATEGORY_ERROR = (#const SDL_LOG_CATEGORY_ERROR) -pattern SDL_LOG_CATEGORY_ASSERT = (#const SDL_LOG_CATEGORY_ASSERT) -pattern SDL_LOG_CATEGORY_SYSTEM = (#const SDL_LOG_CATEGORY_SYSTEM) -pattern SDL_LOG_CATEGORY_AUDIO = (#const SDL_LOG_CATEGORY_AUDIO) -pattern SDL_LOG_CATEGORY_VIDEO = (#const SDL_LOG_CATEGORY_VIDEO) -pattern SDL_LOG_CATEGORY_RENDER = (#const SDL_LOG_CATEGORY_RENDER) -pattern SDL_LOG_CATEGORY_INPUT = (#const SDL_LOG_CATEGORY_INPUT) -pattern SDL_LOG_CATEGORY_TEST = (#const SDL_LOG_CATEGORY_TEST) -pattern SDL_LOG_CATEGORY_CUSTOM = (#const SDL_LOG_CATEGORY_CUSTOM) - -pattern SDL_MESSAGEBOX_ERROR = (#const SDL_MESSAGEBOX_ERROR) -pattern SDL_MESSAGEBOX_WARNING = (#const SDL_MESSAGEBOX_WARNING) -pattern SDL_MESSAGEBOX_INFORMATION = (#const SDL_MESSAGEBOX_INFORMATION) - -pattern SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT = (#const SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT) -pattern SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT = (#const SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT) - -pattern SDL_GL_CONTEXT_PROFILE_CORE = (#const SDL_GL_CONTEXT_PROFILE_CORE) -pattern SDL_GL_CONTEXT_PROFILE_COMPATIBILITY = (#const SDL_GL_CONTEXT_PROFILE_COMPATIBILITY) -pattern SDL_GL_CONTEXT_PROFILE_ES = (#const SDL_GL_CONTEXT_PROFILE_ES) - -pattern SDL_GL_CONTEXT_DEBUG_FLAG = (#const SDL_GL_CONTEXT_DEBUG_FLAG) -pattern SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG = (#const SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG) -pattern SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG = (#const SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG) -pattern SDL_GL_CONTEXT_RESET_ISOLATION_FLAG = (#const SDL_GL_CONTEXT_RESET_ISOLATION_FLAG) - -pattern SDL_PIXELFORMAT_UNKNOWN = (#const SDL_PIXELFORMAT_UNKNOWN) -pattern SDL_PIXELFORMAT_INDEX1LSB = (#const SDL_PIXELFORMAT_INDEX1LSB) -pattern SDL_PIXELFORMAT_INDEX1MSB = (#const SDL_PIXELFORMAT_INDEX1MSB) -pattern SDL_PIXELFORMAT_INDEX4LSB = (#const SDL_PIXELFORMAT_INDEX4LSB) -pattern SDL_PIXELFORMAT_INDEX4MSB = (#const SDL_PIXELFORMAT_INDEX4MSB) -pattern SDL_PIXELFORMAT_INDEX8 = (#const SDL_PIXELFORMAT_INDEX8) -pattern SDL_PIXELFORMAT_RGB332 = (#const SDL_PIXELFORMAT_RGB332) -pattern SDL_PIXELFORMAT_RGB444 = (#const SDL_PIXELFORMAT_RGB444) -pattern SDL_PIXELFORMAT_RGB555 = (#const SDL_PIXELFORMAT_RGB555) -pattern SDL_PIXELFORMAT_BGR555 = (#const SDL_PIXELFORMAT_BGR555) -pattern SDL_PIXELFORMAT_ARGB4444 = (#const SDL_PIXELFORMAT_ARGB4444) -pattern SDL_PIXELFORMAT_RGBA4444 = (#const SDL_PIXELFORMAT_RGBA4444) -pattern SDL_PIXELFORMAT_ABGR4444 = (#const SDL_PIXELFORMAT_ABGR4444) -pattern SDL_PIXELFORMAT_BGRA4444 = (#const SDL_PIXELFORMAT_BGRA4444) -pattern SDL_PIXELFORMAT_ARGB1555 = (#const SDL_PIXELFORMAT_ARGB1555) -pattern SDL_PIXELFORMAT_RGBA5551 = (#const SDL_PIXELFORMAT_RGBA5551) -pattern SDL_PIXELFORMAT_ABGR1555 = (#const SDL_PIXELFORMAT_ABGR1555) -pattern SDL_PIXELFORMAT_BGRA5551 = (#const SDL_PIXELFORMAT_BGRA5551) -pattern SDL_PIXELFORMAT_RGB565 = (#const SDL_PIXELFORMAT_RGB565) -pattern SDL_PIXELFORMAT_BGR565 = (#const SDL_PIXELFORMAT_BGR565) -pattern SDL_PIXELFORMAT_RGB24 = (#const SDL_PIXELFORMAT_RGB24) -pattern SDL_PIXELFORMAT_BGR24 = (#const SDL_PIXELFORMAT_BGR24) -pattern SDL_PIXELFORMAT_RGB888 = (#const SDL_PIXELFORMAT_RGB888) -pattern SDL_PIXELFORMAT_RGBX8888 = (#const SDL_PIXELFORMAT_RGBX8888) -pattern SDL_PIXELFORMAT_BGR888 = (#const SDL_PIXELFORMAT_BGR888) -pattern SDL_PIXELFORMAT_BGRX8888 = (#const SDL_PIXELFORMAT_BGRX8888) -pattern SDL_PIXELFORMAT_ARGB8888 = (#const SDL_PIXELFORMAT_ARGB8888) -pattern SDL_PIXELFORMAT_RGBA8888 = (#const SDL_PIXELFORMAT_RGBA8888) -pattern SDL_PIXELFORMAT_ABGR8888 = (#const SDL_PIXELFORMAT_ABGR8888) -pattern SDL_PIXELFORMAT_BGRA8888 = (#const SDL_PIXELFORMAT_BGRA8888) -pattern SDL_PIXELFORMAT_ARGB2101010 = (#const SDL_PIXELFORMAT_ARGB2101010) -pattern SDL_PIXELFORMAT_YV12 = (#const SDL_PIXELFORMAT_YV12) -pattern SDL_PIXELFORMAT_IYUV = (#const SDL_PIXELFORMAT_IYUV) -pattern SDL_PIXELFORMAT_YUY2 = (#const SDL_PIXELFORMAT_YUY2) -pattern SDL_PIXELFORMAT_UYVY = (#const SDL_PIXELFORMAT_UYVY) -pattern SDL_PIXELFORMAT_YVYU = (#const SDL_PIXELFORMAT_YVYU) - -pattern SDL_RENDERER_SOFTWARE = (#const SDL_RENDERER_SOFTWARE) -pattern SDL_RENDERER_ACCELERATED = (#const SDL_RENDERER_ACCELERATED) -pattern SDL_RENDERER_PRESENTVSYNC = (#const SDL_RENDERER_PRESENTVSYNC) -pattern SDL_RENDERER_TARGETTEXTURE = (#const SDL_RENDERER_TARGETTEXTURE) - -pattern SDL_TEXTUREACCESS_STATIC = (#const SDL_TEXTUREACCESS_STATIC) -pattern SDL_TEXTUREACCESS_STREAMING = (#const SDL_TEXTUREACCESS_STREAMING) -pattern SDL_TEXTUREACCESS_TARGET = (#const SDL_TEXTUREACCESS_TARGET) - -pattern SDL_TEXTUREMODULATE_NONE = (#const SDL_TEXTUREMODULATE_NONE) -pattern SDL_TEXTUREMODULATE_COLOR = (#const SDL_TEXTUREMODULATE_COLOR) -pattern SDL_TEXTUREMODULATE_ALPHA = (#const SDL_TEXTUREMODULATE_ALPHA) - -pattern SDL_TOUCH_MOUSEID = (#const SDL_TOUCH_MOUSEID) - -pattern SDL_WINDOWEVENT_NONE = (#const SDL_WINDOWEVENT_NONE) -pattern SDL_WINDOWEVENT_SHOWN = (#const SDL_WINDOWEVENT_SHOWN) -pattern SDL_WINDOWEVENT_HIDDEN = (#const SDL_WINDOWEVENT_HIDDEN) -pattern SDL_WINDOWEVENT_EXPOSED = (#const SDL_WINDOWEVENT_EXPOSED) -pattern SDL_WINDOWEVENT_MOVED = (#const SDL_WINDOWEVENT_MOVED) -pattern SDL_WINDOWEVENT_RESIZED = (#const SDL_WINDOWEVENT_RESIZED) -pattern SDL_WINDOWEVENT_SIZE_CHANGED = (#const SDL_WINDOWEVENT_SIZE_CHANGED) -pattern SDL_WINDOWEVENT_MINIMIZED = (#const SDL_WINDOWEVENT_MINIMIZED) -pattern SDL_WINDOWEVENT_MAXIMIZED = (#const SDL_WINDOWEVENT_MAXIMIZED) -pattern SDL_WINDOWEVENT_RESTORED = (#const SDL_WINDOWEVENT_RESTORED) -pattern SDL_WINDOWEVENT_ENTER = (#const SDL_WINDOWEVENT_ENTER) -pattern SDL_WINDOWEVENT_LEAVE = (#const SDL_WINDOWEVENT_LEAVE) -pattern SDL_WINDOWEVENT_FOCUS_GAINED = (#const SDL_WINDOWEVENT_FOCUS_GAINED) -pattern SDL_WINDOWEVENT_FOCUS_LOST = (#const SDL_WINDOWEVENT_FOCUS_LOST) -pattern SDL_WINDOWEVENT_CLOSE = (#const SDL_WINDOWEVENT_CLOSE) - -pattern SDL_WINDOW_FULLSCREEN = (#const SDL_WINDOW_FULLSCREEN) -pattern SDL_WINDOW_OPENGL = (#const SDL_WINDOW_OPENGL) -pattern SDL_WINDOW_SHOWN = (#const SDL_WINDOW_SHOWN) -pattern SDL_WINDOW_HIDDEN = (#const SDL_WINDOW_HIDDEN) -pattern SDL_WINDOW_BORDERLESS = (#const SDL_WINDOW_BORDERLESS) -pattern SDL_WINDOW_RESIZABLE = (#const SDL_WINDOW_RESIZABLE) -pattern SDL_WINDOW_MINIMIZED = (#const SDL_WINDOW_MINIMIZED) -pattern SDL_WINDOW_MAXIMIZED = (#const SDL_WINDOW_MAXIMIZED) -pattern SDL_WINDOW_INPUT_GRABBED = (#const SDL_WINDOW_INPUT_GRABBED) -pattern SDL_WINDOW_INPUT_FOCUS = (#const SDL_WINDOW_INPUT_FOCUS) -pattern SDL_WINDOW_MOUSE_FOCUS = (#const SDL_WINDOW_MOUSE_FOCUS) -pattern SDL_WINDOW_FULLSCREEN_DESKTOP = (#const SDL_WINDOW_FULLSCREEN_DESKTOP) -pattern SDL_WINDOW_FOREIGN = (#const SDL_WINDOW_FOREIGN) -pattern SDL_WINDOW_ALLOW_HIGHDPI = (#const SDL_WINDOW_ALLOW_HIGHDPI) - -pattern SDL_WINDOWPOS_UNDEFINED = (#const SDL_WINDOWPOS_UNDEFINED) -pattern SDL_WINDOWPOS_CENTERED = (#const SDL_WINDOWPOS_CENTERED) - -pattern SDL_HAPTIC_CONSTANT = (#const SDL_HAPTIC_CONSTANT) +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PatternSynonyms #-} +module SDL.Raw.Enum ( + -- * Enumerations + + -- ** Audio Format + AudioFormat, + pattern SDL_AUDIO_S8, + pattern SDL_AUDIO_U8, + pattern SDL_AUDIO_S16LSB, + pattern SDL_AUDIO_S16MSB, + pattern SDL_AUDIO_S16SYS, + pattern SDL_AUDIO_U16LSB, + pattern SDL_AUDIO_U16MSB, + pattern SDL_AUDIO_U16SYS, + pattern SDL_AUDIO_S32LSB, + pattern SDL_AUDIO_S32MSB, + pattern SDL_AUDIO_S32SYS, + pattern SDL_AUDIO_F32LSB, + pattern SDL_AUDIO_F32MSB, + pattern SDL_AUDIO_F32SYS, + + -- ** Audio Status + AudioStatus, + pattern SDL_AUDIO_STOPPED, + pattern SDL_AUDIO_PLAYING, + pattern SDL_AUDIO_PAUSED, + + -- ** Blend Mode + BlendMode, + pattern SDL_BLENDMODE_NONE, + pattern SDL_BLENDMODE_BLEND, + pattern SDL_BLENDMODE_ADD, + pattern SDL_BLENDMODE_MOD, + + -- ** Endian Detetection + pattern SDL_BYTEORDER, + pattern SDL_LIL_ENDIAN, + pattern SDL_BIG_ENDIAN, + + -- ** Event Action + EventAction, + pattern SDL_ADDEVENT, + pattern SDL_PEEKEVENT, + pattern SDL_GETEVENT, + + -- ** Game Controller Axis + GameControllerAxis, + pattern SDL_CONTROLLER_AXIS_INVALID, + pattern SDL_CONTROLLER_AXIS_LEFTX, + pattern SDL_CONTROLLER_AXIS_LEFTY, + pattern SDL_CONTROLLER_AXIS_RIGHTX, + pattern SDL_CONTROLLER_AXIS_RIGHTY, + pattern SDL_CONTROLLER_AXIS_TRIGGERLEFT, + pattern SDL_CONTROLLER_AXIS_TRIGGERRIGHT, + pattern SDL_CONTROLLER_AXIS_MAX, + + -- ** Game Controller Button + GameControllerButton, + pattern SDL_CONTROLLER_BUTTON_INVALID, + pattern SDL_CONTROLLER_BUTTON_A, + pattern SDL_CONTROLLER_BUTTON_B, + pattern SDL_CONTROLLER_BUTTON_X, + pattern SDL_CONTROLLER_BUTTON_Y, + pattern SDL_CONTROLLER_BUTTON_BACK, + pattern SDL_CONTROLLER_BUTTON_GUIDE, + pattern SDL_CONTROLLER_BUTTON_START, + pattern SDL_CONTROLLER_BUTTON_LEFTSTICK, + pattern SDL_CONTROLLER_BUTTON_RIGHTSTICK, + pattern SDL_CONTROLLER_BUTTON_LEFTSHOULDER, + pattern SDL_CONTROLLER_BUTTON_RIGHTSHOULDER, + pattern SDL_CONTROLLER_BUTTON_DPAD_UP, + pattern SDL_CONTROLLER_BUTTON_DPAD_DOWN, + pattern SDL_CONTROLLER_BUTTON_DPAD_LEFT, + pattern SDL_CONTROLLER_BUTTON_DPAD_RIGHT, + pattern SDL_CONTROLLER_BUTTON_MAX, + + -- ** OpenGL Attribute + GLattr, + pattern SDL_GL_RED_SIZE, + pattern SDL_GL_GREEN_SIZE, + pattern SDL_GL_BLUE_SIZE, + pattern SDL_GL_ALPHA_SIZE, + pattern SDL_GL_BUFFER_SIZE, + pattern SDL_GL_DOUBLEBUFFER, + pattern SDL_GL_DEPTH_SIZE, + pattern SDL_GL_STENCIL_SIZE, + pattern SDL_GL_ACCUM_RED_SIZE, + pattern SDL_GL_ACCUM_GREEN_SIZE, + pattern SDL_GL_ACCUM_BLUE_SIZE, + pattern SDL_GL_ACCUM_ALPHA_SIZE, + pattern SDL_GL_STEREO, + pattern SDL_GL_MULTISAMPLEBUFFERS, + pattern SDL_GL_MULTISAMPLESAMPLES, + pattern SDL_GL_ACCELERATED_VISUAL, + pattern SDL_GL_RETAINED_BACKING, + pattern SDL_GL_CONTEXT_MAJOR_VERSION, + pattern SDL_GL_CONTEXT_MINOR_VERSION, + pattern SDL_GL_CONTEXT_EGL, + pattern SDL_GL_CONTEXT_FLAGS, + pattern SDL_GL_CONTEXT_PROFILE_MASK, + pattern SDL_GL_SHARE_WITH_CURRENT_CONTEXT, + pattern SDL_GL_FRAMEBUFFER_SRGB_CAPABLE, + + -- ** Hint Priority + HintPriority, + pattern SDL_HINT_DEFAULT, + pattern SDL_HINT_NORMAL, + pattern SDL_HINT_OVERRIDE, + + -- ** Initialization Flag + InitFlag, + pattern SDL_INIT_TIMER, + pattern SDL_INIT_AUDIO, + pattern SDL_INIT_VIDEO, + pattern SDL_INIT_JOYSTICK, + pattern SDL_INIT_HAPTIC, + pattern SDL_INIT_GAMECONTROLLER, + pattern SDL_INIT_EVENTS, + pattern SDL_INIT_NOPARACHUTE, + pattern SDL_INIT_EVERYTHING, + + -- ** Keycode + Keycode, + pattern SDLK_UNKNOWN, + pattern SDLK_RETURN, + pattern SDLK_ESCAPE, + pattern SDLK_BACKSPACE, + pattern SDLK_TAB, + pattern SDLK_SPACE, + pattern SDLK_EXCLAIM, + pattern SDLK_QUOTEDBL, + pattern SDLK_HASH, + pattern SDLK_PERCENT, + pattern SDLK_DOLLAR, + pattern SDLK_AMPERSAND, + pattern SDLK_QUOTE, + pattern SDLK_LEFTPAREN, + pattern SDLK_RIGHTPAREN, + pattern SDLK_ASTERISK, + pattern SDLK_PLUS, + pattern SDLK_COMMA, + pattern SDLK_MINUS, + pattern SDLK_PERIOD, + pattern SDLK_SLASH, + pattern SDLK_0, + pattern SDLK_1, + pattern SDLK_2, + pattern SDLK_3, + pattern SDLK_4, + pattern SDLK_5, + pattern SDLK_6, + pattern SDLK_7, + pattern SDLK_8, + pattern SDLK_9, + pattern SDLK_COLON, + pattern SDLK_SEMICOLON, + pattern SDLK_LESS, + pattern SDLK_EQUALS, + pattern SDLK_GREATER, + pattern SDLK_QUESTION, + pattern SDLK_AT, + pattern SDLK_LEFTBRACKET, + pattern SDLK_BACKSLASH, + pattern SDLK_RIGHTBRACKET, + pattern SDLK_CARET, + pattern SDLK_UNDERSCORE, + pattern SDLK_BACKQUOTE, + pattern SDLK_a, + pattern SDLK_b, + pattern SDLK_c, + pattern SDLK_d, + pattern SDLK_e, + pattern SDLK_f, + pattern SDLK_g, + pattern SDLK_h, + pattern SDLK_i, + pattern SDLK_j, + pattern SDLK_k, + pattern SDLK_l, + pattern SDLK_m, + pattern SDLK_n, + pattern SDLK_o, + pattern SDLK_p, + pattern SDLK_q, + pattern SDLK_r, + pattern SDLK_s, + pattern SDLK_t, + pattern SDLK_u, + pattern SDLK_v, + pattern SDLK_w, + pattern SDLK_x, + pattern SDLK_y, + pattern SDLK_z, + pattern SDLK_CAPSLOCK, + pattern SDLK_F1, + pattern SDLK_F2, + pattern SDLK_F3, + pattern SDLK_F4, + pattern SDLK_F5, + pattern SDLK_F6, + pattern SDLK_F7, + pattern SDLK_F8, + pattern SDLK_F9, + pattern SDLK_F10, + pattern SDLK_F11, + pattern SDLK_F12, + pattern SDLK_PRINTSCREEN, + pattern SDLK_SCROLLLOCK, + pattern SDLK_PAUSE, + pattern SDLK_INSERT, + pattern SDLK_HOME, + pattern SDLK_PAGEUP, + pattern SDLK_DELETE, + pattern SDLK_END, + pattern SDLK_PAGEDOWN, + pattern SDLK_RIGHT, + pattern SDLK_LEFT, + pattern SDLK_DOWN, + pattern SDLK_UP, + pattern SDLK_NUMLOCKCLEAR, + pattern SDLK_KP_DIVIDE, + pattern SDLK_KP_MULTIPLY, + pattern SDLK_KP_MINUS, + pattern SDLK_KP_PLUS, + pattern SDLK_KP_ENTER, + pattern SDLK_KP_1, + pattern SDLK_KP_2, + pattern SDLK_KP_3, + pattern SDLK_KP_4, + pattern SDLK_KP_5, + pattern SDLK_KP_6, + pattern SDLK_KP_7, + pattern SDLK_KP_8, + pattern SDLK_KP_9, + pattern SDLK_KP_0, + pattern SDLK_KP_PERIOD, + pattern SDLK_APPLICATION, + pattern SDLK_POWER, + pattern SDLK_KP_EQUALS, + pattern SDLK_F13, + pattern SDLK_F14, + pattern SDLK_F15, + pattern SDLK_F16, + pattern SDLK_F17, + pattern SDLK_F18, + pattern SDLK_F19, + pattern SDLK_F20, + pattern SDLK_F21, + pattern SDLK_F22, + pattern SDLK_F23, + pattern SDLK_F24, + pattern SDLK_EXECUTE, + pattern SDLK_HELP, + pattern SDLK_MENU, + pattern SDLK_SELECT, + pattern SDLK_STOP, + pattern SDLK_AGAIN, + pattern SDLK_UNDO, + pattern SDLK_CUT, + pattern SDLK_COPY, + pattern SDLK_PASTE, + pattern SDLK_FIND, + pattern SDLK_MUTE, + pattern SDLK_VOLUMEUP, + pattern SDLK_VOLUMEDOWN, + pattern SDLK_KP_COMMA, + pattern SDLK_KP_EQUALSAS400, + pattern SDLK_ALTERASE, + pattern SDLK_SYSREQ, + pattern SDLK_CANCEL, + pattern SDLK_CLEAR, + pattern SDLK_PRIOR, + pattern SDLK_RETURN2, + pattern SDLK_SEPARATOR, + pattern SDLK_OUT, + pattern SDLK_OPER, + pattern SDLK_CLEARAGAIN, + pattern SDLK_CRSEL, + pattern SDLK_EXSEL, + pattern SDLK_KP_00, + pattern SDLK_KP_000, + pattern SDLK_THOUSANDSSEPARATOR, + pattern SDLK_DECIMALSEPARATOR, + pattern SDLK_CURRENCYUNIT, + pattern SDLK_CURRENCYSUBUNIT, + pattern SDLK_KP_LEFTPAREN, + pattern SDLK_KP_RIGHTPAREN, + pattern SDLK_KP_LEFTBRACE, + pattern SDLK_KP_RIGHTBRACE, + pattern SDLK_KP_TAB, + pattern SDLK_KP_BACKSPACE, + pattern SDLK_KP_A, + pattern SDLK_KP_B, + pattern SDLK_KP_C, + pattern SDLK_KP_D, + pattern SDLK_KP_E, + pattern SDLK_KP_F, + pattern SDLK_KP_XOR, + pattern SDLK_KP_POWER, + pattern SDLK_KP_PERCENT, + pattern SDLK_KP_LESS, + pattern SDLK_KP_GREATER, + pattern SDLK_KP_AMPERSAND, + pattern SDLK_KP_DBLAMPERSAND, + pattern SDLK_KP_VERTICALBAR, + pattern SDLK_KP_DBLVERTICALBAR, + pattern SDLK_KP_COLON, + pattern SDLK_KP_HASH, + pattern SDLK_KP_SPACE, + pattern SDLK_KP_AT, + pattern SDLK_KP_EXCLAM, + pattern SDLK_KP_MEMSTORE, + pattern SDLK_KP_MEMRECALL, + pattern SDLK_KP_MEMCLEAR, + pattern SDLK_KP_MEMADD, + pattern SDLK_KP_MEMSUBTRACT, + pattern SDLK_KP_MEMMULTIPLY, + pattern SDLK_KP_MEMDIVIDE, + pattern SDLK_KP_PLUSMINUS, + pattern SDLK_KP_CLEAR, + pattern SDLK_KP_CLEARENTRY, + pattern SDLK_KP_BINARY, + pattern SDLK_KP_OCTAL, + pattern SDLK_KP_DECIMAL, + pattern SDLK_KP_HEXADECIMAL, + pattern SDLK_LCTRL, + pattern SDLK_LSHIFT, + pattern SDLK_LALT, + pattern SDLK_LGUI, + pattern SDLK_RCTRL, + pattern SDLK_RSHIFT, + pattern SDLK_RALT, + pattern SDLK_RGUI, + pattern SDLK_MODE, + pattern SDLK_AUDIONEXT, + pattern SDLK_AUDIOPREV, + pattern SDLK_AUDIOSTOP, + pattern SDLK_AUDIOPLAY, + pattern SDLK_AUDIOMUTE, + pattern SDLK_MEDIASELECT, + pattern SDLK_WWW, + pattern SDLK_MAIL, + pattern SDLK_CALCULATOR, + pattern SDLK_COMPUTER, + pattern SDLK_AC_SEARCH, + pattern SDLK_AC_HOME, + pattern SDLK_AC_BACK, + pattern SDLK_AC_FORWARD, + pattern SDLK_AC_STOP, + pattern SDLK_AC_REFRESH, + pattern SDLK_AC_BOOKMARKS, + pattern SDLK_BRIGHTNESSDOWN, + pattern SDLK_BRIGHTNESSUP, + pattern SDLK_DISPLAYSWITCH, + pattern SDLK_KBDILLUMTOGGLE, + pattern SDLK_KBDILLUMDOWN, + pattern SDLK_KBDILLUMUP, + pattern SDLK_EJECT, + pattern SDLK_SLEEP, + + -- ** Key Modifier + Keymod, + pattern KMOD_NONE, + pattern KMOD_LSHIFT, + pattern KMOD_RSHIFT, + pattern KMOD_SHIFT, + pattern KMOD_LCTRL, + pattern KMOD_RCTRL, + pattern KMOD_CTRL, + pattern KMOD_LALT, + pattern KMOD_RALT, + pattern KMOD_ALT, + pattern KMOD_LGUI, + pattern KMOD_RGUI, + pattern KMOD_GUI, + pattern KMOD_NUM, + pattern KMOD_CAPS, + pattern KMOD_MODE, + pattern KMOD_RESERVED, + + -- ** Log Priority + LogPriority, + pattern SDL_LOG_PRIORITY_VERBOSE, + pattern SDL_LOG_PRIORITY_DEBUG, + pattern SDL_LOG_PRIORITY_INFO, + pattern SDL_LOG_PRIORITY_WARN, + pattern SDL_LOG_PRIORITY_ERROR, + pattern SDL_LOG_PRIORITY_CRITICAL, + pattern SDL_NUM_LOG_PRIORITIES, + + -- ** Power State + PowerState, + pattern SDL_POWERSTATE_UNKNOWN, + pattern SDL_POWERSTATE_ON_BATTERY, + pattern SDL_POWERSTATE_NO_BATTERY, + pattern SDL_POWERSTATE_CHARGING, + pattern SDL_POWERSTATE_CHARGED, + + -- ** Renderer Flip + RendererFlip, + pattern SDL_FLIP_NONE, + pattern SDL_FLIP_HORIZONTAL, + pattern SDL_FLIP_VERTICAL, + + -- ** Scancode + Scancode, + pattern SDL_SCANCODE_UNKNOWN, + pattern SDL_SCANCODE_A, + pattern SDL_SCANCODE_B, + pattern SDL_SCANCODE_C, + pattern SDL_SCANCODE_D, + pattern SDL_SCANCODE_E, + pattern SDL_SCANCODE_F, + pattern SDL_SCANCODE_G, + pattern SDL_SCANCODE_H, + pattern SDL_SCANCODE_I, + pattern SDL_SCANCODE_J, + pattern SDL_SCANCODE_K, + pattern SDL_SCANCODE_L, + pattern SDL_SCANCODE_M, + pattern SDL_SCANCODE_N, + pattern SDL_SCANCODE_O, + pattern SDL_SCANCODE_P, + pattern SDL_SCANCODE_Q, + pattern SDL_SCANCODE_R, + pattern SDL_SCANCODE_S, + pattern SDL_SCANCODE_T, + pattern SDL_SCANCODE_U, + pattern SDL_SCANCODE_V, + pattern SDL_SCANCODE_W, + pattern SDL_SCANCODE_X, + pattern SDL_SCANCODE_Y, + pattern SDL_SCANCODE_Z, + pattern SDL_SCANCODE_1, + pattern SDL_SCANCODE_2, + pattern SDL_SCANCODE_3, + pattern SDL_SCANCODE_4, + pattern SDL_SCANCODE_5, + pattern SDL_SCANCODE_6, + pattern SDL_SCANCODE_7, + pattern SDL_SCANCODE_8, + pattern SDL_SCANCODE_9, + pattern SDL_SCANCODE_0, + pattern SDL_SCANCODE_RETURN, + pattern SDL_SCANCODE_ESCAPE, + pattern SDL_SCANCODE_BACKSPACE, + pattern SDL_SCANCODE_TAB, + pattern SDL_SCANCODE_SPACE, + pattern SDL_SCANCODE_MINUS, + pattern SDL_SCANCODE_EQUALS, + pattern SDL_SCANCODE_LEFTBRACKET, + pattern SDL_SCANCODE_RIGHTBRACKET, + pattern SDL_SCANCODE_BACKSLASH, + pattern SDL_SCANCODE_NONUSHASH, + pattern SDL_SCANCODE_SEMICOLON, + pattern SDL_SCANCODE_APOSTROPHE, + pattern SDL_SCANCODE_GRAVE, + pattern SDL_SCANCODE_COMMA, + pattern SDL_SCANCODE_PERIOD, + pattern SDL_SCANCODE_SLASH, + pattern SDL_SCANCODE_CAPSLOCK, + pattern SDL_SCANCODE_F1, + pattern SDL_SCANCODE_F2, + pattern SDL_SCANCODE_F3, + pattern SDL_SCANCODE_F4, + pattern SDL_SCANCODE_F5, + pattern SDL_SCANCODE_F6, + pattern SDL_SCANCODE_F7, + pattern SDL_SCANCODE_F8, + pattern SDL_SCANCODE_F9, + pattern SDL_SCANCODE_F10, + pattern SDL_SCANCODE_F11, + pattern SDL_SCANCODE_F12, + pattern SDL_SCANCODE_PRINTSCREEN, + pattern SDL_SCANCODE_SCROLLLOCK, + pattern SDL_SCANCODE_PAUSE, + pattern SDL_SCANCODE_INSERT, + pattern SDL_SCANCODE_HOME, + pattern SDL_SCANCODE_PAGEUP, + pattern SDL_SCANCODE_DELETE, + pattern SDL_SCANCODE_END, + pattern SDL_SCANCODE_PAGEDOWN, + pattern SDL_SCANCODE_RIGHT, + pattern SDL_SCANCODE_LEFT, + pattern SDL_SCANCODE_DOWN, + pattern SDL_SCANCODE_UP, + pattern SDL_SCANCODE_NUMLOCKCLEAR, + pattern SDL_SCANCODE_KP_DIVIDE, + pattern SDL_SCANCODE_KP_MULTIPLY, + pattern SDL_SCANCODE_KP_MINUS, + pattern SDL_SCANCODE_KP_PLUS, + pattern SDL_SCANCODE_KP_ENTER, + pattern SDL_SCANCODE_KP_1, + pattern SDL_SCANCODE_KP_2, + pattern SDL_SCANCODE_KP_3, + pattern SDL_SCANCODE_KP_4, + pattern SDL_SCANCODE_KP_5, + pattern SDL_SCANCODE_KP_6, + pattern SDL_SCANCODE_KP_7, + pattern SDL_SCANCODE_KP_8, + pattern SDL_SCANCODE_KP_9, + pattern SDL_SCANCODE_KP_0, + pattern SDL_SCANCODE_KP_PERIOD, + pattern SDL_SCANCODE_NONUSBACKSLASH, + pattern SDL_SCANCODE_APPLICATION, + pattern SDL_SCANCODE_POWER, + pattern SDL_SCANCODE_KP_EQUALS, + pattern SDL_SCANCODE_F13, + pattern SDL_SCANCODE_F14, + pattern SDL_SCANCODE_F15, + pattern SDL_SCANCODE_F16, + pattern SDL_SCANCODE_F17, + pattern SDL_SCANCODE_F18, + pattern SDL_SCANCODE_F19, + pattern SDL_SCANCODE_F20, + pattern SDL_SCANCODE_F21, + pattern SDL_SCANCODE_F22, + pattern SDL_SCANCODE_F23, + pattern SDL_SCANCODE_F24, + pattern SDL_SCANCODE_EXECUTE, + pattern SDL_SCANCODE_HELP, + pattern SDL_SCANCODE_MENU, + pattern SDL_SCANCODE_SELECT, + pattern SDL_SCANCODE_STOP, + pattern SDL_SCANCODE_AGAIN, + pattern SDL_SCANCODE_UNDO, + pattern SDL_SCANCODE_CUT, + pattern SDL_SCANCODE_COPY, + pattern SDL_SCANCODE_PASTE, + pattern SDL_SCANCODE_FIND, + pattern SDL_SCANCODE_MUTE, + pattern SDL_SCANCODE_VOLUMEUP, + pattern SDL_SCANCODE_VOLUMEDOWN, + pattern SDL_SCANCODE_KP_COMMA, + pattern SDL_SCANCODE_KP_EQUALSAS400, + pattern SDL_SCANCODE_INTERNATIONAL1, + pattern SDL_SCANCODE_INTERNATIONAL2, + pattern SDL_SCANCODE_INTERNATIONAL3, + pattern SDL_SCANCODE_INTERNATIONAL4, + pattern SDL_SCANCODE_INTERNATIONAL5, + pattern SDL_SCANCODE_INTERNATIONAL6, + pattern SDL_SCANCODE_INTERNATIONAL7, + pattern SDL_SCANCODE_INTERNATIONAL8, + pattern SDL_SCANCODE_INTERNATIONAL9, + pattern SDL_SCANCODE_LANG1, + pattern SDL_SCANCODE_LANG2, + pattern SDL_SCANCODE_LANG3, + pattern SDL_SCANCODE_LANG4, + pattern SDL_SCANCODE_LANG5, + pattern SDL_SCANCODE_LANG6, + pattern SDL_SCANCODE_LANG7, + pattern SDL_SCANCODE_LANG8, + pattern SDL_SCANCODE_LANG9, + pattern SDL_SCANCODE_ALTERASE, + pattern SDL_SCANCODE_SYSREQ, + pattern SDL_SCANCODE_CANCEL, + pattern SDL_SCANCODE_CLEAR, + pattern SDL_SCANCODE_PRIOR, + pattern SDL_SCANCODE_RETURN2, + pattern SDL_SCANCODE_SEPARATOR, + pattern SDL_SCANCODE_OUT, + pattern SDL_SCANCODE_OPER, + pattern SDL_SCANCODE_CLEARAGAIN, + pattern SDL_SCANCODE_CRSEL, + pattern SDL_SCANCODE_EXSEL, + pattern SDL_SCANCODE_KP_00, + pattern SDL_SCANCODE_KP_000, + pattern SDL_SCANCODE_THOUSANDSSEPARATOR, + pattern SDL_SCANCODE_DECIMALSEPARATOR, + pattern SDL_SCANCODE_CURRENCYUNIT, + pattern SDL_SCANCODE_CURRENCYSUBUNIT, + pattern SDL_SCANCODE_KP_LEFTPAREN, + pattern SDL_SCANCODE_KP_RIGHTPAREN, + pattern SDL_SCANCODE_KP_LEFTBRACE, + pattern SDL_SCANCODE_KP_RIGHTBRACE, + pattern SDL_SCANCODE_KP_TAB, + pattern SDL_SCANCODE_KP_BACKSPACE, + pattern SDL_SCANCODE_KP_A, + pattern SDL_SCANCODE_KP_B, + pattern SDL_SCANCODE_KP_C, + pattern SDL_SCANCODE_KP_D, + pattern SDL_SCANCODE_KP_E, + pattern SDL_SCANCODE_KP_F, + pattern SDL_SCANCODE_KP_XOR, + pattern SDL_SCANCODE_KP_POWER, + pattern SDL_SCANCODE_KP_PERCENT, + pattern SDL_SCANCODE_KP_LESS, + pattern SDL_SCANCODE_KP_GREATER, + pattern SDL_SCANCODE_KP_AMPERSAND, + pattern SDL_SCANCODE_KP_DBLAMPERSAND, + pattern SDL_SCANCODE_KP_VERTICALBAR, + pattern SDL_SCANCODE_KP_DBLVERTICALBAR, + pattern SDL_SCANCODE_KP_COLON, + pattern SDL_SCANCODE_KP_HASH, + pattern SDL_SCANCODE_KP_SPACE, + pattern SDL_SCANCODE_KP_AT, + pattern SDL_SCANCODE_KP_EXCLAM, + pattern SDL_SCANCODE_KP_MEMSTORE, + pattern SDL_SCANCODE_KP_MEMRECALL, + pattern SDL_SCANCODE_KP_MEMCLEAR, + pattern SDL_SCANCODE_KP_MEMADD, + pattern SDL_SCANCODE_KP_MEMSUBTRACT, + pattern SDL_SCANCODE_KP_MEMMULTIPLY, + pattern SDL_SCANCODE_KP_MEMDIVIDE, + pattern SDL_SCANCODE_KP_PLUSMINUS, + pattern SDL_SCANCODE_KP_CLEAR, + pattern SDL_SCANCODE_KP_CLEARENTRY, + pattern SDL_SCANCODE_KP_BINARY, + pattern SDL_SCANCODE_KP_OCTAL, + pattern SDL_SCANCODE_KP_DECIMAL, + pattern SDL_SCANCODE_KP_HEXADECIMAL, + pattern SDL_SCANCODE_LCTRL, + pattern SDL_SCANCODE_LSHIFT, + pattern SDL_SCANCODE_LALT, + pattern SDL_SCANCODE_LGUI, + pattern SDL_SCANCODE_RCTRL, + pattern SDL_SCANCODE_RSHIFT, + pattern SDL_SCANCODE_RALT, + pattern SDL_SCANCODE_RGUI, + pattern SDL_SCANCODE_MODE, + pattern SDL_SCANCODE_AUDIONEXT, + pattern SDL_SCANCODE_AUDIOPREV, + pattern SDL_SCANCODE_AUDIOSTOP, + pattern SDL_SCANCODE_AUDIOPLAY, + pattern SDL_SCANCODE_AUDIOMUTE, + pattern SDL_SCANCODE_MEDIASELECT, + pattern SDL_SCANCODE_WWW, + pattern SDL_SCANCODE_MAIL, + pattern SDL_SCANCODE_CALCULATOR, + pattern SDL_SCANCODE_COMPUTER, + pattern SDL_SCANCODE_AC_SEARCH, + pattern SDL_SCANCODE_AC_HOME, + pattern SDL_SCANCODE_AC_BACK, + pattern SDL_SCANCODE_AC_FORWARD, + pattern SDL_SCANCODE_AC_STOP, + pattern SDL_SCANCODE_AC_REFRESH, + pattern SDL_SCANCODE_AC_BOOKMARKS, + pattern SDL_SCANCODE_BRIGHTNESSDOWN, + pattern SDL_SCANCODE_BRIGHTNESSUP, + pattern SDL_SCANCODE_DISPLAYSWITCH, + pattern SDL_SCANCODE_KBDILLUMTOGGLE, + pattern SDL_SCANCODE_KBDILLUMDOWN, + pattern SDL_SCANCODE_KBDILLUMUP, + pattern SDL_SCANCODE_EJECT, + pattern SDL_SCANCODE_SLEEP, + pattern SDL_SCANCODE_APP1, + pattern SDL_SCANCODE_APP2, + pattern SDL_NUM_SCANCODES, + + pattern SDL_SYSTEM_CURSOR_ARROW, + pattern SDL_SYSTEM_CURSOR_IBEAM, + pattern SDL_SYSTEM_CURSOR_WAIT, + + -- ** System Cursor + SystemCursor, + pattern SDL_SYSTEM_CURSOR_CROSSHAIR, + pattern SDL_SYSTEM_CURSOR_WAITARROW, + pattern SDL_SYSTEM_CURSOR_SIZENWSE, + pattern SDL_SYSTEM_CURSOR_SIZENESW, + pattern SDL_SYSTEM_CURSOR_SIZEWE, + pattern SDL_SYSTEM_CURSOR_SIZENS, + pattern SDL_SYSTEM_CURSOR_SIZEALL, + pattern SDL_SYSTEM_CURSOR_NO, + pattern SDL_SYSTEM_CURSOR_HAND, + pattern SDL_NUM_SYSTEM_CURSORS, + + -- ** Thread Priority + ThreadPriority, + pattern SDL_THREAD_PRIORITY_LOW, + pattern SDL_THREAD_PRIORITY_NORMAL, + pattern SDL_THREAD_PRIORITY_HIGH, + + -- * Miscellaneous Enumerations + -- | These enumerations are not used directly by any SDL function, thus they have a polymorphic type. + + -- ** Audio Allowed Changes + pattern SDL_AUDIO_ALLOW_FREQUENCY_CHANGE, + pattern SDL_AUDIO_ALLOW_FORMAT_CHANGE, + pattern SDL_AUDIO_ALLOW_CHANNELS_CHANGE, + pattern SDL_AUDIO_ALLOW_ANY_CHANGE, + + -- ** Mouse Buttons + pattern SDL_BUTTON_LEFT, + pattern SDL_BUTTON_MIDDLE, + pattern SDL_BUTTON_RIGHT, + pattern SDL_BUTTON_X1, + pattern SDL_BUTTON_X2, + + -- ** Mouse Button Masks + pattern SDL_BUTTON_LMASK, + pattern SDL_BUTTON_MMASK, + pattern SDL_BUTTON_RMASK, + pattern SDL_BUTTON_X1MASK, + pattern SDL_BUTTON_X2MASK, + + -- ** Event Type + pattern SDL_FIRSTEVENT, + pattern SDL_QUIT, + pattern SDL_APP_TERMINATING, + pattern SDL_APP_LOWMEMORY, + pattern SDL_APP_WILLENTERBACKGROUND, + pattern SDL_APP_DIDENTERBACKGROUND, + pattern SDL_APP_WILLENTERFOREGROUND, + pattern SDL_APP_DIDENTERFOREGROUND, + pattern SDL_WINDOWEVENT, + pattern SDL_SYSWMEVENT, + pattern SDL_KEYDOWN, + pattern SDL_KEYUP, + pattern SDL_TEXTEDITING, + pattern SDL_TEXTINPUT, + pattern SDL_MOUSEMOTION, + pattern SDL_MOUSEBUTTONDOWN, + pattern SDL_MOUSEBUTTONUP, + pattern SDL_MOUSEWHEEL, + pattern SDL_JOYAXISMOTION, + pattern SDL_JOYBALLMOTION, + pattern SDL_JOYHATMOTION, + pattern SDL_JOYBUTTONDOWN, + pattern SDL_JOYBUTTONUP, + pattern SDL_JOYDEVICEADDED, + pattern SDL_JOYDEVICEREMOVED, + pattern SDL_CONTROLLERAXISMOTION, + pattern SDL_CONTROLLERBUTTONDOWN, + pattern SDL_CONTROLLERBUTTONUP, + pattern SDL_CONTROLLERDEVICEADDED, + pattern SDL_CONTROLLERDEVICEREMOVED, + pattern SDL_CONTROLLERDEVICEREMAPPED, + pattern SDL_FINGERDOWN, + pattern SDL_FINGERUP, + pattern SDL_FINGERMOTION, + pattern SDL_DOLLARGESTURE, + pattern SDL_DOLLARRECORD, + pattern SDL_MULTIGESTURE, + pattern SDL_CLIPBOARDUPDATE, + pattern SDL_DROPFILE, + pattern SDL_USEREVENT, + pattern SDL_LASTEVENT, + + -- ** Joystick Hat Position + pattern SDL_HAT_CENTERED, + pattern SDL_HAT_UP, + pattern SDL_HAT_RIGHT, + pattern SDL_HAT_DOWN, + pattern SDL_HAT_LEFT, + pattern SDL_HAT_RIGHTUP, + pattern SDL_HAT_RIGHTDOWN, + pattern SDL_HAT_LEFTUP, + pattern SDL_HAT_LEFTDOWN, + + -- ** Key States + pattern SDL_PRESSED, + pattern SDL_RELEASED, + + -- ** Log Category + pattern SDL_LOG_CATEGORY_APPLICATION, + pattern SDL_LOG_CATEGORY_ERROR, + pattern SDL_LOG_CATEGORY_ASSERT, + pattern SDL_LOG_CATEGORY_SYSTEM, + pattern SDL_LOG_CATEGORY_AUDIO, + pattern SDL_LOG_CATEGORY_VIDEO, + pattern SDL_LOG_CATEGORY_RENDER, + pattern SDL_LOG_CATEGORY_INPUT, + pattern SDL_LOG_CATEGORY_TEST, + pattern SDL_LOG_CATEGORY_CUSTOM, + + -- ** Message Box Flags + pattern SDL_MESSAGEBOX_ERROR, + pattern SDL_MESSAGEBOX_WARNING, + pattern SDL_MESSAGEBOX_INFORMATION, + + -- ** Message Box Button Flags + pattern SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT, + pattern SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT, + + -- ** OpenGL Profile + pattern SDL_GL_CONTEXT_PROFILE_CORE, + pattern SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, + pattern SDL_GL_CONTEXT_PROFILE_ES, + + -- ** OpenGL Context Flag + pattern SDL_GL_CONTEXT_DEBUG_FLAG, + pattern SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG, + pattern SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG, + pattern SDL_GL_CONTEXT_RESET_ISOLATION_FLAG, + + -- ** Pixel Formats + pattern SDL_PIXELFORMAT_UNKNOWN, + pattern SDL_PIXELFORMAT_INDEX1LSB, + pattern SDL_PIXELFORMAT_INDEX1MSB, + pattern SDL_PIXELFORMAT_INDEX4LSB, + pattern SDL_PIXELFORMAT_INDEX4MSB, + pattern SDL_PIXELFORMAT_INDEX8, + pattern SDL_PIXELFORMAT_RGB332, + pattern SDL_PIXELFORMAT_RGB444, + pattern SDL_PIXELFORMAT_RGB555, + pattern SDL_PIXELFORMAT_BGR555, + pattern SDL_PIXELFORMAT_ARGB4444, + pattern SDL_PIXELFORMAT_RGBA4444, + pattern SDL_PIXELFORMAT_ABGR4444, + pattern SDL_PIXELFORMAT_BGRA4444, + pattern SDL_PIXELFORMAT_ARGB1555, + pattern SDL_PIXELFORMAT_RGBA5551, + pattern SDL_PIXELFORMAT_ABGR1555, + pattern SDL_PIXELFORMAT_BGRA5551, + pattern SDL_PIXELFORMAT_RGB565, + pattern SDL_PIXELFORMAT_BGR565, + pattern SDL_PIXELFORMAT_RGB24, + pattern SDL_PIXELFORMAT_BGR24, + pattern SDL_PIXELFORMAT_RGB888, + pattern SDL_PIXELFORMAT_RGBX8888, + pattern SDL_PIXELFORMAT_BGR888, + pattern SDL_PIXELFORMAT_BGRX8888, + pattern SDL_PIXELFORMAT_ARGB8888, + pattern SDL_PIXELFORMAT_RGBA8888, + pattern SDL_PIXELFORMAT_ABGR8888, + pattern SDL_PIXELFORMAT_BGRA8888, + pattern SDL_PIXELFORMAT_ARGB2101010, + pattern SDL_PIXELFORMAT_YV12, + pattern SDL_PIXELFORMAT_IYUV, + pattern SDL_PIXELFORMAT_YUY2, + pattern SDL_PIXELFORMAT_UYVY, + pattern SDL_PIXELFORMAT_YVYU, + + -- ** Renderer Flags + pattern SDL_RENDERER_SOFTWARE, + pattern SDL_RENDERER_ACCELERATED, + pattern SDL_RENDERER_PRESENTVSYNC, + pattern SDL_RENDERER_TARGETTEXTURE, + + -- ** Texture Access + pattern SDL_TEXTUREACCESS_STATIC, + pattern SDL_TEXTUREACCESS_STREAMING, + pattern SDL_TEXTUREACCESS_TARGET, + + -- ** Texture Modulate + pattern SDL_TEXTUREMODULATE_NONE, + pattern SDL_TEXTUREMODULATE_COLOR, + pattern SDL_TEXTUREMODULATE_ALPHA, + + -- ** Touch + pattern SDL_TOUCH_MOUSEID, + + -- ** Window Event + pattern SDL_WINDOWEVENT_NONE, + pattern SDL_WINDOWEVENT_SHOWN, + pattern SDL_WINDOWEVENT_HIDDEN, + pattern SDL_WINDOWEVENT_EXPOSED, + pattern SDL_WINDOWEVENT_MOVED, + pattern SDL_WINDOWEVENT_RESIZED, + pattern SDL_WINDOWEVENT_SIZE_CHANGED, + pattern SDL_WINDOWEVENT_MINIMIZED, + pattern SDL_WINDOWEVENT_MAXIMIZED, + pattern SDL_WINDOWEVENT_RESTORED, + pattern SDL_WINDOWEVENT_ENTER, + pattern SDL_WINDOWEVENT_LEAVE, + pattern SDL_WINDOWEVENT_FOCUS_GAINED, + pattern SDL_WINDOWEVENT_FOCUS_LOST, + pattern SDL_WINDOWEVENT_CLOSE, + + -- ** Window Flags + pattern SDL_WINDOW_FULLSCREEN, + pattern SDL_WINDOW_OPENGL, + pattern SDL_WINDOW_SHOWN, + pattern SDL_WINDOW_HIDDEN, + pattern SDL_WINDOW_BORDERLESS, + pattern SDL_WINDOW_RESIZABLE, + pattern SDL_WINDOW_MINIMIZED, + pattern SDL_WINDOW_MAXIMIZED, + pattern SDL_WINDOW_INPUT_GRABBED, + pattern SDL_WINDOW_INPUT_FOCUS, + pattern SDL_WINDOW_MOUSE_FOCUS, + pattern SDL_WINDOW_FULLSCREEN_DESKTOP, + pattern SDL_WINDOW_FOREIGN, + pattern SDL_WINDOW_ALLOW_HIGHDPI, + + -- ** Window Positioning + pattern SDL_WINDOWPOS_UNDEFINED, + pattern SDL_WINDOWPOS_CENTERED, + + -- ** Haptic Event Types + pattern SDL_HAPTIC_CONSTANT +) where + +#include "SDL.h" + +import Data.Int +import Data.Word + +import Foreign.C.Types + +type AudioFormat = (#type SDL_AudioFormat) +type AudioStatus = (#type SDL_AudioStatus) +type BlendMode = (#type SDL_BlendMode) +type Endian = CInt +type EventAction = (#type SDL_eventaction) +type GameControllerAxis = (#type SDL_GameControllerAxis) +type GameControllerButton = (#type SDL_GameControllerButton) +type GLattr = (#type SDL_GLattr) +type HintPriority = (#type SDL_HintPriority) +type InitFlag = Word32 +type Keycode = (#type SDL_Keycode) +type Keymod = (#type SDL_Keymod) +type LogPriority = (#type SDL_LogPriority) +type PowerState = (#type SDL_PowerState) +type RendererFlip = (#type SDL_RendererFlip) +type Scancode = (#type SDL_Scancode) +type SystemCursor = (#type SDL_SystemCursor) +type ThreadPriority = (#type SDL_ThreadPriority) + +pattern SDL_AUDIO_S8 = (#const AUDIO_S8) :: AudioFormat +pattern SDL_AUDIO_U8 = (#const AUDIO_U8) :: AudioFormat +pattern SDL_AUDIO_S16LSB = (#const AUDIO_S16LSB) :: AudioFormat +pattern SDL_AUDIO_S16MSB = (#const AUDIO_S16MSB) :: AudioFormat +pattern SDL_AUDIO_S16SYS = (#const AUDIO_S16SYS) :: AudioFormat +pattern SDL_AUDIO_U16LSB = (#const AUDIO_U16LSB) :: AudioFormat +pattern SDL_AUDIO_U16MSB = (#const AUDIO_U16MSB) :: AudioFormat +pattern SDL_AUDIO_U16SYS = (#const AUDIO_U16SYS) :: AudioFormat +pattern SDL_AUDIO_S32LSB = (#const AUDIO_S32LSB) :: AudioFormat +pattern SDL_AUDIO_S32MSB = (#const AUDIO_S32MSB) :: AudioFormat +pattern SDL_AUDIO_S32SYS = (#const AUDIO_S32SYS) :: AudioFormat +pattern SDL_AUDIO_F32LSB = (#const AUDIO_F32LSB) :: AudioFormat +pattern SDL_AUDIO_F32MSB = (#const AUDIO_F32MSB) :: AudioFormat +pattern SDL_AUDIO_F32SYS = (#const AUDIO_F32SYS) :: AudioFormat + +pattern SDL_AUDIO_STOPPED = (#const SDL_AUDIO_STOPPED) :: AudioStatus +pattern SDL_AUDIO_PLAYING = (#const SDL_AUDIO_PLAYING) :: AudioStatus +pattern SDL_AUDIO_PAUSED = (#const SDL_AUDIO_PAUSED) :: AudioStatus + +pattern SDL_BLENDMODE_NONE = (#const SDL_BLENDMODE_NONE) :: BlendMode +pattern SDL_BLENDMODE_BLEND = (#const SDL_BLENDMODE_BLEND) :: BlendMode +pattern SDL_BLENDMODE_ADD = (#const SDL_BLENDMODE_ADD) :: BlendMode +pattern SDL_BLENDMODE_MOD = (#const SDL_BLENDMODE_MOD) :: BlendMode + +pattern SDL_BYTEORDER = (#const SDL_BYTEORDER) :: Endian +pattern SDL_LIL_ENDIAN = (#const SDL_LIL_ENDIAN) :: Endian +pattern SDL_BIG_ENDIAN = (#const SDL_BIG_ENDIAN) :: Endian + +pattern SDL_ADDEVENT = (#const SDL_ADDEVENT) :: EventAction +pattern SDL_PEEKEVENT = (#const SDL_PEEKEVENT) :: EventAction +pattern SDL_GETEVENT = (#const SDL_GETEVENT) :: EventAction + +pattern SDL_CONTROLLER_AXIS_INVALID = (#const SDL_CONTROLLER_AXIS_INVALID) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_LEFTX = (#const SDL_CONTROLLER_AXIS_LEFTX) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_LEFTY = (#const SDL_CONTROLLER_AXIS_LEFTY) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_RIGHTX = (#const SDL_CONTROLLER_AXIS_RIGHTX) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_RIGHTY = (#const SDL_CONTROLLER_AXIS_RIGHTY) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_TRIGGERLEFT = (#const SDL_CONTROLLER_AXIS_TRIGGERLEFT) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_TRIGGERRIGHT = (#const SDL_CONTROLLER_AXIS_TRIGGERRIGHT) :: GameControllerAxis +pattern SDL_CONTROLLER_AXIS_MAX = (#const SDL_CONTROLLER_AXIS_MAX) :: GameControllerAxis + +pattern SDL_CONTROLLER_BUTTON_INVALID = (#const SDL_CONTROLLER_BUTTON_INVALID) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_A = (#const SDL_CONTROLLER_BUTTON_A) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_B = (#const SDL_CONTROLLER_BUTTON_B) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_X = (#const SDL_CONTROLLER_BUTTON_X) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_Y = (#const SDL_CONTROLLER_BUTTON_Y) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_BACK = (#const SDL_CONTROLLER_BUTTON_BACK) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_GUIDE = (#const SDL_CONTROLLER_BUTTON_GUIDE) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_START = (#const SDL_CONTROLLER_BUTTON_START) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_LEFTSTICK = (#const SDL_CONTROLLER_BUTTON_LEFTSTICK) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_RIGHTSTICK = (#const SDL_CONTROLLER_BUTTON_RIGHTSTICK) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_LEFTSHOULDER = (#const SDL_CONTROLLER_BUTTON_LEFTSHOULDER) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_RIGHTSHOULDER = (#const SDL_CONTROLLER_BUTTON_RIGHTSHOULDER) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_DPAD_UP = (#const SDL_CONTROLLER_BUTTON_DPAD_UP) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_DPAD_DOWN = (#const SDL_CONTROLLER_BUTTON_DPAD_DOWN) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_DPAD_LEFT = (#const SDL_CONTROLLER_BUTTON_DPAD_LEFT) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_DPAD_RIGHT = (#const SDL_CONTROLLER_BUTTON_DPAD_RIGHT) :: GameControllerButton +pattern SDL_CONTROLLER_BUTTON_MAX = (#const SDL_CONTROLLER_BUTTON_MAX) :: GameControllerButton + +pattern SDL_GL_RED_SIZE = (#const SDL_GL_RED_SIZE) :: GLattr +pattern SDL_GL_GREEN_SIZE = (#const SDL_GL_GREEN_SIZE) :: GLattr +pattern SDL_GL_BLUE_SIZE = (#const SDL_GL_BLUE_SIZE) :: GLattr +pattern SDL_GL_ALPHA_SIZE = (#const SDL_GL_ALPHA_SIZE) :: GLattr +pattern SDL_GL_BUFFER_SIZE = (#const SDL_GL_BUFFER_SIZE) :: GLattr +pattern SDL_GL_DOUBLEBUFFER = (#const SDL_GL_DOUBLEBUFFER) :: GLattr +pattern SDL_GL_DEPTH_SIZE = (#const SDL_GL_DEPTH_SIZE) :: GLattr +pattern SDL_GL_STENCIL_SIZE = (#const SDL_GL_STENCIL_SIZE) :: GLattr +pattern SDL_GL_ACCUM_RED_SIZE = (#const SDL_GL_ACCUM_RED_SIZE) :: GLattr +pattern SDL_GL_ACCUM_GREEN_SIZE = (#const SDL_GL_ACCUM_GREEN_SIZE) :: GLattr +pattern SDL_GL_ACCUM_BLUE_SIZE = (#const SDL_GL_ACCUM_BLUE_SIZE) :: GLattr +pattern SDL_GL_ACCUM_ALPHA_SIZE = (#const SDL_GL_ACCUM_ALPHA_SIZE) :: GLattr +pattern SDL_GL_STEREO = (#const SDL_GL_STEREO) :: GLattr +pattern SDL_GL_MULTISAMPLEBUFFERS = (#const SDL_GL_MULTISAMPLEBUFFERS) :: GLattr +pattern SDL_GL_MULTISAMPLESAMPLES = (#const SDL_GL_MULTISAMPLESAMPLES) :: GLattr +pattern SDL_GL_ACCELERATED_VISUAL = (#const SDL_GL_ACCELERATED_VISUAL) :: GLattr +pattern SDL_GL_RETAINED_BACKING = (#const SDL_GL_RETAINED_BACKING) :: GLattr +pattern SDL_GL_CONTEXT_MAJOR_VERSION = (#const SDL_GL_CONTEXT_MAJOR_VERSION) :: GLattr +pattern SDL_GL_CONTEXT_MINOR_VERSION = (#const SDL_GL_CONTEXT_MINOR_VERSION) :: GLattr +pattern SDL_GL_CONTEXT_EGL = (#const SDL_GL_CONTEXT_EGL) :: GLattr +pattern SDL_GL_CONTEXT_FLAGS = (#const SDL_GL_CONTEXT_FLAGS) :: GLattr +pattern SDL_GL_CONTEXT_PROFILE_MASK = (#const SDL_GL_CONTEXT_PROFILE_MASK) :: GLattr +pattern SDL_GL_SHARE_WITH_CURRENT_CONTEXT = (#const SDL_GL_SHARE_WITH_CURRENT_CONTEXT) :: GLattr +pattern SDL_GL_FRAMEBUFFER_SRGB_CAPABLE = (#const SDL_GL_FRAMEBUFFER_SRGB_CAPABLE) :: GLattr + +pattern SDL_HINT_DEFAULT = (#const SDL_HINT_DEFAULT) :: HintPriority +pattern SDL_HINT_NORMAL = (#const SDL_HINT_NORMAL) :: HintPriority +pattern SDL_HINT_OVERRIDE = (#const SDL_HINT_OVERRIDE) :: HintPriority + +pattern SDL_INIT_TIMER = (#const SDL_INIT_TIMER) :: InitFlag +pattern SDL_INIT_AUDIO = (#const SDL_INIT_AUDIO) :: InitFlag +pattern SDL_INIT_VIDEO = (#const SDL_INIT_VIDEO) :: InitFlag +pattern SDL_INIT_JOYSTICK = (#const SDL_INIT_JOYSTICK) :: InitFlag +pattern SDL_INIT_HAPTIC = (#const SDL_INIT_HAPTIC) :: InitFlag +pattern SDL_INIT_GAMECONTROLLER = (#const SDL_INIT_GAMECONTROLLER) :: InitFlag +pattern SDL_INIT_EVENTS = (#const SDL_INIT_EVENTS) :: InitFlag +pattern SDL_INIT_NOPARACHUTE = (#const SDL_INIT_NOPARACHUTE) :: InitFlag +pattern SDL_INIT_EVERYTHING = (#const SDL_INIT_EVERYTHING) :: InitFlag + +pattern SDLK_UNKNOWN = (#const SDLK_UNKNOWN) :: Keycode +pattern SDLK_RETURN = (#const SDLK_RETURN) :: Keycode +pattern SDLK_ESCAPE = (#const SDLK_ESCAPE) :: Keycode +pattern SDLK_BACKSPACE = (#const SDLK_BACKSPACE) :: Keycode +pattern SDLK_TAB = (#const SDLK_TAB) :: Keycode +pattern SDLK_SPACE = (#const SDLK_SPACE) :: Keycode +pattern SDLK_EXCLAIM = (#const SDLK_EXCLAIM) :: Keycode +pattern SDLK_QUOTEDBL = (#const SDLK_QUOTEDBL) :: Keycode +pattern SDLK_HASH = (#const SDLK_HASH) :: Keycode +pattern SDLK_PERCENT = (#const SDLK_PERCENT) :: Keycode +pattern SDLK_DOLLAR = (#const SDLK_DOLLAR) :: Keycode +pattern SDLK_AMPERSAND = (#const SDLK_AMPERSAND) :: Keycode +pattern SDLK_QUOTE = (#const SDLK_QUOTE) :: Keycode +pattern SDLK_LEFTPAREN = (#const SDLK_LEFTPAREN) :: Keycode +pattern SDLK_RIGHTPAREN = (#const SDLK_RIGHTPAREN) :: Keycode +pattern SDLK_ASTERISK = (#const SDLK_ASTERISK) :: Keycode +pattern SDLK_PLUS = (#const SDLK_PLUS) :: Keycode +pattern SDLK_COMMA = (#const SDLK_COMMA) :: Keycode +pattern SDLK_MINUS = (#const SDLK_MINUS) :: Keycode +pattern SDLK_PERIOD = (#const SDLK_PERIOD) :: Keycode +pattern SDLK_SLASH = (#const SDLK_SLASH) :: Keycode +pattern SDLK_0 = (#const SDLK_0) :: Keycode +pattern SDLK_1 = (#const SDLK_1) :: Keycode +pattern SDLK_2 = (#const SDLK_2) :: Keycode +pattern SDLK_3 = (#const SDLK_3) :: Keycode +pattern SDLK_4 = (#const SDLK_4) :: Keycode +pattern SDLK_5 = (#const SDLK_5) :: Keycode +pattern SDLK_6 = (#const SDLK_6) :: Keycode +pattern SDLK_7 = (#const SDLK_7) :: Keycode +pattern SDLK_8 = (#const SDLK_8) :: Keycode +pattern SDLK_9 = (#const SDLK_9) :: Keycode +pattern SDLK_COLON = (#const SDLK_COLON) :: Keycode +pattern SDLK_SEMICOLON = (#const SDLK_SEMICOLON) :: Keycode +pattern SDLK_LESS = (#const SDLK_LESS) :: Keycode +pattern SDLK_EQUALS = (#const SDLK_EQUALS) :: Keycode +pattern SDLK_GREATER = (#const SDLK_GREATER) :: Keycode +pattern SDLK_QUESTION = (#const SDLK_QUESTION) :: Keycode +pattern SDLK_AT = (#const SDLK_AT) :: Keycode +pattern SDLK_LEFTBRACKET = (#const SDLK_LEFTBRACKET) :: Keycode +pattern SDLK_BACKSLASH = (#const SDLK_BACKSLASH) :: Keycode +pattern SDLK_RIGHTBRACKET = (#const SDLK_RIGHTBRACKET) :: Keycode +pattern SDLK_CARET = (#const SDLK_CARET) :: Keycode +pattern SDLK_UNDERSCORE = (#const SDLK_UNDERSCORE) :: Keycode +pattern SDLK_BACKQUOTE = (#const SDLK_BACKQUOTE) :: Keycode +pattern SDLK_a = (#const SDLK_a) :: Keycode +pattern SDLK_b = (#const SDLK_b) :: Keycode +pattern SDLK_c = (#const SDLK_c) :: Keycode +pattern SDLK_d = (#const SDLK_d) :: Keycode +pattern SDLK_e = (#const SDLK_e) :: Keycode +pattern SDLK_f = (#const SDLK_f) :: Keycode +pattern SDLK_g = (#const SDLK_g) :: Keycode +pattern SDLK_h = (#const SDLK_h) :: Keycode +pattern SDLK_i = (#const SDLK_i) :: Keycode +pattern SDLK_j = (#const SDLK_j) :: Keycode +pattern SDLK_k = (#const SDLK_k) :: Keycode +pattern SDLK_l = (#const SDLK_l) :: Keycode +pattern SDLK_m = (#const SDLK_m) :: Keycode +pattern SDLK_n = (#const SDLK_n) :: Keycode +pattern SDLK_o = (#const SDLK_o) :: Keycode +pattern SDLK_p = (#const SDLK_p) :: Keycode +pattern SDLK_q = (#const SDLK_q) :: Keycode +pattern SDLK_r = (#const SDLK_r) :: Keycode +pattern SDLK_s = (#const SDLK_s) :: Keycode +pattern SDLK_t = (#const SDLK_t) :: Keycode +pattern SDLK_u = (#const SDLK_u) :: Keycode +pattern SDLK_v = (#const SDLK_v) :: Keycode +pattern SDLK_w = (#const SDLK_w) :: Keycode +pattern SDLK_x = (#const SDLK_x) :: Keycode +pattern SDLK_y = (#const SDLK_y) :: Keycode +pattern SDLK_z = (#const SDLK_z) :: Keycode +pattern SDLK_CAPSLOCK = (#const SDLK_CAPSLOCK) :: Keycode +pattern SDLK_F1 = (#const SDLK_F1) :: Keycode +pattern SDLK_F2 = (#const SDLK_F2) :: Keycode +pattern SDLK_F3 = (#const SDLK_F3) :: Keycode +pattern SDLK_F4 = (#const SDLK_F4) :: Keycode +pattern SDLK_F5 = (#const SDLK_F5) :: Keycode +pattern SDLK_F6 = (#const SDLK_F6) :: Keycode +pattern SDLK_F7 = (#const SDLK_F7) :: Keycode +pattern SDLK_F8 = (#const SDLK_F8) :: Keycode +pattern SDLK_F9 = (#const SDLK_F9) :: Keycode +pattern SDLK_F10 = (#const SDLK_F10) :: Keycode +pattern SDLK_F11 = (#const SDLK_F11) :: Keycode +pattern SDLK_F12 = (#const SDLK_F12) :: Keycode +pattern SDLK_PRINTSCREEN = (#const SDLK_PRINTSCREEN) :: Keycode +pattern SDLK_SCROLLLOCK = (#const SDLK_SCROLLLOCK) :: Keycode +pattern SDLK_PAUSE = (#const SDLK_PAUSE) :: Keycode +pattern SDLK_INSERT = (#const SDLK_INSERT) :: Keycode +pattern SDLK_HOME = (#const SDLK_HOME) :: Keycode +pattern SDLK_PAGEUP = (#const SDLK_PAGEUP) :: Keycode +pattern SDLK_DELETE = (#const SDLK_DELETE) :: Keycode +pattern SDLK_END = (#const SDLK_END) :: Keycode +pattern SDLK_PAGEDOWN = (#const SDLK_PAGEDOWN) :: Keycode +pattern SDLK_RIGHT = (#const SDLK_RIGHT) :: Keycode +pattern SDLK_LEFT = (#const SDLK_LEFT) :: Keycode +pattern SDLK_DOWN = (#const SDLK_DOWN) :: Keycode +pattern SDLK_UP = (#const SDLK_UP) :: Keycode +pattern SDLK_NUMLOCKCLEAR = (#const SDLK_NUMLOCKCLEAR) :: Keycode +pattern SDLK_KP_DIVIDE = (#const SDLK_KP_DIVIDE) :: Keycode +pattern SDLK_KP_MULTIPLY = (#const SDLK_KP_MULTIPLY) :: Keycode +pattern SDLK_KP_MINUS = (#const SDLK_KP_MINUS) :: Keycode +pattern SDLK_KP_PLUS = (#const SDLK_KP_PLUS) :: Keycode +pattern SDLK_KP_ENTER = (#const SDLK_KP_ENTER) :: Keycode +pattern SDLK_KP_1 = (#const SDLK_KP_1) :: Keycode +pattern SDLK_KP_2 = (#const SDLK_KP_2) :: Keycode +pattern SDLK_KP_3 = (#const SDLK_KP_3) :: Keycode +pattern SDLK_KP_4 = (#const SDLK_KP_4) :: Keycode +pattern SDLK_KP_5 = (#const SDLK_KP_5) :: Keycode +pattern SDLK_KP_6 = (#const SDLK_KP_6) :: Keycode +pattern SDLK_KP_7 = (#const SDLK_KP_7) :: Keycode +pattern SDLK_KP_8 = (#const SDLK_KP_8) :: Keycode +pattern SDLK_KP_9 = (#const SDLK_KP_9) :: Keycode +pattern SDLK_KP_0 = (#const SDLK_KP_0) :: Keycode +pattern SDLK_KP_PERIOD = (#const SDLK_KP_PERIOD) :: Keycode +pattern SDLK_APPLICATION = (#const SDLK_APPLICATION) :: Keycode +pattern SDLK_POWER = (#const SDLK_POWER) :: Keycode +pattern SDLK_KP_EQUALS = (#const SDLK_KP_EQUALS) :: Keycode +pattern SDLK_F13 = (#const SDLK_F13) :: Keycode +pattern SDLK_F14 = (#const SDLK_F14) :: Keycode +pattern SDLK_F15 = (#const SDLK_F15) :: Keycode +pattern SDLK_F16 = (#const SDLK_F16) :: Keycode +pattern SDLK_F17 = (#const SDLK_F17) :: Keycode +pattern SDLK_F18 = (#const SDLK_F18) :: Keycode +pattern SDLK_F19 = (#const SDLK_F19) :: Keycode +pattern SDLK_F20 = (#const SDLK_F20) :: Keycode +pattern SDLK_F21 = (#const SDLK_F21) :: Keycode +pattern SDLK_F22 = (#const SDLK_F22) :: Keycode +pattern SDLK_F23 = (#const SDLK_F23) :: Keycode +pattern SDLK_F24 = (#const SDLK_F24) :: Keycode +pattern SDLK_EXECUTE = (#const SDLK_EXECUTE) :: Keycode +pattern SDLK_HELP = (#const SDLK_HELP) :: Keycode +pattern SDLK_MENU = (#const SDLK_MENU) :: Keycode +pattern SDLK_SELECT = (#const SDLK_SELECT) :: Keycode +pattern SDLK_STOP = (#const SDLK_STOP) :: Keycode +pattern SDLK_AGAIN = (#const SDLK_AGAIN) :: Keycode +pattern SDLK_UNDO = (#const SDLK_UNDO) :: Keycode +pattern SDLK_CUT = (#const SDLK_CUT) :: Keycode +pattern SDLK_COPY = (#const SDLK_COPY) :: Keycode +pattern SDLK_PASTE = (#const SDLK_PASTE) :: Keycode +pattern SDLK_FIND = (#const SDLK_FIND) :: Keycode +pattern SDLK_MUTE = (#const SDLK_MUTE) :: Keycode +pattern SDLK_VOLUMEUP = (#const SDLK_VOLUMEUP) :: Keycode +pattern SDLK_VOLUMEDOWN = (#const SDLK_VOLUMEDOWN) :: Keycode +pattern SDLK_KP_COMMA = (#const SDLK_KP_COMMA) :: Keycode +pattern SDLK_KP_EQUALSAS400 = (#const SDLK_KP_EQUALSAS400) :: Keycode +pattern SDLK_ALTERASE = (#const SDLK_ALTERASE) :: Keycode +pattern SDLK_SYSREQ = (#const SDLK_SYSREQ) :: Keycode +pattern SDLK_CANCEL = (#const SDLK_CANCEL) :: Keycode +pattern SDLK_CLEAR = (#const SDLK_CLEAR) :: Keycode +pattern SDLK_PRIOR = (#const SDLK_PRIOR) :: Keycode +pattern SDLK_RETURN2 = (#const SDLK_RETURN2) :: Keycode +pattern SDLK_SEPARATOR = (#const SDLK_SEPARATOR) :: Keycode +pattern SDLK_OUT = (#const SDLK_OUT) :: Keycode +pattern SDLK_OPER = (#const SDLK_OPER) :: Keycode +pattern SDLK_CLEARAGAIN = (#const SDLK_CLEARAGAIN) :: Keycode +pattern SDLK_CRSEL = (#const SDLK_CRSEL) :: Keycode +pattern SDLK_EXSEL = (#const SDLK_EXSEL) :: Keycode +pattern SDLK_KP_00 = (#const SDLK_KP_00) :: Keycode +pattern SDLK_KP_000 = (#const SDLK_KP_000) :: Keycode +pattern SDLK_THOUSANDSSEPARATOR = (#const SDLK_THOUSANDSSEPARATOR) :: Keycode +pattern SDLK_DECIMALSEPARATOR = (#const SDLK_DECIMALSEPARATOR) :: Keycode +pattern SDLK_CURRENCYUNIT = (#const SDLK_CURRENCYUNIT) :: Keycode +pattern SDLK_CURRENCYSUBUNIT = (#const SDLK_CURRENCYSUBUNIT) :: Keycode +pattern SDLK_KP_LEFTPAREN = (#const SDLK_KP_LEFTPAREN) :: Keycode +pattern SDLK_KP_RIGHTPAREN = (#const SDLK_KP_RIGHTPAREN) :: Keycode +pattern SDLK_KP_LEFTBRACE = (#const SDLK_KP_LEFTBRACE) :: Keycode +pattern SDLK_KP_RIGHTBRACE = (#const SDLK_KP_RIGHTBRACE) :: Keycode +pattern SDLK_KP_TAB = (#const SDLK_KP_TAB) :: Keycode +pattern SDLK_KP_BACKSPACE = (#const SDLK_KP_BACKSPACE) :: Keycode +pattern SDLK_KP_A = (#const SDLK_KP_A) :: Keycode +pattern SDLK_KP_B = (#const SDLK_KP_B) :: Keycode +pattern SDLK_KP_C = (#const SDLK_KP_C) :: Keycode +pattern SDLK_KP_D = (#const SDLK_KP_D) :: Keycode +pattern SDLK_KP_E = (#const SDLK_KP_E) :: Keycode +pattern SDLK_KP_F = (#const SDLK_KP_F) :: Keycode +pattern SDLK_KP_XOR = (#const SDLK_KP_XOR) :: Keycode +pattern SDLK_KP_POWER = (#const SDLK_KP_POWER) :: Keycode +pattern SDLK_KP_PERCENT = (#const SDLK_KP_PERCENT) :: Keycode +pattern SDLK_KP_LESS = (#const SDLK_KP_LESS) :: Keycode +pattern SDLK_KP_GREATER = (#const SDLK_KP_GREATER) :: Keycode +pattern SDLK_KP_AMPERSAND = (#const SDLK_KP_AMPERSAND) :: Keycode +pattern SDLK_KP_DBLAMPERSAND = (#const SDLK_KP_DBLAMPERSAND) :: Keycode +pattern SDLK_KP_VERTICALBAR = (#const SDLK_KP_VERTICALBAR) :: Keycode +pattern SDLK_KP_DBLVERTICALBAR = (#const SDLK_KP_DBLVERTICALBAR) :: Keycode +pattern SDLK_KP_COLON = (#const SDLK_KP_COLON) :: Keycode +pattern SDLK_KP_HASH = (#const SDLK_KP_HASH) :: Keycode +pattern SDLK_KP_SPACE = (#const SDLK_KP_SPACE) :: Keycode +pattern SDLK_KP_AT = (#const SDLK_KP_AT) :: Keycode +pattern SDLK_KP_EXCLAM = (#const SDLK_KP_EXCLAM) :: Keycode +pattern SDLK_KP_MEMSTORE = (#const SDLK_KP_MEMSTORE) :: Keycode +pattern SDLK_KP_MEMRECALL = (#const SDLK_KP_MEMRECALL) :: Keycode +pattern SDLK_KP_MEMCLEAR = (#const SDLK_KP_MEMCLEAR) :: Keycode +pattern SDLK_KP_MEMADD = (#const SDLK_KP_MEMADD) :: Keycode +pattern SDLK_KP_MEMSUBTRACT = (#const SDLK_KP_MEMSUBTRACT) :: Keycode +pattern SDLK_KP_MEMMULTIPLY = (#const SDLK_KP_MEMMULTIPLY) :: Keycode +pattern SDLK_KP_MEMDIVIDE = (#const SDLK_KP_MEMDIVIDE) :: Keycode +pattern SDLK_KP_PLUSMINUS = (#const SDLK_KP_PLUSMINUS) :: Keycode +pattern SDLK_KP_CLEAR = (#const SDLK_KP_CLEAR) :: Keycode +pattern SDLK_KP_CLEARENTRY = (#const SDLK_KP_CLEARENTRY) :: Keycode +pattern SDLK_KP_BINARY = (#const SDLK_KP_BINARY) :: Keycode +pattern SDLK_KP_OCTAL = (#const SDLK_KP_OCTAL) :: Keycode +pattern SDLK_KP_DECIMAL = (#const SDLK_KP_DECIMAL) :: Keycode +pattern SDLK_KP_HEXADECIMAL = (#const SDLK_KP_HEXADECIMAL) :: Keycode +pattern SDLK_LCTRL = (#const SDLK_LCTRL) :: Keycode +pattern SDLK_LSHIFT = (#const SDLK_LSHIFT) :: Keycode +pattern SDLK_LALT = (#const SDLK_LALT) :: Keycode +pattern SDLK_LGUI = (#const SDLK_LGUI) :: Keycode +pattern SDLK_RCTRL = (#const SDLK_RCTRL) :: Keycode +pattern SDLK_RSHIFT = (#const SDLK_RSHIFT) :: Keycode +pattern SDLK_RALT = (#const SDLK_RALT) :: Keycode +pattern SDLK_RGUI = (#const SDLK_RGUI) :: Keycode +pattern SDLK_MODE = (#const SDLK_MODE) :: Keycode +pattern SDLK_AUDIONEXT = (#const SDLK_AUDIONEXT) :: Keycode +pattern SDLK_AUDIOPREV = (#const SDLK_AUDIOPREV) :: Keycode +pattern SDLK_AUDIOSTOP = (#const SDLK_AUDIOSTOP) :: Keycode +pattern SDLK_AUDIOPLAY = (#const SDLK_AUDIOPLAY) :: Keycode +pattern SDLK_AUDIOMUTE = (#const SDLK_AUDIOMUTE) :: Keycode +pattern SDLK_MEDIASELECT = (#const SDLK_MEDIASELECT) :: Keycode +pattern SDLK_WWW = (#const SDLK_WWW) :: Keycode +pattern SDLK_MAIL = (#const SDLK_MAIL) :: Keycode +pattern SDLK_CALCULATOR = (#const SDLK_CALCULATOR) :: Keycode +pattern SDLK_COMPUTER = (#const SDLK_COMPUTER) :: Keycode +pattern SDLK_AC_SEARCH = (#const SDLK_AC_SEARCH) :: Keycode +pattern SDLK_AC_HOME = (#const SDLK_AC_HOME) :: Keycode +pattern SDLK_AC_BACK = (#const SDLK_AC_BACK) :: Keycode +pattern SDLK_AC_FORWARD = (#const SDLK_AC_FORWARD) :: Keycode +pattern SDLK_AC_STOP = (#const SDLK_AC_STOP) :: Keycode +pattern SDLK_AC_REFRESH = (#const SDLK_AC_REFRESH) :: Keycode +pattern SDLK_AC_BOOKMARKS = (#const SDLK_AC_BOOKMARKS) :: Keycode +pattern SDLK_BRIGHTNESSDOWN = (#const SDLK_BRIGHTNESSDOWN) :: Keycode +pattern SDLK_BRIGHTNESSUP = (#const SDLK_BRIGHTNESSUP) :: Keycode +pattern SDLK_DISPLAYSWITCH = (#const SDLK_DISPLAYSWITCH) :: Keycode +pattern SDLK_KBDILLUMTOGGLE = (#const SDLK_KBDILLUMTOGGLE) :: Keycode +pattern SDLK_KBDILLUMDOWN = (#const SDLK_KBDILLUMDOWN) :: Keycode +pattern SDLK_KBDILLUMUP = (#const SDLK_KBDILLUMUP) :: Keycode +pattern SDLK_EJECT = (#const SDLK_EJECT) :: Keycode +pattern SDLK_SLEEP = (#const SDLK_SLEEP) :: Keycode + +pattern KMOD_NONE = (#const KMOD_NONE) +pattern KMOD_LSHIFT = (#const KMOD_LSHIFT) +pattern KMOD_RSHIFT = (#const KMOD_RSHIFT) +pattern KMOD_SHIFT = (#const KMOD_SHIFT) +pattern KMOD_LCTRL = (#const KMOD_LCTRL) +pattern KMOD_RCTRL = (#const KMOD_RCTRL) +pattern KMOD_CTRL = (#const KMOD_CTRL) +pattern KMOD_LALT = (#const KMOD_LALT) +pattern KMOD_RALT = (#const KMOD_RALT) +pattern KMOD_ALT = (#const KMOD_ALT) +pattern KMOD_LGUI = (#const KMOD_LGUI) +pattern KMOD_RGUI = (#const KMOD_RGUI) +pattern KMOD_GUI = (#const KMOD_GUI) +pattern KMOD_NUM = (#const KMOD_NUM) +pattern KMOD_CAPS = (#const KMOD_CAPS) +pattern KMOD_MODE = (#const KMOD_MODE) +pattern KMOD_RESERVED = (#const KMOD_RESERVED) + +pattern SDL_LOG_PRIORITY_VERBOSE = (#const SDL_LOG_PRIORITY_VERBOSE) :: LogPriority +pattern SDL_LOG_PRIORITY_DEBUG = (#const SDL_LOG_PRIORITY_DEBUG) :: LogPriority +pattern SDL_LOG_PRIORITY_INFO = (#const SDL_LOG_PRIORITY_INFO) :: LogPriority +pattern SDL_LOG_PRIORITY_WARN = (#const SDL_LOG_PRIORITY_WARN) :: LogPriority +pattern SDL_LOG_PRIORITY_ERROR = (#const SDL_LOG_PRIORITY_ERROR) :: LogPriority +pattern SDL_LOG_PRIORITY_CRITICAL = (#const SDL_LOG_PRIORITY_CRITICAL) :: LogPriority +pattern SDL_NUM_LOG_PRIORITIES = (#const SDL_NUM_LOG_PRIORITIES) :: LogPriority + +pattern SDL_POWERSTATE_UNKNOWN = (#const SDL_POWERSTATE_UNKNOWN) :: PowerState +pattern SDL_POWERSTATE_ON_BATTERY = (#const SDL_POWERSTATE_ON_BATTERY) :: PowerState +pattern SDL_POWERSTATE_NO_BATTERY = (#const SDL_POWERSTATE_NO_BATTERY) :: PowerState +pattern SDL_POWERSTATE_CHARGING = (#const SDL_POWERSTATE_CHARGING) :: PowerState +pattern SDL_POWERSTATE_CHARGED = (#const SDL_POWERSTATE_CHARGED) :: PowerState + +pattern SDL_FLIP_NONE = (#const SDL_FLIP_NONE) :: RendererFlip +pattern SDL_FLIP_HORIZONTAL = (#const SDL_FLIP_HORIZONTAL) :: RendererFlip +pattern SDL_FLIP_VERTICAL = (#const SDL_FLIP_VERTICAL) :: RendererFlip + +pattern SDL_SCANCODE_UNKNOWN = (#const SDL_SCANCODE_UNKNOWN) :: Scancode +pattern SDL_SCANCODE_A = (#const SDL_SCANCODE_A) :: Scancode +pattern SDL_SCANCODE_B = (#const SDL_SCANCODE_B) :: Scancode +pattern SDL_SCANCODE_C = (#const SDL_SCANCODE_C) :: Scancode +pattern SDL_SCANCODE_D = (#const SDL_SCANCODE_D) :: Scancode +pattern SDL_SCANCODE_E = (#const SDL_SCANCODE_E) :: Scancode +pattern SDL_SCANCODE_F = (#const SDL_SCANCODE_F) :: Scancode +pattern SDL_SCANCODE_G = (#const SDL_SCANCODE_G) :: Scancode +pattern SDL_SCANCODE_H = (#const SDL_SCANCODE_H) :: Scancode +pattern SDL_SCANCODE_I = (#const SDL_SCANCODE_I) :: Scancode +pattern SDL_SCANCODE_J = (#const SDL_SCANCODE_J) :: Scancode +pattern SDL_SCANCODE_K = (#const SDL_SCANCODE_K) :: Scancode +pattern SDL_SCANCODE_L = (#const SDL_SCANCODE_L) :: Scancode +pattern SDL_SCANCODE_M = (#const SDL_SCANCODE_M) :: Scancode +pattern SDL_SCANCODE_N = (#const SDL_SCANCODE_N) :: Scancode +pattern SDL_SCANCODE_O = (#const SDL_SCANCODE_O) :: Scancode +pattern SDL_SCANCODE_P = (#const SDL_SCANCODE_P) :: Scancode +pattern SDL_SCANCODE_Q = (#const SDL_SCANCODE_Q) :: Scancode +pattern SDL_SCANCODE_R = (#const SDL_SCANCODE_R) :: Scancode +pattern SDL_SCANCODE_S = (#const SDL_SCANCODE_S) :: Scancode +pattern SDL_SCANCODE_T = (#const SDL_SCANCODE_T) :: Scancode +pattern SDL_SCANCODE_U = (#const SDL_SCANCODE_U) :: Scancode +pattern SDL_SCANCODE_V = (#const SDL_SCANCODE_V) :: Scancode +pattern SDL_SCANCODE_W = (#const SDL_SCANCODE_W) :: Scancode +pattern SDL_SCANCODE_X = (#const SDL_SCANCODE_X) :: Scancode +pattern SDL_SCANCODE_Y = (#const SDL_SCANCODE_Y) :: Scancode +pattern SDL_SCANCODE_Z = (#const SDL_SCANCODE_Z) :: Scancode +pattern SDL_SCANCODE_1 = (#const SDL_SCANCODE_1) :: Scancode +pattern SDL_SCANCODE_2 = (#const SDL_SCANCODE_2) :: Scancode +pattern SDL_SCANCODE_3 = (#const SDL_SCANCODE_3) :: Scancode +pattern SDL_SCANCODE_4 = (#const SDL_SCANCODE_4) :: Scancode +pattern SDL_SCANCODE_5 = (#const SDL_SCANCODE_5) :: Scancode +pattern SDL_SCANCODE_6 = (#const SDL_SCANCODE_6) :: Scancode +pattern SDL_SCANCODE_7 = (#const SDL_SCANCODE_7) :: Scancode +pattern SDL_SCANCODE_8 = (#const SDL_SCANCODE_8) :: Scancode +pattern SDL_SCANCODE_9 = (#const SDL_SCANCODE_9) :: Scancode +pattern SDL_SCANCODE_0 = (#const SDL_SCANCODE_0) :: Scancode +pattern SDL_SCANCODE_RETURN = (#const SDL_SCANCODE_RETURN) :: Scancode +pattern SDL_SCANCODE_ESCAPE = (#const SDL_SCANCODE_ESCAPE) :: Scancode +pattern SDL_SCANCODE_BACKSPACE = (#const SDL_SCANCODE_BACKSPACE) :: Scancode +pattern SDL_SCANCODE_TAB = (#const SDL_SCANCODE_TAB) :: Scancode +pattern SDL_SCANCODE_SPACE = (#const SDL_SCANCODE_SPACE) :: Scancode +pattern SDL_SCANCODE_MINUS = (#const SDL_SCANCODE_MINUS) :: Scancode +pattern SDL_SCANCODE_EQUALS = (#const SDL_SCANCODE_EQUALS) :: Scancode +pattern SDL_SCANCODE_LEFTBRACKET = (#const SDL_SCANCODE_LEFTBRACKET) :: Scancode +pattern SDL_SCANCODE_RIGHTBRACKET = (#const SDL_SCANCODE_RIGHTBRACKET) :: Scancode +pattern SDL_SCANCODE_BACKSLASH = (#const SDL_SCANCODE_BACKSLASH) :: Scancode +pattern SDL_SCANCODE_NONUSHASH = (#const SDL_SCANCODE_NONUSHASH) :: Scancode +pattern SDL_SCANCODE_SEMICOLON = (#const SDL_SCANCODE_SEMICOLON) :: Scancode +pattern SDL_SCANCODE_APOSTROPHE = (#const SDL_SCANCODE_APOSTROPHE) :: Scancode +pattern SDL_SCANCODE_GRAVE = (#const SDL_SCANCODE_GRAVE) :: Scancode +pattern SDL_SCANCODE_COMMA = (#const SDL_SCANCODE_COMMA) :: Scancode +pattern SDL_SCANCODE_PERIOD = (#const SDL_SCANCODE_PERIOD) :: Scancode +pattern SDL_SCANCODE_SLASH = (#const SDL_SCANCODE_SLASH) :: Scancode +pattern SDL_SCANCODE_CAPSLOCK = (#const SDL_SCANCODE_CAPSLOCK) :: Scancode +pattern SDL_SCANCODE_F1 = (#const SDL_SCANCODE_F1) :: Scancode +pattern SDL_SCANCODE_F2 = (#const SDL_SCANCODE_F2) :: Scancode +pattern SDL_SCANCODE_F3 = (#const SDL_SCANCODE_F3) :: Scancode +pattern SDL_SCANCODE_F4 = (#const SDL_SCANCODE_F4) :: Scancode +pattern SDL_SCANCODE_F5 = (#const SDL_SCANCODE_F5) :: Scancode +pattern SDL_SCANCODE_F6 = (#const SDL_SCANCODE_F6) :: Scancode +pattern SDL_SCANCODE_F7 = (#const SDL_SCANCODE_F7) :: Scancode +pattern SDL_SCANCODE_F8 = (#const SDL_SCANCODE_F8) :: Scancode +pattern SDL_SCANCODE_F9 = (#const SDL_SCANCODE_F9) :: Scancode +pattern SDL_SCANCODE_F10 = (#const SDL_SCANCODE_F10) :: Scancode +pattern SDL_SCANCODE_F11 = (#const SDL_SCANCODE_F11) :: Scancode +pattern SDL_SCANCODE_F12 = (#const SDL_SCANCODE_F12) :: Scancode +pattern SDL_SCANCODE_PRINTSCREEN = (#const SDL_SCANCODE_PRINTSCREEN) :: Scancode +pattern SDL_SCANCODE_SCROLLLOCK = (#const SDL_SCANCODE_SCROLLLOCK) :: Scancode +pattern SDL_SCANCODE_PAUSE = (#const SDL_SCANCODE_PAUSE) :: Scancode +pattern SDL_SCANCODE_INSERT = (#const SDL_SCANCODE_INSERT) :: Scancode +pattern SDL_SCANCODE_HOME = (#const SDL_SCANCODE_HOME) :: Scancode +pattern SDL_SCANCODE_PAGEUP = (#const SDL_SCANCODE_PAGEUP) :: Scancode +pattern SDL_SCANCODE_DELETE = (#const SDL_SCANCODE_DELETE) :: Scancode +pattern SDL_SCANCODE_END = (#const SDL_SCANCODE_END) :: Scancode +pattern SDL_SCANCODE_PAGEDOWN = (#const SDL_SCANCODE_PAGEDOWN) :: Scancode +pattern SDL_SCANCODE_RIGHT = (#const SDL_SCANCODE_RIGHT) :: Scancode +pattern SDL_SCANCODE_LEFT = (#const SDL_SCANCODE_LEFT) :: Scancode +pattern SDL_SCANCODE_DOWN = (#const SDL_SCANCODE_DOWN) :: Scancode +pattern SDL_SCANCODE_UP = (#const SDL_SCANCODE_UP) :: Scancode +pattern SDL_SCANCODE_NUMLOCKCLEAR = (#const SDL_SCANCODE_NUMLOCKCLEAR) :: Scancode +pattern SDL_SCANCODE_KP_DIVIDE = (#const SDL_SCANCODE_KP_DIVIDE) :: Scancode +pattern SDL_SCANCODE_KP_MULTIPLY = (#const SDL_SCANCODE_KP_MULTIPLY) :: Scancode +pattern SDL_SCANCODE_KP_MINUS = (#const SDL_SCANCODE_KP_MINUS) :: Scancode +pattern SDL_SCANCODE_KP_PLUS = (#const SDL_SCANCODE_KP_PLUS) :: Scancode +pattern SDL_SCANCODE_KP_ENTER = (#const SDL_SCANCODE_KP_ENTER) :: Scancode +pattern SDL_SCANCODE_KP_1 = (#const SDL_SCANCODE_KP_1) :: Scancode +pattern SDL_SCANCODE_KP_2 = (#const SDL_SCANCODE_KP_2) :: Scancode +pattern SDL_SCANCODE_KP_3 = (#const SDL_SCANCODE_KP_3) :: Scancode +pattern SDL_SCANCODE_KP_4 = (#const SDL_SCANCODE_KP_4) :: Scancode +pattern SDL_SCANCODE_KP_5 = (#const SDL_SCANCODE_KP_5) :: Scancode +pattern SDL_SCANCODE_KP_6 = (#const SDL_SCANCODE_KP_6) :: Scancode +pattern SDL_SCANCODE_KP_7 = (#const SDL_SCANCODE_KP_7) :: Scancode +pattern SDL_SCANCODE_KP_8 = (#const SDL_SCANCODE_KP_8) :: Scancode +pattern SDL_SCANCODE_KP_9 = (#const SDL_SCANCODE_KP_9) :: Scancode +pattern SDL_SCANCODE_KP_0 = (#const SDL_SCANCODE_KP_0) :: Scancode +pattern SDL_SCANCODE_KP_PERIOD = (#const SDL_SCANCODE_KP_PERIOD) :: Scancode +pattern SDL_SCANCODE_NONUSBACKSLASH = (#const SDL_SCANCODE_NONUSBACKSLASH) :: Scancode +pattern SDL_SCANCODE_APPLICATION = (#const SDL_SCANCODE_APPLICATION) :: Scancode +pattern SDL_SCANCODE_POWER = (#const SDL_SCANCODE_POWER) :: Scancode +pattern SDL_SCANCODE_KP_EQUALS = (#const SDL_SCANCODE_KP_EQUALS) :: Scancode +pattern SDL_SCANCODE_F13 = (#const SDL_SCANCODE_F13) :: Scancode +pattern SDL_SCANCODE_F14 = (#const SDL_SCANCODE_F14) :: Scancode +pattern SDL_SCANCODE_F15 = (#const SDL_SCANCODE_F15) :: Scancode +pattern SDL_SCANCODE_F16 = (#const SDL_SCANCODE_F16) :: Scancode +pattern SDL_SCANCODE_F17 = (#const SDL_SCANCODE_F17) :: Scancode +pattern SDL_SCANCODE_F18 = (#const SDL_SCANCODE_F18) :: Scancode +pattern SDL_SCANCODE_F19 = (#const SDL_SCANCODE_F19) :: Scancode +pattern SDL_SCANCODE_F20 = (#const SDL_SCANCODE_F20) :: Scancode +pattern SDL_SCANCODE_F21 = (#const SDL_SCANCODE_F21) :: Scancode +pattern SDL_SCANCODE_F22 = (#const SDL_SCANCODE_F22) :: Scancode +pattern SDL_SCANCODE_F23 = (#const SDL_SCANCODE_F23) :: Scancode +pattern SDL_SCANCODE_F24 = (#const SDL_SCANCODE_F24) :: Scancode +pattern SDL_SCANCODE_EXECUTE = (#const SDL_SCANCODE_EXECUTE) :: Scancode +pattern SDL_SCANCODE_HELP = (#const SDL_SCANCODE_HELP) :: Scancode +pattern SDL_SCANCODE_MENU = (#const SDL_SCANCODE_MENU) :: Scancode +pattern SDL_SCANCODE_SELECT = (#const SDL_SCANCODE_SELECT) :: Scancode +pattern SDL_SCANCODE_STOP = (#const SDL_SCANCODE_STOP) :: Scancode +pattern SDL_SCANCODE_AGAIN = (#const SDL_SCANCODE_AGAIN) :: Scancode +pattern SDL_SCANCODE_UNDO = (#const SDL_SCANCODE_UNDO) :: Scancode +pattern SDL_SCANCODE_CUT = (#const SDL_SCANCODE_CUT) :: Scancode +pattern SDL_SCANCODE_COPY = (#const SDL_SCANCODE_COPY) :: Scancode +pattern SDL_SCANCODE_PASTE = (#const SDL_SCANCODE_PASTE) :: Scancode +pattern SDL_SCANCODE_FIND = (#const SDL_SCANCODE_FIND) :: Scancode +pattern SDL_SCANCODE_MUTE = (#const SDL_SCANCODE_MUTE) :: Scancode +pattern SDL_SCANCODE_VOLUMEUP = (#const SDL_SCANCODE_VOLUMEUP) :: Scancode +pattern SDL_SCANCODE_VOLUMEDOWN = (#const SDL_SCANCODE_VOLUMEDOWN) :: Scancode +pattern SDL_SCANCODE_KP_COMMA = (#const SDL_SCANCODE_KP_COMMA) :: Scancode +pattern SDL_SCANCODE_KP_EQUALSAS400 = (#const SDL_SCANCODE_KP_EQUALSAS400) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL1 = (#const SDL_SCANCODE_INTERNATIONAL1) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL2 = (#const SDL_SCANCODE_INTERNATIONAL2) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL3 = (#const SDL_SCANCODE_INTERNATIONAL3) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL4 = (#const SDL_SCANCODE_INTERNATIONAL4) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL5 = (#const SDL_SCANCODE_INTERNATIONAL5) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL6 = (#const SDL_SCANCODE_INTERNATIONAL6) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL7 = (#const SDL_SCANCODE_INTERNATIONAL7) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL8 = (#const SDL_SCANCODE_INTERNATIONAL8) :: Scancode +pattern SDL_SCANCODE_INTERNATIONAL9 = (#const SDL_SCANCODE_INTERNATIONAL9) :: Scancode +pattern SDL_SCANCODE_LANG1 = (#const SDL_SCANCODE_LANG1) :: Scancode +pattern SDL_SCANCODE_LANG2 = (#const SDL_SCANCODE_LANG2) :: Scancode +pattern SDL_SCANCODE_LANG3 = (#const SDL_SCANCODE_LANG3) :: Scancode +pattern SDL_SCANCODE_LANG4 = (#const SDL_SCANCODE_LANG4) :: Scancode +pattern SDL_SCANCODE_LANG5 = (#const SDL_SCANCODE_LANG5) :: Scancode +pattern SDL_SCANCODE_LANG6 = (#const SDL_SCANCODE_LANG6) :: Scancode +pattern SDL_SCANCODE_LANG7 = (#const SDL_SCANCODE_LANG7) :: Scancode +pattern SDL_SCANCODE_LANG8 = (#const SDL_SCANCODE_LANG8) :: Scancode +pattern SDL_SCANCODE_LANG9 = (#const SDL_SCANCODE_LANG9) :: Scancode +pattern SDL_SCANCODE_ALTERASE = (#const SDL_SCANCODE_ALTERASE) :: Scancode +pattern SDL_SCANCODE_SYSREQ = (#const SDL_SCANCODE_SYSREQ) :: Scancode +pattern SDL_SCANCODE_CANCEL = (#const SDL_SCANCODE_CANCEL) :: Scancode +pattern SDL_SCANCODE_CLEAR = (#const SDL_SCANCODE_CLEAR) :: Scancode +pattern SDL_SCANCODE_PRIOR = (#const SDL_SCANCODE_PRIOR) :: Scancode +pattern SDL_SCANCODE_RETURN2 = (#const SDL_SCANCODE_RETURN2) :: Scancode +pattern SDL_SCANCODE_SEPARATOR = (#const SDL_SCANCODE_SEPARATOR) :: Scancode +pattern SDL_SCANCODE_OUT = (#const SDL_SCANCODE_OUT) :: Scancode +pattern SDL_SCANCODE_OPER = (#const SDL_SCANCODE_OPER) :: Scancode +pattern SDL_SCANCODE_CLEARAGAIN = (#const SDL_SCANCODE_CLEARAGAIN) :: Scancode +pattern SDL_SCANCODE_CRSEL = (#const SDL_SCANCODE_CRSEL) :: Scancode +pattern SDL_SCANCODE_EXSEL = (#const SDL_SCANCODE_EXSEL) :: Scancode +pattern SDL_SCANCODE_KP_00 = (#const SDL_SCANCODE_KP_00) :: Scancode +pattern SDL_SCANCODE_KP_000 = (#const SDL_SCANCODE_KP_000) :: Scancode +pattern SDL_SCANCODE_THOUSANDSSEPARATOR = (#const SDL_SCANCODE_THOUSANDSSEPARATOR) :: Scancode +pattern SDL_SCANCODE_DECIMALSEPARATOR = (#const SDL_SCANCODE_DECIMALSEPARATOR) :: Scancode +pattern SDL_SCANCODE_CURRENCYUNIT = (#const SDL_SCANCODE_CURRENCYUNIT) :: Scancode +pattern SDL_SCANCODE_CURRENCYSUBUNIT = (#const SDL_SCANCODE_CURRENCYSUBUNIT) :: Scancode +pattern SDL_SCANCODE_KP_LEFTPAREN = (#const SDL_SCANCODE_KP_LEFTPAREN) :: Scancode +pattern SDL_SCANCODE_KP_RIGHTPAREN = (#const SDL_SCANCODE_KP_RIGHTPAREN) :: Scancode +pattern SDL_SCANCODE_KP_LEFTBRACE = (#const SDL_SCANCODE_KP_LEFTBRACE) :: Scancode +pattern SDL_SCANCODE_KP_RIGHTBRACE = (#const SDL_SCANCODE_KP_RIGHTBRACE) :: Scancode +pattern SDL_SCANCODE_KP_TAB = (#const SDL_SCANCODE_KP_TAB) :: Scancode +pattern SDL_SCANCODE_KP_BACKSPACE = (#const SDL_SCANCODE_KP_BACKSPACE) :: Scancode +pattern SDL_SCANCODE_KP_A = (#const SDL_SCANCODE_KP_A) :: Scancode +pattern SDL_SCANCODE_KP_B = (#const SDL_SCANCODE_KP_B) :: Scancode +pattern SDL_SCANCODE_KP_C = (#const SDL_SCANCODE_KP_C) :: Scancode +pattern SDL_SCANCODE_KP_D = (#const SDL_SCANCODE_KP_D) :: Scancode +pattern SDL_SCANCODE_KP_E = (#const SDL_SCANCODE_KP_E) :: Scancode +pattern SDL_SCANCODE_KP_F = (#const SDL_SCANCODE_KP_F) :: Scancode +pattern SDL_SCANCODE_KP_XOR = (#const SDL_SCANCODE_KP_XOR) :: Scancode +pattern SDL_SCANCODE_KP_POWER = (#const SDL_SCANCODE_KP_POWER) :: Scancode +pattern SDL_SCANCODE_KP_PERCENT = (#const SDL_SCANCODE_KP_PERCENT) :: Scancode +pattern SDL_SCANCODE_KP_LESS = (#const SDL_SCANCODE_KP_LESS) :: Scancode +pattern SDL_SCANCODE_KP_GREATER = (#const SDL_SCANCODE_KP_GREATER) :: Scancode +pattern SDL_SCANCODE_KP_AMPERSAND = (#const SDL_SCANCODE_KP_AMPERSAND) :: Scancode +pattern SDL_SCANCODE_KP_DBLAMPERSAND = (#const SDL_SCANCODE_KP_DBLAMPERSAND) :: Scancode +pattern SDL_SCANCODE_KP_VERTICALBAR = (#const SDL_SCANCODE_KP_VERTICALBAR) :: Scancode +pattern SDL_SCANCODE_KP_DBLVERTICALBAR = (#const SDL_SCANCODE_KP_DBLVERTICALBAR) :: Scancode +pattern SDL_SCANCODE_KP_COLON = (#const SDL_SCANCODE_KP_COLON) :: Scancode +pattern SDL_SCANCODE_KP_HASH = (#const SDL_SCANCODE_KP_HASH) :: Scancode +pattern SDL_SCANCODE_KP_SPACE = (#const SDL_SCANCODE_KP_SPACE) :: Scancode +pattern SDL_SCANCODE_KP_AT = (#const SDL_SCANCODE_KP_AT) :: Scancode +pattern SDL_SCANCODE_KP_EXCLAM = (#const SDL_SCANCODE_KP_EXCLAM) :: Scancode +pattern SDL_SCANCODE_KP_MEMSTORE = (#const SDL_SCANCODE_KP_MEMSTORE) :: Scancode +pattern SDL_SCANCODE_KP_MEMRECALL = (#const SDL_SCANCODE_KP_MEMRECALL) :: Scancode +pattern SDL_SCANCODE_KP_MEMCLEAR = (#const SDL_SCANCODE_KP_MEMCLEAR) :: Scancode +pattern SDL_SCANCODE_KP_MEMADD = (#const SDL_SCANCODE_KP_MEMADD) :: Scancode +pattern SDL_SCANCODE_KP_MEMSUBTRACT = (#const SDL_SCANCODE_KP_MEMSUBTRACT) :: Scancode +pattern SDL_SCANCODE_KP_MEMMULTIPLY = (#const SDL_SCANCODE_KP_MEMMULTIPLY) :: Scancode +pattern SDL_SCANCODE_KP_MEMDIVIDE = (#const SDL_SCANCODE_KP_MEMDIVIDE) :: Scancode +pattern SDL_SCANCODE_KP_PLUSMINUS = (#const SDL_SCANCODE_KP_PLUSMINUS) :: Scancode +pattern SDL_SCANCODE_KP_CLEAR = (#const SDL_SCANCODE_KP_CLEAR) :: Scancode +pattern SDL_SCANCODE_KP_CLEARENTRY = (#const SDL_SCANCODE_KP_CLEARENTRY) :: Scancode +pattern SDL_SCANCODE_KP_BINARY = (#const SDL_SCANCODE_KP_BINARY) :: Scancode +pattern SDL_SCANCODE_KP_OCTAL = (#const SDL_SCANCODE_KP_OCTAL) :: Scancode +pattern SDL_SCANCODE_KP_DECIMAL = (#const SDL_SCANCODE_KP_DECIMAL) :: Scancode +pattern SDL_SCANCODE_KP_HEXADECIMAL = (#const SDL_SCANCODE_KP_HEXADECIMAL) :: Scancode +pattern SDL_SCANCODE_LCTRL = (#const SDL_SCANCODE_LCTRL) :: Scancode +pattern SDL_SCANCODE_LSHIFT = (#const SDL_SCANCODE_LSHIFT) :: Scancode +pattern SDL_SCANCODE_LALT = (#const SDL_SCANCODE_LALT) :: Scancode +pattern SDL_SCANCODE_LGUI = (#const SDL_SCANCODE_LGUI) :: Scancode +pattern SDL_SCANCODE_RCTRL = (#const SDL_SCANCODE_RCTRL) :: Scancode +pattern SDL_SCANCODE_RSHIFT = (#const SDL_SCANCODE_RSHIFT) :: Scancode +pattern SDL_SCANCODE_RALT = (#const SDL_SCANCODE_RALT) :: Scancode +pattern SDL_SCANCODE_RGUI = (#const SDL_SCANCODE_RGUI) :: Scancode +pattern SDL_SCANCODE_MODE = (#const SDL_SCANCODE_MODE) :: Scancode +pattern SDL_SCANCODE_AUDIONEXT = (#const SDL_SCANCODE_AUDIONEXT) :: Scancode +pattern SDL_SCANCODE_AUDIOPREV = (#const SDL_SCANCODE_AUDIOPREV) :: Scancode +pattern SDL_SCANCODE_AUDIOSTOP = (#const SDL_SCANCODE_AUDIOSTOP) :: Scancode +pattern SDL_SCANCODE_AUDIOPLAY = (#const SDL_SCANCODE_AUDIOPLAY) :: Scancode +pattern SDL_SCANCODE_AUDIOMUTE = (#const SDL_SCANCODE_AUDIOMUTE) :: Scancode +pattern SDL_SCANCODE_MEDIASELECT = (#const SDL_SCANCODE_MEDIASELECT) :: Scancode +pattern SDL_SCANCODE_WWW = (#const SDL_SCANCODE_WWW) :: Scancode +pattern SDL_SCANCODE_MAIL = (#const SDL_SCANCODE_MAIL) :: Scancode +pattern SDL_SCANCODE_CALCULATOR = (#const SDL_SCANCODE_CALCULATOR) :: Scancode +pattern SDL_SCANCODE_COMPUTER = (#const SDL_SCANCODE_COMPUTER) :: Scancode +pattern SDL_SCANCODE_AC_SEARCH = (#const SDL_SCANCODE_AC_SEARCH) :: Scancode +pattern SDL_SCANCODE_AC_HOME = (#const SDL_SCANCODE_AC_HOME) :: Scancode +pattern SDL_SCANCODE_AC_BACK = (#const SDL_SCANCODE_AC_BACK) :: Scancode +pattern SDL_SCANCODE_AC_FORWARD = (#const SDL_SCANCODE_AC_FORWARD) :: Scancode +pattern SDL_SCANCODE_AC_STOP = (#const SDL_SCANCODE_AC_STOP) :: Scancode +pattern SDL_SCANCODE_AC_REFRESH = (#const SDL_SCANCODE_AC_REFRESH) :: Scancode +pattern SDL_SCANCODE_AC_BOOKMARKS = (#const SDL_SCANCODE_AC_BOOKMARKS) :: Scancode +pattern SDL_SCANCODE_BRIGHTNESSDOWN = (#const SDL_SCANCODE_BRIGHTNESSDOWN) :: Scancode +pattern SDL_SCANCODE_BRIGHTNESSUP = (#const SDL_SCANCODE_BRIGHTNESSUP) :: Scancode +pattern SDL_SCANCODE_DISPLAYSWITCH = (#const SDL_SCANCODE_DISPLAYSWITCH) :: Scancode +pattern SDL_SCANCODE_KBDILLUMTOGGLE = (#const SDL_SCANCODE_KBDILLUMTOGGLE) :: Scancode +pattern SDL_SCANCODE_KBDILLUMDOWN = (#const SDL_SCANCODE_KBDILLUMDOWN) :: Scancode +pattern SDL_SCANCODE_KBDILLUMUP = (#const SDL_SCANCODE_KBDILLUMUP) :: Scancode +pattern SDL_SCANCODE_EJECT = (#const SDL_SCANCODE_EJECT) :: Scancode +pattern SDL_SCANCODE_SLEEP = (#const SDL_SCANCODE_SLEEP) :: Scancode +pattern SDL_SCANCODE_APP1 = (#const SDL_SCANCODE_APP1) :: Scancode +pattern SDL_SCANCODE_APP2 = (#const SDL_SCANCODE_APP2) :: Scancode +pattern SDL_NUM_SCANCODES = (#const SDL_NUM_SCANCODES) :: Scancode + +pattern SDL_SYSTEM_CURSOR_ARROW = (#const SDL_SYSTEM_CURSOR_ARROW) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_IBEAM = (#const SDL_SYSTEM_CURSOR_IBEAM) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_WAIT = (#const SDL_SYSTEM_CURSOR_WAIT) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_CROSSHAIR = (#const SDL_SYSTEM_CURSOR_CROSSHAIR) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_WAITARROW = (#const SDL_SYSTEM_CURSOR_WAITARROW) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_SIZENWSE = (#const SDL_SYSTEM_CURSOR_SIZENWSE) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_SIZENESW = (#const SDL_SYSTEM_CURSOR_SIZENESW) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_SIZEWE = (#const SDL_SYSTEM_CURSOR_SIZEWE) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_SIZENS = (#const SDL_SYSTEM_CURSOR_SIZENS) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_SIZEALL = (#const SDL_SYSTEM_CURSOR_SIZEALL) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_NO = (#const SDL_SYSTEM_CURSOR_NO) :: SystemCursor +pattern SDL_SYSTEM_CURSOR_HAND = (#const SDL_SYSTEM_CURSOR_HAND) :: SystemCursor +pattern SDL_NUM_SYSTEM_CURSORS = (#const SDL_NUM_SYSTEM_CURSORS) :: SystemCursor + +pattern SDL_THREAD_PRIORITY_LOW = (#const SDL_THREAD_PRIORITY_LOW) :: ThreadPriority +pattern SDL_THREAD_PRIORITY_NORMAL = (#const SDL_THREAD_PRIORITY_NORMAL) :: ThreadPriority +pattern SDL_THREAD_PRIORITY_HIGH = (#const SDL_THREAD_PRIORITY_HIGH) :: ThreadPriority + +pattern SDL_AUDIO_ALLOW_FREQUENCY_CHANGE = (#const SDL_AUDIO_ALLOW_FREQUENCY_CHANGE) +pattern SDL_AUDIO_ALLOW_FORMAT_CHANGE = (#const SDL_AUDIO_ALLOW_FORMAT_CHANGE) +pattern SDL_AUDIO_ALLOW_CHANNELS_CHANGE = (#const SDL_AUDIO_ALLOW_CHANNELS_CHANGE) +pattern SDL_AUDIO_ALLOW_ANY_CHANGE = (#const SDL_AUDIO_ALLOW_ANY_CHANGE) + +pattern SDL_BUTTON_LEFT = (#const SDL_BUTTON_LEFT) +pattern SDL_BUTTON_MIDDLE = (#const SDL_BUTTON_MIDDLE) +pattern SDL_BUTTON_RIGHT = (#const SDL_BUTTON_RIGHT) +pattern SDL_BUTTON_X1 = (#const SDL_BUTTON_X1) +pattern SDL_BUTTON_X2 = (#const SDL_BUTTON_X2) +pattern SDL_BUTTON_LMASK = (#const SDL_BUTTON_LMASK) +pattern SDL_BUTTON_MMASK = (#const SDL_BUTTON_MMASK) +pattern SDL_BUTTON_RMASK = (#const SDL_BUTTON_RMASK) +pattern SDL_BUTTON_X1MASK = (#const SDL_BUTTON_X1MASK) +pattern SDL_BUTTON_X2MASK = (#const SDL_BUTTON_X2MASK) + +pattern SDL_FIRSTEVENT = (#const SDL_FIRSTEVENT) +pattern SDL_QUIT = (#const SDL_QUIT) +pattern SDL_APP_TERMINATING = (#const SDL_APP_TERMINATING) +pattern SDL_APP_LOWMEMORY = (#const SDL_APP_LOWMEMORY) +pattern SDL_APP_WILLENTERBACKGROUND = (#const SDL_APP_WILLENTERBACKGROUND) +pattern SDL_APP_DIDENTERBACKGROUND = (#const SDL_APP_DIDENTERBACKGROUND) +pattern SDL_APP_WILLENTERFOREGROUND = (#const SDL_APP_WILLENTERFOREGROUND) +pattern SDL_APP_DIDENTERFOREGROUND = (#const SDL_APP_DIDENTERFOREGROUND) +pattern SDL_WINDOWEVENT = (#const SDL_WINDOWEVENT) +pattern SDL_SYSWMEVENT = (#const SDL_SYSWMEVENT) +pattern SDL_KEYDOWN = (#const SDL_KEYDOWN) +pattern SDL_KEYUP = (#const SDL_KEYUP) +pattern SDL_TEXTEDITING = (#const SDL_TEXTEDITING) +pattern SDL_TEXTINPUT = (#const SDL_TEXTINPUT) +pattern SDL_MOUSEMOTION = (#const SDL_MOUSEMOTION) +pattern SDL_MOUSEBUTTONDOWN = (#const SDL_MOUSEBUTTONDOWN) +pattern SDL_MOUSEBUTTONUP = (#const SDL_MOUSEBUTTONUP) +pattern SDL_MOUSEWHEEL = (#const SDL_MOUSEWHEEL) +pattern SDL_JOYAXISMOTION = (#const SDL_JOYAXISMOTION) +pattern SDL_JOYBALLMOTION = (#const SDL_JOYBALLMOTION) +pattern SDL_JOYHATMOTION = (#const SDL_JOYHATMOTION) +pattern SDL_JOYBUTTONDOWN = (#const SDL_JOYBUTTONDOWN) +pattern SDL_JOYBUTTONUP = (#const SDL_JOYBUTTONUP) +pattern SDL_JOYDEVICEADDED = (#const SDL_JOYDEVICEADDED) +pattern SDL_JOYDEVICEREMOVED = (#const SDL_JOYDEVICEREMOVED) +pattern SDL_CONTROLLERAXISMOTION = (#const SDL_CONTROLLERAXISMOTION) +pattern SDL_CONTROLLERBUTTONDOWN = (#const SDL_CONTROLLERBUTTONDOWN) +pattern SDL_CONTROLLERBUTTONUP = (#const SDL_CONTROLLERBUTTONUP) +pattern SDL_CONTROLLERDEVICEADDED = (#const SDL_CONTROLLERDEVICEADDED) +pattern SDL_CONTROLLERDEVICEREMOVED = (#const SDL_CONTROLLERDEVICEREMOVED) +pattern SDL_CONTROLLERDEVICEREMAPPED = (#const SDL_CONTROLLERDEVICEREMAPPED) +pattern SDL_FINGERDOWN = (#const SDL_FINGERDOWN) +pattern SDL_FINGERUP = (#const SDL_FINGERUP) +pattern SDL_FINGERMOTION = (#const SDL_FINGERMOTION) +pattern SDL_DOLLARGESTURE = (#const SDL_DOLLARGESTURE) +pattern SDL_DOLLARRECORD = (#const SDL_DOLLARRECORD) +pattern SDL_MULTIGESTURE = (#const SDL_MULTIGESTURE) +pattern SDL_CLIPBOARDUPDATE = (#const SDL_CLIPBOARDUPDATE) +pattern SDL_DROPFILE = (#const SDL_DROPFILE) +pattern SDL_USEREVENT = (#const SDL_USEREVENT) +pattern SDL_LASTEVENT = (#const SDL_LASTEVENT) + +pattern SDL_HAT_CENTERED = (#const SDL_HAT_CENTERED) +pattern SDL_HAT_UP = (#const SDL_HAT_UP) +pattern SDL_HAT_RIGHT = (#const SDL_HAT_RIGHT) +pattern SDL_HAT_DOWN = (#const SDL_HAT_DOWN) +pattern SDL_HAT_LEFT = (#const SDL_HAT_LEFT) +pattern SDL_HAT_RIGHTUP = (#const SDL_HAT_RIGHTUP) +pattern SDL_HAT_RIGHTDOWN = (#const SDL_HAT_RIGHTDOWN) +pattern SDL_HAT_LEFTUP = (#const SDL_HAT_LEFTUP) +pattern SDL_HAT_LEFTDOWN = (#const SDL_HAT_LEFTDOWN) + +pattern SDL_PRESSED = (#const SDL_PRESSED) +pattern SDL_RELEASED = (#const SDL_RELEASED) + +pattern SDL_LOG_CATEGORY_APPLICATION = (#const SDL_LOG_CATEGORY_APPLICATION) +pattern SDL_LOG_CATEGORY_ERROR = (#const SDL_LOG_CATEGORY_ERROR) +pattern SDL_LOG_CATEGORY_ASSERT = (#const SDL_LOG_CATEGORY_ASSERT) +pattern SDL_LOG_CATEGORY_SYSTEM = (#const SDL_LOG_CATEGORY_SYSTEM) +pattern SDL_LOG_CATEGORY_AUDIO = (#const SDL_LOG_CATEGORY_AUDIO) +pattern SDL_LOG_CATEGORY_VIDEO = (#const SDL_LOG_CATEGORY_VIDEO) +pattern SDL_LOG_CATEGORY_RENDER = (#const SDL_LOG_CATEGORY_RENDER) +pattern SDL_LOG_CATEGORY_INPUT = (#const SDL_LOG_CATEGORY_INPUT) +pattern SDL_LOG_CATEGORY_TEST = (#const SDL_LOG_CATEGORY_TEST) +pattern SDL_LOG_CATEGORY_CUSTOM = (#const SDL_LOG_CATEGORY_CUSTOM) + +pattern SDL_MESSAGEBOX_ERROR = (#const SDL_MESSAGEBOX_ERROR) +pattern SDL_MESSAGEBOX_WARNING = (#const SDL_MESSAGEBOX_WARNING) +pattern SDL_MESSAGEBOX_INFORMATION = (#const SDL_MESSAGEBOX_INFORMATION) + +pattern SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT = (#const SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT) +pattern SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT = (#const SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT) + +pattern SDL_GL_CONTEXT_PROFILE_CORE = (#const SDL_GL_CONTEXT_PROFILE_CORE) +pattern SDL_GL_CONTEXT_PROFILE_COMPATIBILITY = (#const SDL_GL_CONTEXT_PROFILE_COMPATIBILITY) +pattern SDL_GL_CONTEXT_PROFILE_ES = (#const SDL_GL_CONTEXT_PROFILE_ES) + +pattern SDL_GL_CONTEXT_DEBUG_FLAG = (#const SDL_GL_CONTEXT_DEBUG_FLAG) +pattern SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG = (#const SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG) +pattern SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG = (#const SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG) +pattern SDL_GL_CONTEXT_RESET_ISOLATION_FLAG = (#const SDL_GL_CONTEXT_RESET_ISOLATION_FLAG) + +pattern SDL_PIXELFORMAT_UNKNOWN = (#const SDL_PIXELFORMAT_UNKNOWN) +pattern SDL_PIXELFORMAT_INDEX1LSB = (#const SDL_PIXELFORMAT_INDEX1LSB) +pattern SDL_PIXELFORMAT_INDEX1MSB = (#const SDL_PIXELFORMAT_INDEX1MSB) +pattern SDL_PIXELFORMAT_INDEX4LSB = (#const SDL_PIXELFORMAT_INDEX4LSB) +pattern SDL_PIXELFORMAT_INDEX4MSB = (#const SDL_PIXELFORMAT_INDEX4MSB) +pattern SDL_PIXELFORMAT_INDEX8 = (#const SDL_PIXELFORMAT_INDEX8) +pattern SDL_PIXELFORMAT_RGB332 = (#const SDL_PIXELFORMAT_RGB332) +pattern SDL_PIXELFORMAT_RGB444 = (#const SDL_PIXELFORMAT_RGB444) +pattern SDL_PIXELFORMAT_RGB555 = (#const SDL_PIXELFORMAT_RGB555) +pattern SDL_PIXELFORMAT_BGR555 = (#const SDL_PIXELFORMAT_BGR555) +pattern SDL_PIXELFORMAT_ARGB4444 = (#const SDL_PIXELFORMAT_ARGB4444) +pattern SDL_PIXELFORMAT_RGBA4444 = (#const SDL_PIXELFORMAT_RGBA4444) +pattern SDL_PIXELFORMAT_ABGR4444 = (#const SDL_PIXELFORMAT_ABGR4444) +pattern SDL_PIXELFORMAT_BGRA4444 = (#const SDL_PIXELFORMAT_BGRA4444) +pattern SDL_PIXELFORMAT_ARGB1555 = (#const SDL_PIXELFORMAT_ARGB1555) +pattern SDL_PIXELFORMAT_RGBA5551 = (#const SDL_PIXELFORMAT_RGBA5551) +pattern SDL_PIXELFORMAT_ABGR1555 = (#const SDL_PIXELFORMAT_ABGR1555) +pattern SDL_PIXELFORMAT_BGRA5551 = (#const SDL_PIXELFORMAT_BGRA5551) +pattern SDL_PIXELFORMAT_RGB565 = (#const SDL_PIXELFORMAT_RGB565) +pattern SDL_PIXELFORMAT_BGR565 = (#const SDL_PIXELFORMAT_BGR565) +pattern SDL_PIXELFORMAT_RGB24 = (#const SDL_PIXELFORMAT_RGB24) +pattern SDL_PIXELFORMAT_BGR24 = (#const SDL_PIXELFORMAT_BGR24) +pattern SDL_PIXELFORMAT_RGB888 = (#const SDL_PIXELFORMAT_RGB888) +pattern SDL_PIXELFORMAT_RGBX8888 = (#const SDL_PIXELFORMAT_RGBX8888) +pattern SDL_PIXELFORMAT_BGR888 = (#const SDL_PIXELFORMAT_BGR888) +pattern SDL_PIXELFORMAT_BGRX8888 = (#const SDL_PIXELFORMAT_BGRX8888) +pattern SDL_PIXELFORMAT_ARGB8888 = (#const SDL_PIXELFORMAT_ARGB8888) +pattern SDL_PIXELFORMAT_RGBA8888 = (#const SDL_PIXELFORMAT_RGBA8888) +pattern SDL_PIXELFORMAT_ABGR8888 = (#const SDL_PIXELFORMAT_ABGR8888) +pattern SDL_PIXELFORMAT_BGRA8888 = (#const SDL_PIXELFORMAT_BGRA8888) +pattern SDL_PIXELFORMAT_ARGB2101010 = (#const SDL_PIXELFORMAT_ARGB2101010) +pattern SDL_PIXELFORMAT_YV12 = (#const SDL_PIXELFORMAT_YV12) +pattern SDL_PIXELFORMAT_IYUV = (#const SDL_PIXELFORMAT_IYUV) +pattern SDL_PIXELFORMAT_YUY2 = (#const SDL_PIXELFORMAT_YUY2) +pattern SDL_PIXELFORMAT_UYVY = (#const SDL_PIXELFORMAT_UYVY) +pattern SDL_PIXELFORMAT_YVYU = (#const SDL_PIXELFORMAT_YVYU) + +pattern SDL_RENDERER_SOFTWARE = (#const SDL_RENDERER_SOFTWARE) +pattern SDL_RENDERER_ACCELERATED = (#const SDL_RENDERER_ACCELERATED) +pattern SDL_RENDERER_PRESENTVSYNC = (#const SDL_RENDERER_PRESENTVSYNC) +pattern SDL_RENDERER_TARGETTEXTURE = (#const SDL_RENDERER_TARGETTEXTURE) + +pattern SDL_TEXTUREACCESS_STATIC = (#const SDL_TEXTUREACCESS_STATIC) +pattern SDL_TEXTUREACCESS_STREAMING = (#const SDL_TEXTUREACCESS_STREAMING) +pattern SDL_TEXTUREACCESS_TARGET = (#const SDL_TEXTUREACCESS_TARGET) + +pattern SDL_TEXTUREMODULATE_NONE = (#const SDL_TEXTUREMODULATE_NONE) +pattern SDL_TEXTUREMODULATE_COLOR = (#const SDL_TEXTUREMODULATE_COLOR) +pattern SDL_TEXTUREMODULATE_ALPHA = (#const SDL_TEXTUREMODULATE_ALPHA) + +pattern SDL_TOUCH_MOUSEID = (#const SDL_TOUCH_MOUSEID) + +pattern SDL_WINDOWEVENT_NONE = (#const SDL_WINDOWEVENT_NONE) +pattern SDL_WINDOWEVENT_SHOWN = (#const SDL_WINDOWEVENT_SHOWN) +pattern SDL_WINDOWEVENT_HIDDEN = (#const SDL_WINDOWEVENT_HIDDEN) +pattern SDL_WINDOWEVENT_EXPOSED = (#const SDL_WINDOWEVENT_EXPOSED) +pattern SDL_WINDOWEVENT_MOVED = (#const SDL_WINDOWEVENT_MOVED) +pattern SDL_WINDOWEVENT_RESIZED = (#const SDL_WINDOWEVENT_RESIZED) +pattern SDL_WINDOWEVENT_SIZE_CHANGED = (#const SDL_WINDOWEVENT_SIZE_CHANGED) +pattern SDL_WINDOWEVENT_MINIMIZED = (#const SDL_WINDOWEVENT_MINIMIZED) +pattern SDL_WINDOWEVENT_MAXIMIZED = (#const SDL_WINDOWEVENT_MAXIMIZED) +pattern SDL_WINDOWEVENT_RESTORED = (#const SDL_WINDOWEVENT_RESTORED) +pattern SDL_WINDOWEVENT_ENTER = (#const SDL_WINDOWEVENT_ENTER) +pattern SDL_WINDOWEVENT_LEAVE = (#const SDL_WINDOWEVENT_LEAVE) +pattern SDL_WINDOWEVENT_FOCUS_GAINED = (#const SDL_WINDOWEVENT_FOCUS_GAINED) +pattern SDL_WINDOWEVENT_FOCUS_LOST = (#const SDL_WINDOWEVENT_FOCUS_LOST) +pattern SDL_WINDOWEVENT_CLOSE = (#const SDL_WINDOWEVENT_CLOSE) + +pattern SDL_WINDOW_FULLSCREEN = (#const SDL_WINDOW_FULLSCREEN) +pattern SDL_WINDOW_OPENGL = (#const SDL_WINDOW_OPENGL) +pattern SDL_WINDOW_SHOWN = (#const SDL_WINDOW_SHOWN) +pattern SDL_WINDOW_HIDDEN = (#const SDL_WINDOW_HIDDEN) +pattern SDL_WINDOW_BORDERLESS = (#const SDL_WINDOW_BORDERLESS) +pattern SDL_WINDOW_RESIZABLE = (#const SDL_WINDOW_RESIZABLE) +pattern SDL_WINDOW_MINIMIZED = (#const SDL_WINDOW_MINIMIZED) +pattern SDL_WINDOW_MAXIMIZED = (#const SDL_WINDOW_MAXIMIZED) +pattern SDL_WINDOW_INPUT_GRABBED = (#const SDL_WINDOW_INPUT_GRABBED) +pattern SDL_WINDOW_INPUT_FOCUS = (#const SDL_WINDOW_INPUT_FOCUS) +pattern SDL_WINDOW_MOUSE_FOCUS = (#const SDL_WINDOW_MOUSE_FOCUS) +pattern SDL_WINDOW_FULLSCREEN_DESKTOP = (#const SDL_WINDOW_FULLSCREEN_DESKTOP) +pattern SDL_WINDOW_FOREIGN = (#const SDL_WINDOW_FOREIGN) +pattern SDL_WINDOW_ALLOW_HIGHDPI = (#const SDL_WINDOW_ALLOW_HIGHDPI) + +pattern SDL_WINDOWPOS_UNDEFINED = (#const SDL_WINDOWPOS_UNDEFINED) +pattern SDL_WINDOWPOS_CENTERED = (#const SDL_WINDOWPOS_CENTERED) + +pattern SDL_HAPTIC_CONSTANT = (#const SDL_HAPTIC_CONSTANT) diff --git a/src/SDL/Raw/Error.hs b/src/SDL/Raw/Error.hs --- a/src/SDL/Raw/Error.hs +++ b/src/SDL/Raw/Error.hs @@ -1,44 +1,44 @@ -{-# LANGUAGE DeriveDataTypeable #-} -module SDL.Raw.Error ( - -- * Error Handling - SDLError(..), - throwError, - - -- * Manual Error Handling - clearError, - getError, - setError -) where - -import Control.Exception -import Control.Monad.Catch -import Control.Monad.IO.Class -import Data.Typeable -import Foreign.C.String -import Foreign.C.Types - --- | Note: the 'CString' is only valid until the next SDL function call. If you --- need to preserve the error message, make a copy of it. -newtype SDLError = SDLError CString - deriving (Eq, Show, Typeable) - -instance Exception SDLError - -foreign import ccall "SDL.h SDL_ClearError" clearErrorFFI :: IO () -foreign import ccall "SDL.h SDL_GetError" getErrorFFI :: IO CString -foreign import ccall "sdlhelper.c SDLHelper_SetError" setErrorFFI :: CString -> IO CInt - -throwError :: (MonadThrow m, MonadIO m) => m () -throwError = getError >>= throwM . SDLError - -clearError :: MonadIO m => m () -clearError = liftIO clearErrorFFI -{-# INLINE clearError #-} - -getError :: MonadIO m => m CString -getError = liftIO getErrorFFI -{-# INLINE getError #-} - -setError :: MonadIO m => CString -> m CInt -setError v1 = liftIO $ setErrorFFI v1 -{-# INLINE setError #-} +{-# LANGUAGE DeriveDataTypeable #-} +module SDL.Raw.Error ( + -- * Error Handling + SDLError(..), + throwError, + + -- * Manual Error Handling + clearError, + getError, + setError +) where + +import Control.Exception +import Control.Monad.Catch +import Control.Monad.IO.Class +import Data.Typeable +import Foreign.C.String +import Foreign.C.Types + +-- | Note: the 'CString' is only valid until the next SDL function call. If you +-- need to preserve the error message, make a copy of it. +newtype SDLError = SDLError CString + deriving (Eq, Show, Typeable) + +instance Exception SDLError + +foreign import ccall "SDL.h SDL_ClearError" clearErrorFFI :: IO () +foreign import ccall "SDL.h SDL_GetError" getErrorFFI :: IO CString +foreign import ccall "sdlhelper.c SDLHelper_SetError" setErrorFFI :: CString -> IO CInt + +throwError :: (MonadThrow m, MonadIO m) => m () +throwError = getError >>= throwM . SDLError + +clearError :: MonadIO m => m () +clearError = liftIO clearErrorFFI +{-# INLINE clearError #-} + +getError :: MonadIO m => m CString +getError = liftIO getErrorFFI +{-# INLINE getError #-} + +setError :: MonadIO m => CString -> m CInt +setError v1 = liftIO $ setErrorFFI v1 +{-# INLINE setError #-} diff --git a/src/SDL/Raw/Event.hs b/src/SDL/Raw/Event.hs --- a/src/SDL/Raw/Event.hs +++ b/src/SDL/Raw/Event.hs @@ -1,639 +1,639 @@ -module SDL.Raw.Event ( - -- * Event Handling - addEventWatch, - delEventWatch, - eventState, - filterEvents, - flushEvent, - flushEvents, - getEventFilter, - getNumTouchDevices, - getNumTouchFingers, - getTouchDevice, - getTouchFinger, - hasEvent, - hasEvents, - loadDollarTemplates, - peepEvents, - pollEvent, - pumpEvents, - pushEvent, - quitRequested, - recordGesture, - registerEvents, - saveAllDollarTemplates, - saveDollarTemplate, - setEventFilter, - waitEvent, - waitEventTimeout, - - -- * Keyboard Support - getKeyFromName, - getKeyFromScancode, - getKeyName, - getKeyboardFocus, - getKeyboardState, - getModState, - getScancodeFromKey, - getScancodeFromName, - getScancodeName, - hasScreenKeyboardSupport, - isScreenKeyboardShown, - isTextInputActive, - setModState, - setTextInputRect, - startTextInput, - stopTextInput, - - -- * Mouse Support - createColorCursor, - createCursor, - createSystemCursor, - freeCursor, - getCursor, - getDefaultCursor, - getMouseFocus, - getMouseState, - getRelativeMouseMode, - getRelativeMouseState, - setCursor, - setRelativeMouseMode, - showCursor, - warpMouseInWindow, - - -- * Joystick Support - joystickClose, - joystickEventState, - joystickGetAttached, - joystickGetAxis, - joystickGetBall, - joystickGetButton, - joystickGetDeviceGUID, - joystickGetGUID, - joystickGetGUIDFromString, - joystickGetGUIDString, - joystickGetHat, - joystickInstanceID, - joystickName, - joystickNameForIndex, - joystickNumAxes, - joystickNumBalls, - joystickNumButtons, - joystickNumHats, - joystickOpen, - joystickUpdate, - numJoysticks, - - -- * Game Controller Support - gameControllerAddMapping, - gameControllerAddMappingsFromFile, - gameControllerAddMappingsFromRW, - gameControllerClose, - gameControllerEventState, - gameControllerGetAttached, - gameControllerGetAxis, - gameControllerGetAxisFromString, - gameControllerGetBindForAxis, - gameControllerGetBindForButton, - gameControllerGetButton, - gameControllerGetButtonFromString, - gameControllerGetJoystick, - gameControllerGetStringForAxis, - gameControllerGetStringForButton, - gameControllerMapping, - gameControllerMappingForGUID, - gameControllerName, - gameControllerNameForIndex, - gameControllerOpen, - gameControllerUpdate, - isGameController -) where - -import Control.Monad.IO.Class -import Data.Int -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Marshal.Alloc -import Foreign.Ptr -import Foreign.Storable -import SDL.Raw.Enum -import SDL.Raw.Filesystem -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_AddEventWatch" addEventWatchFFI :: EventFilter -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_DelEventWatch" delEventWatchFFI :: EventFilter -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_EventState" eventStateFFI :: Word32 -> CInt -> IO Word8 -foreign import ccall "SDL.h SDL_FilterEvents" filterEventsFFI :: EventFilter -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_FlushEvent" flushEventFFI :: Word32 -> IO () -foreign import ccall "SDL.h SDL_FlushEvents" flushEventsFFI :: Word32 -> Word32 -> IO () -foreign import ccall "SDL.h SDL_GetEventFilter" getEventFilterFFI :: Ptr EventFilter -> Ptr (Ptr ()) -> IO Bool -foreign import ccall "SDL.h SDL_GetNumTouchDevices" getNumTouchDevicesFFI :: IO CInt -foreign import ccall "SDL.h SDL_GetNumTouchFingers" getNumTouchFingersFFI :: TouchID -> IO CInt -foreign import ccall "SDL.h SDL_GetTouchDevice" getTouchDeviceFFI :: CInt -> IO TouchID -foreign import ccall "SDL.h SDL_GetTouchFinger" getTouchFingerFFI :: TouchID -> CInt -> IO (Ptr Finger) -foreign import ccall "SDL.h SDL_HasEvent" hasEventFFI :: Word32 -> IO Bool -foreign import ccall "SDL.h SDL_HasEvents" hasEventsFFI :: Word32 -> Word32 -> IO Bool -foreign import ccall "SDL.h SDL_LoadDollarTemplates" loadDollarTemplatesFFI :: TouchID -> Ptr RWops -> IO CInt -foreign import ccall "SDL.h SDL_PeepEvents" peepEventsFFI :: Ptr Event -> CInt -> EventAction -> Word32 -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_PollEvent" pollEventFFI :: Ptr Event -> IO CInt -foreign import ccall "SDL.h SDL_PumpEvents" pumpEventsFFI :: IO () -foreign import ccall "SDL.h SDL_PushEvent" pushEventFFI :: Ptr Event -> IO CInt -foreign import ccall "SDL.h SDL_RecordGesture" recordGestureFFI :: TouchID -> IO CInt -foreign import ccall "SDL.h SDL_RegisterEvents" registerEventsFFI :: CInt -> IO Word32 -foreign import ccall "SDL.h SDL_SaveAllDollarTemplates" saveAllDollarTemplatesFFI :: Ptr RWops -> IO CInt -foreign import ccall "SDL.h SDL_SaveDollarTemplate" saveDollarTemplateFFI :: GestureID -> Ptr RWops -> IO CInt -foreign import ccall "SDL.h SDL_SetEventFilter" setEventFilterFFI :: EventFilter -> Ptr () -> IO () -foreign import ccall "SDL.h SDL_WaitEvent" waitEventFFI :: Ptr Event -> IO CInt -foreign import ccall "SDL.h SDL_WaitEventTimeout" waitEventTimeoutFFI :: Ptr Event -> CInt -> IO CInt - -foreign import ccall "SDL.h SDL_GetKeyFromName" getKeyFromNameFFI :: CString -> IO Keycode -foreign import ccall "SDL.h SDL_GetKeyFromScancode" getKeyFromScancodeFFI :: Scancode -> IO Keycode -foreign import ccall "SDL.h SDL_GetKeyName" getKeyNameFFI :: Keycode -> IO CString -foreign import ccall "SDL.h SDL_GetKeyboardFocus" getKeyboardFocusFFI :: IO Window -foreign import ccall "SDL.h SDL_GetKeyboardState" getKeyboardStateFFI :: Ptr CInt -> IO (Ptr Word8) -foreign import ccall "SDL.h SDL_GetModState" getModStateFFI :: IO Keymod -foreign import ccall "SDL.h SDL_GetScancodeFromKey" getScancodeFromKeyFFI :: Keycode -> IO Scancode -foreign import ccall "SDL.h SDL_GetScancodeFromName" getScancodeFromNameFFI :: CString -> IO Scancode -foreign import ccall "SDL.h SDL_GetScancodeName" getScancodeNameFFI :: Scancode -> IO CString -foreign import ccall "SDL.h SDL_HasScreenKeyboardSupport" hasScreenKeyboardSupportFFI :: IO Bool -foreign import ccall "SDL.h SDL_IsScreenKeyboardShown" isScreenKeyboardShownFFI :: Window -> IO Bool -foreign import ccall "SDL.h SDL_IsTextInputActive" isTextInputActiveFFI :: IO Bool -foreign import ccall "SDL.h SDL_SetModState" setModStateFFI :: Keymod -> IO () -foreign import ccall "SDL.h SDL_SetTextInputRect" setTextInputRectFFI :: Ptr Rect -> IO () -foreign import ccall "SDL.h SDL_StartTextInput" startTextInputFFI :: IO () -foreign import ccall "SDL.h SDL_StopTextInput" stopTextInputFFI :: IO () - -foreign import ccall "SDL.h SDL_CreateColorCursor" createColorCursorFFI :: Ptr Surface -> CInt -> CInt -> IO Cursor -foreign import ccall "SDL.h SDL_CreateCursor" createCursorFFI :: Ptr Word8 -> Ptr Word8 -> CInt -> CInt -> CInt -> CInt -> IO Cursor -foreign import ccall "SDL.h SDL_CreateSystemCursor" createSystemCursorFFI :: SystemCursor -> IO Cursor -foreign import ccall "SDL.h SDL_FreeCursor" freeCursorFFI :: Cursor -> IO () -foreign import ccall "SDL.h SDL_GetCursor" getCursorFFI :: IO Cursor -foreign import ccall "SDL.h SDL_GetDefaultCursor" getDefaultCursorFFI :: IO Cursor -foreign import ccall "SDL.h SDL_GetMouseFocus" getMouseFocusFFI :: IO Window -foreign import ccall "SDL.h SDL_GetMouseState" getMouseStateFFI :: Ptr CInt -> Ptr CInt -> IO Word32 -foreign import ccall "SDL.h SDL_GetRelativeMouseMode" getRelativeMouseModeFFI :: IO Bool -foreign import ccall "SDL.h SDL_GetRelativeMouseState" getRelativeMouseStateFFI :: Ptr CInt -> Ptr CInt -> IO Word32 -foreign import ccall "SDL.h SDL_SetCursor" setCursorFFI :: Cursor -> IO () -foreign import ccall "SDL.h SDL_SetRelativeMouseMode" setRelativeMouseModeFFI :: Bool -> IO CInt -foreign import ccall "SDL.h SDL_ShowCursor" showCursorFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_WarpMouseInWindow" warpMouseInWindowFFI :: Window -> CInt -> CInt -> IO () - -foreign import ccall "SDL.h SDL_JoystickClose" joystickCloseFFI :: Joystick -> IO () -foreign import ccall "SDL.h SDL_JoystickEventState" joystickEventStateFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_JoystickGetAttached" joystickGetAttachedFFI :: Joystick -> IO Bool -foreign import ccall "SDL.h SDL_JoystickGetAxis" joystickGetAxisFFI :: Joystick -> CInt -> IO Int16 -foreign import ccall "SDL.h SDL_JoystickGetBall" joystickGetBallFFI :: Joystick -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt -foreign import ccall "SDL.h SDL_JoystickGetButton" joystickGetButtonFFI :: Joystick -> CInt -> IO Word8 -foreign import ccall "sdlhelper.h SDLHelper_JoystickGetDeviceGUID" joystickGetDeviceGUIDFFI :: CInt -> Ptr JoystickGUID -> IO () -foreign import ccall "sdlhelper.h SDLHelper_JoystickGetGUID" joystickGetGUIDFFI :: Joystick -> Ptr JoystickGUID -> IO () -foreign import ccall "sdlhelper.h SDLHelper_JoystickGetGUIDFromString" joystickGetGUIDFromStringFFI :: CString -> Ptr JoystickGUID -> IO () -foreign import ccall "sdlhelper.h SDLHelper_JoystickGetGUIDString" joystickGetGUIDStringFFI :: Ptr JoystickGUID -> CString -> CInt -> IO () -foreign import ccall "SDL.h SDL_JoystickGetHat" joystickGetHatFFI :: Joystick -> CInt -> IO Word8 -foreign import ccall "SDL.h SDL_JoystickInstanceID" joystickInstanceIDFFI :: Joystick -> IO JoystickID -foreign import ccall "SDL.h SDL_JoystickName" joystickNameFFI :: Joystick -> IO CString -foreign import ccall "SDL.h SDL_JoystickNameForIndex" joystickNameForIndexFFI :: CInt -> IO CString -foreign import ccall "SDL.h SDL_JoystickNumAxes" joystickNumAxesFFI :: Joystick -> IO CInt -foreign import ccall "SDL.h SDL_JoystickNumBalls" joystickNumBallsFFI :: Joystick -> IO CInt -foreign import ccall "SDL.h SDL_JoystickNumButtons" joystickNumButtonsFFI :: Joystick -> IO CInt -foreign import ccall "SDL.h SDL_JoystickNumHats" joystickNumHatsFFI :: Joystick -> IO CInt -foreign import ccall "SDL.h SDL_JoystickOpen" joystickOpenFFI :: CInt -> IO Joystick -foreign import ccall "SDL.h SDL_JoystickUpdate" joystickUpdateFFI :: IO () -foreign import ccall "SDL.h SDL_NumJoysticks" numJoysticksFFI :: IO CInt - -foreign import ccall "SDL.h SDL_GameControllerAddMapping" gameControllerAddMappingFFI :: CString -> IO CInt -foreign import ccall "SDL.h SDL_GameControllerAddMappingsFromRW" gameControllerAddMappingsFromRWFFI :: Ptr RWops -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_GameControllerClose" gameControllerCloseFFI :: GameController -> IO () -foreign import ccall "SDL.h SDL_GameControllerEventState" gameControllerEventStateFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_GameControllerGetAttached" gameControllerGetAttachedFFI :: GameController -> IO Bool -foreign import ccall "SDL.h SDL_GameControllerGetAxis" gameControllerGetAxisFFI :: GameController -> GameControllerAxis -> IO Int16 -foreign import ccall "SDL.h SDL_GameControllerGetAxisFromString" gameControllerGetAxisFromStringFFI :: CString -> IO GameControllerAxis -foreign import ccall "sdlhelper.h SDLHelper_GameControllerGetBindForAxis" gameControllerGetBindForAxisFFI :: GameController -> GameControllerAxis -> Ptr GameControllerButtonBind -> IO () -foreign import ccall "sdlhelper.h SDLHelper_GameControllerGetBindForButton" gameControllerGetBindForButtonFFI :: GameController -> GameControllerButton -> Ptr GameControllerButtonBind -> IO () -foreign import ccall "SDL.h SDL_GameControllerGetButton" gameControllerGetButtonFFI :: GameController -> GameControllerButton -> IO Word8 -foreign import ccall "SDL.h SDL_GameControllerGetButtonFromString" gameControllerGetButtonFromStringFFI :: CString -> IO GameControllerButton -foreign import ccall "SDL.h SDL_GameControllerGetJoystick" gameControllerGetJoystickFFI :: GameController -> IO Joystick -foreign import ccall "SDL.h SDL_GameControllerGetStringForAxis" gameControllerGetStringForAxisFFI :: GameControllerAxis -> IO CString -foreign import ccall "SDL.h SDL_GameControllerGetStringForButton" gameControllerGetStringForButtonFFI :: GameControllerButton -> IO CString -foreign import ccall "SDL.h SDL_GameControllerMapping" gameControllerMappingFFI :: GameController -> IO CString -foreign import ccall "sdlhelper.h SDLHelper_GameControllerMappingForGUID" gameControllerMappingForGUIDFFI :: Ptr JoystickGUID -> IO CString -foreign import ccall "SDL.h SDL_GameControllerName" gameControllerNameFFI :: GameController -> IO CString -foreign import ccall "SDL.h SDL_GameControllerNameForIndex" gameControllerNameForIndexFFI :: CInt -> IO CString -foreign import ccall "SDL.h SDL_GameControllerOpen" gameControllerOpenFFI :: CInt -> IO GameController -foreign import ccall "SDL.h SDL_GameControllerUpdate" gameControllerUpdateFFI :: IO () -foreign import ccall "SDL.h SDL_IsGameController" isGameControllerFFI :: CInt -> IO Bool - -addEventWatch :: MonadIO m => EventFilter -> Ptr () -> m () -addEventWatch v1 v2 = liftIO $ addEventWatchFFI v1 v2 -{-# INLINE addEventWatch #-} - -delEventWatch :: MonadIO m => EventFilter -> Ptr () -> m () -delEventWatch v1 v2 = liftIO $ delEventWatchFFI v1 v2 -{-# INLINE delEventWatch #-} - -eventState :: MonadIO m => Word32 -> CInt -> m Word8 -eventState v1 v2 = liftIO $ eventStateFFI v1 v2 -{-# INLINE eventState #-} - -filterEvents :: MonadIO m => EventFilter -> Ptr () -> m () -filterEvents v1 v2 = liftIO $ filterEventsFFI v1 v2 -{-# INLINE filterEvents #-} - -flushEvent :: MonadIO m => Word32 -> m () -flushEvent v1 = liftIO $ flushEventFFI v1 -{-# INLINE flushEvent #-} - -flushEvents :: MonadIO m => Word32 -> Word32 -> m () -flushEvents v1 v2 = liftIO $ flushEventsFFI v1 v2 -{-# INLINE flushEvents #-} - -getEventFilter :: MonadIO m => Ptr EventFilter -> Ptr (Ptr ()) -> m Bool -getEventFilter v1 v2 = liftIO $ getEventFilterFFI v1 v2 -{-# INLINE getEventFilter #-} - -getNumTouchDevices :: MonadIO m => m CInt -getNumTouchDevices = liftIO getNumTouchDevicesFFI -{-# INLINE getNumTouchDevices #-} - -getNumTouchFingers :: MonadIO m => TouchID -> m CInt -getNumTouchFingers v1 = liftIO $ getNumTouchFingersFFI v1 -{-# INLINE getNumTouchFingers #-} - -getTouchDevice :: MonadIO m => CInt -> m TouchID -getTouchDevice v1 = liftIO $ getTouchDeviceFFI v1 -{-# INLINE getTouchDevice #-} - -getTouchFinger :: MonadIO m => TouchID -> CInt -> m (Ptr Finger) -getTouchFinger v1 v2 = liftIO $ getTouchFingerFFI v1 v2 -{-# INLINE getTouchFinger #-} - -hasEvent :: MonadIO m => Word32 -> m Bool -hasEvent v1 = liftIO $ hasEventFFI v1 -{-# INLINE hasEvent #-} - -hasEvents :: MonadIO m => Word32 -> Word32 -> m Bool -hasEvents v1 v2 = liftIO $ hasEventsFFI v1 v2 -{-# INLINE hasEvents #-} - -loadDollarTemplates :: MonadIO m => TouchID -> Ptr RWops -> m CInt -loadDollarTemplates v1 v2 = liftIO $ loadDollarTemplatesFFI v1 v2 -{-# INLINE loadDollarTemplates #-} - -peepEvents :: MonadIO m => Ptr Event -> CInt -> EventAction -> Word32 -> Word32 -> m CInt -peepEvents v1 v2 v3 v4 v5 = liftIO $ peepEventsFFI v1 v2 v3 v4 v5 -{-# INLINE peepEvents #-} - -pollEvent :: MonadIO m => Ptr Event -> m CInt -pollEvent v1 = liftIO $ pollEventFFI v1 -{-# INLINE pollEvent #-} - -pumpEvents :: MonadIO m => m () -pumpEvents = liftIO pumpEventsFFI -{-# INLINE pumpEvents #-} - -pushEvent :: MonadIO m => Ptr Event -> m CInt -pushEvent v1 = liftIO $ pushEventFFI v1 -{-# INLINE pushEvent #-} - -quitRequested :: MonadIO m => m Bool -quitRequested = liftIO $ do - pumpEvents - ev <- peepEvents nullPtr 0 SDL_PEEKEVENT SDL_QUIT SDL_QUIT - return $ ev > 0 -{-# INLINE quitRequested #-} - -recordGesture :: MonadIO m => TouchID -> m CInt -recordGesture v1 = liftIO $ recordGestureFFI v1 -{-# INLINE recordGesture #-} - -registerEvents :: MonadIO m => CInt -> m Word32 -registerEvents v1 = liftIO $ registerEventsFFI v1 -{-# INLINE registerEvents #-} - -saveAllDollarTemplates :: MonadIO m => Ptr RWops -> m CInt -saveAllDollarTemplates v1 = liftIO $ saveAllDollarTemplatesFFI v1 -{-# INLINE saveAllDollarTemplates #-} - -saveDollarTemplate :: MonadIO m => GestureID -> Ptr RWops -> m CInt -saveDollarTemplate v1 v2 = liftIO $ saveDollarTemplateFFI v1 v2 -{-# INLINE saveDollarTemplate #-} - -setEventFilter :: MonadIO m => EventFilter -> Ptr () -> m () -setEventFilter v1 v2 = liftIO $ setEventFilterFFI v1 v2 -{-# INLINE setEventFilter #-} - -waitEvent :: MonadIO m => Ptr Event -> m CInt -waitEvent v1 = liftIO $ waitEventFFI v1 -{-# INLINE waitEvent #-} - -waitEventTimeout :: MonadIO m => Ptr Event -> CInt -> m CInt -waitEventTimeout v1 v2 = liftIO $ waitEventTimeoutFFI v1 v2 -{-# INLINE waitEventTimeout #-} - -getKeyFromName :: MonadIO m => CString -> m Keycode -getKeyFromName v1 = liftIO $ getKeyFromNameFFI v1 -{-# INLINE getKeyFromName #-} - -getKeyFromScancode :: MonadIO m => Scancode -> m Keycode -getKeyFromScancode v1 = liftIO $ getKeyFromScancodeFFI v1 -{-# INLINE getKeyFromScancode #-} - -getKeyName :: MonadIO m => Keycode -> m CString -getKeyName v1 = liftIO $ getKeyNameFFI v1 -{-# INLINE getKeyName #-} - -getKeyboardFocus :: MonadIO m => m Window -getKeyboardFocus = liftIO getKeyboardFocusFFI -{-# INLINE getKeyboardFocus #-} - -getKeyboardState :: MonadIO m => Ptr CInt -> m (Ptr Word8) -getKeyboardState v1 = liftIO $ getKeyboardStateFFI v1 -{-# INLINE getKeyboardState #-} - -getModState :: MonadIO m => m Keymod -getModState = liftIO getModStateFFI -{-# INLINE getModState #-} - -getScancodeFromKey :: MonadIO m => Keycode -> m Scancode -getScancodeFromKey v1 = liftIO $ getScancodeFromKeyFFI v1 -{-# INLINE getScancodeFromKey #-} - -getScancodeFromName :: MonadIO m => CString -> m Scancode -getScancodeFromName v1 = liftIO $ getScancodeFromNameFFI v1 -{-# INLINE getScancodeFromName #-} - -getScancodeName :: MonadIO m => Scancode -> m CString -getScancodeName v1 = liftIO $ getScancodeNameFFI v1 -{-# INLINE getScancodeName #-} - -hasScreenKeyboardSupport :: MonadIO m => m Bool -hasScreenKeyboardSupport = liftIO hasScreenKeyboardSupportFFI -{-# INLINE hasScreenKeyboardSupport #-} - -isScreenKeyboardShown :: MonadIO m => Window -> m Bool -isScreenKeyboardShown v1 = liftIO $ isScreenKeyboardShownFFI v1 -{-# INLINE isScreenKeyboardShown #-} - -isTextInputActive :: MonadIO m => m Bool -isTextInputActive = liftIO isTextInputActiveFFI -{-# INLINE isTextInputActive #-} - -setModState :: MonadIO m => Keymod -> m () -setModState v1 = liftIO $ setModStateFFI v1 -{-# INLINE setModState #-} - -setTextInputRect :: MonadIO m => Ptr Rect -> m () -setTextInputRect v1 = liftIO $ setTextInputRectFFI v1 -{-# INLINE setTextInputRect #-} - -startTextInput :: MonadIO m => m () -startTextInput = liftIO startTextInputFFI -{-# INLINE startTextInput #-} - -stopTextInput :: MonadIO m => m () -stopTextInput = liftIO stopTextInputFFI -{-# INLINE stopTextInput #-} - -createColorCursor :: MonadIO m => Ptr Surface -> CInt -> CInt -> m Cursor -createColorCursor v1 v2 v3 = liftIO $ createColorCursorFFI v1 v2 v3 -{-# INLINE createColorCursor #-} - -createCursor :: MonadIO m => Ptr Word8 -> Ptr Word8 -> CInt -> CInt -> CInt -> CInt -> m Cursor -createCursor v1 v2 v3 v4 v5 v6 = liftIO $ createCursorFFI v1 v2 v3 v4 v5 v6 -{-# INLINE createCursor #-} - -createSystemCursor :: MonadIO m => SystemCursor -> m Cursor -createSystemCursor v1 = liftIO $ createSystemCursorFFI v1 -{-# INLINE createSystemCursor #-} - -freeCursor :: MonadIO m => Cursor -> m () -freeCursor v1 = liftIO $ freeCursorFFI v1 -{-# INLINE freeCursor #-} - -getCursor :: MonadIO m => m Cursor -getCursor = liftIO getCursorFFI -{-# INLINE getCursor #-} - -getDefaultCursor :: MonadIO m => m Cursor -getDefaultCursor = liftIO getDefaultCursorFFI -{-# INLINE getDefaultCursor #-} - -getMouseFocus :: MonadIO m => m Window -getMouseFocus = liftIO getMouseFocusFFI -{-# INLINE getMouseFocus #-} - -getMouseState :: MonadIO m => Ptr CInt -> Ptr CInt -> m Word32 -getMouseState v1 v2 = liftIO $ getMouseStateFFI v1 v2 -{-# INLINE getMouseState #-} - -getRelativeMouseMode :: MonadIO m => m Bool -getRelativeMouseMode = liftIO getRelativeMouseModeFFI -{-# INLINE getRelativeMouseMode #-} - -getRelativeMouseState :: MonadIO m => Ptr CInt -> Ptr CInt -> m Word32 -getRelativeMouseState v1 v2 = liftIO $ getRelativeMouseStateFFI v1 v2 -{-# INLINE getRelativeMouseState #-} - -setCursor :: MonadIO m => Cursor -> m () -setCursor v1 = liftIO $ setCursorFFI v1 -{-# INLINE setCursor #-} - -setRelativeMouseMode :: MonadIO m => Bool -> m CInt -setRelativeMouseMode v1 = liftIO $ setRelativeMouseModeFFI v1 -{-# INLINE setRelativeMouseMode #-} - -showCursor :: MonadIO m => CInt -> m CInt -showCursor v1 = liftIO $ showCursorFFI v1 -{-# INLINE showCursor #-} - -warpMouseInWindow :: MonadIO m => Window -> CInt -> CInt -> m () -warpMouseInWindow v1 v2 v3 = liftIO $ warpMouseInWindowFFI v1 v2 v3 -{-# INLINE warpMouseInWindow #-} - -joystickClose :: MonadIO m => Joystick -> m () -joystickClose v1 = liftIO $ joystickCloseFFI v1 -{-# INLINE joystickClose #-} - -joystickEventState :: MonadIO m => CInt -> m CInt -joystickEventState v1 = liftIO $ joystickEventStateFFI v1 -{-# INLINE joystickEventState #-} - -joystickGetAttached :: MonadIO m => Joystick -> m Bool -joystickGetAttached v1 = liftIO $ joystickGetAttachedFFI v1 -{-# INLINE joystickGetAttached #-} - -joystickGetAxis :: MonadIO m => Joystick -> CInt -> m Int16 -joystickGetAxis v1 v2 = liftIO $ joystickGetAxisFFI v1 v2 -{-# INLINE joystickGetAxis #-} - -joystickGetBall :: MonadIO m => Joystick -> CInt -> Ptr CInt -> Ptr CInt -> m CInt -joystickGetBall v1 v2 v3 v4 = liftIO $ joystickGetBallFFI v1 v2 v3 v4 -{-# INLINE joystickGetBall #-} - -joystickGetButton :: MonadIO m => Joystick -> CInt -> m Word8 -joystickGetButton v1 v2 = liftIO $ joystickGetButtonFFI v1 v2 -{-# INLINE joystickGetButton #-} - -joystickGetDeviceGUID :: MonadIO m => CInt -> m JoystickGUID -joystickGetDeviceGUID device_index = liftIO . alloca $ \ptr -> do - joystickGetDeviceGUIDFFI device_index ptr - peek ptr -{-# INLINE joystickGetDeviceGUID #-} - -joystickGetGUID :: MonadIO m => Joystick -> m JoystickGUID -joystickGetGUID joystick = liftIO . alloca $ \ptr -> do - joystickGetGUIDFFI joystick ptr - peek ptr -{-# INLINE joystickGetGUID #-} - -joystickGetGUIDFromString :: MonadIO m => CString -> m JoystickGUID -joystickGetGUIDFromString pchGUID = liftIO . alloca $ \ptr -> do - joystickGetGUIDFromStringFFI pchGUID ptr - peek ptr -{-# INLINE joystickGetGUIDFromString #-} - -joystickGetGUIDString :: MonadIO m => JoystickGUID -> CString -> CInt -> m () -joystickGetGUIDString guid pszGUID cbGUID = liftIO . alloca $ \ptr -> do - poke ptr guid - joystickGetGUIDStringFFI ptr pszGUID cbGUID -{-# INLINE joystickGetGUIDString #-} - -joystickGetHat :: MonadIO m => Joystick -> CInt -> m Word8 -joystickGetHat v1 v2 = liftIO $ joystickGetHatFFI v1 v2 -{-# INLINE joystickGetHat #-} - -joystickInstanceID :: MonadIO m => Joystick -> m JoystickID -joystickInstanceID v1 = liftIO $ joystickInstanceIDFFI v1 -{-# INLINE joystickInstanceID #-} - -joystickName :: MonadIO m => Joystick -> m CString -joystickName v1 = liftIO $ joystickNameFFI v1 -{-# INLINE joystickName #-} - -joystickNameForIndex :: MonadIO m => CInt -> m CString -joystickNameForIndex v1 = liftIO $ joystickNameForIndexFFI v1 -{-# INLINE joystickNameForIndex #-} - -joystickNumAxes :: MonadIO m => Joystick -> m CInt -joystickNumAxes v1 = liftIO $ joystickNumAxesFFI v1 -{-# INLINE joystickNumAxes #-} - -joystickNumBalls :: MonadIO m => Joystick -> m CInt -joystickNumBalls v1 = liftIO $ joystickNumBallsFFI v1 -{-# INLINE joystickNumBalls #-} - -joystickNumButtons :: MonadIO m => Joystick -> m CInt -joystickNumButtons v1 = liftIO $ joystickNumButtonsFFI v1 -{-# INLINE joystickNumButtons #-} - -joystickNumHats :: MonadIO m => Joystick -> m CInt -joystickNumHats v1 = liftIO $ joystickNumHatsFFI v1 -{-# INLINE joystickNumHats #-} - -joystickOpen :: MonadIO m => CInt -> m Joystick -joystickOpen v1 = liftIO $ joystickOpenFFI v1 -{-# INLINE joystickOpen #-} - -joystickUpdate :: MonadIO m => m () -joystickUpdate = liftIO joystickUpdateFFI -{-# INLINE joystickUpdate #-} - -numJoysticks :: MonadIO m => m CInt -numJoysticks = liftIO numJoysticksFFI -{-# INLINE numJoysticks #-} - -gameControllerAddMapping :: MonadIO m => CString -> m CInt -gameControllerAddMapping v1 = liftIO $ gameControllerAddMappingFFI v1 -{-# INLINE gameControllerAddMapping #-} - -gameControllerAddMappingsFromFile :: MonadIO m => CString -> m CInt -gameControllerAddMappingsFromFile file = liftIO $ do - rw <- withCString "rb" $ rwFromFile file - gameControllerAddMappingsFromRW rw 1 -{-# INLINE gameControllerAddMappingsFromFile #-} - -gameControllerAddMappingsFromRW :: MonadIO m => Ptr RWops -> CInt -> m CInt -gameControllerAddMappingsFromRW v1 v2 = liftIO $ gameControllerAddMappingsFromRWFFI v1 v2 -{-# INLINE gameControllerAddMappingsFromRW #-} - -gameControllerClose :: MonadIO m => GameController -> m () -gameControllerClose v1 = liftIO $ gameControllerCloseFFI v1 -{-# INLINE gameControllerClose #-} - -gameControllerEventState :: MonadIO m => CInt -> m CInt -gameControllerEventState v1 = liftIO $ gameControllerEventStateFFI v1 -{-# INLINE gameControllerEventState #-} - -gameControllerGetAttached :: MonadIO m => GameController -> m Bool -gameControllerGetAttached v1 = liftIO $ gameControllerGetAttachedFFI v1 -{-# INLINE gameControllerGetAttached #-} - -gameControllerGetAxis :: MonadIO m => GameController -> GameControllerAxis -> m Int16 -gameControllerGetAxis v1 v2 = liftIO $ gameControllerGetAxisFFI v1 v2 -{-# INLINE gameControllerGetAxis #-} - -gameControllerGetAxisFromString :: MonadIO m => CString -> m GameControllerAxis -gameControllerGetAxisFromString v1 = liftIO $ gameControllerGetAxisFromStringFFI v1 -{-# INLINE gameControllerGetAxisFromString #-} - -gameControllerGetBindForAxis :: MonadIO m => GameController -> GameControllerAxis -> m GameControllerButtonBind -gameControllerGetBindForAxis gamecontroller axis = liftIO . alloca $ \ptr -> do - gameControllerGetBindForAxisFFI gamecontroller axis ptr - peek ptr -{-# INLINE gameControllerGetBindForAxis #-} - -gameControllerGetBindForButton :: MonadIO m => GameController -> GameControllerButton -> m GameControllerButtonBind -gameControllerGetBindForButton gamecontroller button = liftIO . alloca $ \ptr -> do - gameControllerGetBindForButtonFFI gamecontroller button ptr - peek ptr -{-# INLINE gameControllerGetBindForButton #-} - -gameControllerGetButton :: MonadIO m => GameController -> GameControllerButton -> m Word8 -gameControllerGetButton v1 v2 = liftIO $ gameControllerGetButtonFFI v1 v2 -{-# INLINE gameControllerGetButton #-} - -gameControllerGetButtonFromString :: MonadIO m => CString -> m GameControllerButton -gameControllerGetButtonFromString v1 = liftIO $ gameControllerGetButtonFromStringFFI v1 -{-# INLINE gameControllerGetButtonFromString #-} - -gameControllerGetJoystick :: MonadIO m => GameController -> m Joystick -gameControllerGetJoystick v1 = liftIO $ gameControllerGetJoystickFFI v1 -{-# INLINE gameControllerGetJoystick #-} - -gameControllerGetStringForAxis :: MonadIO m => GameControllerAxis -> m CString -gameControllerGetStringForAxis v1 = liftIO $ gameControllerGetStringForAxisFFI v1 -{-# INLINE gameControllerGetStringForAxis #-} - -gameControllerGetStringForButton :: MonadIO m => GameControllerButton -> m CString -gameControllerGetStringForButton v1 = liftIO $ gameControllerGetStringForButtonFFI v1 -{-# INLINE gameControllerGetStringForButton #-} - -gameControllerMapping :: MonadIO m => GameController -> m CString -gameControllerMapping v1 = liftIO $ gameControllerMappingFFI v1 -{-# INLINE gameControllerMapping #-} - -gameControllerMappingForGUID :: MonadIO m => JoystickGUID -> m CString -gameControllerMappingForGUID guid = liftIO . alloca $ \ptr -> do - poke ptr guid - gameControllerMappingForGUIDFFI ptr -{-# INLINE gameControllerMappingForGUID #-} - -gameControllerName :: MonadIO m => GameController -> m CString -gameControllerName v1 = liftIO $ gameControllerNameFFI v1 -{-# INLINE gameControllerName #-} - -gameControllerNameForIndex :: MonadIO m => CInt -> m CString -gameControllerNameForIndex v1 = liftIO $ gameControllerNameForIndexFFI v1 -{-# INLINE gameControllerNameForIndex #-} - -gameControllerOpen :: MonadIO m => CInt -> m GameController -gameControllerOpen v1 = liftIO $ gameControllerOpenFFI v1 -{-# INLINE gameControllerOpen #-} - -gameControllerUpdate :: MonadIO m => m () -gameControllerUpdate = liftIO gameControllerUpdateFFI -{-# INLINE gameControllerUpdate #-} - -isGameController :: MonadIO m => CInt -> m Bool -isGameController v1 = liftIO $ isGameControllerFFI v1 -{-# INLINE isGameController #-} +module SDL.Raw.Event ( + -- * Event Handling + addEventWatch, + delEventWatch, + eventState, + filterEvents, + flushEvent, + flushEvents, + getEventFilter, + getNumTouchDevices, + getNumTouchFingers, + getTouchDevice, + getTouchFinger, + hasEvent, + hasEvents, + loadDollarTemplates, + peepEvents, + pollEvent, + pumpEvents, + pushEvent, + quitRequested, + recordGesture, + registerEvents, + saveAllDollarTemplates, + saveDollarTemplate, + setEventFilter, + waitEvent, + waitEventTimeout, + + -- * Keyboard Support + getKeyFromName, + getKeyFromScancode, + getKeyName, + getKeyboardFocus, + getKeyboardState, + getModState, + getScancodeFromKey, + getScancodeFromName, + getScancodeName, + hasScreenKeyboardSupport, + isScreenKeyboardShown, + isTextInputActive, + setModState, + setTextInputRect, + startTextInput, + stopTextInput, + + -- * Mouse Support + createColorCursor, + createCursor, + createSystemCursor, + freeCursor, + getCursor, + getDefaultCursor, + getMouseFocus, + getMouseState, + getRelativeMouseMode, + getRelativeMouseState, + setCursor, + setRelativeMouseMode, + showCursor, + warpMouseInWindow, + + -- * Joystick Support + joystickClose, + joystickEventState, + joystickGetAttached, + joystickGetAxis, + joystickGetBall, + joystickGetButton, + joystickGetDeviceGUID, + joystickGetGUID, + joystickGetGUIDFromString, + joystickGetGUIDString, + joystickGetHat, + joystickInstanceID, + joystickName, + joystickNameForIndex, + joystickNumAxes, + joystickNumBalls, + joystickNumButtons, + joystickNumHats, + joystickOpen, + joystickUpdate, + numJoysticks, + + -- * Game Controller Support + gameControllerAddMapping, + gameControllerAddMappingsFromFile, + gameControllerAddMappingsFromRW, + gameControllerClose, + gameControllerEventState, + gameControllerGetAttached, + gameControllerGetAxis, + gameControllerGetAxisFromString, + gameControllerGetBindForAxis, + gameControllerGetBindForButton, + gameControllerGetButton, + gameControllerGetButtonFromString, + gameControllerGetJoystick, + gameControllerGetStringForAxis, + gameControllerGetStringForButton, + gameControllerMapping, + gameControllerMappingForGUID, + gameControllerName, + gameControllerNameForIndex, + gameControllerOpen, + gameControllerUpdate, + isGameController +) where + +import Control.Monad.IO.Class +import Data.Int +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import SDL.Raw.Enum +import SDL.Raw.Filesystem +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_AddEventWatch" addEventWatchFFI :: EventFilter -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_DelEventWatch" delEventWatchFFI :: EventFilter -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_EventState" eventStateFFI :: Word32 -> CInt -> IO Word8 +foreign import ccall "SDL.h SDL_FilterEvents" filterEventsFFI :: EventFilter -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_FlushEvent" flushEventFFI :: Word32 -> IO () +foreign import ccall "SDL.h SDL_FlushEvents" flushEventsFFI :: Word32 -> Word32 -> IO () +foreign import ccall "SDL.h SDL_GetEventFilter" getEventFilterFFI :: Ptr EventFilter -> Ptr (Ptr ()) -> IO Bool +foreign import ccall "SDL.h SDL_GetNumTouchDevices" getNumTouchDevicesFFI :: IO CInt +foreign import ccall "SDL.h SDL_GetNumTouchFingers" getNumTouchFingersFFI :: TouchID -> IO CInt +foreign import ccall "SDL.h SDL_GetTouchDevice" getTouchDeviceFFI :: CInt -> IO TouchID +foreign import ccall "SDL.h SDL_GetTouchFinger" getTouchFingerFFI :: TouchID -> CInt -> IO (Ptr Finger) +foreign import ccall "SDL.h SDL_HasEvent" hasEventFFI :: Word32 -> IO Bool +foreign import ccall "SDL.h SDL_HasEvents" hasEventsFFI :: Word32 -> Word32 -> IO Bool +foreign import ccall "SDL.h SDL_LoadDollarTemplates" loadDollarTemplatesFFI :: TouchID -> Ptr RWops -> IO CInt +foreign import ccall "SDL.h SDL_PeepEvents" peepEventsFFI :: Ptr Event -> CInt -> EventAction -> Word32 -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_PollEvent" pollEventFFI :: Ptr Event -> IO CInt +foreign import ccall "SDL.h SDL_PumpEvents" pumpEventsFFI :: IO () +foreign import ccall "SDL.h SDL_PushEvent" pushEventFFI :: Ptr Event -> IO CInt +foreign import ccall "SDL.h SDL_RecordGesture" recordGestureFFI :: TouchID -> IO CInt +foreign import ccall "SDL.h SDL_RegisterEvents" registerEventsFFI :: CInt -> IO Word32 +foreign import ccall "SDL.h SDL_SaveAllDollarTemplates" saveAllDollarTemplatesFFI :: Ptr RWops -> IO CInt +foreign import ccall "SDL.h SDL_SaveDollarTemplate" saveDollarTemplateFFI :: GestureID -> Ptr RWops -> IO CInt +foreign import ccall "SDL.h SDL_SetEventFilter" setEventFilterFFI :: EventFilter -> Ptr () -> IO () +foreign import ccall "SDL.h SDL_WaitEvent" waitEventFFI :: Ptr Event -> IO CInt +foreign import ccall "SDL.h SDL_WaitEventTimeout" waitEventTimeoutFFI :: Ptr Event -> CInt -> IO CInt + +foreign import ccall "SDL.h SDL_GetKeyFromName" getKeyFromNameFFI :: CString -> IO Keycode +foreign import ccall "SDL.h SDL_GetKeyFromScancode" getKeyFromScancodeFFI :: Scancode -> IO Keycode +foreign import ccall "SDL.h SDL_GetKeyName" getKeyNameFFI :: Keycode -> IO CString +foreign import ccall "SDL.h SDL_GetKeyboardFocus" getKeyboardFocusFFI :: IO Window +foreign import ccall "SDL.h SDL_GetKeyboardState" getKeyboardStateFFI :: Ptr CInt -> IO (Ptr Word8) +foreign import ccall "SDL.h SDL_GetModState" getModStateFFI :: IO Keymod +foreign import ccall "SDL.h SDL_GetScancodeFromKey" getScancodeFromKeyFFI :: Keycode -> IO Scancode +foreign import ccall "SDL.h SDL_GetScancodeFromName" getScancodeFromNameFFI :: CString -> IO Scancode +foreign import ccall "SDL.h SDL_GetScancodeName" getScancodeNameFFI :: Scancode -> IO CString +foreign import ccall "SDL.h SDL_HasScreenKeyboardSupport" hasScreenKeyboardSupportFFI :: IO Bool +foreign import ccall "SDL.h SDL_IsScreenKeyboardShown" isScreenKeyboardShownFFI :: Window -> IO Bool +foreign import ccall "SDL.h SDL_IsTextInputActive" isTextInputActiveFFI :: IO Bool +foreign import ccall "SDL.h SDL_SetModState" setModStateFFI :: Keymod -> IO () +foreign import ccall "SDL.h SDL_SetTextInputRect" setTextInputRectFFI :: Ptr Rect -> IO () +foreign import ccall "SDL.h SDL_StartTextInput" startTextInputFFI :: IO () +foreign import ccall "SDL.h SDL_StopTextInput" stopTextInputFFI :: IO () + +foreign import ccall "SDL.h SDL_CreateColorCursor" createColorCursorFFI :: Ptr Surface -> CInt -> CInt -> IO Cursor +foreign import ccall "SDL.h SDL_CreateCursor" createCursorFFI :: Ptr Word8 -> Ptr Word8 -> CInt -> CInt -> CInt -> CInt -> IO Cursor +foreign import ccall "SDL.h SDL_CreateSystemCursor" createSystemCursorFFI :: SystemCursor -> IO Cursor +foreign import ccall "SDL.h SDL_FreeCursor" freeCursorFFI :: Cursor -> IO () +foreign import ccall "SDL.h SDL_GetCursor" getCursorFFI :: IO Cursor +foreign import ccall "SDL.h SDL_GetDefaultCursor" getDefaultCursorFFI :: IO Cursor +foreign import ccall "SDL.h SDL_GetMouseFocus" getMouseFocusFFI :: IO Window +foreign import ccall "SDL.h SDL_GetMouseState" getMouseStateFFI :: Ptr CInt -> Ptr CInt -> IO Word32 +foreign import ccall "SDL.h SDL_GetRelativeMouseMode" getRelativeMouseModeFFI :: IO Bool +foreign import ccall "SDL.h SDL_GetRelativeMouseState" getRelativeMouseStateFFI :: Ptr CInt -> Ptr CInt -> IO Word32 +foreign import ccall "SDL.h SDL_SetCursor" setCursorFFI :: Cursor -> IO () +foreign import ccall "SDL.h SDL_SetRelativeMouseMode" setRelativeMouseModeFFI :: Bool -> IO CInt +foreign import ccall "SDL.h SDL_ShowCursor" showCursorFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_WarpMouseInWindow" warpMouseInWindowFFI :: Window -> CInt -> CInt -> IO () + +foreign import ccall "SDL.h SDL_JoystickClose" joystickCloseFFI :: Joystick -> IO () +foreign import ccall "SDL.h SDL_JoystickEventState" joystickEventStateFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_JoystickGetAttached" joystickGetAttachedFFI :: Joystick -> IO Bool +foreign import ccall "SDL.h SDL_JoystickGetAxis" joystickGetAxisFFI :: Joystick -> CInt -> IO Int16 +foreign import ccall "SDL.h SDL_JoystickGetBall" joystickGetBallFFI :: Joystick -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt +foreign import ccall "SDL.h SDL_JoystickGetButton" joystickGetButtonFFI :: Joystick -> CInt -> IO Word8 +foreign import ccall "sdlhelper.h SDLHelper_JoystickGetDeviceGUID" joystickGetDeviceGUIDFFI :: CInt -> Ptr JoystickGUID -> IO () +foreign import ccall "sdlhelper.h SDLHelper_JoystickGetGUID" joystickGetGUIDFFI :: Joystick -> Ptr JoystickGUID -> IO () +foreign import ccall "sdlhelper.h SDLHelper_JoystickGetGUIDFromString" joystickGetGUIDFromStringFFI :: CString -> Ptr JoystickGUID -> IO () +foreign import ccall "sdlhelper.h SDLHelper_JoystickGetGUIDString" joystickGetGUIDStringFFI :: Ptr JoystickGUID -> CString -> CInt -> IO () +foreign import ccall "SDL.h SDL_JoystickGetHat" joystickGetHatFFI :: Joystick -> CInt -> IO Word8 +foreign import ccall "SDL.h SDL_JoystickInstanceID" joystickInstanceIDFFI :: Joystick -> IO JoystickID +foreign import ccall "SDL.h SDL_JoystickName" joystickNameFFI :: Joystick -> IO CString +foreign import ccall "SDL.h SDL_JoystickNameForIndex" joystickNameForIndexFFI :: CInt -> IO CString +foreign import ccall "SDL.h SDL_JoystickNumAxes" joystickNumAxesFFI :: Joystick -> IO CInt +foreign import ccall "SDL.h SDL_JoystickNumBalls" joystickNumBallsFFI :: Joystick -> IO CInt +foreign import ccall "SDL.h SDL_JoystickNumButtons" joystickNumButtonsFFI :: Joystick -> IO CInt +foreign import ccall "SDL.h SDL_JoystickNumHats" joystickNumHatsFFI :: Joystick -> IO CInt +foreign import ccall "SDL.h SDL_JoystickOpen" joystickOpenFFI :: CInt -> IO Joystick +foreign import ccall "SDL.h SDL_JoystickUpdate" joystickUpdateFFI :: IO () +foreign import ccall "SDL.h SDL_NumJoysticks" numJoysticksFFI :: IO CInt + +foreign import ccall "SDL.h SDL_GameControllerAddMapping" gameControllerAddMappingFFI :: CString -> IO CInt +foreign import ccall "SDL.h SDL_GameControllerAddMappingsFromRW" gameControllerAddMappingsFromRWFFI :: Ptr RWops -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_GameControllerClose" gameControllerCloseFFI :: GameController -> IO () +foreign import ccall "SDL.h SDL_GameControllerEventState" gameControllerEventStateFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_GameControllerGetAttached" gameControllerGetAttachedFFI :: GameController -> IO Bool +foreign import ccall "SDL.h SDL_GameControllerGetAxis" gameControllerGetAxisFFI :: GameController -> GameControllerAxis -> IO Int16 +foreign import ccall "SDL.h SDL_GameControllerGetAxisFromString" gameControllerGetAxisFromStringFFI :: CString -> IO GameControllerAxis +foreign import ccall "sdlhelper.h SDLHelper_GameControllerGetBindForAxis" gameControllerGetBindForAxisFFI :: GameController -> GameControllerAxis -> Ptr GameControllerButtonBind -> IO () +foreign import ccall "sdlhelper.h SDLHelper_GameControllerGetBindForButton" gameControllerGetBindForButtonFFI :: GameController -> GameControllerButton -> Ptr GameControllerButtonBind -> IO () +foreign import ccall "SDL.h SDL_GameControllerGetButton" gameControllerGetButtonFFI :: GameController -> GameControllerButton -> IO Word8 +foreign import ccall "SDL.h SDL_GameControllerGetButtonFromString" gameControllerGetButtonFromStringFFI :: CString -> IO GameControllerButton +foreign import ccall "SDL.h SDL_GameControllerGetJoystick" gameControllerGetJoystickFFI :: GameController -> IO Joystick +foreign import ccall "SDL.h SDL_GameControllerGetStringForAxis" gameControllerGetStringForAxisFFI :: GameControllerAxis -> IO CString +foreign import ccall "SDL.h SDL_GameControllerGetStringForButton" gameControllerGetStringForButtonFFI :: GameControllerButton -> IO CString +foreign import ccall "SDL.h SDL_GameControllerMapping" gameControllerMappingFFI :: GameController -> IO CString +foreign import ccall "sdlhelper.h SDLHelper_GameControllerMappingForGUID" gameControllerMappingForGUIDFFI :: Ptr JoystickGUID -> IO CString +foreign import ccall "SDL.h SDL_GameControllerName" gameControllerNameFFI :: GameController -> IO CString +foreign import ccall "SDL.h SDL_GameControllerNameForIndex" gameControllerNameForIndexFFI :: CInt -> IO CString +foreign import ccall "SDL.h SDL_GameControllerOpen" gameControllerOpenFFI :: CInt -> IO GameController +foreign import ccall "SDL.h SDL_GameControllerUpdate" gameControllerUpdateFFI :: IO () +foreign import ccall "SDL.h SDL_IsGameController" isGameControllerFFI :: CInt -> IO Bool + +addEventWatch :: MonadIO m => EventFilter -> Ptr () -> m () +addEventWatch v1 v2 = liftIO $ addEventWatchFFI v1 v2 +{-# INLINE addEventWatch #-} + +delEventWatch :: MonadIO m => EventFilter -> Ptr () -> m () +delEventWatch v1 v2 = liftIO $ delEventWatchFFI v1 v2 +{-# INLINE delEventWatch #-} + +eventState :: MonadIO m => Word32 -> CInt -> m Word8 +eventState v1 v2 = liftIO $ eventStateFFI v1 v2 +{-# INLINE eventState #-} + +filterEvents :: MonadIO m => EventFilter -> Ptr () -> m () +filterEvents v1 v2 = liftIO $ filterEventsFFI v1 v2 +{-# INLINE filterEvents #-} + +flushEvent :: MonadIO m => Word32 -> m () +flushEvent v1 = liftIO $ flushEventFFI v1 +{-# INLINE flushEvent #-} + +flushEvents :: MonadIO m => Word32 -> Word32 -> m () +flushEvents v1 v2 = liftIO $ flushEventsFFI v1 v2 +{-# INLINE flushEvents #-} + +getEventFilter :: MonadIO m => Ptr EventFilter -> Ptr (Ptr ()) -> m Bool +getEventFilter v1 v2 = liftIO $ getEventFilterFFI v1 v2 +{-# INLINE getEventFilter #-} + +getNumTouchDevices :: MonadIO m => m CInt +getNumTouchDevices = liftIO getNumTouchDevicesFFI +{-# INLINE getNumTouchDevices #-} + +getNumTouchFingers :: MonadIO m => TouchID -> m CInt +getNumTouchFingers v1 = liftIO $ getNumTouchFingersFFI v1 +{-# INLINE getNumTouchFingers #-} + +getTouchDevice :: MonadIO m => CInt -> m TouchID +getTouchDevice v1 = liftIO $ getTouchDeviceFFI v1 +{-# INLINE getTouchDevice #-} + +getTouchFinger :: MonadIO m => TouchID -> CInt -> m (Ptr Finger) +getTouchFinger v1 v2 = liftIO $ getTouchFingerFFI v1 v2 +{-# INLINE getTouchFinger #-} + +hasEvent :: MonadIO m => Word32 -> m Bool +hasEvent v1 = liftIO $ hasEventFFI v1 +{-# INLINE hasEvent #-} + +hasEvents :: MonadIO m => Word32 -> Word32 -> m Bool +hasEvents v1 v2 = liftIO $ hasEventsFFI v1 v2 +{-# INLINE hasEvents #-} + +loadDollarTemplates :: MonadIO m => TouchID -> Ptr RWops -> m CInt +loadDollarTemplates v1 v2 = liftIO $ loadDollarTemplatesFFI v1 v2 +{-# INLINE loadDollarTemplates #-} + +peepEvents :: MonadIO m => Ptr Event -> CInt -> EventAction -> Word32 -> Word32 -> m CInt +peepEvents v1 v2 v3 v4 v5 = liftIO $ peepEventsFFI v1 v2 v3 v4 v5 +{-# INLINE peepEvents #-} + +pollEvent :: MonadIO m => Ptr Event -> m CInt +pollEvent v1 = liftIO $ pollEventFFI v1 +{-# INLINE pollEvent #-} + +pumpEvents :: MonadIO m => m () +pumpEvents = liftIO pumpEventsFFI +{-# INLINE pumpEvents #-} + +pushEvent :: MonadIO m => Ptr Event -> m CInt +pushEvent v1 = liftIO $ pushEventFFI v1 +{-# INLINE pushEvent #-} + +quitRequested :: MonadIO m => m Bool +quitRequested = liftIO $ do + pumpEvents + ev <- peepEvents nullPtr 0 SDL_PEEKEVENT SDL_QUIT SDL_QUIT + return $ ev > 0 +{-# INLINE quitRequested #-} + +recordGesture :: MonadIO m => TouchID -> m CInt +recordGesture v1 = liftIO $ recordGestureFFI v1 +{-# INLINE recordGesture #-} + +registerEvents :: MonadIO m => CInt -> m Word32 +registerEvents v1 = liftIO $ registerEventsFFI v1 +{-# INLINE registerEvents #-} + +saveAllDollarTemplates :: MonadIO m => Ptr RWops -> m CInt +saveAllDollarTemplates v1 = liftIO $ saveAllDollarTemplatesFFI v1 +{-# INLINE saveAllDollarTemplates #-} + +saveDollarTemplate :: MonadIO m => GestureID -> Ptr RWops -> m CInt +saveDollarTemplate v1 v2 = liftIO $ saveDollarTemplateFFI v1 v2 +{-# INLINE saveDollarTemplate #-} + +setEventFilter :: MonadIO m => EventFilter -> Ptr () -> m () +setEventFilter v1 v2 = liftIO $ setEventFilterFFI v1 v2 +{-# INLINE setEventFilter #-} + +waitEvent :: MonadIO m => Ptr Event -> m CInt +waitEvent v1 = liftIO $ waitEventFFI v1 +{-# INLINE waitEvent #-} + +waitEventTimeout :: MonadIO m => Ptr Event -> CInt -> m CInt +waitEventTimeout v1 v2 = liftIO $ waitEventTimeoutFFI v1 v2 +{-# INLINE waitEventTimeout #-} + +getKeyFromName :: MonadIO m => CString -> m Keycode +getKeyFromName v1 = liftIO $ getKeyFromNameFFI v1 +{-# INLINE getKeyFromName #-} + +getKeyFromScancode :: MonadIO m => Scancode -> m Keycode +getKeyFromScancode v1 = liftIO $ getKeyFromScancodeFFI v1 +{-# INLINE getKeyFromScancode #-} + +getKeyName :: MonadIO m => Keycode -> m CString +getKeyName v1 = liftIO $ getKeyNameFFI v1 +{-# INLINE getKeyName #-} + +getKeyboardFocus :: MonadIO m => m Window +getKeyboardFocus = liftIO getKeyboardFocusFFI +{-# INLINE getKeyboardFocus #-} + +getKeyboardState :: MonadIO m => Ptr CInt -> m (Ptr Word8) +getKeyboardState v1 = liftIO $ getKeyboardStateFFI v1 +{-# INLINE getKeyboardState #-} + +getModState :: MonadIO m => m Keymod +getModState = liftIO getModStateFFI +{-# INLINE getModState #-} + +getScancodeFromKey :: MonadIO m => Keycode -> m Scancode +getScancodeFromKey v1 = liftIO $ getScancodeFromKeyFFI v1 +{-# INLINE getScancodeFromKey #-} + +getScancodeFromName :: MonadIO m => CString -> m Scancode +getScancodeFromName v1 = liftIO $ getScancodeFromNameFFI v1 +{-# INLINE getScancodeFromName #-} + +getScancodeName :: MonadIO m => Scancode -> m CString +getScancodeName v1 = liftIO $ getScancodeNameFFI v1 +{-# INLINE getScancodeName #-} + +hasScreenKeyboardSupport :: MonadIO m => m Bool +hasScreenKeyboardSupport = liftIO hasScreenKeyboardSupportFFI +{-# INLINE hasScreenKeyboardSupport #-} + +isScreenKeyboardShown :: MonadIO m => Window -> m Bool +isScreenKeyboardShown v1 = liftIO $ isScreenKeyboardShownFFI v1 +{-# INLINE isScreenKeyboardShown #-} + +isTextInputActive :: MonadIO m => m Bool +isTextInputActive = liftIO isTextInputActiveFFI +{-# INLINE isTextInputActive #-} + +setModState :: MonadIO m => Keymod -> m () +setModState v1 = liftIO $ setModStateFFI v1 +{-# INLINE setModState #-} + +setTextInputRect :: MonadIO m => Ptr Rect -> m () +setTextInputRect v1 = liftIO $ setTextInputRectFFI v1 +{-# INLINE setTextInputRect #-} + +startTextInput :: MonadIO m => m () +startTextInput = liftIO startTextInputFFI +{-# INLINE startTextInput #-} + +stopTextInput :: MonadIO m => m () +stopTextInput = liftIO stopTextInputFFI +{-# INLINE stopTextInput #-} + +createColorCursor :: MonadIO m => Ptr Surface -> CInt -> CInt -> m Cursor +createColorCursor v1 v2 v3 = liftIO $ createColorCursorFFI v1 v2 v3 +{-# INLINE createColorCursor #-} + +createCursor :: MonadIO m => Ptr Word8 -> Ptr Word8 -> CInt -> CInt -> CInt -> CInt -> m Cursor +createCursor v1 v2 v3 v4 v5 v6 = liftIO $ createCursorFFI v1 v2 v3 v4 v5 v6 +{-# INLINE createCursor #-} + +createSystemCursor :: MonadIO m => SystemCursor -> m Cursor +createSystemCursor v1 = liftIO $ createSystemCursorFFI v1 +{-# INLINE createSystemCursor #-} + +freeCursor :: MonadIO m => Cursor -> m () +freeCursor v1 = liftIO $ freeCursorFFI v1 +{-# INLINE freeCursor #-} + +getCursor :: MonadIO m => m Cursor +getCursor = liftIO getCursorFFI +{-# INLINE getCursor #-} + +getDefaultCursor :: MonadIO m => m Cursor +getDefaultCursor = liftIO getDefaultCursorFFI +{-# INLINE getDefaultCursor #-} + +getMouseFocus :: MonadIO m => m Window +getMouseFocus = liftIO getMouseFocusFFI +{-# INLINE getMouseFocus #-} + +getMouseState :: MonadIO m => Ptr CInt -> Ptr CInt -> m Word32 +getMouseState v1 v2 = liftIO $ getMouseStateFFI v1 v2 +{-# INLINE getMouseState #-} + +getRelativeMouseMode :: MonadIO m => m Bool +getRelativeMouseMode = liftIO getRelativeMouseModeFFI +{-# INLINE getRelativeMouseMode #-} + +getRelativeMouseState :: MonadIO m => Ptr CInt -> Ptr CInt -> m Word32 +getRelativeMouseState v1 v2 = liftIO $ getRelativeMouseStateFFI v1 v2 +{-# INLINE getRelativeMouseState #-} + +setCursor :: MonadIO m => Cursor -> m () +setCursor v1 = liftIO $ setCursorFFI v1 +{-# INLINE setCursor #-} + +setRelativeMouseMode :: MonadIO m => Bool -> m CInt +setRelativeMouseMode v1 = liftIO $ setRelativeMouseModeFFI v1 +{-# INLINE setRelativeMouseMode #-} + +showCursor :: MonadIO m => CInt -> m CInt +showCursor v1 = liftIO $ showCursorFFI v1 +{-# INLINE showCursor #-} + +warpMouseInWindow :: MonadIO m => Window -> CInt -> CInt -> m () +warpMouseInWindow v1 v2 v3 = liftIO $ warpMouseInWindowFFI v1 v2 v3 +{-# INLINE warpMouseInWindow #-} + +joystickClose :: MonadIO m => Joystick -> m () +joystickClose v1 = liftIO $ joystickCloseFFI v1 +{-# INLINE joystickClose #-} + +joystickEventState :: MonadIO m => CInt -> m CInt +joystickEventState v1 = liftIO $ joystickEventStateFFI v1 +{-# INLINE joystickEventState #-} + +joystickGetAttached :: MonadIO m => Joystick -> m Bool +joystickGetAttached v1 = liftIO $ joystickGetAttachedFFI v1 +{-# INLINE joystickGetAttached #-} + +joystickGetAxis :: MonadIO m => Joystick -> CInt -> m Int16 +joystickGetAxis v1 v2 = liftIO $ joystickGetAxisFFI v1 v2 +{-# INLINE joystickGetAxis #-} + +joystickGetBall :: MonadIO m => Joystick -> CInt -> Ptr CInt -> Ptr CInt -> m CInt +joystickGetBall v1 v2 v3 v4 = liftIO $ joystickGetBallFFI v1 v2 v3 v4 +{-# INLINE joystickGetBall #-} + +joystickGetButton :: MonadIO m => Joystick -> CInt -> m Word8 +joystickGetButton v1 v2 = liftIO $ joystickGetButtonFFI v1 v2 +{-# INLINE joystickGetButton #-} + +joystickGetDeviceGUID :: MonadIO m => CInt -> m JoystickGUID +joystickGetDeviceGUID device_index = liftIO . alloca $ \ptr -> do + joystickGetDeviceGUIDFFI device_index ptr + peek ptr +{-# INLINE joystickGetDeviceGUID #-} + +joystickGetGUID :: MonadIO m => Joystick -> m JoystickGUID +joystickGetGUID joystick = liftIO . alloca $ \ptr -> do + joystickGetGUIDFFI joystick ptr + peek ptr +{-# INLINE joystickGetGUID #-} + +joystickGetGUIDFromString :: MonadIO m => CString -> m JoystickGUID +joystickGetGUIDFromString pchGUID = liftIO . alloca $ \ptr -> do + joystickGetGUIDFromStringFFI pchGUID ptr + peek ptr +{-# INLINE joystickGetGUIDFromString #-} + +joystickGetGUIDString :: MonadIO m => JoystickGUID -> CString -> CInt -> m () +joystickGetGUIDString guid pszGUID cbGUID = liftIO . alloca $ \ptr -> do + poke ptr guid + joystickGetGUIDStringFFI ptr pszGUID cbGUID +{-# INLINE joystickGetGUIDString #-} + +joystickGetHat :: MonadIO m => Joystick -> CInt -> m Word8 +joystickGetHat v1 v2 = liftIO $ joystickGetHatFFI v1 v2 +{-# INLINE joystickGetHat #-} + +joystickInstanceID :: MonadIO m => Joystick -> m JoystickID +joystickInstanceID v1 = liftIO $ joystickInstanceIDFFI v1 +{-# INLINE joystickInstanceID #-} + +joystickName :: MonadIO m => Joystick -> m CString +joystickName v1 = liftIO $ joystickNameFFI v1 +{-# INLINE joystickName #-} + +joystickNameForIndex :: MonadIO m => CInt -> m CString +joystickNameForIndex v1 = liftIO $ joystickNameForIndexFFI v1 +{-# INLINE joystickNameForIndex #-} + +joystickNumAxes :: MonadIO m => Joystick -> m CInt +joystickNumAxes v1 = liftIO $ joystickNumAxesFFI v1 +{-# INLINE joystickNumAxes #-} + +joystickNumBalls :: MonadIO m => Joystick -> m CInt +joystickNumBalls v1 = liftIO $ joystickNumBallsFFI v1 +{-# INLINE joystickNumBalls #-} + +joystickNumButtons :: MonadIO m => Joystick -> m CInt +joystickNumButtons v1 = liftIO $ joystickNumButtonsFFI v1 +{-# INLINE joystickNumButtons #-} + +joystickNumHats :: MonadIO m => Joystick -> m CInt +joystickNumHats v1 = liftIO $ joystickNumHatsFFI v1 +{-# INLINE joystickNumHats #-} + +joystickOpen :: MonadIO m => CInt -> m Joystick +joystickOpen v1 = liftIO $ joystickOpenFFI v1 +{-# INLINE joystickOpen #-} + +joystickUpdate :: MonadIO m => m () +joystickUpdate = liftIO joystickUpdateFFI +{-# INLINE joystickUpdate #-} + +numJoysticks :: MonadIO m => m CInt +numJoysticks = liftIO numJoysticksFFI +{-# INLINE numJoysticks #-} + +gameControllerAddMapping :: MonadIO m => CString -> m CInt +gameControllerAddMapping v1 = liftIO $ gameControllerAddMappingFFI v1 +{-# INLINE gameControllerAddMapping #-} + +gameControllerAddMappingsFromFile :: MonadIO m => CString -> m CInt +gameControllerAddMappingsFromFile file = liftIO $ do + rw <- withCString "rb" $ rwFromFile file + gameControllerAddMappingsFromRW rw 1 +{-# INLINE gameControllerAddMappingsFromFile #-} + +gameControllerAddMappingsFromRW :: MonadIO m => Ptr RWops -> CInt -> m CInt +gameControllerAddMappingsFromRW v1 v2 = liftIO $ gameControllerAddMappingsFromRWFFI v1 v2 +{-# INLINE gameControllerAddMappingsFromRW #-} + +gameControllerClose :: MonadIO m => GameController -> m () +gameControllerClose v1 = liftIO $ gameControllerCloseFFI v1 +{-# INLINE gameControllerClose #-} + +gameControllerEventState :: MonadIO m => CInt -> m CInt +gameControllerEventState v1 = liftIO $ gameControllerEventStateFFI v1 +{-# INLINE gameControllerEventState #-} + +gameControllerGetAttached :: MonadIO m => GameController -> m Bool +gameControllerGetAttached v1 = liftIO $ gameControllerGetAttachedFFI v1 +{-# INLINE gameControllerGetAttached #-} + +gameControllerGetAxis :: MonadIO m => GameController -> GameControllerAxis -> m Int16 +gameControllerGetAxis v1 v2 = liftIO $ gameControllerGetAxisFFI v1 v2 +{-# INLINE gameControllerGetAxis #-} + +gameControllerGetAxisFromString :: MonadIO m => CString -> m GameControllerAxis +gameControllerGetAxisFromString v1 = liftIO $ gameControllerGetAxisFromStringFFI v1 +{-# INLINE gameControllerGetAxisFromString #-} + +gameControllerGetBindForAxis :: MonadIO m => GameController -> GameControllerAxis -> m GameControllerButtonBind +gameControllerGetBindForAxis gamecontroller axis = liftIO . alloca $ \ptr -> do + gameControllerGetBindForAxisFFI gamecontroller axis ptr + peek ptr +{-# INLINE gameControllerGetBindForAxis #-} + +gameControllerGetBindForButton :: MonadIO m => GameController -> GameControllerButton -> m GameControllerButtonBind +gameControllerGetBindForButton gamecontroller button = liftIO . alloca $ \ptr -> do + gameControllerGetBindForButtonFFI gamecontroller button ptr + peek ptr +{-# INLINE gameControllerGetBindForButton #-} + +gameControllerGetButton :: MonadIO m => GameController -> GameControllerButton -> m Word8 +gameControllerGetButton v1 v2 = liftIO $ gameControllerGetButtonFFI v1 v2 +{-# INLINE gameControllerGetButton #-} + +gameControllerGetButtonFromString :: MonadIO m => CString -> m GameControllerButton +gameControllerGetButtonFromString v1 = liftIO $ gameControllerGetButtonFromStringFFI v1 +{-# INLINE gameControllerGetButtonFromString #-} + +gameControllerGetJoystick :: MonadIO m => GameController -> m Joystick +gameControllerGetJoystick v1 = liftIO $ gameControllerGetJoystickFFI v1 +{-# INLINE gameControllerGetJoystick #-} + +gameControllerGetStringForAxis :: MonadIO m => GameControllerAxis -> m CString +gameControllerGetStringForAxis v1 = liftIO $ gameControllerGetStringForAxisFFI v1 +{-# INLINE gameControllerGetStringForAxis #-} + +gameControllerGetStringForButton :: MonadIO m => GameControllerButton -> m CString +gameControllerGetStringForButton v1 = liftIO $ gameControllerGetStringForButtonFFI v1 +{-# INLINE gameControllerGetStringForButton #-} + +gameControllerMapping :: MonadIO m => GameController -> m CString +gameControllerMapping v1 = liftIO $ gameControllerMappingFFI v1 +{-# INLINE gameControllerMapping #-} + +gameControllerMappingForGUID :: MonadIO m => JoystickGUID -> m CString +gameControllerMappingForGUID guid = liftIO . alloca $ \ptr -> do + poke ptr guid + gameControllerMappingForGUIDFFI ptr +{-# INLINE gameControllerMappingForGUID #-} + +gameControllerName :: MonadIO m => GameController -> m CString +gameControllerName v1 = liftIO $ gameControllerNameFFI v1 +{-# INLINE gameControllerName #-} + +gameControllerNameForIndex :: MonadIO m => CInt -> m CString +gameControllerNameForIndex v1 = liftIO $ gameControllerNameForIndexFFI v1 +{-# INLINE gameControllerNameForIndex #-} + +gameControllerOpen :: MonadIO m => CInt -> m GameController +gameControllerOpen v1 = liftIO $ gameControllerOpenFFI v1 +{-# INLINE gameControllerOpen #-} + +gameControllerUpdate :: MonadIO m => m () +gameControllerUpdate = liftIO gameControllerUpdateFFI +{-# INLINE gameControllerUpdate #-} + +isGameController :: MonadIO m => CInt -> m Bool +isGameController v1 = liftIO $ isGameControllerFFI v1 +{-# INLINE isGameController #-} diff --git a/src/SDL/Raw/Filesystem.hs b/src/SDL/Raw/Filesystem.hs --- a/src/SDL/Raw/Filesystem.hs +++ b/src/SDL/Raw/Filesystem.hs @@ -1,165 +1,165 @@ -module SDL.Raw.Filesystem ( - -- * Filesystem Paths - getBasePath, - getPrefPath, - - -- * File I/O Abstraction - allocRW, - freeRW, - rwFromConstMem, - rwFromFP, - rwFromFile, - rwFromMem, - rwClose, - rwRead, - rwSeek, - rwTell, - rwWrite, - readBE16, - readBE32, - readBE64, - readLE16, - readLE32, - readLE64, - writeBE16, - writeBE32, - writeBE64, - writeLE16, - writeLE32, - writeLE64 -) where - -import Control.Monad.IO.Class -import Data.Int -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_GetBasePath" getBasePathFFI :: IO CString -foreign import ccall "SDL.h SDL_GetPrefPath" getPrefPathFFI :: CString -> CString -> IO CString - -foreign import ccall "SDL.h SDL_AllocRW" allocRWFFI :: IO (Ptr RWops) -foreign import ccall "SDL.h SDL_FreeRW" freeRWFFI :: Ptr RWops -> IO () -foreign import ccall "SDL.h SDL_RWFromConstMem" rwFromConstMemFFI :: Ptr () -> CInt -> IO (Ptr RWops) -foreign import ccall "SDL.h SDL_RWFromFP" rwFromFPFFI :: Ptr () -> Bool -> IO (Ptr RWops) -foreign import ccall "SDL.h SDL_RWFromFile" rwFromFileFFI :: CString -> CString -> IO (Ptr RWops) -foreign import ccall "SDL.h SDL_RWFromMem" rwFromMemFFI :: Ptr () -> CInt -> IO (Ptr RWops) -foreign import ccall "sdlhelper.h SDLHelper_RWclose" rwCloseFFI :: Ptr RWops -> IO CInt -foreign import ccall "sdlhelper.h SDLHelper_RWread" rwReadFFI :: Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize -foreign import ccall "sdlhelper.h SDLHelper_RWseek" rwSeekFFI :: Ptr RWops -> Int64 -> CInt -> IO Int64 -foreign import ccall "sdlhelper.h SDLHelper_RWtell" rwTellFFI :: Ptr RWops -> IO Int64 -foreign import ccall "sdlhelper.h SDLHelper_RWwrite" rwWriteFFI :: Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize -foreign import ccall "SDL.h SDL_ReadBE16" readBE16FFI :: Ptr RWops -> IO Word16 -foreign import ccall "SDL.h SDL_ReadBE32" readBE32FFI :: Ptr RWops -> IO Word32 -foreign import ccall "SDL.h SDL_ReadBE64" readBE64FFI :: Ptr RWops -> IO Word64 -foreign import ccall "SDL.h SDL_ReadLE16" readLE16FFI :: Ptr RWops -> IO Word16 -foreign import ccall "SDL.h SDL_ReadLE32" readLE32FFI :: Ptr RWops -> IO Word32 -foreign import ccall "SDL.h SDL_ReadLE64" readLE64FFI :: Ptr RWops -> IO Word64 -foreign import ccall "SDL.h SDL_WriteBE16" writeBE16FFI :: Ptr RWops -> Word16 -> IO CSize -foreign import ccall "SDL.h SDL_WriteBE32" writeBE32FFI :: Ptr RWops -> Word32 -> IO CSize -foreign import ccall "SDL.h SDL_WriteBE64" writeBE64FFI :: Ptr RWops -> Word64 -> IO CSize -foreign import ccall "SDL.h SDL_WriteLE16" writeLE16FFI :: Ptr RWops -> Word16 -> IO CSize -foreign import ccall "SDL.h SDL_WriteLE32" writeLE32FFI :: Ptr RWops -> Word32 -> IO CSize -foreign import ccall "SDL.h SDL_WriteLE64" writeLE64FFI :: Ptr RWops -> Word64 -> IO CSize - -getBasePath :: MonadIO m => m CString -getBasePath = liftIO getBasePathFFI -{-# INLINE getBasePath #-} - -getPrefPath :: MonadIO m => CString -> CString -> m CString -getPrefPath v1 v2 = liftIO $ getPrefPathFFI v1 v2 -{-# INLINE getPrefPath #-} - -allocRW :: MonadIO m => m (Ptr RWops) -allocRW = liftIO allocRWFFI -{-# INLINE allocRW #-} - -freeRW :: MonadIO m => Ptr RWops -> m () -freeRW v1 = liftIO $ freeRWFFI v1 -{-# INLINE freeRW #-} - -rwFromConstMem :: MonadIO m => Ptr () -> CInt -> m (Ptr RWops) -rwFromConstMem v1 v2 = liftIO $ rwFromConstMemFFI v1 v2 -{-# INLINE rwFromConstMem #-} - -rwFromFP :: MonadIO m => Ptr () -> Bool -> m (Ptr RWops) -rwFromFP v1 v2 = liftIO $ rwFromFPFFI v1 v2 -{-# INLINE rwFromFP #-} - -rwFromFile :: MonadIO m => CString -> CString -> m (Ptr RWops) -rwFromFile v1 v2 = liftIO $ rwFromFileFFI v1 v2 -{-# INLINE rwFromFile #-} - -rwFromMem :: MonadIO m => Ptr () -> CInt -> m (Ptr RWops) -rwFromMem v1 v2 = liftIO $ rwFromMemFFI v1 v2 -{-# INLINE rwFromMem #-} - -rwClose :: MonadIO m => Ptr RWops -> m CInt -rwClose v1 = liftIO $ rwCloseFFI v1 -{-# INLINE rwClose #-} - -rwRead :: MonadIO m => Ptr RWops -> Ptr () -> CSize -> CSize -> m CSize -rwRead v1 v2 v3 v4 = liftIO $ rwReadFFI v1 v2 v3 v4 -{-# INLINE rwRead #-} - -rwSeek :: MonadIO m => Ptr RWops -> Int64 -> CInt -> m Int64 -rwSeek v1 v2 v3 = liftIO $ rwSeekFFI v1 v2 v3 -{-# INLINE rwSeek #-} - -rwTell :: MonadIO m => Ptr RWops -> m Int64 -rwTell v1 = liftIO $ rwTellFFI v1 -{-# INLINE rwTell #-} - -rwWrite :: MonadIO m => Ptr RWops -> Ptr () -> CSize -> CSize -> m CSize -rwWrite v1 v2 v3 v4 = liftIO $ rwWriteFFI v1 v2 v3 v4 -{-# INLINE rwWrite #-} - -readBE16 :: MonadIO m => Ptr RWops -> m Word16 -readBE16 v1 = liftIO $ readBE16FFI v1 -{-# INLINE readBE16 #-} - -readBE32 :: MonadIO m => Ptr RWops -> m Word32 -readBE32 v1 = liftIO $ readBE32FFI v1 -{-# INLINE readBE32 #-} - -readBE64 :: MonadIO m => Ptr RWops -> m Word64 -readBE64 v1 = liftIO $ readBE64FFI v1 -{-# INLINE readBE64 #-} - -readLE16 :: MonadIO m => Ptr RWops -> m Word16 -readLE16 v1 = liftIO $ readLE16FFI v1 -{-# INLINE readLE16 #-} - -readLE32 :: MonadIO m => Ptr RWops -> m Word32 -readLE32 v1 = liftIO $ readLE32FFI v1 -{-# INLINE readLE32 #-} - -readLE64 :: MonadIO m => Ptr RWops -> m Word64 -readLE64 v1 = liftIO $ readLE64FFI v1 -{-# INLINE readLE64 #-} - -writeBE16 :: MonadIO m => Ptr RWops -> Word16 -> m CSize -writeBE16 v1 v2 = liftIO $ writeBE16FFI v1 v2 -{-# INLINE writeBE16 #-} - -writeBE32 :: MonadIO m => Ptr RWops -> Word32 -> m CSize -writeBE32 v1 v2 = liftIO $ writeBE32FFI v1 v2 -{-# INLINE writeBE32 #-} - -writeBE64 :: MonadIO m => Ptr RWops -> Word64 -> m CSize -writeBE64 v1 v2 = liftIO $ writeBE64FFI v1 v2 -{-# INLINE writeBE64 #-} - -writeLE16 :: MonadIO m => Ptr RWops -> Word16 -> m CSize -writeLE16 v1 v2 = liftIO $ writeLE16FFI v1 v2 -{-# INLINE writeLE16 #-} - -writeLE32 :: MonadIO m => Ptr RWops -> Word32 -> m CSize -writeLE32 v1 v2 = liftIO $ writeLE32FFI v1 v2 -{-# INLINE writeLE32 #-} - -writeLE64 :: MonadIO m => Ptr RWops -> Word64 -> m CSize -writeLE64 v1 v2 = liftIO $ writeLE64FFI v1 v2 -{-# INLINE writeLE64 #-} +module SDL.Raw.Filesystem ( + -- * Filesystem Paths + getBasePath, + getPrefPath, + + -- * File I/O Abstraction + allocRW, + freeRW, + rwFromConstMem, + rwFromFP, + rwFromFile, + rwFromMem, + rwClose, + rwRead, + rwSeek, + rwTell, + rwWrite, + readBE16, + readBE32, + readBE64, + readLE16, + readLE32, + readLE64, + writeBE16, + writeBE32, + writeBE64, + writeLE16, + writeLE32, + writeLE64 +) where + +import Control.Monad.IO.Class +import Data.Int +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_GetBasePath" getBasePathFFI :: IO CString +foreign import ccall "SDL.h SDL_GetPrefPath" getPrefPathFFI :: CString -> CString -> IO CString + +foreign import ccall "SDL.h SDL_AllocRW" allocRWFFI :: IO (Ptr RWops) +foreign import ccall "SDL.h SDL_FreeRW" freeRWFFI :: Ptr RWops -> IO () +foreign import ccall "SDL.h SDL_RWFromConstMem" rwFromConstMemFFI :: Ptr () -> CInt -> IO (Ptr RWops) +foreign import ccall "SDL.h SDL_RWFromFP" rwFromFPFFI :: Ptr () -> Bool -> IO (Ptr RWops) +foreign import ccall "SDL.h SDL_RWFromFile" rwFromFileFFI :: CString -> CString -> IO (Ptr RWops) +foreign import ccall "SDL.h SDL_RWFromMem" rwFromMemFFI :: Ptr () -> CInt -> IO (Ptr RWops) +foreign import ccall "sdlhelper.h SDLHelper_RWclose" rwCloseFFI :: Ptr RWops -> IO CInt +foreign import ccall "sdlhelper.h SDLHelper_RWread" rwReadFFI :: Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize +foreign import ccall "sdlhelper.h SDLHelper_RWseek" rwSeekFFI :: Ptr RWops -> Int64 -> CInt -> IO Int64 +foreign import ccall "sdlhelper.h SDLHelper_RWtell" rwTellFFI :: Ptr RWops -> IO Int64 +foreign import ccall "sdlhelper.h SDLHelper_RWwrite" rwWriteFFI :: Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize +foreign import ccall "SDL.h SDL_ReadBE16" readBE16FFI :: Ptr RWops -> IO Word16 +foreign import ccall "SDL.h SDL_ReadBE32" readBE32FFI :: Ptr RWops -> IO Word32 +foreign import ccall "SDL.h SDL_ReadBE64" readBE64FFI :: Ptr RWops -> IO Word64 +foreign import ccall "SDL.h SDL_ReadLE16" readLE16FFI :: Ptr RWops -> IO Word16 +foreign import ccall "SDL.h SDL_ReadLE32" readLE32FFI :: Ptr RWops -> IO Word32 +foreign import ccall "SDL.h SDL_ReadLE64" readLE64FFI :: Ptr RWops -> IO Word64 +foreign import ccall "SDL.h SDL_WriteBE16" writeBE16FFI :: Ptr RWops -> Word16 -> IO CSize +foreign import ccall "SDL.h SDL_WriteBE32" writeBE32FFI :: Ptr RWops -> Word32 -> IO CSize +foreign import ccall "SDL.h SDL_WriteBE64" writeBE64FFI :: Ptr RWops -> Word64 -> IO CSize +foreign import ccall "SDL.h SDL_WriteLE16" writeLE16FFI :: Ptr RWops -> Word16 -> IO CSize +foreign import ccall "SDL.h SDL_WriteLE32" writeLE32FFI :: Ptr RWops -> Word32 -> IO CSize +foreign import ccall "SDL.h SDL_WriteLE64" writeLE64FFI :: Ptr RWops -> Word64 -> IO CSize + +getBasePath :: MonadIO m => m CString +getBasePath = liftIO getBasePathFFI +{-# INLINE getBasePath #-} + +getPrefPath :: MonadIO m => CString -> CString -> m CString +getPrefPath v1 v2 = liftIO $ getPrefPathFFI v1 v2 +{-# INLINE getPrefPath #-} + +allocRW :: MonadIO m => m (Ptr RWops) +allocRW = liftIO allocRWFFI +{-# INLINE allocRW #-} + +freeRW :: MonadIO m => Ptr RWops -> m () +freeRW v1 = liftIO $ freeRWFFI v1 +{-# INLINE freeRW #-} + +rwFromConstMem :: MonadIO m => Ptr () -> CInt -> m (Ptr RWops) +rwFromConstMem v1 v2 = liftIO $ rwFromConstMemFFI v1 v2 +{-# INLINE rwFromConstMem #-} + +rwFromFP :: MonadIO m => Ptr () -> Bool -> m (Ptr RWops) +rwFromFP v1 v2 = liftIO $ rwFromFPFFI v1 v2 +{-# INLINE rwFromFP #-} + +rwFromFile :: MonadIO m => CString -> CString -> m (Ptr RWops) +rwFromFile v1 v2 = liftIO $ rwFromFileFFI v1 v2 +{-# INLINE rwFromFile #-} + +rwFromMem :: MonadIO m => Ptr () -> CInt -> m (Ptr RWops) +rwFromMem v1 v2 = liftIO $ rwFromMemFFI v1 v2 +{-# INLINE rwFromMem #-} + +rwClose :: MonadIO m => Ptr RWops -> m CInt +rwClose v1 = liftIO $ rwCloseFFI v1 +{-# INLINE rwClose #-} + +rwRead :: MonadIO m => Ptr RWops -> Ptr () -> CSize -> CSize -> m CSize +rwRead v1 v2 v3 v4 = liftIO $ rwReadFFI v1 v2 v3 v4 +{-# INLINE rwRead #-} + +rwSeek :: MonadIO m => Ptr RWops -> Int64 -> CInt -> m Int64 +rwSeek v1 v2 v3 = liftIO $ rwSeekFFI v1 v2 v3 +{-# INLINE rwSeek #-} + +rwTell :: MonadIO m => Ptr RWops -> m Int64 +rwTell v1 = liftIO $ rwTellFFI v1 +{-# INLINE rwTell #-} + +rwWrite :: MonadIO m => Ptr RWops -> Ptr () -> CSize -> CSize -> m CSize +rwWrite v1 v2 v3 v4 = liftIO $ rwWriteFFI v1 v2 v3 v4 +{-# INLINE rwWrite #-} + +readBE16 :: MonadIO m => Ptr RWops -> m Word16 +readBE16 v1 = liftIO $ readBE16FFI v1 +{-# INLINE readBE16 #-} + +readBE32 :: MonadIO m => Ptr RWops -> m Word32 +readBE32 v1 = liftIO $ readBE32FFI v1 +{-# INLINE readBE32 #-} + +readBE64 :: MonadIO m => Ptr RWops -> m Word64 +readBE64 v1 = liftIO $ readBE64FFI v1 +{-# INLINE readBE64 #-} + +readLE16 :: MonadIO m => Ptr RWops -> m Word16 +readLE16 v1 = liftIO $ readLE16FFI v1 +{-# INLINE readLE16 #-} + +readLE32 :: MonadIO m => Ptr RWops -> m Word32 +readLE32 v1 = liftIO $ readLE32FFI v1 +{-# INLINE readLE32 #-} + +readLE64 :: MonadIO m => Ptr RWops -> m Word64 +readLE64 v1 = liftIO $ readLE64FFI v1 +{-# INLINE readLE64 #-} + +writeBE16 :: MonadIO m => Ptr RWops -> Word16 -> m CSize +writeBE16 v1 v2 = liftIO $ writeBE16FFI v1 v2 +{-# INLINE writeBE16 #-} + +writeBE32 :: MonadIO m => Ptr RWops -> Word32 -> m CSize +writeBE32 v1 v2 = liftIO $ writeBE32FFI v1 v2 +{-# INLINE writeBE32 #-} + +writeBE64 :: MonadIO m => Ptr RWops -> Word64 -> m CSize +writeBE64 v1 v2 = liftIO $ writeBE64FFI v1 v2 +{-# INLINE writeBE64 #-} + +writeLE16 :: MonadIO m => Ptr RWops -> Word16 -> m CSize +writeLE16 v1 v2 = liftIO $ writeLE16FFI v1 v2 +{-# INLINE writeLE16 #-} + +writeLE32 :: MonadIO m => Ptr RWops -> Word32 -> m CSize +writeLE32 v1 v2 = liftIO $ writeLE32FFI v1 v2 +{-# INLINE writeLE32 #-} + +writeLE64 :: MonadIO m => Ptr RWops -> Word64 -> m CSize +writeLE64 v1 v2 = liftIO $ writeLE64FFI v1 v2 +{-# INLINE writeLE64 #-} diff --git a/src/SDL/Raw/Haptic.hs b/src/SDL/Raw/Haptic.hs --- a/src/SDL/Raw/Haptic.hs +++ b/src/SDL/Raw/Haptic.hs @@ -1,191 +1,191 @@ -module SDL.Raw.Haptic ( - -- * Force Feedback Support - hapticClose, - hapticDestroyEffect, - hapticEffectSupported, - hapticGetEffectStatus, - hapticIndex, - hapticName, - hapticNewEffect, - hapticNumAxes, - hapticNumEffects, - hapticNumEffectsPlaying, - hapticOpen, - hapticOpenFromJoystick, - hapticOpenFromMouse, - hapticOpened, - hapticPause, - hapticQuery, - hapticRumbleInit, - hapticRumblePlay, - hapticRumbleStop, - hapticRumbleSupported, - hapticRunEffect, - hapticSetAutocenter, - hapticSetGain, - hapticStopAll, - hapticStopEffect, - hapticUnpause, - hapticUpdateEffect, - joystickIsHaptic, - mouseIsHaptic, - numHaptics -) where - -import Control.Monad.IO.Class -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_HapticClose" hapticCloseFFI :: Haptic -> IO () -foreign import ccall "SDL.h SDL_HapticDestroyEffect" hapticDestroyEffectFFI :: Haptic -> CInt -> IO () -foreign import ccall "SDL.h SDL_HapticEffectSupported" hapticEffectSupportedFFI :: Haptic -> Ptr HapticEffect -> IO CInt -foreign import ccall "SDL.h SDL_HapticGetEffectStatus" hapticGetEffectStatusFFI :: Haptic -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_HapticIndex" hapticIndexFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticName" hapticNameFFI :: CInt -> IO CString -foreign import ccall "SDL.h SDL_HapticNewEffect" hapticNewEffectFFI :: Haptic -> Ptr HapticEffect -> IO CInt -foreign import ccall "SDL.h SDL_HapticNumAxes" hapticNumAxesFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticNumEffects" hapticNumEffectsFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticNumEffectsPlaying" hapticNumEffectsPlayingFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticOpen" hapticOpenFFI :: CInt -> IO Haptic -foreign import ccall "SDL.h SDL_HapticOpenFromJoystick" hapticOpenFromJoystickFFI :: Joystick -> IO Haptic -foreign import ccall "SDL.h SDL_HapticOpenFromMouse" hapticOpenFromMouseFFI :: IO Haptic -foreign import ccall "SDL.h SDL_HapticOpened" hapticOpenedFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_HapticPause" hapticPauseFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticQuery" hapticQueryFFI :: Haptic -> IO CUInt -foreign import ccall "SDL.h SDL_HapticRumbleInit" hapticRumbleInitFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticRumblePlay" hapticRumblePlayFFI :: Haptic -> CFloat -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_HapticRumbleStop" hapticRumbleStopFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticRumbleSupported" hapticRumbleSupportedFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticRunEffect" hapticRunEffectFFI :: Haptic -> CInt -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_HapticSetAutocenter" hapticSetAutocenterFFI :: Haptic -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_HapticSetGain" hapticSetGainFFI :: Haptic -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_HapticStopAll" hapticStopAllFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticStopEffect" hapticStopEffectFFI :: Haptic -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_HapticUnpause" hapticUnpauseFFI :: Haptic -> IO CInt -foreign import ccall "SDL.h SDL_HapticUpdateEffect" hapticUpdateEffectFFI :: Haptic -> CInt -> Ptr HapticEffect -> IO CInt -foreign import ccall "SDL.h SDL_JoystickIsHaptic" joystickIsHapticFFI :: Joystick -> IO CInt -foreign import ccall "SDL.h SDL_MouseIsHaptic" mouseIsHapticFFI :: IO CInt -foreign import ccall "SDL.h SDL_NumHaptics" numHapticsFFI :: IO CInt - -hapticClose :: MonadIO m => Haptic -> m () -hapticClose v1 = liftIO $ hapticCloseFFI v1 -{-# INLINE hapticClose #-} - -hapticDestroyEffect :: MonadIO m => Haptic -> CInt -> m () -hapticDestroyEffect v1 v2 = liftIO $ hapticDestroyEffectFFI v1 v2 -{-# INLINE hapticDestroyEffect #-} - -hapticEffectSupported :: MonadIO m => Haptic -> Ptr HapticEffect -> m CInt -hapticEffectSupported v1 v2 = liftIO $ hapticEffectSupportedFFI v1 v2 -{-# INLINE hapticEffectSupported #-} - -hapticGetEffectStatus :: MonadIO m => Haptic -> CInt -> m CInt -hapticGetEffectStatus v1 v2 = liftIO $ hapticGetEffectStatusFFI v1 v2 -{-# INLINE hapticGetEffectStatus #-} - -hapticIndex :: MonadIO m => Haptic -> m CInt -hapticIndex v1 = liftIO $ hapticIndexFFI v1 -{-# INLINE hapticIndex #-} - -hapticName :: MonadIO m => CInt -> m CString -hapticName v1 = liftIO $ hapticNameFFI v1 -{-# INLINE hapticName #-} - -hapticNewEffect :: MonadIO m => Haptic -> Ptr HapticEffect -> m CInt -hapticNewEffect v1 v2 = liftIO $ hapticNewEffectFFI v1 v2 -{-# INLINE hapticNewEffect #-} - -hapticNumAxes :: MonadIO m => Haptic -> m CInt -hapticNumAxes v1 = liftIO $ hapticNumAxesFFI v1 -{-# INLINE hapticNumAxes #-} - -hapticNumEffects :: MonadIO m => Haptic -> m CInt -hapticNumEffects v1 = liftIO $ hapticNumEffectsFFI v1 -{-# INLINE hapticNumEffects #-} - -hapticNumEffectsPlaying :: MonadIO m => Haptic -> m CInt -hapticNumEffectsPlaying v1 = liftIO $ hapticNumEffectsPlayingFFI v1 -{-# INLINE hapticNumEffectsPlaying #-} - -hapticOpen :: MonadIO m => CInt -> m Haptic -hapticOpen v1 = liftIO $ hapticOpenFFI v1 -{-# INLINE hapticOpen #-} - -hapticOpenFromJoystick :: MonadIO m => Joystick -> m Haptic -hapticOpenFromJoystick v1 = liftIO $ hapticOpenFromJoystickFFI v1 -{-# INLINE hapticOpenFromJoystick #-} - -hapticOpenFromMouse :: MonadIO m => m Haptic -hapticOpenFromMouse = liftIO hapticOpenFromMouseFFI -{-# INLINE hapticOpenFromMouse #-} - -hapticOpened :: MonadIO m => CInt -> m CInt -hapticOpened v1 = liftIO $ hapticOpenedFFI v1 -{-# INLINE hapticOpened #-} - -hapticPause :: MonadIO m => Haptic -> m CInt -hapticPause v1 = liftIO $ hapticPauseFFI v1 -{-# INLINE hapticPause #-} - -hapticQuery :: MonadIO m => Haptic -> m CUInt -hapticQuery v1 = liftIO $ hapticQueryFFI v1 -{-# INLINE hapticQuery #-} - -hapticRumbleInit :: MonadIO m => Haptic -> m CInt -hapticRumbleInit v1 = liftIO $ hapticRumbleInitFFI v1 -{-# INLINE hapticRumbleInit #-} - -hapticRumblePlay :: MonadIO m => Haptic -> CFloat -> Word32 -> m CInt -hapticRumblePlay v1 v2 v3 = liftIO $ hapticRumblePlayFFI v1 v2 v3 -{-# INLINE hapticRumblePlay #-} - -hapticRumbleStop :: MonadIO m => Haptic -> m CInt -hapticRumbleStop v1 = liftIO $ hapticRumbleStopFFI v1 -{-# INLINE hapticRumbleStop #-} - -hapticRumbleSupported :: MonadIO m => Haptic -> m CInt -hapticRumbleSupported v1 = liftIO $ hapticRumbleSupportedFFI v1 -{-# INLINE hapticRumbleSupported #-} - -hapticRunEffect :: MonadIO m => Haptic -> CInt -> Word32 -> m CInt -hapticRunEffect v1 v2 v3 = liftIO $ hapticRunEffectFFI v1 v2 v3 -{-# INLINE hapticRunEffect #-} - -hapticSetAutocenter :: MonadIO m => Haptic -> CInt -> m CInt -hapticSetAutocenter v1 v2 = liftIO $ hapticSetAutocenterFFI v1 v2 -{-# INLINE hapticSetAutocenter #-} - -hapticSetGain :: MonadIO m => Haptic -> CInt -> m CInt -hapticSetGain v1 v2 = liftIO $ hapticSetGainFFI v1 v2 -{-# INLINE hapticSetGain #-} - -hapticStopAll :: MonadIO m => Haptic -> m CInt -hapticStopAll v1 = liftIO $ hapticStopAllFFI v1 -{-# INLINE hapticStopAll #-} - -hapticStopEffect :: MonadIO m => Haptic -> CInt -> m CInt -hapticStopEffect v1 v2 = liftIO $ hapticStopEffectFFI v1 v2 -{-# INLINE hapticStopEffect #-} - -hapticUnpause :: MonadIO m => Haptic -> m CInt -hapticUnpause v1 = liftIO $ hapticUnpauseFFI v1 -{-# INLINE hapticUnpause #-} - -hapticUpdateEffect :: MonadIO m => Haptic -> CInt -> Ptr HapticEffect -> m CInt -hapticUpdateEffect v1 v2 v3 = liftIO $ hapticUpdateEffectFFI v1 v2 v3 -{-# INLINE hapticUpdateEffect #-} - -joystickIsHaptic :: MonadIO m => Joystick -> m CInt -joystickIsHaptic v1 = liftIO $ joystickIsHapticFFI v1 -{-# INLINE joystickIsHaptic #-} - -mouseIsHaptic :: MonadIO m => m CInt -mouseIsHaptic = liftIO mouseIsHapticFFI -{-# INLINE mouseIsHaptic #-} - -numHaptics :: MonadIO m => m CInt -numHaptics = liftIO numHapticsFFI -{-# INLINE numHaptics #-} +module SDL.Raw.Haptic ( + -- * Force Feedback Support + hapticClose, + hapticDestroyEffect, + hapticEffectSupported, + hapticGetEffectStatus, + hapticIndex, + hapticName, + hapticNewEffect, + hapticNumAxes, + hapticNumEffects, + hapticNumEffectsPlaying, + hapticOpen, + hapticOpenFromJoystick, + hapticOpenFromMouse, + hapticOpened, + hapticPause, + hapticQuery, + hapticRumbleInit, + hapticRumblePlay, + hapticRumbleStop, + hapticRumbleSupported, + hapticRunEffect, + hapticSetAutocenter, + hapticSetGain, + hapticStopAll, + hapticStopEffect, + hapticUnpause, + hapticUpdateEffect, + joystickIsHaptic, + mouseIsHaptic, + numHaptics +) where + +import Control.Monad.IO.Class +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_HapticClose" hapticCloseFFI :: Haptic -> IO () +foreign import ccall "SDL.h SDL_HapticDestroyEffect" hapticDestroyEffectFFI :: Haptic -> CInt -> IO () +foreign import ccall "SDL.h SDL_HapticEffectSupported" hapticEffectSupportedFFI :: Haptic -> Ptr HapticEffect -> IO CInt +foreign import ccall "SDL.h SDL_HapticGetEffectStatus" hapticGetEffectStatusFFI :: Haptic -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_HapticIndex" hapticIndexFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticName" hapticNameFFI :: CInt -> IO CString +foreign import ccall "SDL.h SDL_HapticNewEffect" hapticNewEffectFFI :: Haptic -> Ptr HapticEffect -> IO CInt +foreign import ccall "SDL.h SDL_HapticNumAxes" hapticNumAxesFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticNumEffects" hapticNumEffectsFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticNumEffectsPlaying" hapticNumEffectsPlayingFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticOpen" hapticOpenFFI :: CInt -> IO Haptic +foreign import ccall "SDL.h SDL_HapticOpenFromJoystick" hapticOpenFromJoystickFFI :: Joystick -> IO Haptic +foreign import ccall "SDL.h SDL_HapticOpenFromMouse" hapticOpenFromMouseFFI :: IO Haptic +foreign import ccall "SDL.h SDL_HapticOpened" hapticOpenedFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_HapticPause" hapticPauseFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticQuery" hapticQueryFFI :: Haptic -> IO CUInt +foreign import ccall "SDL.h SDL_HapticRumbleInit" hapticRumbleInitFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticRumblePlay" hapticRumblePlayFFI :: Haptic -> CFloat -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_HapticRumbleStop" hapticRumbleStopFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticRumbleSupported" hapticRumbleSupportedFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticRunEffect" hapticRunEffectFFI :: Haptic -> CInt -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_HapticSetAutocenter" hapticSetAutocenterFFI :: Haptic -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_HapticSetGain" hapticSetGainFFI :: Haptic -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_HapticStopAll" hapticStopAllFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticStopEffect" hapticStopEffectFFI :: Haptic -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_HapticUnpause" hapticUnpauseFFI :: Haptic -> IO CInt +foreign import ccall "SDL.h SDL_HapticUpdateEffect" hapticUpdateEffectFFI :: Haptic -> CInt -> Ptr HapticEffect -> IO CInt +foreign import ccall "SDL.h SDL_JoystickIsHaptic" joystickIsHapticFFI :: Joystick -> IO CInt +foreign import ccall "SDL.h SDL_MouseIsHaptic" mouseIsHapticFFI :: IO CInt +foreign import ccall "SDL.h SDL_NumHaptics" numHapticsFFI :: IO CInt + +hapticClose :: MonadIO m => Haptic -> m () +hapticClose v1 = liftIO $ hapticCloseFFI v1 +{-# INLINE hapticClose #-} + +hapticDestroyEffect :: MonadIO m => Haptic -> CInt -> m () +hapticDestroyEffect v1 v2 = liftIO $ hapticDestroyEffectFFI v1 v2 +{-# INLINE hapticDestroyEffect #-} + +hapticEffectSupported :: MonadIO m => Haptic -> Ptr HapticEffect -> m CInt +hapticEffectSupported v1 v2 = liftIO $ hapticEffectSupportedFFI v1 v2 +{-# INLINE hapticEffectSupported #-} + +hapticGetEffectStatus :: MonadIO m => Haptic -> CInt -> m CInt +hapticGetEffectStatus v1 v2 = liftIO $ hapticGetEffectStatusFFI v1 v2 +{-# INLINE hapticGetEffectStatus #-} + +hapticIndex :: MonadIO m => Haptic -> m CInt +hapticIndex v1 = liftIO $ hapticIndexFFI v1 +{-# INLINE hapticIndex #-} + +hapticName :: MonadIO m => CInt -> m CString +hapticName v1 = liftIO $ hapticNameFFI v1 +{-# INLINE hapticName #-} + +hapticNewEffect :: MonadIO m => Haptic -> Ptr HapticEffect -> m CInt +hapticNewEffect v1 v2 = liftIO $ hapticNewEffectFFI v1 v2 +{-# INLINE hapticNewEffect #-} + +hapticNumAxes :: MonadIO m => Haptic -> m CInt +hapticNumAxes v1 = liftIO $ hapticNumAxesFFI v1 +{-# INLINE hapticNumAxes #-} + +hapticNumEffects :: MonadIO m => Haptic -> m CInt +hapticNumEffects v1 = liftIO $ hapticNumEffectsFFI v1 +{-# INLINE hapticNumEffects #-} + +hapticNumEffectsPlaying :: MonadIO m => Haptic -> m CInt +hapticNumEffectsPlaying v1 = liftIO $ hapticNumEffectsPlayingFFI v1 +{-# INLINE hapticNumEffectsPlaying #-} + +hapticOpen :: MonadIO m => CInt -> m Haptic +hapticOpen v1 = liftIO $ hapticOpenFFI v1 +{-# INLINE hapticOpen #-} + +hapticOpenFromJoystick :: MonadIO m => Joystick -> m Haptic +hapticOpenFromJoystick v1 = liftIO $ hapticOpenFromJoystickFFI v1 +{-# INLINE hapticOpenFromJoystick #-} + +hapticOpenFromMouse :: MonadIO m => m Haptic +hapticOpenFromMouse = liftIO hapticOpenFromMouseFFI +{-# INLINE hapticOpenFromMouse #-} + +hapticOpened :: MonadIO m => CInt -> m CInt +hapticOpened v1 = liftIO $ hapticOpenedFFI v1 +{-# INLINE hapticOpened #-} + +hapticPause :: MonadIO m => Haptic -> m CInt +hapticPause v1 = liftIO $ hapticPauseFFI v1 +{-# INLINE hapticPause #-} + +hapticQuery :: MonadIO m => Haptic -> m CUInt +hapticQuery v1 = liftIO $ hapticQueryFFI v1 +{-# INLINE hapticQuery #-} + +hapticRumbleInit :: MonadIO m => Haptic -> m CInt +hapticRumbleInit v1 = liftIO $ hapticRumbleInitFFI v1 +{-# INLINE hapticRumbleInit #-} + +hapticRumblePlay :: MonadIO m => Haptic -> CFloat -> Word32 -> m CInt +hapticRumblePlay v1 v2 v3 = liftIO $ hapticRumblePlayFFI v1 v2 v3 +{-# INLINE hapticRumblePlay #-} + +hapticRumbleStop :: MonadIO m => Haptic -> m CInt +hapticRumbleStop v1 = liftIO $ hapticRumbleStopFFI v1 +{-# INLINE hapticRumbleStop #-} + +hapticRumbleSupported :: MonadIO m => Haptic -> m CInt +hapticRumbleSupported v1 = liftIO $ hapticRumbleSupportedFFI v1 +{-# INLINE hapticRumbleSupported #-} + +hapticRunEffect :: MonadIO m => Haptic -> CInt -> Word32 -> m CInt +hapticRunEffect v1 v2 v3 = liftIO $ hapticRunEffectFFI v1 v2 v3 +{-# INLINE hapticRunEffect #-} + +hapticSetAutocenter :: MonadIO m => Haptic -> CInt -> m CInt +hapticSetAutocenter v1 v2 = liftIO $ hapticSetAutocenterFFI v1 v2 +{-# INLINE hapticSetAutocenter #-} + +hapticSetGain :: MonadIO m => Haptic -> CInt -> m CInt +hapticSetGain v1 v2 = liftIO $ hapticSetGainFFI v1 v2 +{-# INLINE hapticSetGain #-} + +hapticStopAll :: MonadIO m => Haptic -> m CInt +hapticStopAll v1 = liftIO $ hapticStopAllFFI v1 +{-# INLINE hapticStopAll #-} + +hapticStopEffect :: MonadIO m => Haptic -> CInt -> m CInt +hapticStopEffect v1 v2 = liftIO $ hapticStopEffectFFI v1 v2 +{-# INLINE hapticStopEffect #-} + +hapticUnpause :: MonadIO m => Haptic -> m CInt +hapticUnpause v1 = liftIO $ hapticUnpauseFFI v1 +{-# INLINE hapticUnpause #-} + +hapticUpdateEffect :: MonadIO m => Haptic -> CInt -> Ptr HapticEffect -> m CInt +hapticUpdateEffect v1 v2 v3 = liftIO $ hapticUpdateEffectFFI v1 v2 v3 +{-# INLINE hapticUpdateEffect #-} + +joystickIsHaptic :: MonadIO m => Joystick -> m CInt +joystickIsHaptic v1 = liftIO $ joystickIsHapticFFI v1 +{-# INLINE joystickIsHaptic #-} + +mouseIsHaptic :: MonadIO m => m CInt +mouseIsHaptic = liftIO mouseIsHapticFFI +{-# INLINE mouseIsHaptic #-} + +numHaptics :: MonadIO m => m CInt +numHaptics = liftIO numHapticsFFI +{-# INLINE numHaptics #-} diff --git a/src/SDL/Raw/Platform.hs b/src/SDL/Raw/Platform.hs --- a/src/SDL/Raw/Platform.hs +++ b/src/SDL/Raw/Platform.hs @@ -1,13 +1,13 @@ -module SDL.Raw.Platform ( - -- * Platform Detection - getPlatform -) where - -import Control.Monad.IO.Class -import Foreign.C.String - -foreign import ccall "SDL.h SDL_GetPlatform" getPlatformFFI :: IO CString - -getPlatform :: MonadIO m => m CString -getPlatform = liftIO getPlatformFFI -{-# INLINE getPlatform #-} +module SDL.Raw.Platform ( + -- * Platform Detection + getPlatform +) where + +import Control.Monad.IO.Class +import Foreign.C.String + +foreign import ccall "SDL.h SDL_GetPlatform" getPlatformFFI :: IO CString + +getPlatform :: MonadIO m => m CString +getPlatform = liftIO getPlatformFFI +{-# INLINE getPlatform #-} diff --git a/src/SDL/Raw/Power.hs b/src/SDL/Raw/Power.hs --- a/src/SDL/Raw/Power.hs +++ b/src/SDL/Raw/Power.hs @@ -1,15 +1,15 @@ -module SDL.Raw.Power ( - -- * Power Management Status - getPowerInfo -) where - -import Control.Monad.IO.Class -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Enum - -foreign import ccall "SDL.h SDL_GetPowerInfo" getPowerInfoFFI :: Ptr CInt -> Ptr CInt -> IO PowerState - -getPowerInfo :: MonadIO m => Ptr CInt -> Ptr CInt -> m PowerState -getPowerInfo v1 v2 = liftIO $ getPowerInfoFFI v1 v2 -{-# INLINE getPowerInfo #-} +module SDL.Raw.Power ( + -- * Power Management Status + getPowerInfo +) where + +import Control.Monad.IO.Class +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Enum + +foreign import ccall "SDL.h SDL_GetPowerInfo" getPowerInfoFFI :: Ptr CInt -> Ptr CInt -> IO PowerState + +getPowerInfo :: MonadIO m => Ptr CInt -> Ptr CInt -> m PowerState +getPowerInfo v1 v2 = liftIO $ getPowerInfoFFI v1 v2 +{-# INLINE getPowerInfo #-} diff --git a/src/SDL/Raw/Thread.hs b/src/SDL/Raw/Thread.hs --- a/src/SDL/Raw/Thread.hs +++ b/src/SDL/Raw/Thread.hs @@ -1,258 +1,258 @@ -module SDL.Raw.Thread ( - -- * Thread Management - createThread, - detachThread, - getThreadID, - getThreadName, - setThreadPriority, - tlsCreate, - tlsGet, - tlsSet, - threadID, - waitThread, - - -- * Thread Synchronization Primitives - condBroadcast, - condSignal, - condWait, - condWaitTimeout, - createCond, - createMutex, - createSemaphore, - destroyCond, - destroyMutex, - destroySemaphore, - lockMutex, - semPost, - semTryWait, - semValue, - semWait, - semWaitTimeout, - tryLockMutex, - unlockMutex, - - -- * Atomic Operations - atomicAdd, - atomicCAS, - atomicCASPtr, - atomicDecRef, - atomicGet, - atomicGetPtr, - atomicIncRef, - atomicLock, - atomicSet, - atomicSetPtr, - atomicTryLock, - atomicUnlock -) where - -import Control.Monad.IO.Class -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Enum -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_CreateThread" createThreadFFI :: ThreadFunction -> CString -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_DetachThread" detachThreadFFI :: Ptr Thread -> IO () -foreign import ccall "SDL.h SDL_GetThreadID" getThreadIDFFI :: Ptr Thread -> IO ThreadID -foreign import ccall "SDL.h SDL_GetThreadName" getThreadNameFFI :: Ptr Thread -> IO CString -foreign import ccall "SDL.h SDL_SetThreadPriority" setThreadPriorityFFI :: ThreadPriority -> IO CInt -foreign import ccall "SDL.h SDL_TLSCreate" tlsCreateFFI :: IO TLSID -foreign import ccall "SDL.h SDL_TLSGet" tlsGetFFI :: TLSID -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_TLSSet" tlsSetFFI :: TLSID -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO CInt -foreign import ccall "SDL.h SDL_ThreadID" threadIDFFI :: IO ThreadID -foreign import ccall "SDL.h SDL_WaitThread" waitThreadFFI :: Ptr Thread -> Ptr CInt -> IO () - -foreign import ccall "SDL.h SDL_CondBroadcast" condBroadcastFFI :: Ptr Cond -> IO CInt -foreign import ccall "SDL.h SDL_CondSignal" condSignalFFI :: Ptr Cond -> IO CInt -foreign import ccall "SDL.h SDL_CondWait" condWaitFFI :: Ptr Cond -> Ptr Mutex -> IO CInt -foreign import ccall "SDL.h SDL_CondWaitTimeout" condWaitTimeoutFFI :: Ptr Cond -> Ptr Mutex -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_CreateCond" createCondFFI :: IO (Ptr Cond) -foreign import ccall "SDL.h SDL_CreateMutex" createMutexFFI :: IO (Ptr Mutex) -foreign import ccall "SDL.h SDL_CreateSemaphore" createSemaphoreFFI :: Word32 -> IO (Ptr Sem) -foreign import ccall "SDL.h SDL_DestroyCond" destroyCondFFI :: Ptr Cond -> IO () -foreign import ccall "SDL.h SDL_DestroyMutex" destroyMutexFFI :: Ptr Mutex -> IO () -foreign import ccall "SDL.h SDL_DestroySemaphore" destroySemaphoreFFI :: Ptr Sem -> IO () -foreign import ccall "SDL.h SDL_LockMutex" lockMutexFFI :: Ptr Mutex -> IO CInt -foreign import ccall "SDL.h SDL_SemPost" semPostFFI :: Ptr Sem -> IO CInt -foreign import ccall "SDL.h SDL_SemTryWait" semTryWaitFFI :: Ptr Sem -> IO CInt -foreign import ccall "SDL.h SDL_SemValue" semValueFFI :: Ptr Sem -> IO Word32 -foreign import ccall "SDL.h SDL_SemWait" semWaitFFI :: Ptr Sem -> IO CInt -foreign import ccall "SDL.h SDL_SemWaitTimeout" semWaitTimeoutFFI :: Ptr Sem -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_TryLockMutex" tryLockMutexFFI :: Ptr Mutex -> IO CInt -foreign import ccall "SDL.h SDL_UnlockMutex" unlockMutexFFI :: Ptr Mutex -> IO CInt - -foreign import ccall "SDL.h SDL_AtomicAdd" atomicAddFFI :: Ptr Atomic -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_AtomicCAS" atomicCASFFI :: Ptr Atomic -> CInt -> CInt -> IO Bool -foreign import ccall "SDL.h SDL_AtomicCASPtr" atomicCASPtrFFI :: Ptr (Ptr ()) -> Ptr () -> Ptr () -> IO Bool -foreign import ccall "SDL.h SDL_AtomicGet" atomicGetFFI :: Ptr Atomic -> IO CInt -foreign import ccall "SDL.h SDL_AtomicGetPtr" atomicGetPtrFFI :: Ptr (Ptr ()) -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_AtomicLock" atomicLockFFI :: Ptr SpinLock -> IO () -foreign import ccall "SDL.h SDL_AtomicSet" atomicSetFFI :: Ptr Atomic -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_AtomicSetPtr" atomicSetPtrFFI :: Ptr (Ptr ()) -> Ptr () -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_AtomicTryLock" atomicTryLockFFI :: Ptr SpinLock -> IO Bool -foreign import ccall "SDL.h SDL_AtomicUnlock" atomicUnlockFFI :: Ptr SpinLock -> IO () - -createThread :: MonadIO m => ThreadFunction -> CString -> m (Ptr ()) -createThread v1 v2 = liftIO $ createThreadFFI v1 v2 -{-# INLINE createThread #-} - -detachThread :: MonadIO m => Ptr Thread -> m () -detachThread v1 = liftIO $ detachThreadFFI v1 -{-# INLINE detachThread #-} - -getThreadID :: MonadIO m => Ptr Thread -> m ThreadID -getThreadID v1 = liftIO $ getThreadIDFFI v1 -{-# INLINE getThreadID #-} - -getThreadName :: MonadIO m => Ptr Thread -> m CString -getThreadName v1 = liftIO $ getThreadNameFFI v1 -{-# INLINE getThreadName #-} - -setThreadPriority :: MonadIO m => ThreadPriority -> m CInt -setThreadPriority v1 = liftIO $ setThreadPriorityFFI v1 -{-# INLINE setThreadPriority #-} - -tlsCreate :: MonadIO m => m TLSID -tlsCreate = liftIO tlsCreateFFI -{-# INLINE tlsCreate #-} - -tlsGet :: MonadIO m => TLSID -> m (Ptr ()) -tlsGet v1 = liftIO $ tlsGetFFI v1 -{-# INLINE tlsGet #-} - -tlsSet :: MonadIO m => TLSID -> Ptr () -> FunPtr (Ptr () -> IO ()) -> m CInt -tlsSet v1 v2 v3 = liftIO $ tlsSetFFI v1 v2 v3 -{-# INLINE tlsSet #-} - -threadID :: MonadIO m => m ThreadID -threadID = liftIO threadIDFFI -{-# INLINE threadID #-} - -waitThread :: MonadIO m => Ptr Thread -> Ptr CInt -> m () -waitThread v1 v2 = liftIO $ waitThreadFFI v1 v2 -{-# INLINE waitThread #-} - -condBroadcast :: MonadIO m => Ptr Cond -> m CInt -condBroadcast v1 = liftIO $ condBroadcastFFI v1 -{-# INLINE condBroadcast #-} - -condSignal :: MonadIO m => Ptr Cond -> m CInt -condSignal v1 = liftIO $ condSignalFFI v1 -{-# INLINE condSignal #-} - -condWait :: MonadIO m => Ptr Cond -> Ptr Mutex -> m CInt -condWait v1 v2 = liftIO $ condWaitFFI v1 v2 -{-# INLINE condWait #-} - -condWaitTimeout :: MonadIO m => Ptr Cond -> Ptr Mutex -> Word32 -> m CInt -condWaitTimeout v1 v2 v3 = liftIO $ condWaitTimeoutFFI v1 v2 v3 -{-# INLINE condWaitTimeout #-} - -createCond :: MonadIO m => m (Ptr Cond) -createCond = liftIO createCondFFI -{-# INLINE createCond #-} - -createMutex :: MonadIO m => m (Ptr Mutex) -createMutex = liftIO createMutexFFI -{-# INLINE createMutex #-} - -createSemaphore :: MonadIO m => Word32 -> m (Ptr Sem) -createSemaphore v1 = liftIO $ createSemaphoreFFI v1 -{-# INLINE createSemaphore #-} - -destroyCond :: MonadIO m => Ptr Cond -> m () -destroyCond v1 = liftIO $ destroyCondFFI v1 -{-# INLINE destroyCond #-} - -destroyMutex :: MonadIO m => Ptr Mutex -> m () -destroyMutex v1 = liftIO $ destroyMutexFFI v1 -{-# INLINE destroyMutex #-} - -destroySemaphore :: MonadIO m => Ptr Sem -> m () -destroySemaphore v1 = liftIO $ destroySemaphoreFFI v1 -{-# INLINE destroySemaphore #-} - -lockMutex :: MonadIO m => Ptr Mutex -> m CInt -lockMutex v1 = liftIO $ lockMutexFFI v1 -{-# INLINE lockMutex #-} - -semPost :: MonadIO m => Ptr Sem -> m CInt -semPost v1 = liftIO $ semPostFFI v1 -{-# INLINE semPost #-} - -semTryWait :: MonadIO m => Ptr Sem -> m CInt -semTryWait v1 = liftIO $ semTryWaitFFI v1 -{-# INLINE semTryWait #-} - -semValue :: MonadIO m => Ptr Sem -> m Word32 -semValue v1 = liftIO $ semValueFFI v1 -{-# INLINE semValue #-} - -semWait :: MonadIO m => Ptr Sem -> m CInt -semWait v1 = liftIO $ semWaitFFI v1 -{-# INLINE semWait #-} - -semWaitTimeout :: MonadIO m => Ptr Sem -> Word32 -> m CInt -semWaitTimeout v1 v2 = liftIO $ semWaitTimeoutFFI v1 v2 -{-# INLINE semWaitTimeout #-} - -tryLockMutex :: MonadIO m => Ptr Mutex -> m CInt -tryLockMutex v1 = liftIO $ tryLockMutexFFI v1 -{-# INLINE tryLockMutex #-} - -unlockMutex :: MonadIO m => Ptr Mutex -> m CInt -unlockMutex v1 = liftIO $ unlockMutexFFI v1 -{-# INLINE unlockMutex #-} - -atomicAdd :: MonadIO m => Ptr Atomic -> CInt -> m CInt -atomicAdd v1 v2 = liftIO $ atomicAddFFI v1 v2 -{-# INLINE atomicAdd #-} - -atomicCAS :: MonadIO m => Ptr Atomic -> CInt -> CInt -> m Bool -atomicCAS v1 v2 v3 = liftIO $ atomicCASFFI v1 v2 v3 -{-# INLINE atomicCAS #-} - -atomicCASPtr :: MonadIO m => Ptr (Ptr ()) -> Ptr () -> Ptr () -> m Bool -atomicCASPtr v1 v2 v3 = liftIO $ atomicCASPtrFFI v1 v2 v3 -{-# INLINE atomicCASPtr #-} - -atomicDecRef :: Ptr Atomic -> IO Bool -atomicDecRef a = do - old <- atomicAdd a (-1) - return $ old == 1 -{-# INLINE atomicDecRef #-} - -atomicGet :: MonadIO m => Ptr Atomic -> m CInt -atomicGet v1 = liftIO $ atomicGetFFI v1 -{-# INLINE atomicGet #-} - -atomicGetPtr :: MonadIO m => Ptr (Ptr ()) -> m (Ptr ()) -atomicGetPtr v1 = liftIO $ atomicGetPtrFFI v1 -{-# INLINE atomicGetPtr #-} - -atomicIncRef :: Ptr Atomic -> IO CInt -atomicIncRef a = atomicAdd a 1 -{-# INLINE atomicIncRef #-} - -atomicLock :: MonadIO m => Ptr SpinLock -> m () -atomicLock v1 = liftIO $ atomicLockFFI v1 -{-# INLINE atomicLock #-} - -atomicSet :: MonadIO m => Ptr Atomic -> CInt -> m CInt -atomicSet v1 v2 = liftIO $ atomicSetFFI v1 v2 -{-# INLINE atomicSet #-} - -atomicSetPtr :: MonadIO m => Ptr (Ptr ()) -> Ptr () -> m (Ptr ()) -atomicSetPtr v1 v2 = liftIO $ atomicSetPtrFFI v1 v2 -{-# INLINE atomicSetPtr #-} - -atomicTryLock :: MonadIO m => Ptr SpinLock -> m Bool -atomicTryLock v1 = liftIO $ atomicTryLockFFI v1 -{-# INLINE atomicTryLock #-} - -atomicUnlock :: MonadIO m => Ptr SpinLock -> m () -atomicUnlock v1 = liftIO $ atomicUnlockFFI v1 -{-# INLINE atomicUnlock #-} +module SDL.Raw.Thread ( + -- * Thread Management + createThread, + detachThread, + getThreadID, + getThreadName, + setThreadPriority, + tlsCreate, + tlsGet, + tlsSet, + threadID, + waitThread, + + -- * Thread Synchronization Primitives + condBroadcast, + condSignal, + condWait, + condWaitTimeout, + createCond, + createMutex, + createSemaphore, + destroyCond, + destroyMutex, + destroySemaphore, + lockMutex, + semPost, + semTryWait, + semValue, + semWait, + semWaitTimeout, + tryLockMutex, + unlockMutex, + + -- * Atomic Operations + atomicAdd, + atomicCAS, + atomicCASPtr, + atomicDecRef, + atomicGet, + atomicGetPtr, + atomicIncRef, + atomicLock, + atomicSet, + atomicSetPtr, + atomicTryLock, + atomicUnlock +) where + +import Control.Monad.IO.Class +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Enum +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_CreateThread" createThreadFFI :: ThreadFunction -> CString -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_DetachThread" detachThreadFFI :: Ptr Thread -> IO () +foreign import ccall "SDL.h SDL_GetThreadID" getThreadIDFFI :: Ptr Thread -> IO ThreadID +foreign import ccall "SDL.h SDL_GetThreadName" getThreadNameFFI :: Ptr Thread -> IO CString +foreign import ccall "SDL.h SDL_SetThreadPriority" setThreadPriorityFFI :: ThreadPriority -> IO CInt +foreign import ccall "SDL.h SDL_TLSCreate" tlsCreateFFI :: IO TLSID +foreign import ccall "SDL.h SDL_TLSGet" tlsGetFFI :: TLSID -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_TLSSet" tlsSetFFI :: TLSID -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO CInt +foreign import ccall "SDL.h SDL_ThreadID" threadIDFFI :: IO ThreadID +foreign import ccall "SDL.h SDL_WaitThread" waitThreadFFI :: Ptr Thread -> Ptr CInt -> IO () + +foreign import ccall "SDL.h SDL_CondBroadcast" condBroadcastFFI :: Ptr Cond -> IO CInt +foreign import ccall "SDL.h SDL_CondSignal" condSignalFFI :: Ptr Cond -> IO CInt +foreign import ccall "SDL.h SDL_CondWait" condWaitFFI :: Ptr Cond -> Ptr Mutex -> IO CInt +foreign import ccall "SDL.h SDL_CondWaitTimeout" condWaitTimeoutFFI :: Ptr Cond -> Ptr Mutex -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_CreateCond" createCondFFI :: IO (Ptr Cond) +foreign import ccall "SDL.h SDL_CreateMutex" createMutexFFI :: IO (Ptr Mutex) +foreign import ccall "SDL.h SDL_CreateSemaphore" createSemaphoreFFI :: Word32 -> IO (Ptr Sem) +foreign import ccall "SDL.h SDL_DestroyCond" destroyCondFFI :: Ptr Cond -> IO () +foreign import ccall "SDL.h SDL_DestroyMutex" destroyMutexFFI :: Ptr Mutex -> IO () +foreign import ccall "SDL.h SDL_DestroySemaphore" destroySemaphoreFFI :: Ptr Sem -> IO () +foreign import ccall "SDL.h SDL_LockMutex" lockMutexFFI :: Ptr Mutex -> IO CInt +foreign import ccall "SDL.h SDL_SemPost" semPostFFI :: Ptr Sem -> IO CInt +foreign import ccall "SDL.h SDL_SemTryWait" semTryWaitFFI :: Ptr Sem -> IO CInt +foreign import ccall "SDL.h SDL_SemValue" semValueFFI :: Ptr Sem -> IO Word32 +foreign import ccall "SDL.h SDL_SemWait" semWaitFFI :: Ptr Sem -> IO CInt +foreign import ccall "SDL.h SDL_SemWaitTimeout" semWaitTimeoutFFI :: Ptr Sem -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_TryLockMutex" tryLockMutexFFI :: Ptr Mutex -> IO CInt +foreign import ccall "SDL.h SDL_UnlockMutex" unlockMutexFFI :: Ptr Mutex -> IO CInt + +foreign import ccall "SDL.h SDL_AtomicAdd" atomicAddFFI :: Ptr Atomic -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_AtomicCAS" atomicCASFFI :: Ptr Atomic -> CInt -> CInt -> IO Bool +foreign import ccall "SDL.h SDL_AtomicCASPtr" atomicCASPtrFFI :: Ptr (Ptr ()) -> Ptr () -> Ptr () -> IO Bool +foreign import ccall "SDL.h SDL_AtomicGet" atomicGetFFI :: Ptr Atomic -> IO CInt +foreign import ccall "SDL.h SDL_AtomicGetPtr" atomicGetPtrFFI :: Ptr (Ptr ()) -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_AtomicLock" atomicLockFFI :: Ptr SpinLock -> IO () +foreign import ccall "SDL.h SDL_AtomicSet" atomicSetFFI :: Ptr Atomic -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_AtomicSetPtr" atomicSetPtrFFI :: Ptr (Ptr ()) -> Ptr () -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_AtomicTryLock" atomicTryLockFFI :: Ptr SpinLock -> IO Bool +foreign import ccall "SDL.h SDL_AtomicUnlock" atomicUnlockFFI :: Ptr SpinLock -> IO () + +createThread :: MonadIO m => ThreadFunction -> CString -> m (Ptr ()) +createThread v1 v2 = liftIO $ createThreadFFI v1 v2 +{-# INLINE createThread #-} + +detachThread :: MonadIO m => Ptr Thread -> m () +detachThread v1 = liftIO $ detachThreadFFI v1 +{-# INLINE detachThread #-} + +getThreadID :: MonadIO m => Ptr Thread -> m ThreadID +getThreadID v1 = liftIO $ getThreadIDFFI v1 +{-# INLINE getThreadID #-} + +getThreadName :: MonadIO m => Ptr Thread -> m CString +getThreadName v1 = liftIO $ getThreadNameFFI v1 +{-# INLINE getThreadName #-} + +setThreadPriority :: MonadIO m => ThreadPriority -> m CInt +setThreadPriority v1 = liftIO $ setThreadPriorityFFI v1 +{-# INLINE setThreadPriority #-} + +tlsCreate :: MonadIO m => m TLSID +tlsCreate = liftIO tlsCreateFFI +{-# INLINE tlsCreate #-} + +tlsGet :: MonadIO m => TLSID -> m (Ptr ()) +tlsGet v1 = liftIO $ tlsGetFFI v1 +{-# INLINE tlsGet #-} + +tlsSet :: MonadIO m => TLSID -> Ptr () -> FunPtr (Ptr () -> IO ()) -> m CInt +tlsSet v1 v2 v3 = liftIO $ tlsSetFFI v1 v2 v3 +{-# INLINE tlsSet #-} + +threadID :: MonadIO m => m ThreadID +threadID = liftIO threadIDFFI +{-# INLINE threadID #-} + +waitThread :: MonadIO m => Ptr Thread -> Ptr CInt -> m () +waitThread v1 v2 = liftIO $ waitThreadFFI v1 v2 +{-# INLINE waitThread #-} + +condBroadcast :: MonadIO m => Ptr Cond -> m CInt +condBroadcast v1 = liftIO $ condBroadcastFFI v1 +{-# INLINE condBroadcast #-} + +condSignal :: MonadIO m => Ptr Cond -> m CInt +condSignal v1 = liftIO $ condSignalFFI v1 +{-# INLINE condSignal #-} + +condWait :: MonadIO m => Ptr Cond -> Ptr Mutex -> m CInt +condWait v1 v2 = liftIO $ condWaitFFI v1 v2 +{-# INLINE condWait #-} + +condWaitTimeout :: MonadIO m => Ptr Cond -> Ptr Mutex -> Word32 -> m CInt +condWaitTimeout v1 v2 v3 = liftIO $ condWaitTimeoutFFI v1 v2 v3 +{-# INLINE condWaitTimeout #-} + +createCond :: MonadIO m => m (Ptr Cond) +createCond = liftIO createCondFFI +{-# INLINE createCond #-} + +createMutex :: MonadIO m => m (Ptr Mutex) +createMutex = liftIO createMutexFFI +{-# INLINE createMutex #-} + +createSemaphore :: MonadIO m => Word32 -> m (Ptr Sem) +createSemaphore v1 = liftIO $ createSemaphoreFFI v1 +{-# INLINE createSemaphore #-} + +destroyCond :: MonadIO m => Ptr Cond -> m () +destroyCond v1 = liftIO $ destroyCondFFI v1 +{-# INLINE destroyCond #-} + +destroyMutex :: MonadIO m => Ptr Mutex -> m () +destroyMutex v1 = liftIO $ destroyMutexFFI v1 +{-# INLINE destroyMutex #-} + +destroySemaphore :: MonadIO m => Ptr Sem -> m () +destroySemaphore v1 = liftIO $ destroySemaphoreFFI v1 +{-# INLINE destroySemaphore #-} + +lockMutex :: MonadIO m => Ptr Mutex -> m CInt +lockMutex v1 = liftIO $ lockMutexFFI v1 +{-# INLINE lockMutex #-} + +semPost :: MonadIO m => Ptr Sem -> m CInt +semPost v1 = liftIO $ semPostFFI v1 +{-# INLINE semPost #-} + +semTryWait :: MonadIO m => Ptr Sem -> m CInt +semTryWait v1 = liftIO $ semTryWaitFFI v1 +{-# INLINE semTryWait #-} + +semValue :: MonadIO m => Ptr Sem -> m Word32 +semValue v1 = liftIO $ semValueFFI v1 +{-# INLINE semValue #-} + +semWait :: MonadIO m => Ptr Sem -> m CInt +semWait v1 = liftIO $ semWaitFFI v1 +{-# INLINE semWait #-} + +semWaitTimeout :: MonadIO m => Ptr Sem -> Word32 -> m CInt +semWaitTimeout v1 v2 = liftIO $ semWaitTimeoutFFI v1 v2 +{-# INLINE semWaitTimeout #-} + +tryLockMutex :: MonadIO m => Ptr Mutex -> m CInt +tryLockMutex v1 = liftIO $ tryLockMutexFFI v1 +{-# INLINE tryLockMutex #-} + +unlockMutex :: MonadIO m => Ptr Mutex -> m CInt +unlockMutex v1 = liftIO $ unlockMutexFFI v1 +{-# INLINE unlockMutex #-} + +atomicAdd :: MonadIO m => Ptr Atomic -> CInt -> m CInt +atomicAdd v1 v2 = liftIO $ atomicAddFFI v1 v2 +{-# INLINE atomicAdd #-} + +atomicCAS :: MonadIO m => Ptr Atomic -> CInt -> CInt -> m Bool +atomicCAS v1 v2 v3 = liftIO $ atomicCASFFI v1 v2 v3 +{-# INLINE atomicCAS #-} + +atomicCASPtr :: MonadIO m => Ptr (Ptr ()) -> Ptr () -> Ptr () -> m Bool +atomicCASPtr v1 v2 v3 = liftIO $ atomicCASPtrFFI v1 v2 v3 +{-# INLINE atomicCASPtr #-} + +atomicDecRef :: Ptr Atomic -> IO Bool +atomicDecRef a = do + old <- atomicAdd a (-1) + return $ old == 1 +{-# INLINE atomicDecRef #-} + +atomicGet :: MonadIO m => Ptr Atomic -> m CInt +atomicGet v1 = liftIO $ atomicGetFFI v1 +{-# INLINE atomicGet #-} + +atomicGetPtr :: MonadIO m => Ptr (Ptr ()) -> m (Ptr ()) +atomicGetPtr v1 = liftIO $ atomicGetPtrFFI v1 +{-# INLINE atomicGetPtr #-} + +atomicIncRef :: Ptr Atomic -> IO CInt +atomicIncRef a = atomicAdd a 1 +{-# INLINE atomicIncRef #-} + +atomicLock :: MonadIO m => Ptr SpinLock -> m () +atomicLock v1 = liftIO $ atomicLockFFI v1 +{-# INLINE atomicLock #-} + +atomicSet :: MonadIO m => Ptr Atomic -> CInt -> m CInt +atomicSet v1 v2 = liftIO $ atomicSetFFI v1 v2 +{-# INLINE atomicSet #-} + +atomicSetPtr :: MonadIO m => Ptr (Ptr ()) -> Ptr () -> m (Ptr ()) +atomicSetPtr v1 v2 = liftIO $ atomicSetPtrFFI v1 v2 +{-# INLINE atomicSetPtr #-} + +atomicTryLock :: MonadIO m => Ptr SpinLock -> m Bool +atomicTryLock v1 = liftIO $ atomicTryLockFFI v1 +{-# INLINE atomicTryLock #-} + +atomicUnlock :: MonadIO m => Ptr SpinLock -> m () +atomicUnlock v1 = liftIO $ atomicUnlockFFI v1 +{-# INLINE atomicUnlock #-} diff --git a/src/SDL/Raw/Timer.hs b/src/SDL/Raw/Timer.hs --- a/src/SDL/Raw/Timer.hs +++ b/src/SDL/Raw/Timer.hs @@ -1,46 +1,46 @@ -module SDL.Raw.Timer ( - -- * Timer Support - addTimer, - delay, - getPerformanceCounter, - getPerformanceFrequency, - getTicks, - removeTimer -) where - -import Control.Monad.IO.Class -import Data.Word -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_AddTimer" addTimerFFI :: Word32 -> TimerCallback -> Ptr () -> IO TimerID -foreign import ccall "SDL.h SDL_Delay" delayFFI :: Word32 -> IO () -foreign import ccall "SDL.h SDL_GetPerformanceCounter" getPerformanceCounterFFI :: IO Word64 -foreign import ccall "SDL.h SDL_GetPerformanceFrequency" getPerformanceFrequencyFFI :: IO Word64 -foreign import ccall "SDL.h SDL_GetTicks" getTicksFFI :: IO Word32 -foreign import ccall "SDL.h SDL_RemoveTimer" removeTimerFFI :: TimerID -> IO Bool - -addTimer :: MonadIO m => Word32 -> TimerCallback -> Ptr () -> m TimerID -addTimer v1 v2 v3 = liftIO $ addTimerFFI v1 v2 v3 -{-# INLINE addTimer #-} - -delay :: MonadIO m => Word32 -> m () -delay v1 = liftIO $ delayFFI v1 -{-# INLINE delay #-} - -getPerformanceCounter :: MonadIO m => m Word64 -getPerformanceCounter = liftIO getPerformanceCounterFFI -{-# INLINE getPerformanceCounter #-} - -getPerformanceFrequency :: MonadIO m => m Word64 -getPerformanceFrequency = liftIO getPerformanceFrequencyFFI -{-# INLINE getPerformanceFrequency #-} - -getTicks :: MonadIO m => m Word32 -getTicks = liftIO getTicksFFI -{-# INLINE getTicks #-} - -removeTimer :: MonadIO m => TimerID -> m Bool -removeTimer v1 = liftIO $ removeTimerFFI v1 -{-# INLINE removeTimer #-} +module SDL.Raw.Timer ( + -- * Timer Support + addTimer, + delay, + getPerformanceCounter, + getPerformanceFrequency, + getTicks, + removeTimer +) where + +import Control.Monad.IO.Class +import Data.Word +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_AddTimer" addTimerFFI :: Word32 -> TimerCallback -> Ptr () -> IO TimerID +foreign import ccall "SDL.h SDL_Delay" delayFFI :: Word32 -> IO () +foreign import ccall "SDL.h SDL_GetPerformanceCounter" getPerformanceCounterFFI :: IO Word64 +foreign import ccall "SDL.h SDL_GetPerformanceFrequency" getPerformanceFrequencyFFI :: IO Word64 +foreign import ccall "SDL.h SDL_GetTicks" getTicksFFI :: IO Word32 +foreign import ccall "SDL.h SDL_RemoveTimer" removeTimerFFI :: TimerID -> IO Bool + +addTimer :: MonadIO m => Word32 -> TimerCallback -> Ptr () -> m TimerID +addTimer v1 v2 v3 = liftIO $ addTimerFFI v1 v2 v3 +{-# INLINE addTimer #-} + +delay :: MonadIO m => Word32 -> m () +delay v1 = liftIO $ delayFFI v1 +{-# INLINE delay #-} + +getPerformanceCounter :: MonadIO m => m Word64 +getPerformanceCounter = liftIO getPerformanceCounterFFI +{-# INLINE getPerformanceCounter #-} + +getPerformanceFrequency :: MonadIO m => m Word64 +getPerformanceFrequency = liftIO getPerformanceFrequencyFFI +{-# INLINE getPerformanceFrequency #-} + +getTicks :: MonadIO m => m Word32 +getTicks = liftIO getTicksFFI +{-# INLINE getTicks #-} + +removeTimer :: MonadIO m => TimerID -> m Bool +removeTimer v1 = liftIO $ removeTimerFFI v1 +{-# INLINE removeTimer #-} diff --git a/src/SDL/Raw/Types.hsc b/src/SDL/Raw/Types.hsc --- a/src/SDL/Raw/Types.hsc +++ b/src/SDL/Raw/Types.hsc @@ -1,1422 +1,1423 @@ -{-# LANGUAGE DeriveDataTypeable #-} -module SDL.Raw.Types ( - -- * Type Aliases - -- ** Function Types - AudioCallback, - EventFilter, - HintCallback, - LogOutputFunction, - ThreadFunction, - TimerCallback, - - mkAudioCallback, - mkEventFilter, - mkHintCallback, - mkLogOutputFunction, - mkThreadFunction, - mkTimerCallback, - - -- ** Common Types - AudioDeviceID, - AudioFormat, - Cond, - Cursor, - FingerID, - GameController, - GestureID, - GLContext, - Haptic, - Joystick, - JoystickID, - Mutex, - Renderer, - Sem, - SpinLock, - SysWMinfo, - SysWMmsg, - Texture, - Thread, - ThreadID, - TimerID, - TLSID, - TouchID, - Window, - - -- * Data Structures - Atomic(..), - AudioCVT(..), - AudioSpec(..), - Color(..), - DisplayMode(..), - Event(..), - Finger(..), - GameControllerButtonBind(..), - HapticDirection(..), - HapticEffect(..), - JoystickGUID(..), - Keysym(..), - MessageBoxButtonData(..), - MessageBoxColor(..), - MessageBoxColorScheme(..), - MessageBoxData(..), - Palette(..), - PixelFormat(..), - Point(..), - Rect(..), - RendererInfo(..), - RWops(..), - Surface(..), - Version(..) -) where - -#include "SDL.h" - -import Data.Int -import Data.Typeable -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Marshal.Array -import Foreign.Ptr -import Foreign.Storable -import SDL.Raw.Enum - -type AudioCallback = FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO ()) -type EventFilter = FunPtr (Ptr () -> Ptr Event -> IO CInt) -type HintCallback = FunPtr (Ptr () -> CString -> CString -> CString -> IO ()) -type LogOutputFunction = FunPtr (Ptr () -> CInt -> LogPriority -> CString -> IO ()) -type ThreadFunction = FunPtr (Ptr () -> IO CInt) -type TimerCallback = FunPtr (Word32 -> Ptr () -> IO Word32) - --- | The storage associated with the resulting 'FunPtr' has to be released with --- 'freeHaskellFunPtr' when it is no longer required. -foreign import ccall "wrapper" - mkAudioCallback :: (Ptr () -> Ptr Word8 -> CInt -> IO ()) -> IO AudioCallback - --- | The storage associated with the resulting 'FunPtr' has to be released with --- 'freeHaskellFunPtr' when it is no longer required. -foreign import ccall "wrapper" - mkEventFilter :: (Ptr () -> Ptr Event -> IO CInt) -> IO EventFilter - --- | The storage associated with the resulting 'FunPtr' has to be released with --- 'freeHaskellFunPtr' when it is no longer required. -foreign import ccall "wrapper" - mkHintCallback :: (Ptr () -> CString -> CString -> CString -> IO ()) -> IO HintCallback - --- | The storage associated with the resulting 'FunPtr' has to be released with --- 'freeHaskellFunPtr' when it is no longer required. -foreign import ccall "wrapper" - mkLogOutputFunction :: (Ptr () -> CInt -> LogPriority -> CString -> IO ()) -> IO LogOutputFunction - --- | The storage associated with the resulting 'FunPtr' has to be released with --- 'freeHaskellFunPtr' when it is no longer required. -foreign import ccall "wrapper" - mkThreadFunction :: (Ptr () -> IO CInt) -> IO ThreadFunction - --- | The storage associated with the resulting 'FunPtr' has to be released with --- 'freeHaskellFunPtr' when it is no longer required. -foreign import ccall "wrapper" - mkTimerCallback :: (Word32 -> Ptr () -> IO Word32) -> IO TimerCallback - -type AudioDeviceID = Word32 -type Cond = Ptr () -type Cursor = Ptr () -type FingerID = Int64 -type GameController = Ptr () -type GestureID = Int64 -type GLContext = Ptr () -type Haptic = Ptr () -type Joystick = Ptr () -type JoystickID = Int32 -type Mutex = Ptr () -type Renderer = Ptr () -type Sem = Ptr () -type SpinLock = CInt -type SysWMinfo = Ptr () -type SysWMmsg = Ptr () -type Texture = Ptr () -type Thread = Ptr () -type ThreadID = CULong -type TimerID = CInt -type TLSID = CUInt -type TouchID = Int64 -type Window = Ptr () - -data Atomic = Atomic - { atomicValue :: !CInt - } deriving (Eq, Show, Typeable) - -instance Storable Atomic where - sizeOf _ = (#size SDL_atomic_t) - alignment = sizeOf - peek ptr = do - value <- (#peek SDL_atomic_t, value) ptr - return $! Atomic value - poke ptr (Atomic value) = do - (#poke SDL_atomic_t, value) ptr value - -data AudioCVT = AudioCVT - { audioCVTNeeded :: !CInt - , audioCVTSrcFormat :: !AudioFormat - , audioCVTDstFormat :: !AudioFormat - , audioCVTRateIncr :: !CDouble - , audioCVTBuf :: !(Ptr Word8) - , audioCVTLen :: !CInt - , audioCVTLenCvt :: !CInt - , audioCVTLenMult :: !CInt - , audioCVTLenRatio :: !CDouble - } deriving (Eq, Show, Typeable) - -instance Storable AudioCVT where - sizeOf _ = (#size SDL_AudioCVT) - alignment = sizeOf - peek ptr = do - needed <- (#peek SDL_AudioCVT, needed) ptr - src_format <- (#peek SDL_AudioCVT, src_format) ptr - dst_format <- (#peek SDL_AudioCVT, dst_format) ptr - rate_incr <- (#peek SDL_AudioCVT, rate_incr) ptr - buf <- (#peek SDL_AudioCVT, buf) ptr - len <- (#peek SDL_AudioCVT, len) ptr - len_cvt <- (#peek SDL_AudioCVT, len_cvt) ptr - len_mult <- (#peek SDL_AudioCVT, len_mult) ptr - len_ratio <- (#peek SDL_AudioCVT, len_ratio) ptr - return $! AudioCVT needed src_format dst_format rate_incr buf len len_cvt len_mult len_ratio - poke ptr (AudioCVT needed src_format dst_format rate_incr buf len len_cvt len_mult len_ratio) = do - (#poke SDL_AudioCVT, needed) ptr needed - (#poke SDL_AudioCVT, src_format) ptr src_format - (#poke SDL_AudioCVT, dst_format) ptr dst_format - (#poke SDL_AudioCVT, rate_incr) ptr rate_incr - (#poke SDL_AudioCVT, buf) ptr buf - (#poke SDL_AudioCVT, len) ptr len - (#poke SDL_AudioCVT, len_cvt) ptr len_cvt - (#poke SDL_AudioCVT, len_mult) ptr len_mult - (#poke SDL_AudioCVT, len_ratio) ptr len_ratio - -data AudioSpec = AudioSpec - { audioSpecFreq :: !CInt - , audioSpecFormat :: !AudioFormat - , audioSpecChannels :: !Word8 - , audioSpecSilence :: !Word8 - , audioSpecSamples :: !Word16 - , audioSpecSize :: !Word32 - , audioSpecCallback :: !AudioCallback - , audioSpecUserdata :: !(Ptr ()) - } deriving (Eq, Show, Typeable) - -instance Storable AudioSpec where - sizeOf _ = (#size SDL_AudioSpec) - alignment = sizeOf - peek ptr = do - freq <- (#peek SDL_AudioSpec, freq) ptr - format <- (#peek SDL_AudioSpec, format) ptr - channels <- (#peek SDL_AudioSpec, channels) ptr - silence <- (#peek SDL_AudioSpec, silence) ptr - samples <- (#peek SDL_AudioSpec, samples) ptr - size <- (#peek SDL_AudioSpec, size) ptr - callback <- (#peek SDL_AudioSpec, callback) ptr - userdata <- (#peek SDL_AudioSpec, userdata) ptr - return $! AudioSpec freq format channels silence samples size callback userdata - poke ptr (AudioSpec freq format channels silence samples size callback userdata) = do - (#poke SDL_AudioSpec, freq) ptr freq - (#poke SDL_AudioSpec, format) ptr format - (#poke SDL_AudioSpec, channels) ptr channels - (#poke SDL_AudioSpec, silence) ptr silence - (#poke SDL_AudioSpec, samples) ptr samples - (#poke SDL_AudioSpec, size) ptr size - (#poke SDL_AudioSpec, callback) ptr callback - (#poke SDL_AudioSpec, userdata) ptr userdata - -data Color = Color - { colorR :: !Word8 - , colorG :: !Word8 - , colorB :: !Word8 - , colorA :: !Word8 - } deriving (Eq, Show, Typeable) - -instance Storable Color where - sizeOf _ = (#size SDL_Color) - alignment = sizeOf - peek ptr = do - r <- (#peek SDL_Color, r) ptr - g <- (#peek SDL_Color, g) ptr - b <- (#peek SDL_Color, b) ptr - a <- (#peek SDL_Color, a) ptr - return $! Color r g b a - poke ptr (Color r g b a) = do - (#poke SDL_Color, r) ptr r - (#poke SDL_Color, g) ptr g - (#poke SDL_Color, b) ptr b - (#poke SDL_Color, a) ptr a - -data DisplayMode = DisplayMode - { displayModeFormat :: !Word32 - , displayModeW :: !CInt - , displayModeH :: !CInt - , displayModeRefreshRate :: !CInt - , displayModeDriverData :: !(Ptr ()) - } deriving (Eq, Show, Typeable) - -instance Storable DisplayMode where - sizeOf _ = (#size SDL_DisplayMode) - alignment = sizeOf - peek ptr = do - format <- (#peek SDL_DisplayMode, format) ptr - w <- (#peek SDL_DisplayMode, w) ptr - h <- (#peek SDL_DisplayMode, h) ptr - refresh_rate <- (#peek SDL_DisplayMode, refresh_rate) ptr - driverdata <- (#peek SDL_DisplayMode, driverdata) ptr - return $! DisplayMode format w h refresh_rate driverdata - poke ptr (DisplayMode format w h refresh_rate driverdata) = do - (#poke SDL_DisplayMode, format) ptr format - (#poke SDL_DisplayMode, w) ptr w - (#poke SDL_DisplayMode, h) ptr h - (#poke SDL_DisplayMode, refresh_rate) ptr refresh_rate - (#poke SDL_DisplayMode, driverdata) ptr driverdata - -data Event - = WindowEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , windowEventWindowID :: !Word32 - , windowEventEvent :: !Word8 - , windowEventData1 :: !Int32 - , windowEventData2 :: !Int32 - } - | KeyboardEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , keyboardEventWindowID :: !Word32 - , keyboardEventState :: !Word8 - , keyboardEventRepeat :: !Word8 - , keyboardEventKeysym :: !Keysym - } - | TextEditingEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , textEditingEventWindowID :: !Word32 - , textEditingEventText :: ![CChar] - , textEditingEventStart :: !Int32 - , textEditingEventLength :: !Int32 - } - | TextInputEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , textInputEventWindowID :: !Word32 - , textInputEventText :: ![CChar] - } - | MouseMotionEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , mouseMotionEventWindowID :: !Word32 - , mouseMotionEventWhich :: !Word32 - , mouseMotionEventState :: !Word32 - , mouseMotionEventX :: !Int32 - , mouseMotionEventY :: !Int32 - , mouseMotionEventXRel :: !Int32 - , mouseMotionEventYRel :: !Int32 - } - | MouseButtonEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , mouseButtonEventWindowID :: !Word32 - , mouseButtonEventWhich :: !Word32 - , mouseButtonEventButton :: !Word8 - , mouseButtonEventState :: !Word8 - , mouseButtonEventClicks :: !Word8 - , mouseButtonEventX :: !Int32 - , mouseButtonEventY :: !Int32 - } - | MouseWheelEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , mouseWheelEventWindowID :: !Word32 - , mouseWheelEventWhich :: !Word32 - , mouseWheelEventX :: !Int32 - , mouseWheelEventY :: !Int32 - } - | JoyAxisEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , joyAxisEventWhich :: !JoystickID - , joyAxisEventAxis :: !Word8 - , joyAxisEventValue :: !Int16 - } - | JoyBallEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , joyBallEventWhich :: !JoystickID - , joyBallEventBall :: !Word8 - , joyBallEventXRel :: !Int16 - , joyBallEventYRel :: !Int16 - } - | JoyHatEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , joyHatEventWhich :: !JoystickID - , joyHatEventHat :: !Word8 - , joyHatEventValue :: !Word8 - } - | JoyButtonEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , joyButtonEventWhich :: !JoystickID - , joyButtonEventButton :: !Word8 - , joyButtonEventState :: !Word8 - } - | JoyDeviceEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , joyDeviceEventWhich :: !Int32 - } - | ControllerAxisEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , controllerAxisEventWhich :: !JoystickID - , controllerAxisEventAxis :: !Word8 - , controllerAxisEventValue :: !Int16 - } - | ControllerButtonEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , controllerButtonEventWhich :: !JoystickID - , controllerButtonEventButton :: !Word8 - , controllerButtonEventState :: !Word8 - } - | ControllerDeviceEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , controllerDeviceEventWhich :: !Int32 - } - | QuitEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - } - | UserEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , userEventWindowID :: !Word32 - , userEventCode :: !Int32 - , userEventData1 :: !(Ptr ()) - , userEventData2 :: !(Ptr ()) - } - | SysWMEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , sysWMEventMsg :: !SysWMmsg - } - | TouchFingerEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , touchFingerEventTouchID :: !TouchID - , touchFingerEventFingerID :: !FingerID - , touchFingerEventX :: !CFloat - , touchFingerEventY :: !CFloat - , touchFingerEventDX :: !CFloat - , touchFingerEventDY :: !CFloat - , touchFingerEventPressure :: !CFloat - } - | MultiGestureEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , multiGestureEventTouchID :: !TouchID - , multiGestureEventDTheta :: !CFloat - , multiGestureEventDDist :: !CFloat - , multiGestureEventX :: !CFloat - , multiGestureEventY :: !CFloat - , multiGestureEventNumFingers :: !Word16 - } - | DollarGestureEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , dollarGestureEventTouchID :: !TouchID - , dollarGestureEventGestureID :: !GestureID - , dollarGestureEventNumFingers :: !Word32 - , dollarGestureEventError :: !CFloat - , dollarGestureEventX :: !CFloat - , dollarGestureEventY :: !CFloat - } - | DropEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - , dropEventFile :: !CString - } - | ClipboardUpdateEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - } - | UnknownEvent - { eventType :: !Word32 - , eventTimestamp :: !Word32 - } - deriving (Eq, Show, Typeable) - -instance Storable Event where - sizeOf _ = (#size SDL_Event) - alignment = sizeOf - peek ptr = do - typ <- (#peek SDL_Event, common.type) ptr - timestamp <- (#peek SDL_Event, common.timestamp) ptr - case typ of - (#const SDL_QUIT) -> - return $! QuitEvent typ timestamp - (#const SDL_WINDOWEVENT) -> do - wid <- (#peek SDL_Event, window.windowID) ptr - event <- (#peek SDL_Event, window.event) ptr - data1 <- (#peek SDL_Event, window.data1) ptr - data2 <- (#peek SDL_Event, window.data2) ptr - return $! WindowEvent typ timestamp wid event data1 data2 - (#const SDL_SYSWMEVENT) -> do - msg <- (#peek SDL_Event, syswm.msg) ptr - return $! SysWMEvent typ timestamp msg - (#const SDL_KEYDOWN) -> key $ KeyboardEvent typ timestamp - (#const SDL_KEYUP) -> key $ KeyboardEvent typ timestamp - (#const SDL_TEXTEDITING) -> do - wid <- (#peek SDL_Event, edit.windowID) ptr - text <- peekArray (#const SDL_TEXTEDITINGEVENT_TEXT_SIZE) $ (#ptr SDL_Event, edit.text) ptr - start <- (#peek SDL_Event, edit.start) ptr - len <- (#peek SDL_Event, edit.length) ptr - return $! TextEditingEvent typ timestamp wid text start len - (#const SDL_TEXTINPUT) -> do - wid <- (#peek SDL_Event, text.windowID) ptr - text <- peekArray (#const SDL_TEXTINPUTEVENT_TEXT_SIZE) $ (#ptr SDL_Event, text.text) ptr - let upToNull = takeWhile (/= 0) text - return $! TextInputEvent typ timestamp wid upToNull - (#const SDL_MOUSEMOTION) -> do - wid <- (#peek SDL_Event, motion.windowID) ptr - which <- (#peek SDL_Event, motion.which) ptr - state <- (#peek SDL_Event, motion.state) ptr - x <- (#peek SDL_Event, motion.x) ptr - y <- (#peek SDL_Event, motion.y) ptr - xrel <- (#peek SDL_Event, motion.xrel) ptr - yrel <- (#peek SDL_Event, motion.yrel) ptr - return $! MouseMotionEvent typ timestamp wid which state x y xrel yrel - (#const SDL_MOUSEBUTTONDOWN) -> mouse $ MouseButtonEvent typ timestamp - (#const SDL_MOUSEBUTTONUP) -> mouse $ MouseButtonEvent typ timestamp - (#const SDL_MOUSEWHEEL) -> do - wid <- (#peek SDL_Event, wheel.windowID) ptr - which <- (#peek SDL_Event, wheel.which) ptr - x <- (#peek SDL_Event, wheel.x) ptr - y <- (#peek SDL_Event, wheel.y) ptr - return $! MouseWheelEvent typ timestamp wid which x y - (#const SDL_JOYAXISMOTION) -> do - which <- (#peek SDL_Event, jaxis.which) ptr - axis <- (#peek SDL_Event, jaxis.axis) ptr - value <- (#peek SDL_Event, jaxis.value) ptr - return $! JoyAxisEvent typ timestamp which axis value - (#const SDL_JOYBALLMOTION) -> do - which <- (#peek SDL_Event, jball.which) ptr - ball <- (#peek SDL_Event, jball.ball) ptr - xrel <- (#peek SDL_Event, jball.xrel) ptr - yrel <- (#peek SDL_Event, jball.yrel) ptr - return $! JoyBallEvent typ timestamp which ball xrel yrel - (#const SDL_JOYHATMOTION) -> do - which <- (#peek SDL_Event, jhat.which) ptr - hat <- (#peek SDL_Event, jhat.hat) ptr - value <- (#peek SDL_Event, jhat.value) ptr - return $! JoyHatEvent typ timestamp which hat value - (#const SDL_JOYBUTTONDOWN) -> joybutton $ JoyButtonEvent typ timestamp - (#const SDL_JOYBUTTONUP) -> joybutton $ JoyButtonEvent typ timestamp - (#const SDL_JOYDEVICEADDED) -> joydevice $ JoyDeviceEvent typ timestamp - (#const SDL_JOYDEVICEREMOVED) -> joydevice $ JoyDeviceEvent typ timestamp - (#const SDL_CONTROLLERAXISMOTION) -> do - which <- (#peek SDL_Event, caxis.which) ptr - axis <- (#peek SDL_Event, caxis.axis) ptr - value <- (#peek SDL_Event, caxis.value) ptr - return $! ControllerButtonEvent typ timestamp which axis value - (#const SDL_CONTROLLERBUTTONDOWN) -> controllerbutton $ ControllerButtonEvent typ timestamp - (#const SDL_CONTROLLERBUTTONUP) -> controllerbutton $ ControllerButtonEvent typ timestamp - (#const SDL_CONTROLLERDEVICEADDED) -> controllerdevice $ ControllerDeviceEvent typ timestamp - (#const SDL_CONTROLLERDEVICEREMOVED) -> controllerdevice $ ControllerDeviceEvent typ timestamp - (#const SDL_CONTROLLERDEVICEREMAPPED) -> controllerdevice $ ControllerDeviceEvent typ timestamp - (#const SDL_FINGERDOWN) -> finger $ TouchFingerEvent typ timestamp - (#const SDL_FINGERUP) -> finger $ TouchFingerEvent typ timestamp - (#const SDL_FINGERMOTION) -> finger $ TouchFingerEvent typ timestamp - (#const SDL_DOLLARGESTURE) -> dollargesture $ DollarGestureEvent typ timestamp - (#const SDL_DOLLARRECORD) -> dollargesture $ DollarGestureEvent typ timestamp - (#const SDL_MULTIGESTURE) -> do - touchId <- (#peek SDL_Event, mgesture.touchId) ptr - dTheta <- (#peek SDL_Event, mgesture.dTheta) ptr - dDist <- (#peek SDL_Event, mgesture.dDist) ptr - x <- (#peek SDL_Event, mgesture.x) ptr - y <- (#peek SDL_Event, mgesture.y) ptr - numFingers <- (#peek SDL_Event, mgesture.numFingers) ptr - return $! MultiGestureEvent typ timestamp touchId dTheta dDist x y numFingers - (#const SDL_CLIPBOARDUPDATE) -> - return $! ClipboardUpdateEvent typ timestamp - (#const SDL_DROPFILE) -> do - file <- (#peek SDL_Event, drop.file) ptr - return $! DropEvent typ timestamp file - x | x >= (#const SDL_USEREVENT) -> do - wid <- (#peek SDL_Event, user.windowID) ptr - code <- (#peek SDL_Event, user.code) ptr - data1 <- (#peek SDL_Event, user.data1) ptr - data2 <- (#peek SDL_Event, user.data2) ptr - return $! UserEvent typ timestamp wid code data1 data2 - _ -> return $! UnknownEvent typ timestamp - where - key f = do - wid <- (#peek SDL_Event, key.windowID) ptr - state <- (#peek SDL_Event, key.state) ptr - repeat' <- (#peek SDL_Event, key.repeat) ptr - keysym <- (#peek SDL_Event, key.keysym) ptr - return $! f wid state repeat' keysym - - mouse f = do - wid <- (#peek SDL_Event, button.windowID) ptr - which <- (#peek SDL_Event, button.which) ptr - button <- (#peek SDL_Event, button.button) ptr - state <- (#peek SDL_Event, button.state) ptr - clicks <- (#peek SDL_Event, button.clicks) ptr - x <- (#peek SDL_Event, button.x) ptr - y <- (#peek SDL_Event, button.y) ptr - return $! f wid which button state clicks x y - - joybutton f = do - which <- (#peek SDL_Event, jbutton.which) ptr - button <- (#peek SDL_Event, jbutton.button) ptr - state <- (#peek SDL_Event, jbutton.state) ptr - return $! f which button state - - joydevice f = do - which <- (#peek SDL_Event, jdevice.which) ptr - return $! f which - - controllerbutton f = do - which <- (#peek SDL_Event, cbutton.which) ptr - button <- (#peek SDL_Event, cbutton.button) ptr - state <- (#peek SDL_Event, cbutton.state) ptr - return $! f which button state - - controllerdevice f = do - which <- (#peek SDL_Event, cdevice.which) ptr - return $! f which - - finger f = do - touchId <- (#peek SDL_Event, tfinger.touchId) ptr - fingerId <- (#peek SDL_Event, tfinger.fingerId) ptr - x <- (#peek SDL_Event, tfinger.x) ptr - y <- (#peek SDL_Event, tfinger.y) ptr - dx <- (#peek SDL_Event, tfinger.dx) ptr - dy <- (#peek SDL_Event, tfinger.dy) ptr - pressure <- (#peek SDL_Event, tfinger.pressure) ptr - return $! f touchId fingerId x y dx dy pressure - - dollargesture f = do - touchId <- (#peek SDL_Event, dgesture.touchId) ptr - gestureId <- (#peek SDL_Event, dgesture.gestureId) ptr - numFingers <- (#peek SDL_Event, dgesture.numFingers) ptr - err <- (#peek SDL_Event, dgesture.error) ptr - x <- (#peek SDL_Event, dgesture.x) ptr - y <- (#peek SDL_Event, dgesture.y) ptr - return $! f touchId gestureId numFingers err x y - poke ptr ev = case ev of - WindowEvent typ timestamp wid event data1 data2 -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, window.windowID) ptr wid - (#poke SDL_Event, window.event) ptr event - (#poke SDL_Event, window.data1) ptr data1 - (#poke SDL_Event, window.data2) ptr data2 - KeyboardEvent typ timestamp wid state repeat' keysym -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, key.windowID) ptr wid - (#poke SDL_Event, key.state) ptr state - (#poke SDL_Event, key.repeat) ptr repeat' - (#poke SDL_Event, key.keysym) ptr keysym - TextEditingEvent typ timestamp wid text start len -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, edit.windowID) ptr wid - pokeArray ((#ptr SDL_Event, edit.text) ptr) text - (#poke SDL_Event, edit.start) ptr start - (#poke SDL_Event, edit.length) ptr len - TextInputEvent typ timestamp wid text -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, text.windowID) ptr wid - pokeArray ((#ptr SDL_Event, text.text) ptr) text - MouseMotionEvent typ timestamp wid which state x y xrel yrel -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, motion.windowID) ptr wid - (#poke SDL_Event, motion.which) ptr which - (#poke SDL_Event, motion.state) ptr state - (#poke SDL_Event, motion.x) ptr x - (#poke SDL_Event, motion.y) ptr y - (#poke SDL_Event, motion.xrel) ptr xrel - (#poke SDL_Event, motion.yrel) ptr yrel - MouseButtonEvent typ timestamp wid which button state clicks x y -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, button.windowID) ptr wid - (#poke SDL_Event, button.which) ptr which - (#poke SDL_Event, button.button) ptr button - (#poke SDL_Event, button.state) ptr state - (#poke SDL_Event, button.clicks) ptr clicks - (#poke SDL_Event, button.x) ptr x - (#poke SDL_Event, button.y) ptr y - MouseWheelEvent typ timestamp wid which x y -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, wheel.windowID) ptr wid - (#poke SDL_Event, wheel.which) ptr which - (#poke SDL_Event, wheel.x) ptr x - (#poke SDL_Event, wheel.y) ptr y - JoyAxisEvent typ timestamp which axis value -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, jaxis.which) ptr which - (#poke SDL_Event, jaxis.axis) ptr axis - (#poke SDL_Event, jaxis.value) ptr value - JoyBallEvent typ timestamp which ball xrel yrel -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, jball.which) ptr which - (#poke SDL_Event, jball.ball) ptr ball - (#poke SDL_Event, jball.xrel) ptr xrel - (#poke SDL_Event, jball.yrel) ptr yrel - JoyHatEvent typ timestamp which hat value -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, jhat.which) ptr which - (#poke SDL_Event, jhat.hat) ptr hat - (#poke SDL_Event, jhat.value) ptr value - JoyButtonEvent typ timestamp which button state -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, jbutton.which) ptr which - (#poke SDL_Event, jbutton.button) ptr button - (#poke SDL_Event, jbutton.state) ptr state - JoyDeviceEvent typ timestamp which -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, jdevice.which) ptr which - ControllerAxisEvent typ timestamp which axis value -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, caxis.which) ptr which - (#poke SDL_Event, caxis.axis) ptr axis - (#poke SDL_Event, caxis.value) ptr value - ControllerButtonEvent typ timestamp which button state -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, cbutton.which) ptr which - (#poke SDL_Event, cbutton.button) ptr button - (#poke SDL_Event, cbutton.state) ptr state - ControllerDeviceEvent typ timestamp which -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, cdevice.which) ptr which - QuitEvent typ timestamp -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - UserEvent typ timestamp wid code data1 data2 -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, user.windowID) ptr wid - (#poke SDL_Event, user.code) ptr code - (#poke SDL_Event, user.data1) ptr data1 - (#poke SDL_Event, user.data2) ptr data2 - SysWMEvent typ timestamp msg -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, syswm.msg) ptr msg - TouchFingerEvent typ timestamp touchid fingerid x y dx dy pressure -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, tfinger.touchId) ptr touchid - (#poke SDL_Event, tfinger.fingerId) ptr fingerid - (#poke SDL_Event, tfinger.x) ptr x - (#poke SDL_Event, tfinger.y) ptr y - (#poke SDL_Event, tfinger.dx) ptr dx - (#poke SDL_Event, tfinger.dy) ptr dy - (#poke SDL_Event, tfinger.pressure) ptr pressure - MultiGestureEvent typ timestamp touchid dtheta ddist x y numfingers -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, mgesture.touchId) ptr touchid - (#poke SDL_Event, mgesture.dTheta) ptr dtheta - (#poke SDL_Event, mgesture.dDist) ptr ddist - (#poke SDL_Event, mgesture.x) ptr x - (#poke SDL_Event, mgesture.y) ptr y - (#poke SDL_Event, mgesture.numFingers) ptr numfingers - DollarGestureEvent typ timestamp touchid gestureid numfingers err x y -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, dgesture.touchId) ptr touchid - (#poke SDL_Event, dgesture.gestureId) ptr gestureid - (#poke SDL_Event, dgesture.numFingers) ptr numfingers - (#poke SDL_Event, dgesture.error) ptr err - (#poke SDL_Event, dgesture.x) ptr x - (#poke SDL_Event, dgesture.y) ptr y - ClipboardUpdateEvent typ timestamp -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - DropEvent typ timestamp file -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - (#poke SDL_Event, drop.file) ptr file - UnknownEvent typ timestamp -> do - (#poke SDL_Event, common.type) ptr typ - (#poke SDL_Event, common.timestamp) ptr timestamp - -data Finger = Finger - { fingerID :: !FingerID - , fingerX :: !CFloat - , fingerY :: !CFloat - , fingerPressure :: !CFloat - } deriving (Eq, Show, Typeable) - -instance Storable Finger where - sizeOf _ = (#size SDL_Finger) - alignment = sizeOf - peek ptr = do - fingerId <- (#peek SDL_Finger, id) ptr - x <- (#peek SDL_Finger, x) ptr - y <- (#peek SDL_Finger, y) ptr - pressure <- (#peek SDL_Finger, pressure) ptr - return $! Finger fingerId x y pressure - poke ptr (Finger fingerId x y pressure) = do - (#poke SDL_Finger, id) ptr fingerId - (#poke SDL_Finger, x) ptr x - (#poke SDL_Finger, y) ptr y - (#poke SDL_Finger, pressure) ptr pressure - -data GameControllerButtonBind - = GameControllerButtonBindNone - | GameControllerButtonBindButton - { gameControllerButtonBindButton :: !CInt - } - | GameControllerButtonBindAxis - { gameControllerButtonBindAxis :: !CInt - } - | GameControllerButtonBindHat - { gameControllerButtonBindHat :: !CInt - , gameControllerButtonBindHatMask :: !CInt - } - deriving (Eq, Show, Typeable) - -instance Storable GameControllerButtonBind where - sizeOf _ = (#size SDL_GameControllerButtonBind) - alignment = sizeOf - peek ptr = do - bind_type <- (#peek SDL_GameControllerButtonBind, bindType) ptr - case bind_type :: (#type SDL_GameControllerBindType) of - (#const SDL_CONTROLLER_BINDTYPE_NONE) -> do - return $! GameControllerButtonBindNone - (#const SDL_CONTROLLER_BINDTYPE_BUTTON) -> do - button <- (#peek SDL_GameControllerButtonBind, value.button) ptr - return $! GameControllerButtonBindButton button - (#const SDL_CONTROLLER_BINDTYPE_AXIS) -> do - axis <- (#peek SDL_GameControllerButtonBind, value.axis) ptr - return $! GameControllerButtonBindAxis axis - (#const SDL_CONTROLLER_BINDTYPE_HAT) -> do - hat <- (#peek SDL_GameControllerButtonBind, value.hat.hat) ptr - hat_mask <- (#peek SDL_GameControllerButtonBind, value.hat.hat_mask) ptr - return $! GameControllerButtonBindHat hat hat_mask - _ -> error $ "Unknown type " ++ show bind_type ++ " for SDL_GameControllerButtonBind" - poke ptr bind = case bind of - GameControllerButtonBindNone -> do - (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_NONE) :: (#type SDL_GameControllerBindType)) - GameControllerButtonBindButton button -> do - (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_BUTTON) :: (#type SDL_GameControllerBindType)) - (#poke SDL_GameControllerButtonBind, value.button) ptr button - GameControllerButtonBindAxis axis -> do - (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_AXIS) :: (#type SDL_GameControllerBindType)) - (#poke SDL_GameControllerButtonBind, value.axis) ptr axis - GameControllerButtonBindHat hat hat_mask -> do - (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_HAT) :: (#type SDL_GameControllerBindType)) - (#poke SDL_GameControllerButtonBind, value.hat.hat) ptr hat - (#poke SDL_GameControllerButtonBind, value.hat.hat_mask) ptr hat_mask - -data HapticDirection = HapticDirection - { hapticDirectionType :: !Word8 - , hapticDirectionX :: !Int32 - , hapticDirectionY :: !Int32 - , hapticDirectionZ :: !Int32 - } deriving (Eq, Show, Typeable) - -instance Storable HapticDirection where - sizeOf _ = (#size SDL_HapticDirection) - alignment = sizeOf - peek ptr = do - typ <- (#peek SDL_HapticDirection, type) ptr - x <- (#peek SDL_HapticDirection, dir[0]) ptr - y <- (#peek SDL_HapticDirection, dir[1]) ptr - z <- (#peek SDL_HapticDirection, dir[2]) ptr - return $! HapticDirection typ x y z - poke ptr (HapticDirection typ x y z) = do - (#poke SDL_HapticDirection, type) ptr typ - (#poke SDL_HapticDirection, dir[0]) ptr x - (#poke SDL_HapticDirection, dir[1]) ptr y - (#poke SDL_HapticDirection, dir[2]) ptr z - -data HapticEffect - = HapticConstant - { hapticEffectType :: !Word16 - , hapticConstantDirection :: !HapticDirection - , hapticConstantLength :: !Word32 - , hapticConstantDelay :: !Word16 - , hapticConstantButton :: !Word16 - , hapticConstantInterval :: !Word16 - , hapticConstantLevel :: !Int16 - , hapticConstantAttackLength :: !Word16 - , hapticConstantAttackLevel :: !Word16 - , hapticConstantFadeLength :: !Word16 - , hapticConstantFadeLevel :: !Word16 - } - | HapticPeriodic - { hapticEffectType :: !Word16 - , hapticPeriodicDirection :: !HapticDirection - , hapticPeriodicLength :: !Word32 - , hapticPeriodicDelay :: !Word16 - , hapticPeriodicButton :: !Word16 - , hapticPeriodicInterval :: !Word16 - , hapticPeriodicPeriod :: !Word16 - , hapticPeriodicMagnitude :: !Int16 - , hapticPeriodicOffset :: !Int16 - , hapticPeriodicPhase :: !Word16 - , hapticPeriodicAttackLength :: !Word16 - , hapticPeriodicAttackLevel :: !Word16 - , hapticPeriodicFadeLength :: !Word16 - , hapticPeriodicFadeLevel :: !Word16 - } - | HapticCondition - { hapticEffectType :: !Word16 - , hapticConditionLength :: !Word32 - , hapticConditionDelay :: !Word16 - , hapticConditionButton :: !Word16 - , hapticConditionInterval :: !Word16 - , hapticConditionRightSat :: ![Word16] - , hapticConditionLeftSat :: ![Word16] - , hapticConditionRightCoeff :: ![Int16] - , hapticConditionLeftCoeff :: ![Int16] - , hapticConditionDeadband :: ![Word16] - , hapticConditionCenter :: ![Int16] - } - | HapticRamp - { hapticEffectType :: !Word16 - , hapticRampDirection :: !HapticDirection - , hapticRampLength :: !Word32 - , hapticRampDelay :: !Word16 - , hapticRampButton :: !Word16 - , hapticRampInterval :: !Word16 - , hapticRampStart :: !Int16 - , hapticRampEnd :: !Int16 - , hapticRampAttackLength :: !Word16 - , hapticRampAttackLevel :: !Word16 - , hapticRampFadeLength :: !Word16 - , hapticRampFadeLevel :: !Word16 - } - | HapticLeftRight - { hapticEffectType :: !Word16 - , hapticLeftRightLength :: !Word32 - , hapticLeftRightLargeMagnitude :: !Word16 - , hapticLeftRightSmallMagnitude :: !Word16 - } - | HapticCustom - { hapticEffectType :: !Word16 - , hapticCustomDirection :: !HapticDirection - , hapticCustomLength :: !Word32 - , hapticCustomDelay :: !Word16 - , hapticCustomButton :: !Word16 - , hapticCustomInterval :: !Word16 - , hapticCustomChannels :: !Word8 - , hapticCustomPeriod :: !Word16 - , hapticCustomSamples :: !Word16 - , hapticCustomData :: !(Ptr Word16) - , hapticCustomAttackLength :: !Word16 - , hapticCustomAttackLevel :: !Word16 - , hapticCustomFadeLength :: !Word16 - , hapticCustomFadeLevel :: !Word16 - } - deriving (Eq, Show, Typeable) - -instance Storable HapticEffect where - sizeOf _ = (#size SDL_HapticEffect) - alignment = sizeOf - peek ptr = do - typ <- (#peek SDL_HapticEffect, type) ptr - case typ of - (#const SDL_HAPTIC_CONSTANT) -> do - direction <- (#peek SDL_HapticEffect, constant.direction) ptr - len <- (#peek SDL_HapticEffect, constant.length) ptr - delay <- (#peek SDL_HapticEffect, constant.delay) ptr - button <- (#peek SDL_HapticEffect, constant.button) ptr - interval <- (#peek SDL_HapticEffect, constant.interval) ptr - level <- (#peek SDL_HapticEffect, constant.level) ptr - attack_length <- (#peek SDL_HapticEffect, constant.attack_length) ptr - attack_level <- (#peek SDL_HapticEffect, constant.attack_level) ptr - fade_length <- (#peek SDL_HapticEffect, constant.fade_length) ptr - fade_level <- (#peek SDL_HapticEffect, constant.fade_level) ptr - return $! HapticConstant typ direction len delay button interval level attack_length attack_level fade_length fade_level - - (#const SDL_HAPTIC_SINE) -> hapticperiodic $ HapticPeriodic typ - (#const SDL_HAPTIC_TRIANGLE) -> hapticperiodic $ HapticPeriodic typ - (#const SDL_HAPTIC_SAWTOOTHUP) -> hapticperiodic $ HapticPeriodic typ - (#const SDL_HAPTIC_SAWTOOTHDOWN) -> hapticperiodic $ HapticPeriodic typ - - (#const SDL_HAPTIC_RAMP) -> do - direction <- (#peek SDL_HapticEffect, ramp.direction) ptr - len <- (#peek SDL_HapticEffect, ramp.length) ptr - delay <- (#peek SDL_HapticEffect, ramp.delay) ptr - button <- (#peek SDL_HapticEffect, ramp.button) ptr - interval <- (#peek SDL_HapticEffect, ramp.interval) ptr - start <- (#peek SDL_HapticEffect, ramp.start) ptr - end <- (#peek SDL_HapticEffect, ramp.end) ptr - attack_length <- (#peek SDL_HapticEffect, ramp.attack_length) ptr - attack_level <- (#peek SDL_HapticEffect, ramp.attack_level) ptr - fade_length <- (#peek SDL_HapticEffect, ramp.fade_length) ptr - fade_level <- (#peek SDL_HapticEffect, ramp.fade_level) ptr - return $! HapticRamp typ direction len delay button interval start end attack_length attack_level fade_length fade_level - - (#const SDL_HAPTIC_SPRING) -> hapticcondition $ HapticCondition typ - (#const SDL_HAPTIC_DAMPER) -> hapticcondition $ HapticCondition typ - (#const SDL_HAPTIC_INERTIA) -> hapticcondition $ HapticCondition typ - (#const SDL_HAPTIC_FRICTION) -> hapticcondition $ HapticCondition typ - - (#const SDL_HAPTIC_LEFTRIGHT) -> do - len <- (#peek SDL_HapticEffect, leftright.length) ptr - large_magnitude <- (#peek SDL_HapticEffect, leftright.large_magnitude) ptr - small_magnitude <- (#peek SDL_HapticEffect, leftright.small_magnitude) ptr - return $! HapticLeftRight typ len large_magnitude small_magnitude - - (#const SDL_HAPTIC_CUSTOM) -> do - direction <- (#peek SDL_HapticEffect, custom.direction) ptr - len <- (#peek SDL_HapticEffect, custom.length) ptr - delay <- (#peek SDL_HapticEffect, custom.delay) ptr - button <- (#peek SDL_HapticEffect, custom.button) ptr - interval <- (#peek SDL_HapticEffect, custom.interval) ptr - channels <- (#peek SDL_HapticEffect, custom.channels) ptr - period <- (#peek SDL_HapticEffect, custom.period) ptr - samples <- (#peek SDL_HapticEffect, custom.samples) ptr - datum <- (#peek SDL_HapticEffect, custom.data) ptr - attack_length <- (#peek SDL_HapticEffect, custom.attack_length) ptr - attack_level <- (#peek SDL_HapticEffect, custom.attack_level) ptr - fade_length <- (#peek SDL_HapticEffect, custom.fade_length) ptr - fade_level <- (#peek SDL_HapticEffect, custom.fade_level) ptr - return $! HapticCustom typ direction len delay button interval channels period samples datum attack_length attack_level fade_length fade_level - _ -> error $ "Unknown type " ++ show typ ++ " for SDL_HapticEffect" - where - hapticperiodic f = do - direction <- (#peek SDL_HapticEffect, periodic.direction) ptr - len <- (#peek SDL_HapticEffect, periodic.length) ptr - delay <- (#peek SDL_HapticEffect, periodic.delay) ptr - button <- (#peek SDL_HapticEffect, periodic.button) ptr - interval <- (#peek SDL_HapticEffect, periodic.interval) ptr - period <- (#peek SDL_HapticEffect, periodic.period) ptr - magnitude <- (#peek SDL_HapticEffect, periodic.magnitude) ptr - offset <- (#peek SDL_HapticEffect, periodic.offset) ptr - phase <- (#peek SDL_HapticEffect, periodic.phase) ptr - attack_length <- (#peek SDL_HapticEffect, periodic.attack_length) ptr - attack_level <- (#peek SDL_HapticEffect, periodic.attack_level) ptr - fade_length <- (#peek SDL_HapticEffect, periodic.fade_length) ptr - fade_level <- (#peek SDL_HapticEffect, periodic.fade_level) ptr - return $! f direction len delay button interval period magnitude offset phase attack_length attack_level fade_length fade_level - - hapticcondition f = do - len <- (#peek SDL_HapticEffect, condition.length) ptr - delay <- (#peek SDL_HapticEffect, condition.delay) ptr - button <- (#peek SDL_HapticEffect, condition.button) ptr - interval <- (#peek SDL_HapticEffect, condition.interval) ptr - right_sat <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.right_sat) ptr - left_sat <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.left_sat) ptr - right_coeff <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.right_coeff) ptr - left_coeff <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.left_coeff) ptr - deadband <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.deadband) ptr - center <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.center) ptr - return $! f len delay button interval right_sat left_sat right_coeff left_coeff deadband center - poke ptr event = case event of - HapticConstant typ direction len delay button interval level attack_length attack_level fade_length fade_level -> do - (#poke SDL_HapticEffect, type) ptr typ - (#poke SDL_HapticEffect, constant.direction) ptr direction - (#poke SDL_HapticEffect, constant.length) ptr len - (#poke SDL_HapticEffect, constant.delay) ptr delay - (#poke SDL_HapticEffect, constant.button) ptr button - (#poke SDL_HapticEffect, constant.interval) ptr interval - (#poke SDL_HapticEffect, constant.level) ptr level - (#poke SDL_HapticEffect, constant.attack_length) ptr attack_length - (#poke SDL_HapticEffect, constant.attack_level) ptr attack_level - (#poke SDL_HapticEffect, constant.fade_length) ptr fade_length - (#poke SDL_HapticEffect, constant.fade_level) ptr fade_level - HapticPeriodic typ direction len delay button interval period magnitude offset phase attack_length attack_level fade_length fade_level -> do - (#poke SDL_HapticEffect, type) ptr typ - (#poke SDL_HapticEffect, periodic.direction) ptr direction - (#poke SDL_HapticEffect, periodic.length) ptr len - (#poke SDL_HapticEffect, periodic.delay) ptr delay - (#poke SDL_HapticEffect, periodic.button) ptr button - (#poke SDL_HapticEffect, periodic.interval) ptr interval - (#poke SDL_HapticEffect, periodic.period) ptr period - (#poke SDL_HapticEffect, periodic.magnitude) ptr magnitude - (#poke SDL_HapticEffect, periodic.offset) ptr offset - (#poke SDL_HapticEffect, periodic.phase) ptr phase - (#poke SDL_HapticEffect, periodic.attack_length) ptr attack_length - (#poke SDL_HapticEffect, periodic.attack_level) ptr attack_level - (#poke SDL_HapticEffect, periodic.fade_length) ptr fade_length - (#poke SDL_HapticEffect, periodic.fade_level) ptr fade_level - HapticCondition typ len delay button interval right_sat left_sat right_coeff left_coeff deadband center -> do - (#poke SDL_HapticEffect, type) ptr typ - (#poke SDL_HapticEffect, condition.length) ptr len - (#poke SDL_HapticEffect, condition.delay) ptr delay - (#poke SDL_HapticEffect, condition.button) ptr button - (#poke SDL_HapticEffect, condition.interval) ptr interval - pokeArray ((#ptr SDL_HapticEffect, condition.right_sat) ptr) right_sat - pokeArray ((#ptr SDL_HapticEffect, condition.left_sat) ptr) left_sat - pokeArray ((#ptr SDL_HapticEffect, condition.right_coeff) ptr) right_coeff - pokeArray ((#ptr SDL_HapticEffect, condition.left_coeff) ptr) left_coeff - pokeArray ((#ptr SDL_HapticEffect, condition.deadband) ptr) deadband - pokeArray ((#ptr SDL_HapticEffect, condition.center) ptr) center - HapticRamp typ direction len delay button interval start end attack_length attack_level fade_length fade_level -> do - (#poke SDL_HapticEffect, type) ptr typ - (#poke SDL_HapticEffect, ramp.direction) ptr direction - (#poke SDL_HapticEffect, ramp.length) ptr len - (#poke SDL_HapticEffect, ramp.delay) ptr delay - (#poke SDL_HapticEffect, ramp.button) ptr button - (#poke SDL_HapticEffect, ramp.interval) ptr interval - (#poke SDL_HapticEffect, ramp.start) ptr start - (#poke SDL_HapticEffect, ramp.end) ptr end - (#poke SDL_HapticEffect, ramp.attack_length) ptr attack_length - (#poke SDL_HapticEffect, ramp.attack_level) ptr attack_level - (#poke SDL_HapticEffect, ramp.fade_length) ptr fade_length - (#poke SDL_HapticEffect, ramp.fade_level) ptr fade_level - HapticLeftRight typ len large_magnitude small_magnitude -> do - (#poke SDL_HapticEffect, type) ptr typ - (#poke SDL_HapticEffect, leftright.length) ptr len - (#poke SDL_HapticEffect, leftright.large_magnitude) ptr large_magnitude - (#poke SDL_HapticEffect, leftright.small_magnitude) ptr small_magnitude - HapticCustom typ direction len delay button interval channels period samples datum attack_length attack_level fade_length fade_level -> do - (#poke SDL_HapticEffect, type) ptr typ - (#poke SDL_HapticEffect, custom.direction) ptr direction - (#poke SDL_HapticEffect, custom.length) ptr len - (#poke SDL_HapticEffect, custom.delay) ptr delay - (#poke SDL_HapticEffect, custom.button) ptr button - (#poke SDL_HapticEffect, custom.interval) ptr interval - (#poke SDL_HapticEffect, custom.channels) ptr channels - (#poke SDL_HapticEffect, custom.period) ptr period - (#poke SDL_HapticEffect, custom.samples) ptr samples - (#poke SDL_HapticEffect, custom.data) ptr datum - (#poke SDL_HapticEffect, custom.attack_length) ptr attack_length - (#poke SDL_HapticEffect, custom.attack_level) ptr attack_level - (#poke SDL_HapticEffect, custom.fade_length) ptr fade_length - (#poke SDL_HapticEffect, custom.fade_level) ptr fade_level - -data JoystickGUID = JoystickGUID - { joystickGUID :: ![Word8] - } deriving (Eq, Show, Typeable) - -instance Storable JoystickGUID where - sizeOf _ = (#size SDL_JoystickGUID) - alignment = sizeOf - peek ptr = do - guid <- peekArray 16 $ (#ptr SDL_JoystickGUID, data) ptr - return $! JoystickGUID guid - poke ptr (JoystickGUID guid) = - pokeArray ((#ptr SDL_JoystickGUID, data) ptr) guid - -data Keysym = Keysym - { keysymScancode :: !Scancode - , keysymKeycode :: !Keycode - , keysymMod :: !Word16 - } deriving (Eq, Show, Typeable) - -instance Storable Keysym where - sizeOf _ = (#size SDL_Keysym) - alignment = sizeOf - peek ptr = do - scancode <- (#peek SDL_Keysym, scancode) ptr - sym <- (#peek SDL_Keysym, sym) ptr - mod' <- (#peek SDL_Keysym, mod) ptr - return $! Keysym scancode sym mod' - poke ptr (Keysym scancode sym mod') = do - (#poke SDL_Keysym, scancode) ptr scancode - (#poke SDL_Keysym, sym) ptr sym - (#poke SDL_Keysym, mod) ptr mod' - -data MessageBoxButtonData = MessageBoxButtonData - { messageBoxButtonDataFlags :: !Word32 - , messageBoxButtonButtonID :: !CInt - , messageBoxButtonText :: !CString - } deriving (Eq, Show, Typeable) - -instance Storable MessageBoxButtonData where - sizeOf _ = (#size SDL_MessageBoxButtonData) - alignment = sizeOf - peek ptr = do - flags <- (#peek SDL_MessageBoxButtonData, flags) ptr - buttonid <- (#peek SDL_MessageBoxButtonData, buttonid) ptr - text <- (#peek SDL_MessageBoxButtonData, text) ptr - return $! MessageBoxButtonData flags buttonid text - poke ptr (MessageBoxButtonData flags buttonid text) = do - (#poke SDL_MessageBoxButtonData, flags) ptr flags - (#poke SDL_MessageBoxButtonData, buttonid) ptr buttonid - (#poke SDL_MessageBoxButtonData, text) ptr text - -data MessageBoxColor = MessageBoxColor - { messageBoxColorR :: !Word8 - , messageBoxColorG :: !Word8 - , messageBoxColorB :: !Word8 - } deriving (Eq, Show, Typeable) - -instance Storable MessageBoxColor where - sizeOf _ = (#size SDL_MessageBoxColor) - alignment = sizeOf - peek ptr = do - r <- (#peek SDL_MessageBoxColor, r) ptr - g <- (#peek SDL_MessageBoxColor, g) ptr - b <- (#peek SDL_MessageBoxColor, b) ptr - return $! MessageBoxColor r g b - poke ptr (MessageBoxColor r g b) = do - (#poke SDL_MessageBoxColor, r) ptr r - (#poke SDL_MessageBoxColor, g) ptr g - (#poke SDL_MessageBoxColor, b) ptr b - -data MessageBoxColorScheme = MessageBoxColorScheme - { messageBoxColorSchemeColorBackground :: !MessageBoxColor - , messageBoxColorSchemeColorText :: !MessageBoxColor - , messageBoxColorSchemeColorButtonBorder :: !MessageBoxColor - , messageBoxColorSchemeColorButtonBackground :: !MessageBoxColor - , messageBoxColorSchemeColorButtonSelected :: !MessageBoxColor - } deriving (Eq, Show, Typeable) - -instance Storable MessageBoxColorScheme where - sizeOf _ = (#size SDL_MessageBoxColorScheme) - alignment = sizeOf - peek ptr = do - background <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BACKGROUND]) ptr - text <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_TEXT]) ptr - button_border <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BORDER]) ptr - button_background <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BACKGROUND]) ptr - button_selected <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_SELECTED]) ptr - return $! MessageBoxColorScheme background text button_border button_background button_selected - poke ptr (MessageBoxColorScheme background text button_border button_background button_selected) = do - (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BACKGROUND]) ptr background - (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_TEXT]) ptr text - (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BORDER]) ptr button_border - (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BACKGROUND]) ptr button_background - (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_SELECTED]) ptr button_selected - -data MessageBoxData = MessageBoxData - { messageBoxDataFlags :: !Word32 - , messageBoxDataWindow :: !Window - , messageBoxDataTitle :: !CString - , messageBoxDataMessage :: !CString - , messageBoxDataNumButtons :: !CInt - , messageBoxDataButtons :: !(Ptr MessageBoxButtonData) - , messageBoxDataColorScheme :: !(Ptr MessageBoxColorScheme) - } deriving (Eq, Show, Typeable) - -instance Storable MessageBoxData where - sizeOf _ = (#size SDL_MessageBoxData) - alignment = sizeOf - peek ptr = do - flags <- (#peek SDL_MessageBoxData, flags) ptr - window <- (#peek SDL_MessageBoxData, window) ptr - title <- (#peek SDL_MessageBoxData, title) ptr - message <- (#peek SDL_MessageBoxData, message) ptr - numbuttons <- (#peek SDL_MessageBoxData, numbuttons) ptr - buttons <- (#peek SDL_MessageBoxData, buttons) ptr - color_scheme <- (#peek SDL_MessageBoxData, colorScheme) ptr - return $! MessageBoxData flags window title message numbuttons buttons color_scheme - poke ptr (MessageBoxData flags window title message numbuttons buttons color_scheme) = do - (#poke SDL_MessageBoxData, flags) ptr flags - (#poke SDL_MessageBoxData, window) ptr window - (#poke SDL_MessageBoxData, title) ptr title - (#poke SDL_MessageBoxData, message) ptr message - (#poke SDL_MessageBoxData, numbuttons) ptr numbuttons - (#poke SDL_MessageBoxData, buttons) ptr buttons - (#poke SDL_MessageBoxData, colorScheme) ptr color_scheme - -data Palette = Palette - { paletteNColors :: !CInt - , paletteColors :: !(Ptr Color) - } deriving (Eq, Show, Typeable) - -instance Storable Palette where - sizeOf _ = (#size SDL_Palette) - alignment = sizeOf - peek ptr = do - ncolors <- (#peek SDL_Palette, ncolors) ptr - colors <- (#peek SDL_Palette, colors) ptr - return $! Palette ncolors colors - poke ptr (Palette ncolors colors) = do - (#poke SDL_Palette, ncolors) ptr ncolors - (#poke SDL_Palette, colors) ptr colors - -data PixelFormat = PixelFormat - { pixelFormatFormat :: !Word32 - , pixelFormatPalette :: !(Ptr Palette) - , pixelFormatBitsPerPixel :: !Word8 - , pixelFormatBytesPerPixel :: !Word8 - , pixelFormatRMask :: !Word32 - , pixelFormatGMask :: !Word32 - , pixelFormatBMask :: !Word32 - , pixelFormatAMask :: !Word32 - } deriving (Eq, Show, Typeable) - -instance Storable PixelFormat where - sizeOf _ = (#size SDL_PixelFormat) - alignment = sizeOf - peek ptr = do - format <- (#peek SDL_PixelFormat, format) ptr - palette <- (#peek SDL_PixelFormat, palette) ptr - bits_per_pixel <- (#peek SDL_PixelFormat, BitsPerPixel) ptr - bytes_per_pixel <- (#peek SDL_PixelFormat, BytesPerPixel) ptr - rmask <- (#peek SDL_PixelFormat, Rmask) ptr - gmask <- (#peek SDL_PixelFormat, Gmask) ptr - bmask <- (#peek SDL_PixelFormat, Bmask) ptr - amask <- (#peek SDL_PixelFormat, Amask) ptr - return $! PixelFormat format palette bits_per_pixel bytes_per_pixel rmask gmask bmask amask - poke ptr (PixelFormat format palette bits_per_pixel bytes_per_pixel rmask gmask bmask amask) = do - (#poke SDL_PixelFormat, format) ptr format - (#poke SDL_PixelFormat, palette) ptr palette - (#poke SDL_PixelFormat, BitsPerPixel) ptr bits_per_pixel - (#poke SDL_PixelFormat, BytesPerPixel) ptr bytes_per_pixel - (#poke SDL_PixelFormat, Rmask) ptr rmask - (#poke SDL_PixelFormat, Gmask) ptr gmask - (#poke SDL_PixelFormat, Bmask) ptr bmask - (#poke SDL_PixelFormat, Amask) ptr amask - -data Point = Point - { pointX :: !CInt - , pointY :: !CInt - } deriving (Eq, Show, Typeable) - -instance Storable Point where - sizeOf _ = (#size SDL_Point) - alignment = sizeOf - peek ptr = do - x <- (#peek SDL_Point, x) ptr - y <- (#peek SDL_Point, y) ptr - return $! Point x y - poke ptr (Point x y) = do - (#poke SDL_Point, x) ptr x - (#poke SDL_Point, y) ptr y - -data Rect = Rect - { rectX :: !CInt - , rectY :: !CInt - , rectW :: !CInt - , rectH :: !CInt - } deriving (Eq, Show, Typeable) - -instance Storable Rect where - sizeOf _ = (#size SDL_Rect) - alignment = sizeOf - peek ptr = do - x <- (#peek SDL_Rect, x) ptr - y <- (#peek SDL_Rect, y) ptr - w <- (#peek SDL_Rect, w) ptr - h <- (#peek SDL_Rect, h) ptr - return $! Rect x y w h - poke ptr (Rect x y w h) = do - (#poke SDL_Rect, x) ptr x - (#poke SDL_Rect, y) ptr y - (#poke SDL_Rect, w) ptr w - (#poke SDL_Rect, h) ptr h - -data RendererInfo = RendererInfo - { rendererInfoName :: !CString - , rendererInfoFlags :: !Word32 - , rendererInfoNumTextureFormats :: !Word32 - , rendererInfoTextureFormats :: ![Word32] - , rendererInfoMaxTextureWidth :: !CInt - , rendererInfoMaxTextureHeight :: !CInt - } deriving (Eq, Show, Typeable) - -instance Storable RendererInfo where - sizeOf _ = (#size SDL_RendererInfo) - alignment = sizeOf - peek ptr = do - name <- (#peek SDL_RendererInfo, name) ptr - flags <- (#peek SDL_RendererInfo, flags) ptr - num_texture_formats <- (#peek SDL_RendererInfo, num_texture_formats) ptr - texture_formats <- peekArray 16 $ (#ptr SDL_RendererInfo, texture_formats) ptr - max_texture_width <- (#peek SDL_RendererInfo, max_texture_width) ptr - max_texture_height <- (#peek SDL_RendererInfo, max_texture_height) ptr - return $! RendererInfo name flags num_texture_formats texture_formats max_texture_width max_texture_height - poke ptr (RendererInfo name flags num_texture_formats texture_formats max_texture_width max_texture_height) = do - (#poke SDL_RendererInfo, name) ptr name - (#poke SDL_RendererInfo, flags) ptr flags - (#poke SDL_RendererInfo, num_texture_formats) ptr num_texture_formats - pokeArray ((#ptr SDL_RendererInfo, texture_formats) ptr) texture_formats - (#poke SDL_RendererInfo, max_texture_width) ptr max_texture_width - (#poke SDL_RendererInfo, max_texture_height) ptr max_texture_height - -data RWops = RWops - { rwopsSize :: !(FunPtr (Ptr RWops -> IO Int64)) - , rwopsSeek :: !(FunPtr (Ptr RWops -> Int64 -> CInt -> IO Int64)) - , rwopsRead :: !(FunPtr (Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize)) - , rwopsWrite :: !(FunPtr (Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize)) - , rwopsClose :: !(FunPtr (Ptr RWops -> IO CInt)) - , rwopsType :: !Word32 - } deriving (Eq, Show, Typeable) - -instance Storable RWops where - sizeOf _ = (#size SDL_RWops) - alignment = sizeOf - peek ptr = do - size <- (#peek SDL_RWops, size) ptr - seek <- (#peek SDL_RWops, seek) ptr - read' <- (#peek SDL_RWops, read) ptr - write <- (#peek SDL_RWops, write) ptr - close <- (#peek SDL_RWops, close) ptr - typ <- (#peek SDL_RWops, type) ptr - return $! RWops size seek read' write close typ - poke ptr (RWops size seek read' write close typ) = do - (#poke SDL_RWops, size) ptr size - (#poke SDL_RWops, seek) ptr seek - (#poke SDL_RWops, read) ptr read' - (#poke SDL_RWops, write) ptr write - (#poke SDL_RWops, close) ptr close - (#poke SDL_RWops, type) ptr typ - -data Surface = Surface - { surfaceFormat :: !(Ptr PixelFormat) - , surfaceW :: !CInt - , surfaceH :: !CInt - , surfacePixels :: !(Ptr ()) - , surfaceUserdata :: !(Ptr ()) - , surfaceClipRect :: !Rect - , surfaceRefcount :: !CInt - } deriving (Eq, Show, Typeable) - -instance Storable Surface where - sizeOf _ = (#size SDL_Surface) - alignment = sizeOf - peek ptr = do - format <- (#peek SDL_Surface, format) ptr - w <- (#peek SDL_Surface, w) ptr - h <- (#peek SDL_Surface, h) ptr - pixels <- (#peek SDL_Surface, pixels) ptr - userdata <- (#peek SDL_Surface, userdata) ptr - cliprect <- (#peek SDL_Surface, clip_rect) ptr - refcount <- (#peek SDL_Surface, refcount) ptr - return $! Surface format w h pixels userdata cliprect refcount - poke ptr (Surface format w h pixels userdata cliprect refcount) = do - (#poke SDL_Surface, format) ptr format - (#poke SDL_Surface, w) ptr w - (#poke SDL_Surface, h) ptr h - (#poke SDL_Surface, pixels) ptr pixels - (#poke SDL_Surface, userdata) ptr userdata - (#poke SDL_Surface, clip_rect) ptr cliprect - (#poke SDL_Surface, refcount) ptr refcount - -data Version = Version - { versionMajor :: !Word8 - , versionMinor :: !Word8 - , versionPatch :: !Word8 - } deriving (Eq, Show, Typeable) - -instance Storable Version where - sizeOf _ = (#size SDL_version) - alignment = sizeOf - peek ptr = do - major <- (#peek SDL_version, major) ptr - minor <- (#peek SDL_version, minor) ptr - patch <- (#peek SDL_version, patch) ptr - return $! Version major minor patch - poke ptr (Version major minor patch) = do - (#poke SDL_version, major) ptr major - (#poke SDL_version, minor) ptr minor - (#poke SDL_version, patch) ptr patch +{-# LANGUAGE DeriveDataTypeable #-} +module SDL.Raw.Types ( + -- * Type Aliases + -- ** Function Types + AudioCallback, + EventFilter, + HintCallback, + LogOutputFunction, + ThreadFunction, + TimerCallback, + + mkAudioCallback, + mkEventFilter, + mkHintCallback, + mkLogOutputFunction, + mkThreadFunction, + mkTimerCallback, + + -- ** Common Types + AudioDeviceID, + AudioFormat, + Cond, + Cursor, + FingerID, + GameController, + GestureID, + GLContext, + Haptic, + Joystick, + JoystickID, + Mutex, + Renderer, + Sem, + SpinLock, + SysWMinfo, + SysWMmsg, + Texture, + Thread, + ThreadID, + TimerID, + TLSID, + TouchID, + Window, + + -- * Data Structures + Atomic(..), + AudioCVT(..), + AudioSpec(..), + Color(..), + DisplayMode(..), + Event(..), + Finger(..), + GameControllerButtonBind(..), + HapticDirection(..), + HapticEffect(..), + JoystickGUID(..), + Keysym(..), + MessageBoxButtonData(..), + MessageBoxColor(..), + MessageBoxColorScheme(..), + MessageBoxData(..), + Palette(..), + PixelFormat(..), + Point(..), + Rect(..), + RendererInfo(..), + RWops(..), + Surface(..), + Version(..) +) where + +#include "SDL.h" + +import Data.Int +import Data.Typeable +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable +import SDL.Raw.Enum + +type AudioCallback = FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO ()) +type EventFilter = FunPtr (Ptr () -> Ptr Event -> IO CInt) +type HintCallback = FunPtr (Ptr () -> CString -> CString -> CString -> IO ()) +type LogOutputFunction = FunPtr (Ptr () -> CInt -> LogPriority -> CString -> IO ()) +type ThreadFunction = FunPtr (Ptr () -> IO CInt) +type TimerCallback = FunPtr (Word32 -> Ptr () -> IO Word32) + +-- | The storage associated with the resulting 'FunPtr' has to be released with +-- 'freeHaskellFunPtr' when it is no longer required. +foreign import ccall "wrapper" + mkAudioCallback :: (Ptr () -> Ptr Word8 -> CInt -> IO ()) -> IO AudioCallback + +-- | The storage associated with the resulting 'FunPtr' has to be released with +-- 'freeHaskellFunPtr' when it is no longer required. +foreign import ccall "wrapper" + mkEventFilter :: (Ptr () -> Ptr Event -> IO CInt) -> IO EventFilter + +-- | The storage associated with the resulting 'FunPtr' has to be released with +-- 'freeHaskellFunPtr' when it is no longer required. +foreign import ccall "wrapper" + mkHintCallback :: (Ptr () -> CString -> CString -> CString -> IO ()) -> IO HintCallback + +-- | The storage associated with the resulting 'FunPtr' has to be released with +-- 'freeHaskellFunPtr' when it is no longer required. +foreign import ccall "wrapper" + mkLogOutputFunction :: (Ptr () -> CInt -> LogPriority -> CString -> IO ()) -> IO LogOutputFunction + +-- | The storage associated with the resulting 'FunPtr' has to be released with +-- 'freeHaskellFunPtr' when it is no longer required. +foreign import ccall "wrapper" + mkThreadFunction :: (Ptr () -> IO CInt) -> IO ThreadFunction + +-- | The storage associated with the resulting 'FunPtr' has to be released with +-- 'freeHaskellFunPtr' when it is no longer required. +foreign import ccall "wrapper" + mkTimerCallback :: (Word32 -> Ptr () -> IO Word32) -> IO TimerCallback + +type AudioDeviceID = Word32 +type Cond = Ptr () +type Cursor = Ptr () +type FingerID = Int64 +type GameController = Ptr () +type GestureID = Int64 +type GLContext = Ptr () +type Haptic = Ptr () +type Joystick = Ptr () +type JoystickID = Int32 +type Mutex = Ptr () +type Renderer = Ptr () +type Sem = Ptr () +type SpinLock = CInt +type SysWMinfo = Ptr () +type SysWMmsg = Ptr () +type Texture = Ptr () +type Thread = Ptr () +type ThreadID = CULong +type TimerID = CInt +type TLSID = CUInt +type TouchID = Int64 +type Window = Ptr () + +data Atomic = Atomic + { atomicValue :: !CInt + } deriving (Eq, Show, Typeable) + +instance Storable Atomic where + sizeOf _ = (#size SDL_atomic_t) + alignment = sizeOf + peek ptr = do + value <- (#peek SDL_atomic_t, value) ptr + return $! Atomic value + poke ptr (Atomic value) = do + (#poke SDL_atomic_t, value) ptr value + +data AudioCVT = AudioCVT + { audioCVTNeeded :: !CInt + , audioCVTSrcFormat :: !AudioFormat + , audioCVTDstFormat :: !AudioFormat + , audioCVTRateIncr :: !CDouble + , audioCVTBuf :: !(Ptr Word8) + , audioCVTLen :: !CInt + , audioCVTLenCvt :: !CInt + , audioCVTLenMult :: !CInt + , audioCVTLenRatio :: !CDouble + } deriving (Eq, Show, Typeable) + +instance Storable AudioCVT where + sizeOf _ = (#size SDL_AudioCVT) + alignment = sizeOf + peek ptr = do + needed <- (#peek SDL_AudioCVT, needed) ptr + src_format <- (#peek SDL_AudioCVT, src_format) ptr + dst_format <- (#peek SDL_AudioCVT, dst_format) ptr + rate_incr <- (#peek SDL_AudioCVT, rate_incr) ptr + buf <- (#peek SDL_AudioCVT, buf) ptr + len <- (#peek SDL_AudioCVT, len) ptr + len_cvt <- (#peek SDL_AudioCVT, len_cvt) ptr + len_mult <- (#peek SDL_AudioCVT, len_mult) ptr + len_ratio <- (#peek SDL_AudioCVT, len_ratio) ptr + return $! AudioCVT needed src_format dst_format rate_incr buf len len_cvt len_mult len_ratio + poke ptr (AudioCVT needed src_format dst_format rate_incr buf len len_cvt len_mult len_ratio) = do + (#poke SDL_AudioCVT, needed) ptr needed + (#poke SDL_AudioCVT, src_format) ptr src_format + (#poke SDL_AudioCVT, dst_format) ptr dst_format + (#poke SDL_AudioCVT, rate_incr) ptr rate_incr + (#poke SDL_AudioCVT, buf) ptr buf + (#poke SDL_AudioCVT, len) ptr len + (#poke SDL_AudioCVT, len_cvt) ptr len_cvt + (#poke SDL_AudioCVT, len_mult) ptr len_mult + (#poke SDL_AudioCVT, len_ratio) ptr len_ratio + +data AudioSpec = AudioSpec + { audioSpecFreq :: !CInt + , audioSpecFormat :: !AudioFormat + , audioSpecChannels :: !Word8 + , audioSpecSilence :: !Word8 + , audioSpecSamples :: !Word16 + , audioSpecSize :: !Word32 + , audioSpecCallback :: !AudioCallback + , audioSpecUserdata :: !(Ptr ()) + } deriving (Eq, Show, Typeable) + +instance Storable AudioSpec where + sizeOf _ = (#size SDL_AudioSpec) + alignment = sizeOf + peek ptr = do + freq <- (#peek SDL_AudioSpec, freq) ptr + format <- (#peek SDL_AudioSpec, format) ptr + channels <- (#peek SDL_AudioSpec, channels) ptr + silence <- (#peek SDL_AudioSpec, silence) ptr + samples <- (#peek SDL_AudioSpec, samples) ptr + size <- (#peek SDL_AudioSpec, size) ptr + callback <- (#peek SDL_AudioSpec, callback) ptr + userdata <- (#peek SDL_AudioSpec, userdata) ptr + return $! AudioSpec freq format channels silence samples size callback userdata + poke ptr (AudioSpec freq format channels silence samples size callback userdata) = do + (#poke SDL_AudioSpec, freq) ptr freq + (#poke SDL_AudioSpec, format) ptr format + (#poke SDL_AudioSpec, channels) ptr channels + (#poke SDL_AudioSpec, silence) ptr silence + (#poke SDL_AudioSpec, samples) ptr samples + (#poke SDL_AudioSpec, size) ptr size + (#poke SDL_AudioSpec, callback) ptr callback + (#poke SDL_AudioSpec, userdata) ptr userdata + +data Color = Color + { colorR :: !Word8 + , colorG :: !Word8 + , colorB :: !Word8 + , colorA :: !Word8 + } deriving (Eq, Show, Typeable) + +instance Storable Color where + sizeOf _ = (#size SDL_Color) + alignment = sizeOf + peek ptr = do + r <- (#peek SDL_Color, r) ptr + g <- (#peek SDL_Color, g) ptr + b <- (#peek SDL_Color, b) ptr + a <- (#peek SDL_Color, a) ptr + return $! Color r g b a + poke ptr (Color r g b a) = do + (#poke SDL_Color, r) ptr r + (#poke SDL_Color, g) ptr g + (#poke SDL_Color, b) ptr b + (#poke SDL_Color, a) ptr a + +data DisplayMode = DisplayMode + { displayModeFormat :: !Word32 + , displayModeW :: !CInt + , displayModeH :: !CInt + , displayModeRefreshRate :: !CInt + , displayModeDriverData :: !(Ptr ()) + } deriving (Eq, Show, Typeable) + +instance Storable DisplayMode where + sizeOf _ = (#size SDL_DisplayMode) + alignment = sizeOf + peek ptr = do + format <- (#peek SDL_DisplayMode, format) ptr + w <- (#peek SDL_DisplayMode, w) ptr + h <- (#peek SDL_DisplayMode, h) ptr + refresh_rate <- (#peek SDL_DisplayMode, refresh_rate) ptr + driverdata <- (#peek SDL_DisplayMode, driverdata) ptr + return $! DisplayMode format w h refresh_rate driverdata + poke ptr (DisplayMode format w h refresh_rate driverdata) = do + (#poke SDL_DisplayMode, format) ptr format + (#poke SDL_DisplayMode, w) ptr w + (#poke SDL_DisplayMode, h) ptr h + (#poke SDL_DisplayMode, refresh_rate) ptr refresh_rate + (#poke SDL_DisplayMode, driverdata) ptr driverdata + +data Event + = WindowEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , windowEventWindowID :: !Word32 + , windowEventEvent :: !Word8 + , windowEventData1 :: !Int32 + , windowEventData2 :: !Int32 + } + | KeyboardEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , keyboardEventWindowID :: !Word32 + , keyboardEventState :: !Word8 + , keyboardEventRepeat :: !Word8 + , keyboardEventKeysym :: !Keysym + } + | TextEditingEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , textEditingEventWindowID :: !Word32 + , textEditingEventText :: ![CChar] + , textEditingEventStart :: !Int32 + , textEditingEventLength :: !Int32 + } + | TextInputEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , textInputEventWindowID :: !Word32 + , textInputEventText :: ![CChar] + } + | MouseMotionEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , mouseMotionEventWindowID :: !Word32 + , mouseMotionEventWhich :: !Word32 + , mouseMotionEventState :: !Word32 + , mouseMotionEventX :: !Int32 + , mouseMotionEventY :: !Int32 + , mouseMotionEventXRel :: !Int32 + , mouseMotionEventYRel :: !Int32 + } + | MouseButtonEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , mouseButtonEventWindowID :: !Word32 + , mouseButtonEventWhich :: !Word32 + , mouseButtonEventButton :: !Word8 + , mouseButtonEventState :: !Word8 + , mouseButtonEventClicks :: !Word8 + , mouseButtonEventX :: !Int32 + , mouseButtonEventY :: !Int32 + } + | MouseWheelEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , mouseWheelEventWindowID :: !Word32 + , mouseWheelEventWhich :: !Word32 + , mouseWheelEventX :: !Int32 + , mouseWheelEventY :: !Int32 + } + | JoyAxisEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , joyAxisEventWhich :: !JoystickID + , joyAxisEventAxis :: !Word8 + , joyAxisEventValue :: !Int16 + } + | JoyBallEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , joyBallEventWhich :: !JoystickID + , joyBallEventBall :: !Word8 + , joyBallEventXRel :: !Int16 + , joyBallEventYRel :: !Int16 + } + | JoyHatEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , joyHatEventWhich :: !JoystickID + , joyHatEventHat :: !Word8 + , joyHatEventValue :: !Word8 + } + | JoyButtonEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , joyButtonEventWhich :: !JoystickID + , joyButtonEventButton :: !Word8 + , joyButtonEventState :: !Word8 + } + | JoyDeviceEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , joyDeviceEventWhich :: !Int32 + } + | ControllerAxisEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , controllerAxisEventWhich :: !JoystickID + , controllerAxisEventAxis :: !Word8 + , controllerAxisEventValue :: !Int16 + } + | ControllerButtonEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , controllerButtonEventWhich :: !JoystickID + , controllerButtonEventButton :: !Word8 + , controllerButtonEventState :: !Word8 + } + | ControllerDeviceEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , controllerDeviceEventWhich :: !Int32 + } + | QuitEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + } + | UserEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , userEventWindowID :: !Word32 + , userEventCode :: !Int32 + , userEventData1 :: !(Ptr ()) + , userEventData2 :: !(Ptr ()) + } + | SysWMEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , sysWMEventMsg :: !SysWMmsg + } + | TouchFingerEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , touchFingerEventTouchID :: !TouchID + , touchFingerEventFingerID :: !FingerID + , touchFingerEventX :: !CFloat + , touchFingerEventY :: !CFloat + , touchFingerEventDX :: !CFloat + , touchFingerEventDY :: !CFloat + , touchFingerEventPressure :: !CFloat + } + | MultiGestureEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , multiGestureEventTouchID :: !TouchID + , multiGestureEventDTheta :: !CFloat + , multiGestureEventDDist :: !CFloat + , multiGestureEventX :: !CFloat + , multiGestureEventY :: !CFloat + , multiGestureEventNumFingers :: !Word16 + } + | DollarGestureEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , dollarGestureEventTouchID :: !TouchID + , dollarGestureEventGestureID :: !GestureID + , dollarGestureEventNumFingers :: !Word32 + , dollarGestureEventError :: !CFloat + , dollarGestureEventX :: !CFloat + , dollarGestureEventY :: !CFloat + } + | DropEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + , dropEventFile :: !CString + } + | ClipboardUpdateEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + } + | UnknownEvent + { eventType :: !Word32 + , eventTimestamp :: !Word32 + } + deriving (Eq, Show, Typeable) + +instance Storable Event where + sizeOf _ = (#size SDL_Event) + alignment = sizeOf + peek ptr = do + typ <- (#peek SDL_Event, common.type) ptr + timestamp <- (#peek SDL_Event, common.timestamp) ptr + case typ of + (#const SDL_QUIT) -> + return $! QuitEvent typ timestamp + (#const SDL_WINDOWEVENT) -> do + wid <- (#peek SDL_Event, window.windowID) ptr + event <- (#peek SDL_Event, window.event) ptr + data1 <- (#peek SDL_Event, window.data1) ptr + data2 <- (#peek SDL_Event, window.data2) ptr + return $! WindowEvent typ timestamp wid event data1 data2 + (#const SDL_SYSWMEVENT) -> do + msg <- (#peek SDL_Event, syswm.msg) ptr + return $! SysWMEvent typ timestamp msg + (#const SDL_KEYDOWN) -> key $ KeyboardEvent typ timestamp + (#const SDL_KEYUP) -> key $ KeyboardEvent typ timestamp + (#const SDL_TEXTEDITING) -> do + wid <- (#peek SDL_Event, edit.windowID) ptr + text <- peekArray (#const SDL_TEXTEDITINGEVENT_TEXT_SIZE) $ (#ptr SDL_Event, edit.text) ptr + start <- (#peek SDL_Event, edit.start) ptr + len <- (#peek SDL_Event, edit.length) ptr + let upToNull = takeWhile (/= 0) text + return $! TextEditingEvent typ timestamp wid upToNull start len + (#const SDL_TEXTINPUT) -> do + wid <- (#peek SDL_Event, text.windowID) ptr + text <- peekArray (#const SDL_TEXTINPUTEVENT_TEXT_SIZE) $ (#ptr SDL_Event, text.text) ptr + let upToNull = takeWhile (/= 0) text + return $! TextInputEvent typ timestamp wid upToNull + (#const SDL_MOUSEMOTION) -> do + wid <- (#peek SDL_Event, motion.windowID) ptr + which <- (#peek SDL_Event, motion.which) ptr + state <- (#peek SDL_Event, motion.state) ptr + x <- (#peek SDL_Event, motion.x) ptr + y <- (#peek SDL_Event, motion.y) ptr + xrel <- (#peek SDL_Event, motion.xrel) ptr + yrel <- (#peek SDL_Event, motion.yrel) ptr + return $! MouseMotionEvent typ timestamp wid which state x y xrel yrel + (#const SDL_MOUSEBUTTONDOWN) -> mouse $ MouseButtonEvent typ timestamp + (#const SDL_MOUSEBUTTONUP) -> mouse $ MouseButtonEvent typ timestamp + (#const SDL_MOUSEWHEEL) -> do + wid <- (#peek SDL_Event, wheel.windowID) ptr + which <- (#peek SDL_Event, wheel.which) ptr + x <- (#peek SDL_Event, wheel.x) ptr + y <- (#peek SDL_Event, wheel.y) ptr + return $! MouseWheelEvent typ timestamp wid which x y + (#const SDL_JOYAXISMOTION) -> do + which <- (#peek SDL_Event, jaxis.which) ptr + axis <- (#peek SDL_Event, jaxis.axis) ptr + value <- (#peek SDL_Event, jaxis.value) ptr + return $! JoyAxisEvent typ timestamp which axis value + (#const SDL_JOYBALLMOTION) -> do + which <- (#peek SDL_Event, jball.which) ptr + ball <- (#peek SDL_Event, jball.ball) ptr + xrel <- (#peek SDL_Event, jball.xrel) ptr + yrel <- (#peek SDL_Event, jball.yrel) ptr + return $! JoyBallEvent typ timestamp which ball xrel yrel + (#const SDL_JOYHATMOTION) -> do + which <- (#peek SDL_Event, jhat.which) ptr + hat <- (#peek SDL_Event, jhat.hat) ptr + value <- (#peek SDL_Event, jhat.value) ptr + return $! JoyHatEvent typ timestamp which hat value + (#const SDL_JOYBUTTONDOWN) -> joybutton $ JoyButtonEvent typ timestamp + (#const SDL_JOYBUTTONUP) -> joybutton $ JoyButtonEvent typ timestamp + (#const SDL_JOYDEVICEADDED) -> joydevice $ JoyDeviceEvent typ timestamp + (#const SDL_JOYDEVICEREMOVED) -> joydevice $ JoyDeviceEvent typ timestamp + (#const SDL_CONTROLLERAXISMOTION) -> do + which <- (#peek SDL_Event, caxis.which) ptr + axis <- (#peek SDL_Event, caxis.axis) ptr + value <- (#peek SDL_Event, caxis.value) ptr + return $! ControllerButtonEvent typ timestamp which axis value + (#const SDL_CONTROLLERBUTTONDOWN) -> controllerbutton $ ControllerButtonEvent typ timestamp + (#const SDL_CONTROLLERBUTTONUP) -> controllerbutton $ ControllerButtonEvent typ timestamp + (#const SDL_CONTROLLERDEVICEADDED) -> controllerdevice $ ControllerDeviceEvent typ timestamp + (#const SDL_CONTROLLERDEVICEREMOVED) -> controllerdevice $ ControllerDeviceEvent typ timestamp + (#const SDL_CONTROLLERDEVICEREMAPPED) -> controllerdevice $ ControllerDeviceEvent typ timestamp + (#const SDL_FINGERDOWN) -> finger $ TouchFingerEvent typ timestamp + (#const SDL_FINGERUP) -> finger $ TouchFingerEvent typ timestamp + (#const SDL_FINGERMOTION) -> finger $ TouchFingerEvent typ timestamp + (#const SDL_DOLLARGESTURE) -> dollargesture $ DollarGestureEvent typ timestamp + (#const SDL_DOLLARRECORD) -> dollargesture $ DollarGestureEvent typ timestamp + (#const SDL_MULTIGESTURE) -> do + touchId <- (#peek SDL_Event, mgesture.touchId) ptr + dTheta <- (#peek SDL_Event, mgesture.dTheta) ptr + dDist <- (#peek SDL_Event, mgesture.dDist) ptr + x <- (#peek SDL_Event, mgesture.x) ptr + y <- (#peek SDL_Event, mgesture.y) ptr + numFingers <- (#peek SDL_Event, mgesture.numFingers) ptr + return $! MultiGestureEvent typ timestamp touchId dTheta dDist x y numFingers + (#const SDL_CLIPBOARDUPDATE) -> + return $! ClipboardUpdateEvent typ timestamp + (#const SDL_DROPFILE) -> do + file <- (#peek SDL_Event, drop.file) ptr + return $! DropEvent typ timestamp file + x | x >= (#const SDL_USEREVENT) -> do + wid <- (#peek SDL_Event, user.windowID) ptr + code <- (#peek SDL_Event, user.code) ptr + data1 <- (#peek SDL_Event, user.data1) ptr + data2 <- (#peek SDL_Event, user.data2) ptr + return $! UserEvent typ timestamp wid code data1 data2 + _ -> return $! UnknownEvent typ timestamp + where + key f = do + wid <- (#peek SDL_Event, key.windowID) ptr + state <- (#peek SDL_Event, key.state) ptr + repeat' <- (#peek SDL_Event, key.repeat) ptr + keysym <- (#peek SDL_Event, key.keysym) ptr + return $! f wid state repeat' keysym + + mouse f = do + wid <- (#peek SDL_Event, button.windowID) ptr + which <- (#peek SDL_Event, button.which) ptr + button <- (#peek SDL_Event, button.button) ptr + state <- (#peek SDL_Event, button.state) ptr + clicks <- (#peek SDL_Event, button.clicks) ptr + x <- (#peek SDL_Event, button.x) ptr + y <- (#peek SDL_Event, button.y) ptr + return $! f wid which button state clicks x y + + joybutton f = do + which <- (#peek SDL_Event, jbutton.which) ptr + button <- (#peek SDL_Event, jbutton.button) ptr + state <- (#peek SDL_Event, jbutton.state) ptr + return $! f which button state + + joydevice f = do + which <- (#peek SDL_Event, jdevice.which) ptr + return $! f which + + controllerbutton f = do + which <- (#peek SDL_Event, cbutton.which) ptr + button <- (#peek SDL_Event, cbutton.button) ptr + state <- (#peek SDL_Event, cbutton.state) ptr + return $! f which button state + + controllerdevice f = do + which <- (#peek SDL_Event, cdevice.which) ptr + return $! f which + + finger f = do + touchId <- (#peek SDL_Event, tfinger.touchId) ptr + fingerId <- (#peek SDL_Event, tfinger.fingerId) ptr + x <- (#peek SDL_Event, tfinger.x) ptr + y <- (#peek SDL_Event, tfinger.y) ptr + dx <- (#peek SDL_Event, tfinger.dx) ptr + dy <- (#peek SDL_Event, tfinger.dy) ptr + pressure <- (#peek SDL_Event, tfinger.pressure) ptr + return $! f touchId fingerId x y dx dy pressure + + dollargesture f = do + touchId <- (#peek SDL_Event, dgesture.touchId) ptr + gestureId <- (#peek SDL_Event, dgesture.gestureId) ptr + numFingers <- (#peek SDL_Event, dgesture.numFingers) ptr + err <- (#peek SDL_Event, dgesture.error) ptr + x <- (#peek SDL_Event, dgesture.x) ptr + y <- (#peek SDL_Event, dgesture.y) ptr + return $! f touchId gestureId numFingers err x y + poke ptr ev = case ev of + WindowEvent typ timestamp wid event data1 data2 -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, window.windowID) ptr wid + (#poke SDL_Event, window.event) ptr event + (#poke SDL_Event, window.data1) ptr data1 + (#poke SDL_Event, window.data2) ptr data2 + KeyboardEvent typ timestamp wid state repeat' keysym -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, key.windowID) ptr wid + (#poke SDL_Event, key.state) ptr state + (#poke SDL_Event, key.repeat) ptr repeat' + (#poke SDL_Event, key.keysym) ptr keysym + TextEditingEvent typ timestamp wid text start len -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, edit.windowID) ptr wid + pokeArray ((#ptr SDL_Event, edit.text) ptr) text + (#poke SDL_Event, edit.start) ptr start + (#poke SDL_Event, edit.length) ptr len + TextInputEvent typ timestamp wid text -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, text.windowID) ptr wid + pokeArray ((#ptr SDL_Event, text.text) ptr) text + MouseMotionEvent typ timestamp wid which state x y xrel yrel -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, motion.windowID) ptr wid + (#poke SDL_Event, motion.which) ptr which + (#poke SDL_Event, motion.state) ptr state + (#poke SDL_Event, motion.x) ptr x + (#poke SDL_Event, motion.y) ptr y + (#poke SDL_Event, motion.xrel) ptr xrel + (#poke SDL_Event, motion.yrel) ptr yrel + MouseButtonEvent typ timestamp wid which button state clicks x y -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, button.windowID) ptr wid + (#poke SDL_Event, button.which) ptr which + (#poke SDL_Event, button.button) ptr button + (#poke SDL_Event, button.state) ptr state + (#poke SDL_Event, button.clicks) ptr clicks + (#poke SDL_Event, button.x) ptr x + (#poke SDL_Event, button.y) ptr y + MouseWheelEvent typ timestamp wid which x y -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, wheel.windowID) ptr wid + (#poke SDL_Event, wheel.which) ptr which + (#poke SDL_Event, wheel.x) ptr x + (#poke SDL_Event, wheel.y) ptr y + JoyAxisEvent typ timestamp which axis value -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, jaxis.which) ptr which + (#poke SDL_Event, jaxis.axis) ptr axis + (#poke SDL_Event, jaxis.value) ptr value + JoyBallEvent typ timestamp which ball xrel yrel -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, jball.which) ptr which + (#poke SDL_Event, jball.ball) ptr ball + (#poke SDL_Event, jball.xrel) ptr xrel + (#poke SDL_Event, jball.yrel) ptr yrel + JoyHatEvent typ timestamp which hat value -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, jhat.which) ptr which + (#poke SDL_Event, jhat.hat) ptr hat + (#poke SDL_Event, jhat.value) ptr value + JoyButtonEvent typ timestamp which button state -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, jbutton.which) ptr which + (#poke SDL_Event, jbutton.button) ptr button + (#poke SDL_Event, jbutton.state) ptr state + JoyDeviceEvent typ timestamp which -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, jdevice.which) ptr which + ControllerAxisEvent typ timestamp which axis value -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, caxis.which) ptr which + (#poke SDL_Event, caxis.axis) ptr axis + (#poke SDL_Event, caxis.value) ptr value + ControllerButtonEvent typ timestamp which button state -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, cbutton.which) ptr which + (#poke SDL_Event, cbutton.button) ptr button + (#poke SDL_Event, cbutton.state) ptr state + ControllerDeviceEvent typ timestamp which -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, cdevice.which) ptr which + QuitEvent typ timestamp -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + UserEvent typ timestamp wid code data1 data2 -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, user.windowID) ptr wid + (#poke SDL_Event, user.code) ptr code + (#poke SDL_Event, user.data1) ptr data1 + (#poke SDL_Event, user.data2) ptr data2 + SysWMEvent typ timestamp msg -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, syswm.msg) ptr msg + TouchFingerEvent typ timestamp touchid fingerid x y dx dy pressure -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, tfinger.touchId) ptr touchid + (#poke SDL_Event, tfinger.fingerId) ptr fingerid + (#poke SDL_Event, tfinger.x) ptr x + (#poke SDL_Event, tfinger.y) ptr y + (#poke SDL_Event, tfinger.dx) ptr dx + (#poke SDL_Event, tfinger.dy) ptr dy + (#poke SDL_Event, tfinger.pressure) ptr pressure + MultiGestureEvent typ timestamp touchid dtheta ddist x y numfingers -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, mgesture.touchId) ptr touchid + (#poke SDL_Event, mgesture.dTheta) ptr dtheta + (#poke SDL_Event, mgesture.dDist) ptr ddist + (#poke SDL_Event, mgesture.x) ptr x + (#poke SDL_Event, mgesture.y) ptr y + (#poke SDL_Event, mgesture.numFingers) ptr numfingers + DollarGestureEvent typ timestamp touchid gestureid numfingers err x y -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, dgesture.touchId) ptr touchid + (#poke SDL_Event, dgesture.gestureId) ptr gestureid + (#poke SDL_Event, dgesture.numFingers) ptr numfingers + (#poke SDL_Event, dgesture.error) ptr err + (#poke SDL_Event, dgesture.x) ptr x + (#poke SDL_Event, dgesture.y) ptr y + ClipboardUpdateEvent typ timestamp -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + DropEvent typ timestamp file -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + (#poke SDL_Event, drop.file) ptr file + UnknownEvent typ timestamp -> do + (#poke SDL_Event, common.type) ptr typ + (#poke SDL_Event, common.timestamp) ptr timestamp + +data Finger = Finger + { fingerID :: !FingerID + , fingerX :: !CFloat + , fingerY :: !CFloat + , fingerPressure :: !CFloat + } deriving (Eq, Show, Typeable) + +instance Storable Finger where + sizeOf _ = (#size SDL_Finger) + alignment = sizeOf + peek ptr = do + fingerId <- (#peek SDL_Finger, id) ptr + x <- (#peek SDL_Finger, x) ptr + y <- (#peek SDL_Finger, y) ptr + pressure <- (#peek SDL_Finger, pressure) ptr + return $! Finger fingerId x y pressure + poke ptr (Finger fingerId x y pressure) = do + (#poke SDL_Finger, id) ptr fingerId + (#poke SDL_Finger, x) ptr x + (#poke SDL_Finger, y) ptr y + (#poke SDL_Finger, pressure) ptr pressure + +data GameControllerButtonBind + = GameControllerButtonBindNone + | GameControllerButtonBindButton + { gameControllerButtonBindButton :: !CInt + } + | GameControllerButtonBindAxis + { gameControllerButtonBindAxis :: !CInt + } + | GameControllerButtonBindHat + { gameControllerButtonBindHat :: !CInt + , gameControllerButtonBindHatMask :: !CInt + } + deriving (Eq, Show, Typeable) + +instance Storable GameControllerButtonBind where + sizeOf _ = (#size SDL_GameControllerButtonBind) + alignment = sizeOf + peek ptr = do + bind_type <- (#peek SDL_GameControllerButtonBind, bindType) ptr + case bind_type :: (#type SDL_GameControllerBindType) of + (#const SDL_CONTROLLER_BINDTYPE_NONE) -> do + return $! GameControllerButtonBindNone + (#const SDL_CONTROLLER_BINDTYPE_BUTTON) -> do + button <- (#peek SDL_GameControllerButtonBind, value.button) ptr + return $! GameControllerButtonBindButton button + (#const SDL_CONTROLLER_BINDTYPE_AXIS) -> do + axis <- (#peek SDL_GameControllerButtonBind, value.axis) ptr + return $! GameControllerButtonBindAxis axis + (#const SDL_CONTROLLER_BINDTYPE_HAT) -> do + hat <- (#peek SDL_GameControllerButtonBind, value.hat.hat) ptr + hat_mask <- (#peek SDL_GameControllerButtonBind, value.hat.hat_mask) ptr + return $! GameControllerButtonBindHat hat hat_mask + _ -> error $ "Unknown type " ++ show bind_type ++ " for SDL_GameControllerButtonBind" + poke ptr bind = case bind of + GameControllerButtonBindNone -> do + (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_NONE) :: (#type SDL_GameControllerBindType)) + GameControllerButtonBindButton button -> do + (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_BUTTON) :: (#type SDL_GameControllerBindType)) + (#poke SDL_GameControllerButtonBind, value.button) ptr button + GameControllerButtonBindAxis axis -> do + (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_AXIS) :: (#type SDL_GameControllerBindType)) + (#poke SDL_GameControllerButtonBind, value.axis) ptr axis + GameControllerButtonBindHat hat hat_mask -> do + (#poke SDL_GameControllerButtonBind, bindType) ptr ((#const SDL_CONTROLLER_BINDTYPE_HAT) :: (#type SDL_GameControllerBindType)) + (#poke SDL_GameControllerButtonBind, value.hat.hat) ptr hat + (#poke SDL_GameControllerButtonBind, value.hat.hat_mask) ptr hat_mask + +data HapticDirection = HapticDirection + { hapticDirectionType :: !Word8 + , hapticDirectionX :: !Int32 + , hapticDirectionY :: !Int32 + , hapticDirectionZ :: !Int32 + } deriving (Eq, Show, Typeable) + +instance Storable HapticDirection where + sizeOf _ = (#size SDL_HapticDirection) + alignment = sizeOf + peek ptr = do + typ <- (#peek SDL_HapticDirection, type) ptr + x <- (#peek SDL_HapticDirection, dir[0]) ptr + y <- (#peek SDL_HapticDirection, dir[1]) ptr + z <- (#peek SDL_HapticDirection, dir[2]) ptr + return $! HapticDirection typ x y z + poke ptr (HapticDirection typ x y z) = do + (#poke SDL_HapticDirection, type) ptr typ + (#poke SDL_HapticDirection, dir[0]) ptr x + (#poke SDL_HapticDirection, dir[1]) ptr y + (#poke SDL_HapticDirection, dir[2]) ptr z + +data HapticEffect + = HapticConstant + { hapticEffectType :: !Word16 + , hapticConstantDirection :: !HapticDirection + , hapticConstantLength :: !Word32 + , hapticConstantDelay :: !Word16 + , hapticConstantButton :: !Word16 + , hapticConstantInterval :: !Word16 + , hapticConstantLevel :: !Int16 + , hapticConstantAttackLength :: !Word16 + , hapticConstantAttackLevel :: !Word16 + , hapticConstantFadeLength :: !Word16 + , hapticConstantFadeLevel :: !Word16 + } + | HapticPeriodic + { hapticEffectType :: !Word16 + , hapticPeriodicDirection :: !HapticDirection + , hapticPeriodicLength :: !Word32 + , hapticPeriodicDelay :: !Word16 + , hapticPeriodicButton :: !Word16 + , hapticPeriodicInterval :: !Word16 + , hapticPeriodicPeriod :: !Word16 + , hapticPeriodicMagnitude :: !Int16 + , hapticPeriodicOffset :: !Int16 + , hapticPeriodicPhase :: !Word16 + , hapticPeriodicAttackLength :: !Word16 + , hapticPeriodicAttackLevel :: !Word16 + , hapticPeriodicFadeLength :: !Word16 + , hapticPeriodicFadeLevel :: !Word16 + } + | HapticCondition + { hapticEffectType :: !Word16 + , hapticConditionLength :: !Word32 + , hapticConditionDelay :: !Word16 + , hapticConditionButton :: !Word16 + , hapticConditionInterval :: !Word16 + , hapticConditionRightSat :: ![Word16] + , hapticConditionLeftSat :: ![Word16] + , hapticConditionRightCoeff :: ![Int16] + , hapticConditionLeftCoeff :: ![Int16] + , hapticConditionDeadband :: ![Word16] + , hapticConditionCenter :: ![Int16] + } + | HapticRamp + { hapticEffectType :: !Word16 + , hapticRampDirection :: !HapticDirection + , hapticRampLength :: !Word32 + , hapticRampDelay :: !Word16 + , hapticRampButton :: !Word16 + , hapticRampInterval :: !Word16 + , hapticRampStart :: !Int16 + , hapticRampEnd :: !Int16 + , hapticRampAttackLength :: !Word16 + , hapticRampAttackLevel :: !Word16 + , hapticRampFadeLength :: !Word16 + , hapticRampFadeLevel :: !Word16 + } + | HapticLeftRight + { hapticEffectType :: !Word16 + , hapticLeftRightLength :: !Word32 + , hapticLeftRightLargeMagnitude :: !Word16 + , hapticLeftRightSmallMagnitude :: !Word16 + } + | HapticCustom + { hapticEffectType :: !Word16 + , hapticCustomDirection :: !HapticDirection + , hapticCustomLength :: !Word32 + , hapticCustomDelay :: !Word16 + , hapticCustomButton :: !Word16 + , hapticCustomInterval :: !Word16 + , hapticCustomChannels :: !Word8 + , hapticCustomPeriod :: !Word16 + , hapticCustomSamples :: !Word16 + , hapticCustomData :: !(Ptr Word16) + , hapticCustomAttackLength :: !Word16 + , hapticCustomAttackLevel :: !Word16 + , hapticCustomFadeLength :: !Word16 + , hapticCustomFadeLevel :: !Word16 + } + deriving (Eq, Show, Typeable) + +instance Storable HapticEffect where + sizeOf _ = (#size SDL_HapticEffect) + alignment = sizeOf + peek ptr = do + typ <- (#peek SDL_HapticEffect, type) ptr + case typ of + (#const SDL_HAPTIC_CONSTANT) -> do + direction <- (#peek SDL_HapticEffect, constant.direction) ptr + len <- (#peek SDL_HapticEffect, constant.length) ptr + delay <- (#peek SDL_HapticEffect, constant.delay) ptr + button <- (#peek SDL_HapticEffect, constant.button) ptr + interval <- (#peek SDL_HapticEffect, constant.interval) ptr + level <- (#peek SDL_HapticEffect, constant.level) ptr + attack_length <- (#peek SDL_HapticEffect, constant.attack_length) ptr + attack_level <- (#peek SDL_HapticEffect, constant.attack_level) ptr + fade_length <- (#peek SDL_HapticEffect, constant.fade_length) ptr + fade_level <- (#peek SDL_HapticEffect, constant.fade_level) ptr + return $! HapticConstant typ direction len delay button interval level attack_length attack_level fade_length fade_level + + (#const SDL_HAPTIC_SINE) -> hapticperiodic $ HapticPeriodic typ + (#const SDL_HAPTIC_TRIANGLE) -> hapticperiodic $ HapticPeriodic typ + (#const SDL_HAPTIC_SAWTOOTHUP) -> hapticperiodic $ HapticPeriodic typ + (#const SDL_HAPTIC_SAWTOOTHDOWN) -> hapticperiodic $ HapticPeriodic typ + + (#const SDL_HAPTIC_RAMP) -> do + direction <- (#peek SDL_HapticEffect, ramp.direction) ptr + len <- (#peek SDL_HapticEffect, ramp.length) ptr + delay <- (#peek SDL_HapticEffect, ramp.delay) ptr + button <- (#peek SDL_HapticEffect, ramp.button) ptr + interval <- (#peek SDL_HapticEffect, ramp.interval) ptr + start <- (#peek SDL_HapticEffect, ramp.start) ptr + end <- (#peek SDL_HapticEffect, ramp.end) ptr + attack_length <- (#peek SDL_HapticEffect, ramp.attack_length) ptr + attack_level <- (#peek SDL_HapticEffect, ramp.attack_level) ptr + fade_length <- (#peek SDL_HapticEffect, ramp.fade_length) ptr + fade_level <- (#peek SDL_HapticEffect, ramp.fade_level) ptr + return $! HapticRamp typ direction len delay button interval start end attack_length attack_level fade_length fade_level + + (#const SDL_HAPTIC_SPRING) -> hapticcondition $ HapticCondition typ + (#const SDL_HAPTIC_DAMPER) -> hapticcondition $ HapticCondition typ + (#const SDL_HAPTIC_INERTIA) -> hapticcondition $ HapticCondition typ + (#const SDL_HAPTIC_FRICTION) -> hapticcondition $ HapticCondition typ + + (#const SDL_HAPTIC_LEFTRIGHT) -> do + len <- (#peek SDL_HapticEffect, leftright.length) ptr + large_magnitude <- (#peek SDL_HapticEffect, leftright.large_magnitude) ptr + small_magnitude <- (#peek SDL_HapticEffect, leftright.small_magnitude) ptr + return $! HapticLeftRight typ len large_magnitude small_magnitude + + (#const SDL_HAPTIC_CUSTOM) -> do + direction <- (#peek SDL_HapticEffect, custom.direction) ptr + len <- (#peek SDL_HapticEffect, custom.length) ptr + delay <- (#peek SDL_HapticEffect, custom.delay) ptr + button <- (#peek SDL_HapticEffect, custom.button) ptr + interval <- (#peek SDL_HapticEffect, custom.interval) ptr + channels <- (#peek SDL_HapticEffect, custom.channels) ptr + period <- (#peek SDL_HapticEffect, custom.period) ptr + samples <- (#peek SDL_HapticEffect, custom.samples) ptr + datum <- (#peek SDL_HapticEffect, custom.data) ptr + attack_length <- (#peek SDL_HapticEffect, custom.attack_length) ptr + attack_level <- (#peek SDL_HapticEffect, custom.attack_level) ptr + fade_length <- (#peek SDL_HapticEffect, custom.fade_length) ptr + fade_level <- (#peek SDL_HapticEffect, custom.fade_level) ptr + return $! HapticCustom typ direction len delay button interval channels period samples datum attack_length attack_level fade_length fade_level + _ -> error $ "Unknown type " ++ show typ ++ " for SDL_HapticEffect" + where + hapticperiodic f = do + direction <- (#peek SDL_HapticEffect, periodic.direction) ptr + len <- (#peek SDL_HapticEffect, periodic.length) ptr + delay <- (#peek SDL_HapticEffect, periodic.delay) ptr + button <- (#peek SDL_HapticEffect, periodic.button) ptr + interval <- (#peek SDL_HapticEffect, periodic.interval) ptr + period <- (#peek SDL_HapticEffect, periodic.period) ptr + magnitude <- (#peek SDL_HapticEffect, periodic.magnitude) ptr + offset <- (#peek SDL_HapticEffect, periodic.offset) ptr + phase <- (#peek SDL_HapticEffect, periodic.phase) ptr + attack_length <- (#peek SDL_HapticEffect, periodic.attack_length) ptr + attack_level <- (#peek SDL_HapticEffect, periodic.attack_level) ptr + fade_length <- (#peek SDL_HapticEffect, periodic.fade_length) ptr + fade_level <- (#peek SDL_HapticEffect, periodic.fade_level) ptr + return $! f direction len delay button interval period magnitude offset phase attack_length attack_level fade_length fade_level + + hapticcondition f = do + len <- (#peek SDL_HapticEffect, condition.length) ptr + delay <- (#peek SDL_HapticEffect, condition.delay) ptr + button <- (#peek SDL_HapticEffect, condition.button) ptr + interval <- (#peek SDL_HapticEffect, condition.interval) ptr + right_sat <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.right_sat) ptr + left_sat <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.left_sat) ptr + right_coeff <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.right_coeff) ptr + left_coeff <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.left_coeff) ptr + deadband <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.deadband) ptr + center <- peekArray 3 $ (#ptr SDL_HapticEffect, condition.center) ptr + return $! f len delay button interval right_sat left_sat right_coeff left_coeff deadband center + poke ptr event = case event of + HapticConstant typ direction len delay button interval level attack_length attack_level fade_length fade_level -> do + (#poke SDL_HapticEffect, type) ptr typ + (#poke SDL_HapticEffect, constant.direction) ptr direction + (#poke SDL_HapticEffect, constant.length) ptr len + (#poke SDL_HapticEffect, constant.delay) ptr delay + (#poke SDL_HapticEffect, constant.button) ptr button + (#poke SDL_HapticEffect, constant.interval) ptr interval + (#poke SDL_HapticEffect, constant.level) ptr level + (#poke SDL_HapticEffect, constant.attack_length) ptr attack_length + (#poke SDL_HapticEffect, constant.attack_level) ptr attack_level + (#poke SDL_HapticEffect, constant.fade_length) ptr fade_length + (#poke SDL_HapticEffect, constant.fade_level) ptr fade_level + HapticPeriodic typ direction len delay button interval period magnitude offset phase attack_length attack_level fade_length fade_level -> do + (#poke SDL_HapticEffect, type) ptr typ + (#poke SDL_HapticEffect, periodic.direction) ptr direction + (#poke SDL_HapticEffect, periodic.length) ptr len + (#poke SDL_HapticEffect, periodic.delay) ptr delay + (#poke SDL_HapticEffect, periodic.button) ptr button + (#poke SDL_HapticEffect, periodic.interval) ptr interval + (#poke SDL_HapticEffect, periodic.period) ptr period + (#poke SDL_HapticEffect, periodic.magnitude) ptr magnitude + (#poke SDL_HapticEffect, periodic.offset) ptr offset + (#poke SDL_HapticEffect, periodic.phase) ptr phase + (#poke SDL_HapticEffect, periodic.attack_length) ptr attack_length + (#poke SDL_HapticEffect, periodic.attack_level) ptr attack_level + (#poke SDL_HapticEffect, periodic.fade_length) ptr fade_length + (#poke SDL_HapticEffect, periodic.fade_level) ptr fade_level + HapticCondition typ len delay button interval right_sat left_sat right_coeff left_coeff deadband center -> do + (#poke SDL_HapticEffect, type) ptr typ + (#poke SDL_HapticEffect, condition.length) ptr len + (#poke SDL_HapticEffect, condition.delay) ptr delay + (#poke SDL_HapticEffect, condition.button) ptr button + (#poke SDL_HapticEffect, condition.interval) ptr interval + pokeArray ((#ptr SDL_HapticEffect, condition.right_sat) ptr) right_sat + pokeArray ((#ptr SDL_HapticEffect, condition.left_sat) ptr) left_sat + pokeArray ((#ptr SDL_HapticEffect, condition.right_coeff) ptr) right_coeff + pokeArray ((#ptr SDL_HapticEffect, condition.left_coeff) ptr) left_coeff + pokeArray ((#ptr SDL_HapticEffect, condition.deadband) ptr) deadband + pokeArray ((#ptr SDL_HapticEffect, condition.center) ptr) center + HapticRamp typ direction len delay button interval start end attack_length attack_level fade_length fade_level -> do + (#poke SDL_HapticEffect, type) ptr typ + (#poke SDL_HapticEffect, ramp.direction) ptr direction + (#poke SDL_HapticEffect, ramp.length) ptr len + (#poke SDL_HapticEffect, ramp.delay) ptr delay + (#poke SDL_HapticEffect, ramp.button) ptr button + (#poke SDL_HapticEffect, ramp.interval) ptr interval + (#poke SDL_HapticEffect, ramp.start) ptr start + (#poke SDL_HapticEffect, ramp.end) ptr end + (#poke SDL_HapticEffect, ramp.attack_length) ptr attack_length + (#poke SDL_HapticEffect, ramp.attack_level) ptr attack_level + (#poke SDL_HapticEffect, ramp.fade_length) ptr fade_length + (#poke SDL_HapticEffect, ramp.fade_level) ptr fade_level + HapticLeftRight typ len large_magnitude small_magnitude -> do + (#poke SDL_HapticEffect, type) ptr typ + (#poke SDL_HapticEffect, leftright.length) ptr len + (#poke SDL_HapticEffect, leftright.large_magnitude) ptr large_magnitude + (#poke SDL_HapticEffect, leftright.small_magnitude) ptr small_magnitude + HapticCustom typ direction len delay button interval channels period samples datum attack_length attack_level fade_length fade_level -> do + (#poke SDL_HapticEffect, type) ptr typ + (#poke SDL_HapticEffect, custom.direction) ptr direction + (#poke SDL_HapticEffect, custom.length) ptr len + (#poke SDL_HapticEffect, custom.delay) ptr delay + (#poke SDL_HapticEffect, custom.button) ptr button + (#poke SDL_HapticEffect, custom.interval) ptr interval + (#poke SDL_HapticEffect, custom.channels) ptr channels + (#poke SDL_HapticEffect, custom.period) ptr period + (#poke SDL_HapticEffect, custom.samples) ptr samples + (#poke SDL_HapticEffect, custom.data) ptr datum + (#poke SDL_HapticEffect, custom.attack_length) ptr attack_length + (#poke SDL_HapticEffect, custom.attack_level) ptr attack_level + (#poke SDL_HapticEffect, custom.fade_length) ptr fade_length + (#poke SDL_HapticEffect, custom.fade_level) ptr fade_level + +data JoystickGUID = JoystickGUID + { joystickGUID :: ![Word8] + } deriving (Eq, Show, Typeable) + +instance Storable JoystickGUID where + sizeOf _ = (#size SDL_JoystickGUID) + alignment = sizeOf + peek ptr = do + guid <- peekArray 16 $ (#ptr SDL_JoystickGUID, data) ptr + return $! JoystickGUID guid + poke ptr (JoystickGUID guid) = + pokeArray ((#ptr SDL_JoystickGUID, data) ptr) guid + +data Keysym = Keysym + { keysymScancode :: !Scancode + , keysymKeycode :: !Keycode + , keysymMod :: !Word16 + } deriving (Eq, Show, Typeable) + +instance Storable Keysym where + sizeOf _ = (#size SDL_Keysym) + alignment = sizeOf + peek ptr = do + scancode <- (#peek SDL_Keysym, scancode) ptr + sym <- (#peek SDL_Keysym, sym) ptr + mod' <- (#peek SDL_Keysym, mod) ptr + return $! Keysym scancode sym mod' + poke ptr (Keysym scancode sym mod') = do + (#poke SDL_Keysym, scancode) ptr scancode + (#poke SDL_Keysym, sym) ptr sym + (#poke SDL_Keysym, mod) ptr mod' + +data MessageBoxButtonData = MessageBoxButtonData + { messageBoxButtonDataFlags :: !Word32 + , messageBoxButtonButtonID :: !CInt + , messageBoxButtonText :: !CString + } deriving (Eq, Show, Typeable) + +instance Storable MessageBoxButtonData where + sizeOf _ = (#size SDL_MessageBoxButtonData) + alignment = sizeOf + peek ptr = do + flags <- (#peek SDL_MessageBoxButtonData, flags) ptr + buttonid <- (#peek SDL_MessageBoxButtonData, buttonid) ptr + text <- (#peek SDL_MessageBoxButtonData, text) ptr + return $! MessageBoxButtonData flags buttonid text + poke ptr (MessageBoxButtonData flags buttonid text) = do + (#poke SDL_MessageBoxButtonData, flags) ptr flags + (#poke SDL_MessageBoxButtonData, buttonid) ptr buttonid + (#poke SDL_MessageBoxButtonData, text) ptr text + +data MessageBoxColor = MessageBoxColor + { messageBoxColorR :: !Word8 + , messageBoxColorG :: !Word8 + , messageBoxColorB :: !Word8 + } deriving (Eq, Show, Typeable) + +instance Storable MessageBoxColor where + sizeOf _ = (#size SDL_MessageBoxColor) + alignment = sizeOf + peek ptr = do + r <- (#peek SDL_MessageBoxColor, r) ptr + g <- (#peek SDL_MessageBoxColor, g) ptr + b <- (#peek SDL_MessageBoxColor, b) ptr + return $! MessageBoxColor r g b + poke ptr (MessageBoxColor r g b) = do + (#poke SDL_MessageBoxColor, r) ptr r + (#poke SDL_MessageBoxColor, g) ptr g + (#poke SDL_MessageBoxColor, b) ptr b + +data MessageBoxColorScheme = MessageBoxColorScheme + { messageBoxColorSchemeColorBackground :: !MessageBoxColor + , messageBoxColorSchemeColorText :: !MessageBoxColor + , messageBoxColorSchemeColorButtonBorder :: !MessageBoxColor + , messageBoxColorSchemeColorButtonBackground :: !MessageBoxColor + , messageBoxColorSchemeColorButtonSelected :: !MessageBoxColor + } deriving (Eq, Show, Typeable) + +instance Storable MessageBoxColorScheme where + sizeOf _ = (#size SDL_MessageBoxColorScheme) + alignment = sizeOf + peek ptr = do + background <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BACKGROUND]) ptr + text <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_TEXT]) ptr + button_border <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BORDER]) ptr + button_background <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BACKGROUND]) ptr + button_selected <- (#peek SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_SELECTED]) ptr + return $! MessageBoxColorScheme background text button_border button_background button_selected + poke ptr (MessageBoxColorScheme background text button_border button_background button_selected) = do + (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BACKGROUND]) ptr background + (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_TEXT]) ptr text + (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BORDER]) ptr button_border + (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_BACKGROUND]) ptr button_background + (#poke SDL_MessageBoxColorScheme, colors[SDL_MESSAGEBOX_COLOR_BUTTON_SELECTED]) ptr button_selected + +data MessageBoxData = MessageBoxData + { messageBoxDataFlags :: !Word32 + , messageBoxDataWindow :: !Window + , messageBoxDataTitle :: !CString + , messageBoxDataMessage :: !CString + , messageBoxDataNumButtons :: !CInt + , messageBoxDataButtons :: !(Ptr MessageBoxButtonData) + , messageBoxDataColorScheme :: !(Ptr MessageBoxColorScheme) + } deriving (Eq, Show, Typeable) + +instance Storable MessageBoxData where + sizeOf _ = (#size SDL_MessageBoxData) + alignment = sizeOf + peek ptr = do + flags <- (#peek SDL_MessageBoxData, flags) ptr + window <- (#peek SDL_MessageBoxData, window) ptr + title <- (#peek SDL_MessageBoxData, title) ptr + message <- (#peek SDL_MessageBoxData, message) ptr + numbuttons <- (#peek SDL_MessageBoxData, numbuttons) ptr + buttons <- (#peek SDL_MessageBoxData, buttons) ptr + color_scheme <- (#peek SDL_MessageBoxData, colorScheme) ptr + return $! MessageBoxData flags window title message numbuttons buttons color_scheme + poke ptr (MessageBoxData flags window title message numbuttons buttons color_scheme) = do + (#poke SDL_MessageBoxData, flags) ptr flags + (#poke SDL_MessageBoxData, window) ptr window + (#poke SDL_MessageBoxData, title) ptr title + (#poke SDL_MessageBoxData, message) ptr message + (#poke SDL_MessageBoxData, numbuttons) ptr numbuttons + (#poke SDL_MessageBoxData, buttons) ptr buttons + (#poke SDL_MessageBoxData, colorScheme) ptr color_scheme + +data Palette = Palette + { paletteNColors :: !CInt + , paletteColors :: !(Ptr Color) + } deriving (Eq, Show, Typeable) + +instance Storable Palette where + sizeOf _ = (#size SDL_Palette) + alignment = sizeOf + peek ptr = do + ncolors <- (#peek SDL_Palette, ncolors) ptr + colors <- (#peek SDL_Palette, colors) ptr + return $! Palette ncolors colors + poke ptr (Palette ncolors colors) = do + (#poke SDL_Palette, ncolors) ptr ncolors + (#poke SDL_Palette, colors) ptr colors + +data PixelFormat = PixelFormat + { pixelFormatFormat :: !Word32 + , pixelFormatPalette :: !(Ptr Palette) + , pixelFormatBitsPerPixel :: !Word8 + , pixelFormatBytesPerPixel :: !Word8 + , pixelFormatRMask :: !Word32 + , pixelFormatGMask :: !Word32 + , pixelFormatBMask :: !Word32 + , pixelFormatAMask :: !Word32 + } deriving (Eq, Show, Typeable) + +instance Storable PixelFormat where + sizeOf _ = (#size SDL_PixelFormat) + alignment = sizeOf + peek ptr = do + format <- (#peek SDL_PixelFormat, format) ptr + palette <- (#peek SDL_PixelFormat, palette) ptr + bits_per_pixel <- (#peek SDL_PixelFormat, BitsPerPixel) ptr + bytes_per_pixel <- (#peek SDL_PixelFormat, BytesPerPixel) ptr + rmask <- (#peek SDL_PixelFormat, Rmask) ptr + gmask <- (#peek SDL_PixelFormat, Gmask) ptr + bmask <- (#peek SDL_PixelFormat, Bmask) ptr + amask <- (#peek SDL_PixelFormat, Amask) ptr + return $! PixelFormat format palette bits_per_pixel bytes_per_pixel rmask gmask bmask amask + poke ptr (PixelFormat format palette bits_per_pixel bytes_per_pixel rmask gmask bmask amask) = do + (#poke SDL_PixelFormat, format) ptr format + (#poke SDL_PixelFormat, palette) ptr palette + (#poke SDL_PixelFormat, BitsPerPixel) ptr bits_per_pixel + (#poke SDL_PixelFormat, BytesPerPixel) ptr bytes_per_pixel + (#poke SDL_PixelFormat, Rmask) ptr rmask + (#poke SDL_PixelFormat, Gmask) ptr gmask + (#poke SDL_PixelFormat, Bmask) ptr bmask + (#poke SDL_PixelFormat, Amask) ptr amask + +data Point = Point + { pointX :: !CInt + , pointY :: !CInt + } deriving (Eq, Show, Typeable) + +instance Storable Point where + sizeOf _ = (#size SDL_Point) + alignment = sizeOf + peek ptr = do + x <- (#peek SDL_Point, x) ptr + y <- (#peek SDL_Point, y) ptr + return $! Point x y + poke ptr (Point x y) = do + (#poke SDL_Point, x) ptr x + (#poke SDL_Point, y) ptr y + +data Rect = Rect + { rectX :: !CInt + , rectY :: !CInt + , rectW :: !CInt + , rectH :: !CInt + } deriving (Eq, Show, Typeable) + +instance Storable Rect where + sizeOf _ = (#size SDL_Rect) + alignment = sizeOf + peek ptr = do + x <- (#peek SDL_Rect, x) ptr + y <- (#peek SDL_Rect, y) ptr + w <- (#peek SDL_Rect, w) ptr + h <- (#peek SDL_Rect, h) ptr + return $! Rect x y w h + poke ptr (Rect x y w h) = do + (#poke SDL_Rect, x) ptr x + (#poke SDL_Rect, y) ptr y + (#poke SDL_Rect, w) ptr w + (#poke SDL_Rect, h) ptr h + +data RendererInfo = RendererInfo + { rendererInfoName :: !CString + , rendererInfoFlags :: !Word32 + , rendererInfoNumTextureFormats :: !Word32 + , rendererInfoTextureFormats :: ![Word32] + , rendererInfoMaxTextureWidth :: !CInt + , rendererInfoMaxTextureHeight :: !CInt + } deriving (Eq, Show, Typeable) + +instance Storable RendererInfo where + sizeOf _ = (#size SDL_RendererInfo) + alignment = sizeOf + peek ptr = do + name <- (#peek SDL_RendererInfo, name) ptr + flags <- (#peek SDL_RendererInfo, flags) ptr + num_texture_formats <- (#peek SDL_RendererInfo, num_texture_formats) ptr + texture_formats <- peekArray 16 $ (#ptr SDL_RendererInfo, texture_formats) ptr + max_texture_width <- (#peek SDL_RendererInfo, max_texture_width) ptr + max_texture_height <- (#peek SDL_RendererInfo, max_texture_height) ptr + return $! RendererInfo name flags num_texture_formats texture_formats max_texture_width max_texture_height + poke ptr (RendererInfo name flags num_texture_formats texture_formats max_texture_width max_texture_height) = do + (#poke SDL_RendererInfo, name) ptr name + (#poke SDL_RendererInfo, flags) ptr flags + (#poke SDL_RendererInfo, num_texture_formats) ptr num_texture_formats + pokeArray ((#ptr SDL_RendererInfo, texture_formats) ptr) texture_formats + (#poke SDL_RendererInfo, max_texture_width) ptr max_texture_width + (#poke SDL_RendererInfo, max_texture_height) ptr max_texture_height + +data RWops = RWops + { rwopsSize :: !(FunPtr (Ptr RWops -> IO Int64)) + , rwopsSeek :: !(FunPtr (Ptr RWops -> Int64 -> CInt -> IO Int64)) + , rwopsRead :: !(FunPtr (Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize)) + , rwopsWrite :: !(FunPtr (Ptr RWops -> Ptr () -> CSize -> CSize -> IO CSize)) + , rwopsClose :: !(FunPtr (Ptr RWops -> IO CInt)) + , rwopsType :: !Word32 + } deriving (Eq, Show, Typeable) + +instance Storable RWops where + sizeOf _ = (#size SDL_RWops) + alignment = sizeOf + peek ptr = do + size <- (#peek SDL_RWops, size) ptr + seek <- (#peek SDL_RWops, seek) ptr + read' <- (#peek SDL_RWops, read) ptr + write <- (#peek SDL_RWops, write) ptr + close <- (#peek SDL_RWops, close) ptr + typ <- (#peek SDL_RWops, type) ptr + return $! RWops size seek read' write close typ + poke ptr (RWops size seek read' write close typ) = do + (#poke SDL_RWops, size) ptr size + (#poke SDL_RWops, seek) ptr seek + (#poke SDL_RWops, read) ptr read' + (#poke SDL_RWops, write) ptr write + (#poke SDL_RWops, close) ptr close + (#poke SDL_RWops, type) ptr typ + +data Surface = Surface + { surfaceFormat :: !(Ptr PixelFormat) + , surfaceW :: !CInt + , surfaceH :: !CInt + , surfacePixels :: !(Ptr ()) + , surfaceUserdata :: !(Ptr ()) + , surfaceClipRect :: !Rect + , surfaceRefcount :: !CInt + } deriving (Eq, Show, Typeable) + +instance Storable Surface where + sizeOf _ = (#size SDL_Surface) + alignment = sizeOf + peek ptr = do + format <- (#peek SDL_Surface, format) ptr + w <- (#peek SDL_Surface, w) ptr + h <- (#peek SDL_Surface, h) ptr + pixels <- (#peek SDL_Surface, pixels) ptr + userdata <- (#peek SDL_Surface, userdata) ptr + cliprect <- (#peek SDL_Surface, clip_rect) ptr + refcount <- (#peek SDL_Surface, refcount) ptr + return $! Surface format w h pixels userdata cliprect refcount + poke ptr (Surface format w h pixels userdata cliprect refcount) = do + (#poke SDL_Surface, format) ptr format + (#poke SDL_Surface, w) ptr w + (#poke SDL_Surface, h) ptr h + (#poke SDL_Surface, pixels) ptr pixels + (#poke SDL_Surface, userdata) ptr userdata + (#poke SDL_Surface, clip_rect) ptr cliprect + (#poke SDL_Surface, refcount) ptr refcount + +data Version = Version + { versionMajor :: !Word8 + , versionMinor :: !Word8 + , versionPatch :: !Word8 + } deriving (Eq, Show, Typeable) + +instance Storable Version where + sizeOf _ = (#size SDL_version) + alignment = sizeOf + peek ptr = do + major <- (#peek SDL_version, major) ptr + minor <- (#peek SDL_version, minor) ptr + patch <- (#peek SDL_version, patch) ptr + return $! Version major minor patch + poke ptr (Version major minor patch) = do + (#poke SDL_version, major) ptr major + (#poke SDL_version, minor) ptr minor + (#poke SDL_version, patch) ptr patch diff --git a/src/SDL/Raw/Video.hs b/src/SDL/Raw/Video.hs --- a/src/SDL/Raw/Video.hs +++ b/src/SDL/Raw/Video.hs @@ -1,1113 +1,1113 @@ -module SDL.Raw.Video ( - -- * Display and Window Management - createWindow, - createWindowAndRenderer, - createWindowFrom, - destroyWindow, - disableScreenSaver, - enableScreenSaver, - glBindTexture, - glCreateContext, - glDeleteContext, - glExtensionSupported, - glGetAttribute, - glGetCurrentContext, - glGetCurrentWindow, - glGetDrawableSize, - glGetProcAddress, - glGetSwapInterval, - glLoadLibrary, - glMakeCurrent, - glResetAttributes, - glSetAttribute, - glSetSwapInterval, - glSwapWindow, - glUnbindTexture, - glUnloadLibrary, - getClosestDisplayMode, - getCurrentDisplayMode, - getCurrentVideoDriver, - getDesktopDisplayMode, - getDisplayBounds, - getDisplayMode, - getDisplayName, - getNumDisplayModes, - getNumVideoDisplays, - getNumVideoDrivers, - getVideoDriver, - getWindowBrightness, - getWindowData, - getWindowDisplayIndex, - getWindowDisplayMode, - getWindowFlags, - getWindowFromID, - getWindowGammaRamp, - getWindowGrab, - getWindowID, - getWindowMaximumSize, - getWindowMinimumSize, - getWindowPixelFormat, - getWindowPosition, - getWindowSize, - getWindowSurface, - getWindowTitle, - hideWindow, - isScreenSaverEnabled, - maximizeWindow, - minimizeWindow, - raiseWindow, - restoreWindow, - setWindowBordered, - setWindowBrightness, - setWindowData, - setWindowDisplayMode, - setWindowFullscreen, - setWindowGammaRamp, - setWindowGrab, - setWindowIcon, - setWindowMaximumSize, - setWindowMinimumSize, - setWindowPosition, - setWindowSize, - setWindowTitle, - showMessageBox, - showSimpleMessageBox, - showWindow, - updateWindowSurface, - updateWindowSurfaceRects, - videoInit, - videoQuit, - - -- * 2D Accelerated Rendering - createRenderer, - createSoftwareRenderer, - createTexture, - createTextureFromSurface, - destroyRenderer, - destroyTexture, - getNumRenderDrivers, - getRenderDrawBlendMode, - getRenderDrawColor, - getRenderDriverInfo, - getRenderTarget, - getRenderer, - getRendererInfo, - getRendererOutputSize, - getTextureAlphaMod, - getTextureBlendMode, - getTextureColorMod, - lockTexture, - queryTexture, - renderClear, - renderCopy, - renderCopyEx, - renderDrawLine, - renderDrawLines, - renderDrawPoint, - renderDrawPoints, - renderDrawRect, - renderDrawRects, - renderFillRect, - renderFillRects, - renderGetClipRect, - renderGetLogicalSize, - renderGetScale, - renderGetViewport, - renderPresent, - renderReadPixels, - renderSetClipRect, - renderSetLogicalSize, - renderSetScale, - renderSetViewport, - renderTargetSupported, - setRenderDrawBlendMode, - setRenderDrawColor, - setRenderTarget, - setTextureAlphaMod, - setTextureBlendMode, - setTextureColorMod, - unlockTexture, - updateTexture, - updateYUVTexture, - - -- * Pixel Formats and Conversion Routines - allocFormat, - allocPalette, - calculateGammaRamp, - freeFormat, - freePalette, - getPixelFormatName, - getRGB, - getRGBA, - mapRGB, - mapRGBA, - masksToPixelFormatEnum, - pixelFormatEnumToMasks, - setPaletteColors, - setPixelFormatPalette, - - -- * Rectangle Functions - enclosePoints, - hasIntersection, - intersectRect, - intersectRectAndLine, - unionRect, - - -- * Surface Creation and Simple Drawing - blitScaled, - blitSurface, - convertPixels, - convertSurface, - convertSurfaceFormat, - createRGBSurface, - createRGBSurfaceFrom, - fillRect, - fillRects, - freeSurface, - getClipRect, - getColorKey, - getSurfaceAlphaMod, - getSurfaceBlendMode, - getSurfaceColorMod, - loadBMP, - loadBMP_RW, - lockSurface, - lowerBlit, - lowerBlitScaled, - saveBMP, - saveBMP_RW, - setClipRect, - setColorKey, - setSurfaceAlphaMod, - setSurfaceBlendMode, - setSurfaceColorMod, - setSurfacePalette, - setSurfaceRLE, - unlockSurface, - - -- * Platform-specific Window Management - getWindowWMInfo, - - -- * Clipboard Handling - getClipboardText, - hasClipboardText, - setClipboardText -) where - -import Control.Monad.IO.Class -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Ptr -import SDL.Raw.Enum -import SDL.Raw.Filesystem -import SDL.Raw.Types - -foreign import ccall "SDL.h SDL_CreateWindow" createWindowFFI :: CString -> CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window -foreign import ccall "SDL.h SDL_CreateWindowAndRenderer" createWindowAndRendererFFI :: CInt -> CInt -> Word32 -> Ptr Window -> Ptr Renderer -> IO CInt -foreign import ccall "SDL.h SDL_CreateWindowFrom" createWindowFromFFI :: Ptr () -> IO Window -foreign import ccall "SDL.h SDL_DestroyWindow" destroyWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_DisableScreenSaver" disableScreenSaverFFI :: IO () -foreign import ccall "SDL.h SDL_EnableScreenSaver" enableScreenSaverFFI :: IO () -foreign import ccall "SDL.h SDL_GL_BindTexture" glBindTextureFFI :: Texture -> Ptr CFloat -> Ptr CFloat -> IO CInt -foreign import ccall "SDL.h SDL_GL_CreateContext" glCreateContextFFI :: Window -> IO GLContext -foreign import ccall "SDL.h SDL_GL_DeleteContext" glDeleteContextFFI :: GLContext -> IO () -foreign import ccall "SDL.h SDL_GL_ExtensionSupported" glExtensionSupportedFFI :: CString -> IO Bool -foreign import ccall "SDL.h SDL_GL_GetAttribute" glGetAttributeFFI :: GLattr -> Ptr CInt -> IO CInt -foreign import ccall "SDL.h SDL_GL_GetCurrentContext" glGetCurrentContextFFI :: IO GLContext -foreign import ccall "SDL.h SDL_GL_GetCurrentWindow" glGetCurrentWindowFFI :: IO Window -foreign import ccall "SDL.h SDL_GL_GetDrawableSize" glGetDrawableSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () -foreign import ccall "SDL.h SDL_GL_GetProcAddress" glGetProcAddressFFI :: CString -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_GL_GetSwapInterval" glGetSwapIntervalFFI :: IO CInt -foreign import ccall "SDL.h SDL_GL_LoadLibrary" glLoadLibraryFFI :: CString -> IO CInt -foreign import ccall "SDL.h SDL_GL_MakeCurrent" glMakeCurrentFFI :: Window -> GLContext -> IO CInt -foreign import ccall "SDL.h SDL_GL_ResetAttributes" glResetAttributesFFI :: IO () -foreign import ccall "SDL.h SDL_GL_SetAttribute" glSetAttributeFFI :: GLattr -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_GL_SetSwapInterval" glSetSwapIntervalFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_GL_SwapWindow" glSwapWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_GL_UnbindTexture" glUnbindTextureFFI :: Texture -> IO CInt -foreign import ccall "SDL.h SDL_GL_UnloadLibrary" glUnloadLibraryFFI :: IO () -foreign import ccall "SDL.h SDL_GetClosestDisplayMode" getClosestDisplayModeFFI :: CInt -> Ptr DisplayMode -> Ptr DisplayMode -> IO (Ptr DisplayMode) -foreign import ccall "SDL.h SDL_GetCurrentDisplayMode" getCurrentDisplayModeFFI :: CInt -> Ptr DisplayMode -> IO CInt -foreign import ccall "SDL.h SDL_GetCurrentVideoDriver" getCurrentVideoDriverFFI :: IO CString -foreign import ccall "SDL.h SDL_GetDesktopDisplayMode" getDesktopDisplayModeFFI :: CInt -> Ptr DisplayMode -> IO CInt -foreign import ccall "SDL.h SDL_GetDisplayBounds" getDisplayBoundsFFI :: CInt -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_GetDisplayMode" getDisplayModeFFI :: CInt -> CInt -> Ptr DisplayMode -> IO CInt -foreign import ccall "SDL.h SDL_GetDisplayName" getDisplayNameFFI :: CInt -> IO CString -foreign import ccall "SDL.h SDL_GetNumDisplayModes" getNumDisplayModesFFI :: CInt -> IO CInt -foreign import ccall "SDL.h SDL_GetNumVideoDisplays" getNumVideoDisplaysFFI :: IO CInt -foreign import ccall "SDL.h SDL_GetNumVideoDrivers" getNumVideoDriversFFI :: IO CInt -foreign import ccall "SDL.h SDL_GetVideoDriver" getVideoDriverFFI :: CInt -> IO CString -foreign import ccall "SDL.h SDL_GetWindowBrightness" getWindowBrightnessFFI :: Window -> IO CFloat -foreign import ccall "SDL.h SDL_GetWindowData" getWindowDataFFI :: Window -> CString -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_GetWindowDisplayIndex" getWindowDisplayIndexFFI :: Window -> IO CInt -foreign import ccall "SDL.h SDL_GetWindowDisplayMode" getWindowDisplayModeFFI :: Window -> Ptr DisplayMode -> IO CInt -foreign import ccall "SDL.h SDL_GetWindowFlags" getWindowFlagsFFI :: Window -> IO Word32 -foreign import ccall "SDL.h SDL_GetWindowFromID" getWindowFromIDFFI :: Word32 -> IO Window -foreign import ccall "SDL.h SDL_GetWindowGammaRamp" getWindowGammaRampFFI :: Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt -foreign import ccall "SDL.h SDL_GetWindowGrab" getWindowGrabFFI :: Window -> IO Bool -foreign import ccall "SDL.h SDL_GetWindowID" getWindowIDFFI :: Window -> IO Word32 -foreign import ccall "SDL.h SDL_GetWindowMaximumSize" getWindowMaximumSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () -foreign import ccall "SDL.h SDL_GetWindowMinimumSize" getWindowMinimumSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () -foreign import ccall "SDL.h SDL_GetWindowPixelFormat" getWindowPixelFormatFFI :: Window -> IO Word32 -foreign import ccall "SDL.h SDL_GetWindowPosition" getWindowPositionFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () -foreign import ccall "SDL.h SDL_GetWindowSize" getWindowSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () -foreign import ccall "SDL.h SDL_GetWindowSurface" getWindowSurfaceFFI :: Window -> IO (Ptr Surface) -foreign import ccall "SDL.h SDL_GetWindowTitle" getWindowTitleFFI :: Window -> IO CString -foreign import ccall "SDL.h SDL_HideWindow" hideWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_IsScreenSaverEnabled" isScreenSaverEnabledFFI :: IO Bool -foreign import ccall "SDL.h SDL_MaximizeWindow" maximizeWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_MinimizeWindow" minimizeWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_RaiseWindow" raiseWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_RestoreWindow" restoreWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_SetWindowBordered" setWindowBorderedFFI :: Window -> Bool -> IO () -foreign import ccall "SDL.h SDL_SetWindowBrightness" setWindowBrightnessFFI :: Window -> CFloat -> IO CInt -foreign import ccall "SDL.h SDL_SetWindowData" setWindowDataFFI :: Window -> CString -> Ptr () -> IO (Ptr ()) -foreign import ccall "SDL.h SDL_SetWindowDisplayMode" setWindowDisplayModeFFI :: Window -> Ptr DisplayMode -> IO CInt -foreign import ccall "SDL.h SDL_SetWindowFullscreen" setWindowFullscreenFFI :: Window -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_SetWindowGammaRamp" setWindowGammaRampFFI :: Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt -foreign import ccall "SDL.h SDL_SetWindowGrab" setWindowGrabFFI :: Window -> Bool -> IO () -foreign import ccall "SDL.h SDL_SetWindowIcon" setWindowIconFFI :: Window -> Ptr Surface -> IO () -foreign import ccall "SDL.h SDL_SetWindowMaximumSize" setWindowMaximumSizeFFI :: Window -> CInt -> CInt -> IO () -foreign import ccall "SDL.h SDL_SetWindowMinimumSize" setWindowMinimumSizeFFI :: Window -> CInt -> CInt -> IO () -foreign import ccall "SDL.h SDL_SetWindowPosition" setWindowPositionFFI :: Window -> CInt -> CInt -> IO () -foreign import ccall "SDL.h SDL_SetWindowSize" setWindowSizeFFI :: Window -> CInt -> CInt -> IO () -foreign import ccall "SDL.h SDL_SetWindowTitle" setWindowTitleFFI :: Window -> CString -> IO () -foreign import ccall "SDL.h SDL_ShowMessageBox" showMessageBoxFFI :: Ptr MessageBoxData -> Ptr CInt -> IO CInt -foreign import ccall "SDL.h SDL_ShowSimpleMessageBox" showSimpleMessageBoxFFI :: Word32 -> CString -> CString -> Window -> IO CInt -foreign import ccall "SDL.h SDL_ShowWindow" showWindowFFI :: Window -> IO () -foreign import ccall "SDL.h SDL_UpdateWindowSurface" updateWindowSurfaceFFI :: Window -> IO CInt -foreign import ccall "SDL.h SDL_UpdateWindowSurfaceRects" updateWindowSurfaceRectsFFI :: Window -> Ptr Rect -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_VideoInit" videoInitFFI :: CString -> IO CInt -foreign import ccall "SDL.h SDL_VideoQuit" videoQuitFFI :: IO () - -foreign import ccall "SDL.h SDL_CreateRenderer" createRendererFFI :: Window -> CInt -> Word32 -> IO Renderer -foreign import ccall "SDL.h SDL_CreateSoftwareRenderer" createSoftwareRendererFFI :: Ptr Surface -> IO Renderer -foreign import ccall "SDL.h SDL_CreateTexture" createTextureFFI :: Renderer -> Word32 -> CInt -> CInt -> CInt -> IO Texture -foreign import ccall "SDL.h SDL_CreateTextureFromSurface" createTextureFromSurfaceFFI :: Renderer -> Ptr Surface -> IO Texture -foreign import ccall "SDL.h SDL_DestroyRenderer" destroyRendererFFI :: Renderer -> IO () -foreign import ccall "SDL.h SDL_DestroyTexture" destroyTextureFFI :: Texture -> IO () -foreign import ccall "SDL.h SDL_GetNumRenderDrivers" getNumRenderDriversFFI :: IO CInt -foreign import ccall "SDL.h SDL_GetRenderDrawBlendMode" getRenderDrawBlendModeFFI :: Renderer -> Ptr BlendMode -> IO Int -foreign import ccall "SDL.h SDL_GetRenderDrawColor" getRenderDrawColorFFI :: Renderer -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt -foreign import ccall "SDL.h SDL_GetRenderDriverInfo" getRenderDriverInfoFFI :: CInt -> Ptr RendererInfo -> IO CInt -foreign import ccall "SDL.h SDL_GetRenderTarget" getRenderTargetFFI :: Renderer -> IO Texture -foreign import ccall "SDL.h SDL_GetRenderer" getRendererFFI :: Window -> IO Renderer -foreign import ccall "SDL.h SDL_GetRendererInfo" getRendererInfoFFI :: Renderer -> Ptr RendererInfo -> IO CInt -foreign import ccall "SDL.h SDL_GetRendererOutputSize" getRendererOutputSizeFFI :: Renderer -> Ptr CInt -> Ptr CInt -> IO CInt -foreign import ccall "SDL.h SDL_GetTextureAlphaMod" getTextureAlphaModFFI :: Texture -> Ptr Word8 -> IO CInt -foreign import ccall "SDL.h SDL_GetTextureBlendMode" getTextureBlendModeFFI :: Texture -> Ptr BlendMode -> IO CInt -foreign import ccall "SDL.h SDL_GetTextureColorMod" getTextureColorModFFI :: Texture -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt -foreign import ccall "SDL.h SDL_LockTexture" lockTextureFFI :: Texture -> Ptr Rect -> Ptr (Ptr ()) -> Ptr CInt -> IO CInt -foreign import ccall "SDL.h SDL_QueryTexture" queryTextureFFI :: Texture -> Ptr Word32 -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderClear" renderClearFFI :: Renderer -> IO CInt -foreign import ccall "SDL.h SDL_RenderCopy" renderCopyFFI :: Renderer -> Texture -> Ptr Rect -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_RenderCopyEx" renderCopyExFFI :: Renderer -> Texture -> Ptr Rect -> Ptr Rect -> CDouble -> Ptr Point -> RendererFlip -> IO CInt -foreign import ccall "SDL.h SDL_RenderDrawLine" renderDrawLineFFI :: Renderer -> CInt -> CInt -> CInt -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderDrawLines" renderDrawLinesFFI :: Renderer -> Ptr Point -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderDrawPoint" renderDrawPointFFI :: Renderer -> CInt -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderDrawPoints" renderDrawPointsFFI :: Renderer -> Ptr Point -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderDrawRect" renderDrawRectFFI :: Renderer -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_RenderDrawRects" renderDrawRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderFillRect" renderFillRectFFI :: Renderer -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_RenderFillRects" renderFillRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderGetClipRect" renderGetClipRectFFI :: Renderer -> Ptr Rect -> IO () -foreign import ccall "SDL.h SDL_RenderGetLogicalSize" renderGetLogicalSizeFFI :: Renderer -> Ptr CInt -> Ptr CInt -> IO () -foreign import ccall "SDL.h SDL_RenderGetScale" renderGetScaleFFI :: Renderer -> Ptr CFloat -> Ptr CFloat -> IO () -foreign import ccall "SDL.h SDL_RenderGetViewport" renderGetViewportFFI :: Renderer -> Ptr Rect -> IO () -foreign import ccall "SDL.h SDL_RenderPresent" renderPresentFFI :: Renderer -> IO () -foreign import ccall "SDL.h SDL_RenderReadPixels" renderReadPixelsFFI :: Renderer -> Ptr Rect -> Word32 -> Ptr () -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderSetClipRect" renderSetClipRectFFI :: Renderer -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_RenderSetLogicalSize" renderSetLogicalSizeFFI :: Renderer -> CInt -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_RenderSetScale" renderSetScaleFFI :: Renderer -> CFloat -> CFloat -> IO CInt -foreign import ccall "SDL.h SDL_RenderSetViewport" renderSetViewportFFI :: Renderer -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_RenderTargetSupported" renderTargetSupportedFFI :: Renderer -> IO Bool -foreign import ccall "SDL.h SDL_SetRenderDrawBlendMode" setRenderDrawBlendModeFFI :: Renderer -> BlendMode -> IO CInt -foreign import ccall "SDL.h SDL_SetRenderDrawColor" setRenderDrawColorFFI :: Renderer -> Word8 -> Word8 -> Word8 -> Word8 -> IO CInt -foreign import ccall "SDL.h SDL_SetRenderTarget" setRenderTargetFFI :: Renderer -> Texture -> IO CInt -foreign import ccall "SDL.h SDL_SetTextureAlphaMod" setTextureAlphaModFFI :: Texture -> Word8 -> IO CInt -foreign import ccall "SDL.h SDL_SetTextureBlendMode" setTextureBlendModeFFI :: Texture -> BlendMode -> IO CInt -foreign import ccall "SDL.h SDL_SetTextureColorMod" setTextureColorModFFI :: Texture -> Word8 -> Word8 -> Word8 -> IO CInt -foreign import ccall "SDL.h SDL_UnlockTexture" unlockTextureFFI :: Texture -> IO () -foreign import ccall "SDL.h SDL_UpdateTexture" updateTextureFFI :: Texture -> Ptr Rect -> Ptr () -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_UpdateYUVTexture" updateYUVTextureFFI :: Texture -> Ptr Rect -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO CInt - -foreign import ccall "SDL.h SDL_AllocFormat" allocFormatFFI :: Word32 -> IO (Ptr PixelFormat) -foreign import ccall "SDL.h SDL_AllocPalette" allocPaletteFFI :: CInt -> IO (Ptr Palette) -foreign import ccall "SDL.h SDL_CalculateGammaRamp" calculateGammaRampFFI :: CFloat -> Ptr Word16 -> IO () -foreign import ccall "SDL.h SDL_FreeFormat" freeFormatFFI :: Ptr PixelFormat -> IO () -foreign import ccall "SDL.h SDL_FreePalette" freePaletteFFI :: Ptr Palette -> IO () -foreign import ccall "SDL.h SDL_GetPixelFormatName" getPixelFormatNameFFI :: Word32 -> IO CString -foreign import ccall "SDL.h SDL_GetRGB" getRGBFFI :: Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () -foreign import ccall "SDL.h SDL_GetRGBA" getRGBAFFI :: Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () -foreign import ccall "SDL.h SDL_MapRGB" mapRGBFFI :: Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> IO Word32 -foreign import ccall "SDL.h SDL_MapRGBA" mapRGBAFFI :: Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> Word8 -> IO Word32 -foreign import ccall "SDL.h SDL_MasksToPixelFormatEnum" masksToPixelFormatEnumFFI :: CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO Word32 -foreign import ccall "SDL.h SDL_PixelFormatEnumToMasks" pixelFormatEnumToMasksFFI :: Word32 -> Ptr CInt -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> IO Bool -foreign import ccall "SDL.h SDL_SetPaletteColors" setPaletteColorsFFI :: Ptr Palette -> Ptr Color -> CInt -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_SetPixelFormatPalette" setPixelFormatPaletteFFI :: Ptr PixelFormat -> Ptr Palette -> IO CInt - -foreign import ccall "SDL.h SDL_EnclosePoints" enclosePointsFFI :: Ptr Point -> CInt -> Ptr Rect -> Ptr Rect -> IO Bool -foreign import ccall "SDL.h SDL_HasIntersection" hasIntersectionFFI :: Ptr Rect -> Ptr Rect -> IO Bool -foreign import ccall "SDL.h SDL_IntersectRect" intersectRectFFI :: Ptr Rect -> Ptr Rect -> Ptr Rect -> IO Bool -foreign import ccall "SDL.h SDL_IntersectRectAndLine" intersectRectAndLineFFI :: Ptr Rect -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO Bool -foreign import ccall "SDL.h SDL_UnionRect" unionRectFFI :: Ptr Rect -> Ptr Rect -> Ptr Rect -> IO () - -foreign import ccall "SDL.h SDL_UpperBlitScaled" blitScaledFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_UpperBlit" blitSurfaceFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_ConvertPixels" convertPixelsFFI :: CInt -> CInt -> Word32 -> Ptr () -> CInt -> Word32 -> Ptr () -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_ConvertSurface" convertSurfaceFFI :: Ptr Surface -> Ptr PixelFormat -> Word32 -> IO (Ptr Surface) -foreign import ccall "SDL.h SDL_ConvertSurfaceFormat" convertSurfaceFormatFFI :: Ptr Surface -> Word32 -> Word32 -> IO (Ptr Surface) -foreign import ccall "SDL.h SDL_CreateRGBSurface" createRGBSurfaceFFI :: Word32 -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr Surface) -foreign import ccall "SDL.h SDL_CreateRGBSurfaceFrom" createRGBSurfaceFromFFI :: Ptr () -> CInt -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr Surface) -foreign import ccall "SDL.h SDL_FillRect" fillRectFFI :: Ptr Surface -> Ptr Rect -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_FillRects" fillRectsFFI :: Ptr Surface -> Ptr Rect -> CInt -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_FreeSurface" freeSurfaceFFI :: Ptr Surface -> IO () -foreign import ccall "SDL.h SDL_GetClipRect" getClipRectFFI :: Ptr Surface -> Ptr Rect -> IO () -foreign import ccall "SDL.h SDL_GetColorKey" getColorKeyFFI :: Ptr Surface -> Ptr Word32 -> IO CInt -foreign import ccall "SDL.h SDL_GetSurfaceAlphaMod" getSurfaceAlphaModFFI :: Ptr Surface -> Ptr Word8 -> IO CInt -foreign import ccall "SDL.h SDL_GetSurfaceBlendMode" getSurfaceBlendModeFFI :: Ptr Surface -> Ptr BlendMode -> IO CInt -foreign import ccall "SDL.h SDL_GetSurfaceColorMod" getSurfaceColorModFFI :: Ptr Surface -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt -foreign import ccall "SDL.h SDL_LoadBMP_RW" loadBMP_RWFFI :: Ptr RWops -> CInt -> IO (Ptr Surface) -foreign import ccall "SDL.h SDL_LockSurface" lockSurfaceFFI :: Ptr Surface -> IO CInt -foreign import ccall "SDL.h SDL_LowerBlit" lowerBlitFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_LowerBlitScaled" lowerBlitScaledFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt -foreign import ccall "SDL.h SDL_SaveBMP_RW" saveBMP_RWFFI :: Ptr Surface -> Ptr RWops -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_SetClipRect" setClipRectFFI :: Ptr Surface -> Ptr Rect -> IO Bool -foreign import ccall "SDL.h SDL_SetColorKey" setColorKeyFFI :: Ptr Surface -> CInt -> Word32 -> IO CInt -foreign import ccall "SDL.h SDL_SetSurfaceAlphaMod" setSurfaceAlphaModFFI :: Ptr Surface -> Word8 -> IO CInt -foreign import ccall "SDL.h SDL_SetSurfaceBlendMode" setSurfaceBlendModeFFI :: Ptr Surface -> BlendMode -> IO CInt -foreign import ccall "SDL.h SDL_SetSurfaceColorMod" setSurfaceColorModFFI :: Ptr Surface -> Word8 -> Word8 -> Word8 -> IO CInt -foreign import ccall "SDL.h SDL_SetSurfacePalette" setSurfacePaletteFFI :: Ptr Surface -> Ptr Palette -> IO CInt -foreign import ccall "SDL.h SDL_SetSurfaceRLE" setSurfaceRLEFFI :: Ptr Surface -> CInt -> IO CInt -foreign import ccall "SDL.h SDL_UnlockSurface" unlockSurfaceFFI :: Ptr Surface -> IO () - -foreign import ccall "SDL.h SDL_GetWindowWMInfo" getWindowWMInfoFFI :: Window -> SysWMinfo -> IO Bool - -foreign import ccall "SDL.h SDL_GetClipboardText" getClipboardTextFFI :: IO CString -foreign import ccall "SDL.h SDL_HasClipboardText" hasClipboardTextFFI :: IO Bool -foreign import ccall "SDL.h SDL_SetClipboardText" setClipboardTextFFI :: CString -> IO CInt - -createWindow :: MonadIO m => CString -> CInt -> CInt -> CInt -> CInt -> Word32 -> m Window -createWindow v1 v2 v3 v4 v5 v6 = liftIO $ createWindowFFI v1 v2 v3 v4 v5 v6 -{-# INLINE createWindow #-} - -createWindowAndRenderer :: MonadIO m => CInt -> CInt -> Word32 -> Ptr Window -> Ptr Renderer -> m CInt -createWindowAndRenderer v1 v2 v3 v4 v5 = liftIO $ createWindowAndRendererFFI v1 v2 v3 v4 v5 -{-# INLINE createWindowAndRenderer #-} - -createWindowFrom :: MonadIO m => Ptr () -> m Window -createWindowFrom v1 = liftIO $ createWindowFromFFI v1 -{-# INLINE createWindowFrom #-} - -destroyWindow :: MonadIO m => Window -> m () -destroyWindow v1 = liftIO $ destroyWindowFFI v1 -{-# INLINE destroyWindow #-} - -disableScreenSaver :: MonadIO m => m () -disableScreenSaver = liftIO disableScreenSaverFFI -{-# INLINE disableScreenSaver #-} - -enableScreenSaver :: MonadIO m => m () -enableScreenSaver = liftIO enableScreenSaverFFI -{-# INLINE enableScreenSaver #-} - -glBindTexture :: MonadIO m => Texture -> Ptr CFloat -> Ptr CFloat -> m CInt -glBindTexture v1 v2 v3 = liftIO $ glBindTextureFFI v1 v2 v3 -{-# INLINE glBindTexture #-} - -glCreateContext :: MonadIO m => Window -> m GLContext -glCreateContext v1 = liftIO $ glCreateContextFFI v1 -{-# INLINE glCreateContext #-} - -glDeleteContext :: MonadIO m => GLContext -> m () -glDeleteContext v1 = liftIO $ glDeleteContextFFI v1 -{-# INLINE glDeleteContext #-} - -glExtensionSupported :: MonadIO m => CString -> m Bool -glExtensionSupported v1 = liftIO $ glExtensionSupportedFFI v1 -{-# INLINE glExtensionSupported #-} - -glGetAttribute :: MonadIO m => GLattr -> Ptr CInt -> m CInt -glGetAttribute v1 v2 = liftIO $ glGetAttributeFFI v1 v2 -{-# INLINE glGetAttribute #-} - -glGetCurrentContext :: MonadIO m => m GLContext -glGetCurrentContext = liftIO glGetCurrentContextFFI -{-# INLINE glGetCurrentContext #-} - -glGetCurrentWindow :: MonadIO m => m Window -glGetCurrentWindow = liftIO glGetCurrentWindowFFI -{-# INLINE glGetCurrentWindow #-} - -glGetDrawableSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () -glGetDrawableSize v1 v2 v3 = liftIO $ glGetDrawableSizeFFI v1 v2 v3 -{-# INLINE glGetDrawableSize #-} - -glGetProcAddress :: MonadIO m => CString -> m (Ptr ()) -glGetProcAddress v1 = liftIO $ glGetProcAddressFFI v1 -{-# INLINE glGetProcAddress #-} - -glGetSwapInterval :: MonadIO m => m CInt -glGetSwapInterval = liftIO glGetSwapIntervalFFI -{-# INLINE glGetSwapInterval #-} - -glLoadLibrary :: MonadIO m => CString -> m CInt -glLoadLibrary v1 = liftIO $ glLoadLibraryFFI v1 -{-# INLINE glLoadLibrary #-} - -glMakeCurrent :: MonadIO m => Window -> GLContext -> m CInt -glMakeCurrent v1 v2 = liftIO $ glMakeCurrentFFI v1 v2 -{-# INLINE glMakeCurrent #-} - -glResetAttributes :: MonadIO m => m () -glResetAttributes = liftIO glResetAttributesFFI -{-# INLINE glResetAttributes #-} - -glSetAttribute :: MonadIO m => GLattr -> CInt -> m CInt -glSetAttribute v1 v2 = liftIO $ glSetAttributeFFI v1 v2 -{-# INLINE glSetAttribute #-} - -glSetSwapInterval :: MonadIO m => CInt -> m CInt -glSetSwapInterval v1 = liftIO $ glSetSwapIntervalFFI v1 -{-# INLINE glSetSwapInterval #-} - -glSwapWindow :: MonadIO m => Window -> m () -glSwapWindow v1 = liftIO $ glSwapWindowFFI v1 -{-# INLINE glSwapWindow #-} - -glUnbindTexture :: MonadIO m => Texture -> m CInt -glUnbindTexture v1 = liftIO $ glUnbindTextureFFI v1 -{-# INLINE glUnbindTexture #-} - -glUnloadLibrary :: MonadIO m => m () -glUnloadLibrary = liftIO glUnloadLibraryFFI -{-# INLINE glUnloadLibrary #-} - -getClosestDisplayMode :: MonadIO m => CInt -> Ptr DisplayMode -> Ptr DisplayMode -> m (Ptr DisplayMode) -getClosestDisplayMode v1 v2 v3 = liftIO $ getClosestDisplayModeFFI v1 v2 v3 -{-# INLINE getClosestDisplayMode #-} - -getCurrentDisplayMode :: MonadIO m => CInt -> Ptr DisplayMode -> m CInt -getCurrentDisplayMode v1 v2 = liftIO $ getCurrentDisplayModeFFI v1 v2 -{-# INLINE getCurrentDisplayMode #-} - -getCurrentVideoDriver :: MonadIO m => m CString -getCurrentVideoDriver = liftIO getCurrentVideoDriverFFI -{-# INLINE getCurrentVideoDriver #-} - -getDesktopDisplayMode :: MonadIO m => CInt -> Ptr DisplayMode -> m CInt -getDesktopDisplayMode v1 v2 = liftIO $ getDesktopDisplayModeFFI v1 v2 -{-# INLINE getDesktopDisplayMode #-} - -getDisplayBounds :: MonadIO m => CInt -> Ptr Rect -> m CInt -getDisplayBounds v1 v2 = liftIO $ getDisplayBoundsFFI v1 v2 -{-# INLINE getDisplayBounds #-} - -getDisplayMode :: MonadIO m => CInt -> CInt -> Ptr DisplayMode -> m CInt -getDisplayMode v1 v2 v3 = liftIO $ getDisplayModeFFI v1 v2 v3 -{-# INLINE getDisplayMode #-} - -getDisplayName :: MonadIO m => CInt -> m CString -getDisplayName v1 = liftIO $ getDisplayNameFFI v1 -{-# INLINE getDisplayName #-} - -getNumDisplayModes :: MonadIO m => CInt -> m CInt -getNumDisplayModes v1 = liftIO $ getNumDisplayModesFFI v1 -{-# INLINE getNumDisplayModes #-} - -getNumVideoDisplays :: MonadIO m => m CInt -getNumVideoDisplays = liftIO getNumVideoDisplaysFFI -{-# INLINE getNumVideoDisplays #-} - -getNumVideoDrivers :: MonadIO m => m CInt -getNumVideoDrivers = liftIO getNumVideoDriversFFI -{-# INLINE getNumVideoDrivers #-} - -getVideoDriver :: MonadIO m => CInt -> m CString -getVideoDriver v1 = liftIO $ getVideoDriverFFI v1 -{-# INLINE getVideoDriver #-} - -getWindowBrightness :: MonadIO m => Window -> m CFloat -getWindowBrightness v1 = liftIO $ getWindowBrightnessFFI v1 -{-# INLINE getWindowBrightness #-} - -getWindowData :: MonadIO m => Window -> CString -> m (Ptr ()) -getWindowData v1 v2 = liftIO $ getWindowDataFFI v1 v2 -{-# INLINE getWindowData #-} - -getWindowDisplayIndex :: MonadIO m => Window -> m CInt -getWindowDisplayIndex v1 = liftIO $ getWindowDisplayIndexFFI v1 -{-# INLINE getWindowDisplayIndex #-} - -getWindowDisplayMode :: MonadIO m => Window -> Ptr DisplayMode -> m CInt -getWindowDisplayMode v1 v2 = liftIO $ getWindowDisplayModeFFI v1 v2 -{-# INLINE getWindowDisplayMode #-} - -getWindowFlags :: MonadIO m => Window -> m Word32 -getWindowFlags v1 = liftIO $ getWindowFlagsFFI v1 -{-# INLINE getWindowFlags #-} - -getWindowFromID :: MonadIO m => Word32 -> m Window -getWindowFromID v1 = liftIO $ getWindowFromIDFFI v1 -{-# INLINE getWindowFromID #-} - -getWindowGammaRamp :: MonadIO m => Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> m CInt -getWindowGammaRamp v1 v2 v3 v4 = liftIO $ getWindowGammaRampFFI v1 v2 v3 v4 -{-# INLINE getWindowGammaRamp #-} - -getWindowGrab :: MonadIO m => Window -> m Bool -getWindowGrab v1 = liftIO $ getWindowGrabFFI v1 -{-# INLINE getWindowGrab #-} - -getWindowID :: MonadIO m => Window -> m Word32 -getWindowID v1 = liftIO $ getWindowIDFFI v1 -{-# INLINE getWindowID #-} - -getWindowMaximumSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () -getWindowMaximumSize v1 v2 v3 = liftIO $ getWindowMaximumSizeFFI v1 v2 v3 -{-# INLINE getWindowMaximumSize #-} - -getWindowMinimumSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () -getWindowMinimumSize v1 v2 v3 = liftIO $ getWindowMinimumSizeFFI v1 v2 v3 -{-# INLINE getWindowMinimumSize #-} - -getWindowPixelFormat :: MonadIO m => Window -> m Word32 -getWindowPixelFormat v1 = liftIO $ getWindowPixelFormatFFI v1 -{-# INLINE getWindowPixelFormat #-} - -getWindowPosition :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () -getWindowPosition v1 v2 v3 = liftIO $ getWindowPositionFFI v1 v2 v3 -{-# INLINE getWindowPosition #-} - -getWindowSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () -getWindowSize v1 v2 v3 = liftIO $ getWindowSizeFFI v1 v2 v3 -{-# INLINE getWindowSize #-} - -getWindowSurface :: MonadIO m => Window -> m (Ptr Surface) -getWindowSurface v1 = liftIO $ getWindowSurfaceFFI v1 -{-# INLINE getWindowSurface #-} - -getWindowTitle :: MonadIO m => Window -> m CString -getWindowTitle v1 = liftIO $ getWindowTitleFFI v1 -{-# INLINE getWindowTitle #-} - -hideWindow :: MonadIO m => Window -> m () -hideWindow v1 = liftIO $ hideWindowFFI v1 -{-# INLINE hideWindow #-} - -isScreenSaverEnabled :: MonadIO m => m Bool -isScreenSaverEnabled = liftIO isScreenSaverEnabledFFI -{-# INLINE isScreenSaverEnabled #-} - -maximizeWindow :: MonadIO m => Window -> m () -maximizeWindow v1 = liftIO $ maximizeWindowFFI v1 -{-# INLINE maximizeWindow #-} - -minimizeWindow :: MonadIO m => Window -> m () -minimizeWindow v1 = liftIO $ minimizeWindowFFI v1 -{-# INLINE minimizeWindow #-} - -raiseWindow :: MonadIO m => Window -> m () -raiseWindow v1 = liftIO $ raiseWindowFFI v1 -{-# INLINE raiseWindow #-} - -restoreWindow :: MonadIO m => Window -> m () -restoreWindow v1 = liftIO $ restoreWindowFFI v1 -{-# INLINE restoreWindow #-} - -setWindowBordered :: MonadIO m => Window -> Bool -> m () -setWindowBordered v1 v2 = liftIO $ setWindowBorderedFFI v1 v2 -{-# INLINE setWindowBordered #-} - -setWindowBrightness :: MonadIO m => Window -> CFloat -> m CInt -setWindowBrightness v1 v2 = liftIO $ setWindowBrightnessFFI v1 v2 -{-# INLINE setWindowBrightness #-} - -setWindowData :: MonadIO m => Window -> CString -> Ptr () -> m (Ptr ()) -setWindowData v1 v2 v3 = liftIO $ setWindowDataFFI v1 v2 v3 -{-# INLINE setWindowData #-} - -setWindowDisplayMode :: MonadIO m => Window -> Ptr DisplayMode -> m CInt -setWindowDisplayMode v1 v2 = liftIO $ setWindowDisplayModeFFI v1 v2 -{-# INLINE setWindowDisplayMode #-} - -setWindowFullscreen :: MonadIO m => Window -> Word32 -> m CInt -setWindowFullscreen v1 v2 = liftIO $ setWindowFullscreenFFI v1 v2 -{-# INLINE setWindowFullscreen #-} - -setWindowGammaRamp :: MonadIO m => Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> m CInt -setWindowGammaRamp v1 v2 v3 v4 = liftIO $ setWindowGammaRampFFI v1 v2 v3 v4 -{-# INLINE setWindowGammaRamp #-} - -setWindowGrab :: MonadIO m => Window -> Bool -> m () -setWindowGrab v1 v2 = liftIO $ setWindowGrabFFI v1 v2 -{-# INLINE setWindowGrab #-} - -setWindowIcon :: MonadIO m => Window -> Ptr Surface -> m () -setWindowIcon v1 v2 = liftIO $ setWindowIconFFI v1 v2 -{-# INLINE setWindowIcon #-} - -setWindowMaximumSize :: MonadIO m => Window -> CInt -> CInt -> m () -setWindowMaximumSize v1 v2 v3 = liftIO $ setWindowMaximumSizeFFI v1 v2 v3 -{-# INLINE setWindowMaximumSize #-} - -setWindowMinimumSize :: MonadIO m => Window -> CInt -> CInt -> m () -setWindowMinimumSize v1 v2 v3 = liftIO $ setWindowMinimumSizeFFI v1 v2 v3 -{-# INLINE setWindowMinimumSize #-} - -setWindowPosition :: MonadIO m => Window -> CInt -> CInt -> m () -setWindowPosition v1 v2 v3 = liftIO $ setWindowPositionFFI v1 v2 v3 -{-# INLINE setWindowPosition #-} - -setWindowSize :: MonadIO m => Window -> CInt -> CInt -> m () -setWindowSize v1 v2 v3 = liftIO $ setWindowSizeFFI v1 v2 v3 -{-# INLINE setWindowSize #-} - -setWindowTitle :: MonadIO m => Window -> CString -> m () -setWindowTitle v1 v2 = liftIO $ setWindowTitleFFI v1 v2 -{-# INLINE setWindowTitle #-} - -showMessageBox :: MonadIO m => Ptr MessageBoxData -> Ptr CInt -> m CInt -showMessageBox v1 v2 = liftIO $ showMessageBoxFFI v1 v2 -{-# INLINE showMessageBox #-} - -showSimpleMessageBox :: MonadIO m => Word32 -> CString -> CString -> Window -> m CInt -showSimpleMessageBox v1 v2 v3 v4 = liftIO $ showSimpleMessageBoxFFI v1 v2 v3 v4 -{-# INLINE showSimpleMessageBox #-} - -showWindow :: MonadIO m => Window -> m () -showWindow v1 = liftIO $ showWindowFFI v1 -{-# INLINE showWindow #-} - -updateWindowSurface :: MonadIO m => Window -> m CInt -updateWindowSurface v1 = liftIO $ updateWindowSurfaceFFI v1 -{-# INLINE updateWindowSurface #-} - -updateWindowSurfaceRects :: MonadIO m => Window -> Ptr Rect -> CInt -> m CInt -updateWindowSurfaceRects v1 v2 v3 = liftIO $ updateWindowSurfaceRectsFFI v1 v2 v3 -{-# INLINE updateWindowSurfaceRects #-} - -videoInit :: MonadIO m => CString -> m CInt -videoInit v1 = liftIO $ videoInitFFI v1 -{-# INLINE videoInit #-} - -videoQuit :: MonadIO m => m () -videoQuit = liftIO videoQuitFFI -{-# INLINE videoQuit #-} - -createRenderer :: MonadIO m => Window -> CInt -> Word32 -> m Renderer -createRenderer v1 v2 v3 = liftIO $ createRendererFFI v1 v2 v3 -{-# INLINE createRenderer #-} - -createSoftwareRenderer :: MonadIO m => Ptr Surface -> m Renderer -createSoftwareRenderer v1 = liftIO $ createSoftwareRendererFFI v1 -{-# INLINE createSoftwareRenderer #-} - -createTexture :: MonadIO m => Renderer -> Word32 -> CInt -> CInt -> CInt -> m Texture -createTexture v1 v2 v3 v4 v5 = liftIO $ createTextureFFI v1 v2 v3 v4 v5 -{-# INLINE createTexture #-} - -createTextureFromSurface :: MonadIO m => Renderer -> Ptr Surface -> m Texture -createTextureFromSurface v1 v2 = liftIO $ createTextureFromSurfaceFFI v1 v2 -{-# INLINE createTextureFromSurface #-} - -destroyRenderer :: MonadIO m => Renderer -> m () -destroyRenderer v1 = liftIO $ destroyRendererFFI v1 -{-# INLINE destroyRenderer #-} - -destroyTexture :: MonadIO m => Texture -> m () -destroyTexture v1 = liftIO $ destroyTextureFFI v1 -{-# INLINE destroyTexture #-} - -getNumRenderDrivers :: MonadIO m => m CInt -getNumRenderDrivers = liftIO getNumRenderDriversFFI -{-# INLINE getNumRenderDrivers #-} - -getRenderDrawBlendMode :: MonadIO m => Renderer -> Ptr BlendMode -> m Int -getRenderDrawBlendMode v1 v2 = liftIO $ getRenderDrawBlendModeFFI v1 v2 -{-# INLINE getRenderDrawBlendMode #-} - -getRenderDrawColor :: MonadIO m => Renderer -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m CInt -getRenderDrawColor v1 v2 v3 v4 v5 = liftIO $ getRenderDrawColorFFI v1 v2 v3 v4 v5 -{-# INLINE getRenderDrawColor #-} - -getRenderDriverInfo :: MonadIO m => CInt -> Ptr RendererInfo -> m CInt -getRenderDriverInfo v1 v2 = liftIO $ getRenderDriverInfoFFI v1 v2 -{-# INLINE getRenderDriverInfo #-} - -getRenderTarget :: MonadIO m => Renderer -> m Texture -getRenderTarget v1 = liftIO $ getRenderTargetFFI v1 -{-# INLINE getRenderTarget #-} - -getRenderer :: MonadIO m => Window -> m Renderer -getRenderer v1 = liftIO $ getRendererFFI v1 -{-# INLINE getRenderer #-} - -getRendererInfo :: MonadIO m => Renderer -> Ptr RendererInfo -> m CInt -getRendererInfo v1 v2 = liftIO $ getRendererInfoFFI v1 v2 -{-# INLINE getRendererInfo #-} - -getRendererOutputSize :: MonadIO m => Renderer -> Ptr CInt -> Ptr CInt -> m CInt -getRendererOutputSize v1 v2 v3 = liftIO $ getRendererOutputSizeFFI v1 v2 v3 -{-# INLINE getRendererOutputSize #-} - -getTextureAlphaMod :: MonadIO m => Texture -> Ptr Word8 -> m CInt -getTextureAlphaMod v1 v2 = liftIO $ getTextureAlphaModFFI v1 v2 -{-# INLINE getTextureAlphaMod #-} - -getTextureBlendMode :: MonadIO m => Texture -> Ptr BlendMode -> m CInt -getTextureBlendMode v1 v2 = liftIO $ getTextureBlendModeFFI v1 v2 -{-# INLINE getTextureBlendMode #-} - -getTextureColorMod :: MonadIO m => Texture -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m CInt -getTextureColorMod v1 v2 v3 v4 = liftIO $ getTextureColorModFFI v1 v2 v3 v4 -{-# INLINE getTextureColorMod #-} - -lockTexture :: MonadIO m => Texture -> Ptr Rect -> Ptr (Ptr ()) -> Ptr CInt -> m CInt -lockTexture v1 v2 v3 v4 = liftIO $ lockTextureFFI v1 v2 v3 v4 -{-# INLINE lockTexture #-} - -queryTexture :: MonadIO m => Texture -> Ptr Word32 -> Ptr CInt -> Ptr CInt -> Ptr CInt -> m CInt -queryTexture v1 v2 v3 v4 v5 = liftIO $ queryTextureFFI v1 v2 v3 v4 v5 -{-# INLINE queryTexture #-} - -renderClear :: MonadIO m => Renderer -> m CInt -renderClear v1 = liftIO $ renderClearFFI v1 -{-# INLINE renderClear #-} - -renderCopy :: MonadIO m => Renderer -> Texture -> Ptr Rect -> Ptr Rect -> m CInt -renderCopy v1 v2 v3 v4 = liftIO $ renderCopyFFI v1 v2 v3 v4 -{-# INLINE renderCopy #-} - -renderCopyEx :: MonadIO m => Renderer -> Texture -> Ptr Rect -> Ptr Rect -> CDouble -> Ptr Point -> RendererFlip -> m CInt -renderCopyEx v1 v2 v3 v4 v5 v6 v7 = liftIO $ renderCopyExFFI v1 v2 v3 v4 v5 v6 v7 -{-# INLINE renderCopyEx #-} - -renderDrawLine :: MonadIO m => Renderer -> CInt -> CInt -> CInt -> CInt -> m CInt -renderDrawLine v1 v2 v3 v4 v5 = liftIO $ renderDrawLineFFI v1 v2 v3 v4 v5 -{-# INLINE renderDrawLine #-} - -renderDrawLines :: MonadIO m => Renderer -> Ptr Point -> CInt -> m CInt -renderDrawLines v1 v2 v3 = liftIO $ renderDrawLinesFFI v1 v2 v3 -{-# INLINE renderDrawLines #-} - -renderDrawPoint :: MonadIO m => Renderer -> CInt -> CInt -> m CInt -renderDrawPoint v1 v2 v3 = liftIO $ renderDrawPointFFI v1 v2 v3 -{-# INLINE renderDrawPoint #-} - -renderDrawPoints :: MonadIO m => Renderer -> Ptr Point -> CInt -> m CInt -renderDrawPoints v1 v2 v3 = liftIO $ renderDrawPointsFFI v1 v2 v3 -{-# INLINE renderDrawPoints #-} - -renderDrawRect :: MonadIO m => Renderer -> Ptr Rect -> m CInt -renderDrawRect v1 v2 = liftIO $ renderDrawRectFFI v1 v2 -{-# INLINE renderDrawRect #-} - -renderDrawRects :: MonadIO m => Renderer -> Ptr Rect -> CInt -> m CInt -renderDrawRects v1 v2 v3 = liftIO $ renderDrawRectsFFI v1 v2 v3 -{-# INLINE renderDrawRects #-} - -renderFillRect :: MonadIO m => Renderer -> Ptr Rect -> m CInt -renderFillRect v1 v2 = liftIO $ renderFillRectFFI v1 v2 -{-# INLINE renderFillRect #-} - -renderFillRects :: MonadIO m => Renderer -> Ptr Rect -> CInt -> m CInt -renderFillRects v1 v2 v3 = liftIO $ renderFillRectsFFI v1 v2 v3 -{-# INLINE renderFillRects #-} - -renderGetClipRect :: MonadIO m => Renderer -> Ptr Rect -> m () -renderGetClipRect v1 v2 = liftIO $ renderGetClipRectFFI v1 v2 -{-# INLINE renderGetClipRect #-} - -renderGetLogicalSize :: MonadIO m => Renderer -> Ptr CInt -> Ptr CInt -> m () -renderGetLogicalSize v1 v2 v3 = liftIO $ renderGetLogicalSizeFFI v1 v2 v3 -{-# INLINE renderGetLogicalSize #-} - -renderGetScale :: MonadIO m => Renderer -> Ptr CFloat -> Ptr CFloat -> m () -renderGetScale v1 v2 v3 = liftIO $ renderGetScaleFFI v1 v2 v3 -{-# INLINE renderGetScale #-} - -renderGetViewport :: MonadIO m => Renderer -> Ptr Rect -> m () -renderGetViewport v1 v2 = liftIO $ renderGetViewportFFI v1 v2 -{-# INLINE renderGetViewport #-} - -renderPresent :: MonadIO m => Renderer -> m () -renderPresent v1 = liftIO $ renderPresentFFI v1 -{-# INLINE renderPresent #-} - -renderReadPixels :: MonadIO m => Renderer -> Ptr Rect -> Word32 -> Ptr () -> CInt -> m CInt -renderReadPixels v1 v2 v3 v4 v5 = liftIO $ renderReadPixelsFFI v1 v2 v3 v4 v5 -{-# INLINE renderReadPixels #-} - -renderSetClipRect :: MonadIO m => Renderer -> Ptr Rect -> m CInt -renderSetClipRect v1 v2 = liftIO $ renderSetClipRectFFI v1 v2 -{-# INLINE renderSetClipRect #-} - -renderSetLogicalSize :: MonadIO m => Renderer -> CInt -> CInt -> m CInt -renderSetLogicalSize v1 v2 v3 = liftIO $ renderSetLogicalSizeFFI v1 v2 v3 -{-# INLINE renderSetLogicalSize #-} - -renderSetScale :: MonadIO m => Renderer -> CFloat -> CFloat -> m CInt -renderSetScale v1 v2 v3 = liftIO $ renderSetScaleFFI v1 v2 v3 -{-# INLINE renderSetScale #-} - -renderSetViewport :: MonadIO m => Renderer -> Ptr Rect -> m CInt -renderSetViewport v1 v2 = liftIO $ renderSetViewportFFI v1 v2 -{-# INLINE renderSetViewport #-} - -renderTargetSupported :: MonadIO m => Renderer -> m Bool -renderTargetSupported v1 = liftIO $ renderTargetSupportedFFI v1 -{-# INLINE renderTargetSupported #-} - -setRenderDrawBlendMode :: MonadIO m => Renderer -> BlendMode -> m CInt -setRenderDrawBlendMode v1 v2 = liftIO $ setRenderDrawBlendModeFFI v1 v2 -{-# INLINE setRenderDrawBlendMode #-} - -setRenderDrawColor :: MonadIO m => Renderer -> Word8 -> Word8 -> Word8 -> Word8 -> m CInt -setRenderDrawColor v1 v2 v3 v4 v5 = liftIO $ setRenderDrawColorFFI v1 v2 v3 v4 v5 -{-# INLINE setRenderDrawColor #-} - -setRenderTarget :: MonadIO m => Renderer -> Texture -> m CInt -setRenderTarget v1 v2 = liftIO $ setRenderTargetFFI v1 v2 -{-# INLINE setRenderTarget #-} - -setTextureAlphaMod :: MonadIO m => Texture -> Word8 -> m CInt -setTextureAlphaMod v1 v2 = liftIO $ setTextureAlphaModFFI v1 v2 -{-# INLINE setTextureAlphaMod #-} - -setTextureBlendMode :: MonadIO m => Texture -> BlendMode -> m CInt -setTextureBlendMode v1 v2 = liftIO $ setTextureBlendModeFFI v1 v2 -{-# INLINE setTextureBlendMode #-} - -setTextureColorMod :: MonadIO m => Texture -> Word8 -> Word8 -> Word8 -> m CInt -setTextureColorMod v1 v2 v3 v4 = liftIO $ setTextureColorModFFI v1 v2 v3 v4 -{-# INLINE setTextureColorMod #-} - -unlockTexture :: MonadIO m => Texture -> m () -unlockTexture v1 = liftIO $ unlockTextureFFI v1 -{-# INLINE unlockTexture #-} - -updateTexture :: MonadIO m => Texture -> Ptr Rect -> Ptr () -> CInt -> m CInt -updateTexture v1 v2 v3 v4 = liftIO $ updateTextureFFI v1 v2 v3 v4 -{-# INLINE updateTexture #-} - -updateYUVTexture :: MonadIO m => Texture -> Ptr Rect -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> m CInt -updateYUVTexture v1 v2 v3 v4 v5 v6 v7 v8 = liftIO $ updateYUVTextureFFI v1 v2 v3 v4 v5 v6 v7 v8 -{-# INLINE updateYUVTexture #-} - -allocFormat :: MonadIO m => Word32 -> m (Ptr PixelFormat) -allocFormat v1 = liftIO $ allocFormatFFI v1 -{-# INLINE allocFormat #-} - -allocPalette :: MonadIO m => CInt -> m (Ptr Palette) -allocPalette v1 = liftIO $ allocPaletteFFI v1 -{-# INLINE allocPalette #-} - -calculateGammaRamp :: MonadIO m => CFloat -> Ptr Word16 -> m () -calculateGammaRamp v1 v2 = liftIO $ calculateGammaRampFFI v1 v2 -{-# INLINE calculateGammaRamp #-} - -freeFormat :: MonadIO m => Ptr PixelFormat -> m () -freeFormat v1 = liftIO $ freeFormatFFI v1 -{-# INLINE freeFormat #-} - -freePalette :: MonadIO m => Ptr Palette -> m () -freePalette v1 = liftIO $ freePaletteFFI v1 -{-# INLINE freePalette #-} - -getPixelFormatName :: MonadIO m => Word32 -> m CString -getPixelFormatName v1 = liftIO $ getPixelFormatNameFFI v1 -{-# INLINE getPixelFormatName #-} - -getRGB :: MonadIO m => Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m () -getRGB v1 v2 v3 v4 v5 = liftIO $ getRGBFFI v1 v2 v3 v4 v5 -{-# INLINE getRGB #-} - -getRGBA :: MonadIO m => Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m () -getRGBA v1 v2 v3 v4 v5 v6 = liftIO $ getRGBAFFI v1 v2 v3 v4 v5 v6 -{-# INLINE getRGBA #-} - -mapRGB :: MonadIO m => Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> m Word32 -mapRGB v1 v2 v3 v4 = liftIO $ mapRGBFFI v1 v2 v3 v4 -{-# INLINE mapRGB #-} - -mapRGBA :: MonadIO m => Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> Word8 -> m Word32 -mapRGBA v1 v2 v3 v4 v5 = liftIO $ mapRGBAFFI v1 v2 v3 v4 v5 -{-# INLINE mapRGBA #-} - -masksToPixelFormatEnum :: MonadIO m => CInt -> Word32 -> Word32 -> Word32 -> Word32 -> m Word32 -masksToPixelFormatEnum v1 v2 v3 v4 v5 = liftIO $ masksToPixelFormatEnumFFI v1 v2 v3 v4 v5 -{-# INLINE masksToPixelFormatEnum #-} - -pixelFormatEnumToMasks :: MonadIO m => Word32 -> Ptr CInt -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> m Bool -pixelFormatEnumToMasks v1 v2 v3 v4 v5 v6 = liftIO $ pixelFormatEnumToMasksFFI v1 v2 v3 v4 v5 v6 -{-# INLINE pixelFormatEnumToMasks #-} - -setPaletteColors :: MonadIO m => Ptr Palette -> Ptr Color -> CInt -> CInt -> m CInt -setPaletteColors v1 v2 v3 v4 = liftIO $ setPaletteColorsFFI v1 v2 v3 v4 -{-# INLINE setPaletteColors #-} - -setPixelFormatPalette :: MonadIO m => Ptr PixelFormat -> Ptr Palette -> m CInt -setPixelFormatPalette v1 v2 = liftIO $ setPixelFormatPaletteFFI v1 v2 -{-# INLINE setPixelFormatPalette #-} - -enclosePoints :: MonadIO m => Ptr Point -> CInt -> Ptr Rect -> Ptr Rect -> m Bool -enclosePoints v1 v2 v3 v4 = liftIO $ enclosePointsFFI v1 v2 v3 v4 -{-# INLINE enclosePoints #-} - -hasIntersection :: MonadIO m => Ptr Rect -> Ptr Rect -> m Bool -hasIntersection v1 v2 = liftIO $ hasIntersectionFFI v1 v2 -{-# INLINE hasIntersection #-} - -intersectRect :: MonadIO m => Ptr Rect -> Ptr Rect -> Ptr Rect -> m Bool -intersectRect v1 v2 v3 = liftIO $ intersectRectFFI v1 v2 v3 -{-# INLINE intersectRect #-} - -intersectRectAndLine :: MonadIO m => Ptr Rect -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> m Bool -intersectRectAndLine v1 v2 v3 v4 v5 = liftIO $ intersectRectAndLineFFI v1 v2 v3 v4 v5 -{-# INLINE intersectRectAndLine #-} - -unionRect :: MonadIO m => Ptr Rect -> Ptr Rect -> Ptr Rect -> m () -unionRect v1 v2 v3 = liftIO $ unionRectFFI v1 v2 v3 -{-# INLINE unionRect #-} - -blitScaled :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt -blitScaled v1 v2 v3 v4 = liftIO $ blitScaledFFI v1 v2 v3 v4 -{-# INLINE blitScaled #-} - -blitSurface :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt -blitSurface v1 v2 v3 v4 = liftIO $ blitSurfaceFFI v1 v2 v3 v4 -{-# INLINE blitSurface #-} - -convertPixels :: MonadIO m => CInt -> CInt -> Word32 -> Ptr () -> CInt -> Word32 -> Ptr () -> CInt -> m CInt -convertPixels v1 v2 v3 v4 v5 v6 v7 v8 = liftIO $ convertPixelsFFI v1 v2 v3 v4 v5 v6 v7 v8 -{-# INLINE convertPixels #-} - -convertSurface :: MonadIO m => Ptr Surface -> Ptr PixelFormat -> Word32 -> m (Ptr Surface) -convertSurface v1 v2 v3 = liftIO $ convertSurfaceFFI v1 v2 v3 -{-# INLINE convertSurface #-} - -convertSurfaceFormat :: MonadIO m => Ptr Surface -> Word32 -> Word32 -> m (Ptr Surface) -convertSurfaceFormat v1 v2 v3 = liftIO $ convertSurfaceFormatFFI v1 v2 v3 -{-# INLINE convertSurfaceFormat #-} - -createRGBSurface :: MonadIO m => Word32 -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> m (Ptr Surface) -createRGBSurface v1 v2 v3 v4 v5 v6 v7 v8 = liftIO $ createRGBSurfaceFFI v1 v2 v3 v4 v5 v6 v7 v8 -{-# INLINE createRGBSurface #-} - -createRGBSurfaceFrom :: MonadIO m => Ptr () -> CInt -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> m (Ptr Surface) -createRGBSurfaceFrom v1 v2 v3 v4 v5 v6 v7 v8 v9 = liftIO $ createRGBSurfaceFromFFI v1 v2 v3 v4 v5 v6 v7 v8 v9 -{-# INLINE createRGBSurfaceFrom #-} - -fillRect :: MonadIO m => Ptr Surface -> Ptr Rect -> Word32 -> m CInt -fillRect v1 v2 v3 = liftIO $ fillRectFFI v1 v2 v3 -{-# INLINE fillRect #-} - -fillRects :: MonadIO m => Ptr Surface -> Ptr Rect -> CInt -> Word32 -> m CInt -fillRects v1 v2 v3 v4 = liftIO $ fillRectsFFI v1 v2 v3 v4 -{-# INLINE fillRects #-} - -freeSurface :: MonadIO m => Ptr Surface -> m () -freeSurface v1 = liftIO $ freeSurfaceFFI v1 -{-# INLINE freeSurface #-} - -getClipRect :: MonadIO m => Ptr Surface -> Ptr Rect -> m () -getClipRect v1 v2 = liftIO $ getClipRectFFI v1 v2 -{-# INLINE getClipRect #-} - -getColorKey :: MonadIO m => Ptr Surface -> Ptr Word32 -> m CInt -getColorKey v1 v2 = liftIO $ getColorKeyFFI v1 v2 -{-# INLINE getColorKey #-} - -getSurfaceAlphaMod :: MonadIO m => Ptr Surface -> Ptr Word8 -> m CInt -getSurfaceAlphaMod v1 v2 = liftIO $ getSurfaceAlphaModFFI v1 v2 -{-# INLINE getSurfaceAlphaMod #-} - -getSurfaceBlendMode :: MonadIO m => Ptr Surface -> Ptr BlendMode -> m CInt -getSurfaceBlendMode v1 v2 = liftIO $ getSurfaceBlendModeFFI v1 v2 -{-# INLINE getSurfaceBlendMode #-} - -getSurfaceColorMod :: MonadIO m => Ptr Surface -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m CInt -getSurfaceColorMod v1 v2 v3 v4 = liftIO $ getSurfaceColorModFFI v1 v2 v3 v4 -{-# INLINE getSurfaceColorMod #-} - -loadBMP :: MonadIO m => CString -> m (Ptr Surface) -loadBMP file = liftIO $ do - rw <- withCString "rb" $ rwFromFile file - loadBMP_RW rw 1 -{-# INLINE loadBMP #-} - -loadBMP_RW :: MonadIO m => Ptr RWops -> CInt -> m (Ptr Surface) -loadBMP_RW v1 v2 = liftIO $ loadBMP_RWFFI v1 v2 -{-# INLINE loadBMP_RW #-} - -lockSurface :: MonadIO m => Ptr Surface -> m CInt -lockSurface v1 = liftIO $ lockSurfaceFFI v1 -{-# INLINE lockSurface #-} - -lowerBlit :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt -lowerBlit v1 v2 v3 v4 = liftIO $ lowerBlitFFI v1 v2 v3 v4 -{-# INLINE lowerBlit #-} - -lowerBlitScaled :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt -lowerBlitScaled v1 v2 v3 v4 = liftIO $ lowerBlitScaledFFI v1 v2 v3 v4 -{-# INLINE lowerBlitScaled #-} - -saveBMP :: MonadIO m => Ptr Surface -> CString -> m CInt -saveBMP surface file = liftIO $ do - rw <- withCString "wb" $ rwFromFile file - saveBMP_RW surface rw 1 -{-# INLINE saveBMP #-} - -saveBMP_RW :: MonadIO m => Ptr Surface -> Ptr RWops -> CInt -> m CInt -saveBMP_RW v1 v2 v3 = liftIO $ saveBMP_RWFFI v1 v2 v3 -{-# INLINE saveBMP_RW #-} - -setClipRect :: MonadIO m => Ptr Surface -> Ptr Rect -> m Bool -setClipRect v1 v2 = liftIO $ setClipRectFFI v1 v2 -{-# INLINE setClipRect #-} - -setColorKey :: MonadIO m => Ptr Surface -> CInt -> Word32 -> m CInt -setColorKey v1 v2 v3 = liftIO $ setColorKeyFFI v1 v2 v3 -{-# INLINE setColorKey #-} - -setSurfaceAlphaMod :: MonadIO m => Ptr Surface -> Word8 -> m CInt -setSurfaceAlphaMod v1 v2 = liftIO $ setSurfaceAlphaModFFI v1 v2 -{-# INLINE setSurfaceAlphaMod #-} - -setSurfaceBlendMode :: MonadIO m => Ptr Surface -> BlendMode -> m CInt -setSurfaceBlendMode v1 v2 = liftIO $ setSurfaceBlendModeFFI v1 v2 -{-# INLINE setSurfaceBlendMode #-} - -setSurfaceColorMod :: MonadIO m => Ptr Surface -> Word8 -> Word8 -> Word8 -> m CInt -setSurfaceColorMod v1 v2 v3 v4 = liftIO $ setSurfaceColorModFFI v1 v2 v3 v4 -{-# INLINE setSurfaceColorMod #-} - -setSurfacePalette :: MonadIO m => Ptr Surface -> Ptr Palette -> m CInt -setSurfacePalette v1 v2 = liftIO $ setSurfacePaletteFFI v1 v2 -{-# INLINE setSurfacePalette #-} - -setSurfaceRLE :: MonadIO m => Ptr Surface -> CInt -> m CInt -setSurfaceRLE v1 v2 = liftIO $ setSurfaceRLEFFI v1 v2 -{-# INLINE setSurfaceRLE #-} - -unlockSurface :: MonadIO m => Ptr Surface -> m () -unlockSurface v1 = liftIO $ unlockSurfaceFFI v1 -{-# INLINE unlockSurface #-} - -getWindowWMInfo :: MonadIO m => Window -> SysWMinfo -> m Bool -getWindowWMInfo v1 v2 = liftIO $ getWindowWMInfoFFI v1 v2 -{-# INLINE getWindowWMInfo #-} - -getClipboardText :: MonadIO m => m CString -getClipboardText = liftIO getClipboardTextFFI -{-# INLINE getClipboardText #-} - -hasClipboardText :: MonadIO m => m Bool -hasClipboardText = liftIO hasClipboardTextFFI -{-# INLINE hasClipboardText #-} - -setClipboardText :: MonadIO m => CString -> m CInt -setClipboardText v1 = liftIO $ setClipboardTextFFI v1 -{-# INLINE setClipboardText #-} +module SDL.Raw.Video ( + -- * Display and Window Management + createWindow, + createWindowAndRenderer, + createWindowFrom, + destroyWindow, + disableScreenSaver, + enableScreenSaver, + glBindTexture, + glCreateContext, + glDeleteContext, + glExtensionSupported, + glGetAttribute, + glGetCurrentContext, + glGetCurrentWindow, + glGetDrawableSize, + glGetProcAddress, + glGetSwapInterval, + glLoadLibrary, + glMakeCurrent, + glResetAttributes, + glSetAttribute, + glSetSwapInterval, + glSwapWindow, + glUnbindTexture, + glUnloadLibrary, + getClosestDisplayMode, + getCurrentDisplayMode, + getCurrentVideoDriver, + getDesktopDisplayMode, + getDisplayBounds, + getDisplayMode, + getDisplayName, + getNumDisplayModes, + getNumVideoDisplays, + getNumVideoDrivers, + getVideoDriver, + getWindowBrightness, + getWindowData, + getWindowDisplayIndex, + getWindowDisplayMode, + getWindowFlags, + getWindowFromID, + getWindowGammaRamp, + getWindowGrab, + getWindowID, + getWindowMaximumSize, + getWindowMinimumSize, + getWindowPixelFormat, + getWindowPosition, + getWindowSize, + getWindowSurface, + getWindowTitle, + hideWindow, + isScreenSaverEnabled, + maximizeWindow, + minimizeWindow, + raiseWindow, + restoreWindow, + setWindowBordered, + setWindowBrightness, + setWindowData, + setWindowDisplayMode, + setWindowFullscreen, + setWindowGammaRamp, + setWindowGrab, + setWindowIcon, + setWindowMaximumSize, + setWindowMinimumSize, + setWindowPosition, + setWindowSize, + setWindowTitle, + showMessageBox, + showSimpleMessageBox, + showWindow, + updateWindowSurface, + updateWindowSurfaceRects, + videoInit, + videoQuit, + + -- * 2D Accelerated Rendering + createRenderer, + createSoftwareRenderer, + createTexture, + createTextureFromSurface, + destroyRenderer, + destroyTexture, + getNumRenderDrivers, + getRenderDrawBlendMode, + getRenderDrawColor, + getRenderDriverInfo, + getRenderTarget, + getRenderer, + getRendererInfo, + getRendererOutputSize, + getTextureAlphaMod, + getTextureBlendMode, + getTextureColorMod, + lockTexture, + queryTexture, + renderClear, + renderCopy, + renderCopyEx, + renderDrawLine, + renderDrawLines, + renderDrawPoint, + renderDrawPoints, + renderDrawRect, + renderDrawRects, + renderFillRect, + renderFillRects, + renderGetClipRect, + renderGetLogicalSize, + renderGetScale, + renderGetViewport, + renderPresent, + renderReadPixels, + renderSetClipRect, + renderSetLogicalSize, + renderSetScale, + renderSetViewport, + renderTargetSupported, + setRenderDrawBlendMode, + setRenderDrawColor, + setRenderTarget, + setTextureAlphaMod, + setTextureBlendMode, + setTextureColorMod, + unlockTexture, + updateTexture, + updateYUVTexture, + + -- * Pixel Formats and Conversion Routines + allocFormat, + allocPalette, + calculateGammaRamp, + freeFormat, + freePalette, + getPixelFormatName, + getRGB, + getRGBA, + mapRGB, + mapRGBA, + masksToPixelFormatEnum, + pixelFormatEnumToMasks, + setPaletteColors, + setPixelFormatPalette, + + -- * Rectangle Functions + enclosePoints, + hasIntersection, + intersectRect, + intersectRectAndLine, + unionRect, + + -- * Surface Creation and Simple Drawing + blitScaled, + blitSurface, + convertPixels, + convertSurface, + convertSurfaceFormat, + createRGBSurface, + createRGBSurfaceFrom, + fillRect, + fillRects, + freeSurface, + getClipRect, + getColorKey, + getSurfaceAlphaMod, + getSurfaceBlendMode, + getSurfaceColorMod, + loadBMP, + loadBMP_RW, + lockSurface, + lowerBlit, + lowerBlitScaled, + saveBMP, + saveBMP_RW, + setClipRect, + setColorKey, + setSurfaceAlphaMod, + setSurfaceBlendMode, + setSurfaceColorMod, + setSurfacePalette, + setSurfaceRLE, + unlockSurface, + + -- * Platform-specific Window Management + getWindowWMInfo, + + -- * Clipboard Handling + getClipboardText, + hasClipboardText, + setClipboardText +) where + +import Control.Monad.IO.Class +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import SDL.Raw.Enum +import SDL.Raw.Filesystem +import SDL.Raw.Types + +foreign import ccall "SDL.h SDL_CreateWindow" createWindowFFI :: CString -> CInt -> CInt -> CInt -> CInt -> Word32 -> IO Window +foreign import ccall "SDL.h SDL_CreateWindowAndRenderer" createWindowAndRendererFFI :: CInt -> CInt -> Word32 -> Ptr Window -> Ptr Renderer -> IO CInt +foreign import ccall "SDL.h SDL_CreateWindowFrom" createWindowFromFFI :: Ptr () -> IO Window +foreign import ccall "SDL.h SDL_DestroyWindow" destroyWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_DisableScreenSaver" disableScreenSaverFFI :: IO () +foreign import ccall "SDL.h SDL_EnableScreenSaver" enableScreenSaverFFI :: IO () +foreign import ccall "SDL.h SDL_GL_BindTexture" glBindTextureFFI :: Texture -> Ptr CFloat -> Ptr CFloat -> IO CInt +foreign import ccall "SDL.h SDL_GL_CreateContext" glCreateContextFFI :: Window -> IO GLContext +foreign import ccall "SDL.h SDL_GL_DeleteContext" glDeleteContextFFI :: GLContext -> IO () +foreign import ccall "SDL.h SDL_GL_ExtensionSupported" glExtensionSupportedFFI :: CString -> IO Bool +foreign import ccall "SDL.h SDL_GL_GetAttribute" glGetAttributeFFI :: GLattr -> Ptr CInt -> IO CInt +foreign import ccall "SDL.h SDL_GL_GetCurrentContext" glGetCurrentContextFFI :: IO GLContext +foreign import ccall "SDL.h SDL_GL_GetCurrentWindow" glGetCurrentWindowFFI :: IO Window +foreign import ccall "SDL.h SDL_GL_GetDrawableSize" glGetDrawableSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () +foreign import ccall "SDL.h SDL_GL_GetProcAddress" glGetProcAddressFFI :: CString -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_GL_GetSwapInterval" glGetSwapIntervalFFI :: IO CInt +foreign import ccall "SDL.h SDL_GL_LoadLibrary" glLoadLibraryFFI :: CString -> IO CInt +foreign import ccall "SDL.h SDL_GL_MakeCurrent" glMakeCurrentFFI :: Window -> GLContext -> IO CInt +foreign import ccall "SDL.h SDL_GL_ResetAttributes" glResetAttributesFFI :: IO () +foreign import ccall "SDL.h SDL_GL_SetAttribute" glSetAttributeFFI :: GLattr -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_GL_SetSwapInterval" glSetSwapIntervalFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_GL_SwapWindow" glSwapWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_GL_UnbindTexture" glUnbindTextureFFI :: Texture -> IO CInt +foreign import ccall "SDL.h SDL_GL_UnloadLibrary" glUnloadLibraryFFI :: IO () +foreign import ccall "SDL.h SDL_GetClosestDisplayMode" getClosestDisplayModeFFI :: CInt -> Ptr DisplayMode -> Ptr DisplayMode -> IO (Ptr DisplayMode) +foreign import ccall "SDL.h SDL_GetCurrentDisplayMode" getCurrentDisplayModeFFI :: CInt -> Ptr DisplayMode -> IO CInt +foreign import ccall "SDL.h SDL_GetCurrentVideoDriver" getCurrentVideoDriverFFI :: IO CString +foreign import ccall "SDL.h SDL_GetDesktopDisplayMode" getDesktopDisplayModeFFI :: CInt -> Ptr DisplayMode -> IO CInt +foreign import ccall "SDL.h SDL_GetDisplayBounds" getDisplayBoundsFFI :: CInt -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_GetDisplayMode" getDisplayModeFFI :: CInt -> CInt -> Ptr DisplayMode -> IO CInt +foreign import ccall "SDL.h SDL_GetDisplayName" getDisplayNameFFI :: CInt -> IO CString +foreign import ccall "SDL.h SDL_GetNumDisplayModes" getNumDisplayModesFFI :: CInt -> IO CInt +foreign import ccall "SDL.h SDL_GetNumVideoDisplays" getNumVideoDisplaysFFI :: IO CInt +foreign import ccall "SDL.h SDL_GetNumVideoDrivers" getNumVideoDriversFFI :: IO CInt +foreign import ccall "SDL.h SDL_GetVideoDriver" getVideoDriverFFI :: CInt -> IO CString +foreign import ccall "SDL.h SDL_GetWindowBrightness" getWindowBrightnessFFI :: Window -> IO CFloat +foreign import ccall "SDL.h SDL_GetWindowData" getWindowDataFFI :: Window -> CString -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_GetWindowDisplayIndex" getWindowDisplayIndexFFI :: Window -> IO CInt +foreign import ccall "SDL.h SDL_GetWindowDisplayMode" getWindowDisplayModeFFI :: Window -> Ptr DisplayMode -> IO CInt +foreign import ccall "SDL.h SDL_GetWindowFlags" getWindowFlagsFFI :: Window -> IO Word32 +foreign import ccall "SDL.h SDL_GetWindowFromID" getWindowFromIDFFI :: Word32 -> IO Window +foreign import ccall "SDL.h SDL_GetWindowGammaRamp" getWindowGammaRampFFI :: Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt +foreign import ccall "SDL.h SDL_GetWindowGrab" getWindowGrabFFI :: Window -> IO Bool +foreign import ccall "SDL.h SDL_GetWindowID" getWindowIDFFI :: Window -> IO Word32 +foreign import ccall "SDL.h SDL_GetWindowMaximumSize" getWindowMaximumSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () +foreign import ccall "SDL.h SDL_GetWindowMinimumSize" getWindowMinimumSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () +foreign import ccall "SDL.h SDL_GetWindowPixelFormat" getWindowPixelFormatFFI :: Window -> IO Word32 +foreign import ccall "SDL.h SDL_GetWindowPosition" getWindowPositionFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () +foreign import ccall "SDL.h SDL_GetWindowSize" getWindowSizeFFI :: Window -> Ptr CInt -> Ptr CInt -> IO () +foreign import ccall "SDL.h SDL_GetWindowSurface" getWindowSurfaceFFI :: Window -> IO (Ptr Surface) +foreign import ccall "SDL.h SDL_GetWindowTitle" getWindowTitleFFI :: Window -> IO CString +foreign import ccall "SDL.h SDL_HideWindow" hideWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_IsScreenSaverEnabled" isScreenSaverEnabledFFI :: IO Bool +foreign import ccall "SDL.h SDL_MaximizeWindow" maximizeWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_MinimizeWindow" minimizeWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_RaiseWindow" raiseWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_RestoreWindow" restoreWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_SetWindowBordered" setWindowBorderedFFI :: Window -> Bool -> IO () +foreign import ccall "SDL.h SDL_SetWindowBrightness" setWindowBrightnessFFI :: Window -> CFloat -> IO CInt +foreign import ccall "SDL.h SDL_SetWindowData" setWindowDataFFI :: Window -> CString -> Ptr () -> IO (Ptr ()) +foreign import ccall "SDL.h SDL_SetWindowDisplayMode" setWindowDisplayModeFFI :: Window -> Ptr DisplayMode -> IO CInt +foreign import ccall "SDL.h SDL_SetWindowFullscreen" setWindowFullscreenFFI :: Window -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_SetWindowGammaRamp" setWindowGammaRampFFI :: Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> IO CInt +foreign import ccall "SDL.h SDL_SetWindowGrab" setWindowGrabFFI :: Window -> Bool -> IO () +foreign import ccall "SDL.h SDL_SetWindowIcon" setWindowIconFFI :: Window -> Ptr Surface -> IO () +foreign import ccall "SDL.h SDL_SetWindowMaximumSize" setWindowMaximumSizeFFI :: Window -> CInt -> CInt -> IO () +foreign import ccall "SDL.h SDL_SetWindowMinimumSize" setWindowMinimumSizeFFI :: Window -> CInt -> CInt -> IO () +foreign import ccall "SDL.h SDL_SetWindowPosition" setWindowPositionFFI :: Window -> CInt -> CInt -> IO () +foreign import ccall "SDL.h SDL_SetWindowSize" setWindowSizeFFI :: Window -> CInt -> CInt -> IO () +foreign import ccall "SDL.h SDL_SetWindowTitle" setWindowTitleFFI :: Window -> CString -> IO () +foreign import ccall "SDL.h SDL_ShowMessageBox" showMessageBoxFFI :: Ptr MessageBoxData -> Ptr CInt -> IO CInt +foreign import ccall "SDL.h SDL_ShowSimpleMessageBox" showSimpleMessageBoxFFI :: Word32 -> CString -> CString -> Window -> IO CInt +foreign import ccall "SDL.h SDL_ShowWindow" showWindowFFI :: Window -> IO () +foreign import ccall "SDL.h SDL_UpdateWindowSurface" updateWindowSurfaceFFI :: Window -> IO CInt +foreign import ccall "SDL.h SDL_UpdateWindowSurfaceRects" updateWindowSurfaceRectsFFI :: Window -> Ptr Rect -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_VideoInit" videoInitFFI :: CString -> IO CInt +foreign import ccall "SDL.h SDL_VideoQuit" videoQuitFFI :: IO () + +foreign import ccall "SDL.h SDL_CreateRenderer" createRendererFFI :: Window -> CInt -> Word32 -> IO Renderer +foreign import ccall "SDL.h SDL_CreateSoftwareRenderer" createSoftwareRendererFFI :: Ptr Surface -> IO Renderer +foreign import ccall "SDL.h SDL_CreateTexture" createTextureFFI :: Renderer -> Word32 -> CInt -> CInt -> CInt -> IO Texture +foreign import ccall "SDL.h SDL_CreateTextureFromSurface" createTextureFromSurfaceFFI :: Renderer -> Ptr Surface -> IO Texture +foreign import ccall "SDL.h SDL_DestroyRenderer" destroyRendererFFI :: Renderer -> IO () +foreign import ccall "SDL.h SDL_DestroyTexture" destroyTextureFFI :: Texture -> IO () +foreign import ccall "SDL.h SDL_GetNumRenderDrivers" getNumRenderDriversFFI :: IO CInt +foreign import ccall "SDL.h SDL_GetRenderDrawBlendMode" getRenderDrawBlendModeFFI :: Renderer -> Ptr BlendMode -> IO Int +foreign import ccall "SDL.h SDL_GetRenderDrawColor" getRenderDrawColorFFI :: Renderer -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt +foreign import ccall "SDL.h SDL_GetRenderDriverInfo" getRenderDriverInfoFFI :: CInt -> Ptr RendererInfo -> IO CInt +foreign import ccall "SDL.h SDL_GetRenderTarget" getRenderTargetFFI :: Renderer -> IO Texture +foreign import ccall "SDL.h SDL_GetRenderer" getRendererFFI :: Window -> IO Renderer +foreign import ccall "SDL.h SDL_GetRendererInfo" getRendererInfoFFI :: Renderer -> Ptr RendererInfo -> IO CInt +foreign import ccall "SDL.h SDL_GetRendererOutputSize" getRendererOutputSizeFFI :: Renderer -> Ptr CInt -> Ptr CInt -> IO CInt +foreign import ccall "SDL.h SDL_GetTextureAlphaMod" getTextureAlphaModFFI :: Texture -> Ptr Word8 -> IO CInt +foreign import ccall "SDL.h SDL_GetTextureBlendMode" getTextureBlendModeFFI :: Texture -> Ptr BlendMode -> IO CInt +foreign import ccall "SDL.h SDL_GetTextureColorMod" getTextureColorModFFI :: Texture -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt +foreign import ccall "SDL.h SDL_LockTexture" lockTextureFFI :: Texture -> Ptr Rect -> Ptr (Ptr ()) -> Ptr CInt -> IO CInt +foreign import ccall "SDL.h SDL_QueryTexture" queryTextureFFI :: Texture -> Ptr Word32 -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderClear" renderClearFFI :: Renderer -> IO CInt +foreign import ccall "SDL.h SDL_RenderCopy" renderCopyFFI :: Renderer -> Texture -> Ptr Rect -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_RenderCopyEx" renderCopyExFFI :: Renderer -> Texture -> Ptr Rect -> Ptr Rect -> CDouble -> Ptr Point -> RendererFlip -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawLine" renderDrawLineFFI :: Renderer -> CInt -> CInt -> CInt -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawLines" renderDrawLinesFFI :: Renderer -> Ptr Point -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawPoint" renderDrawPointFFI :: Renderer -> CInt -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawPoints" renderDrawPointsFFI :: Renderer -> Ptr Point -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawRect" renderDrawRectFFI :: Renderer -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_RenderDrawRects" renderDrawRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderFillRect" renderFillRectFFI :: Renderer -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_RenderFillRects" renderFillRectsFFI :: Renderer -> Ptr Rect -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderGetClipRect" renderGetClipRectFFI :: Renderer -> Ptr Rect -> IO () +foreign import ccall "SDL.h SDL_RenderGetLogicalSize" renderGetLogicalSizeFFI :: Renderer -> Ptr CInt -> Ptr CInt -> IO () +foreign import ccall "SDL.h SDL_RenderGetScale" renderGetScaleFFI :: Renderer -> Ptr CFloat -> Ptr CFloat -> IO () +foreign import ccall "SDL.h SDL_RenderGetViewport" renderGetViewportFFI :: Renderer -> Ptr Rect -> IO () +foreign import ccall "SDL.h SDL_RenderPresent" renderPresentFFI :: Renderer -> IO () +foreign import ccall "SDL.h SDL_RenderReadPixels" renderReadPixelsFFI :: Renderer -> Ptr Rect -> Word32 -> Ptr () -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderSetClipRect" renderSetClipRectFFI :: Renderer -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_RenderSetLogicalSize" renderSetLogicalSizeFFI :: Renderer -> CInt -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_RenderSetScale" renderSetScaleFFI :: Renderer -> CFloat -> CFloat -> IO CInt +foreign import ccall "SDL.h SDL_RenderSetViewport" renderSetViewportFFI :: Renderer -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_RenderTargetSupported" renderTargetSupportedFFI :: Renderer -> IO Bool +foreign import ccall "SDL.h SDL_SetRenderDrawBlendMode" setRenderDrawBlendModeFFI :: Renderer -> BlendMode -> IO CInt +foreign import ccall "SDL.h SDL_SetRenderDrawColor" setRenderDrawColorFFI :: Renderer -> Word8 -> Word8 -> Word8 -> Word8 -> IO CInt +foreign import ccall "SDL.h SDL_SetRenderTarget" setRenderTargetFFI :: Renderer -> Texture -> IO CInt +foreign import ccall "SDL.h SDL_SetTextureAlphaMod" setTextureAlphaModFFI :: Texture -> Word8 -> IO CInt +foreign import ccall "SDL.h SDL_SetTextureBlendMode" setTextureBlendModeFFI :: Texture -> BlendMode -> IO CInt +foreign import ccall "SDL.h SDL_SetTextureColorMod" setTextureColorModFFI :: Texture -> Word8 -> Word8 -> Word8 -> IO CInt +foreign import ccall "SDL.h SDL_UnlockTexture" unlockTextureFFI :: Texture -> IO () +foreign import ccall "SDL.h SDL_UpdateTexture" updateTextureFFI :: Texture -> Ptr Rect -> Ptr () -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_UpdateYUVTexture" updateYUVTextureFFI :: Texture -> Ptr Rect -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO CInt + +foreign import ccall "SDL.h SDL_AllocFormat" allocFormatFFI :: Word32 -> IO (Ptr PixelFormat) +foreign import ccall "SDL.h SDL_AllocPalette" allocPaletteFFI :: CInt -> IO (Ptr Palette) +foreign import ccall "SDL.h SDL_CalculateGammaRamp" calculateGammaRampFFI :: CFloat -> Ptr Word16 -> IO () +foreign import ccall "SDL.h SDL_FreeFormat" freeFormatFFI :: Ptr PixelFormat -> IO () +foreign import ccall "SDL.h SDL_FreePalette" freePaletteFFI :: Ptr Palette -> IO () +foreign import ccall "SDL.h SDL_GetPixelFormatName" getPixelFormatNameFFI :: Word32 -> IO CString +foreign import ccall "SDL.h SDL_GetRGB" getRGBFFI :: Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall "SDL.h SDL_GetRGBA" getRGBAFFI :: Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () +foreign import ccall "SDL.h SDL_MapRGB" mapRGBFFI :: Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> IO Word32 +foreign import ccall "SDL.h SDL_MapRGBA" mapRGBAFFI :: Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> Word8 -> IO Word32 +foreign import ccall "SDL.h SDL_MasksToPixelFormatEnum" masksToPixelFormatEnumFFI :: CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO Word32 +foreign import ccall "SDL.h SDL_PixelFormatEnumToMasks" pixelFormatEnumToMasksFFI :: Word32 -> Ptr CInt -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> IO Bool +foreign import ccall "SDL.h SDL_SetPaletteColors" setPaletteColorsFFI :: Ptr Palette -> Ptr Color -> CInt -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_SetPixelFormatPalette" setPixelFormatPaletteFFI :: Ptr PixelFormat -> Ptr Palette -> IO CInt + +foreign import ccall "SDL.h SDL_EnclosePoints" enclosePointsFFI :: Ptr Point -> CInt -> Ptr Rect -> Ptr Rect -> IO Bool +foreign import ccall "SDL.h SDL_HasIntersection" hasIntersectionFFI :: Ptr Rect -> Ptr Rect -> IO Bool +foreign import ccall "SDL.h SDL_IntersectRect" intersectRectFFI :: Ptr Rect -> Ptr Rect -> Ptr Rect -> IO Bool +foreign import ccall "SDL.h SDL_IntersectRectAndLine" intersectRectAndLineFFI :: Ptr Rect -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO Bool +foreign import ccall "SDL.h SDL_UnionRect" unionRectFFI :: Ptr Rect -> Ptr Rect -> Ptr Rect -> IO () + +foreign import ccall "SDL.h SDL_UpperBlitScaled" blitScaledFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_UpperBlit" blitSurfaceFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_ConvertPixels" convertPixelsFFI :: CInt -> CInt -> Word32 -> Ptr () -> CInt -> Word32 -> Ptr () -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_ConvertSurface" convertSurfaceFFI :: Ptr Surface -> Ptr PixelFormat -> Word32 -> IO (Ptr Surface) +foreign import ccall "SDL.h SDL_ConvertSurfaceFormat" convertSurfaceFormatFFI :: Ptr Surface -> Word32 -> Word32 -> IO (Ptr Surface) +foreign import ccall "SDL.h SDL_CreateRGBSurface" createRGBSurfaceFFI :: Word32 -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr Surface) +foreign import ccall "SDL.h SDL_CreateRGBSurfaceFrom" createRGBSurfaceFromFFI :: Ptr () -> CInt -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> IO (Ptr Surface) +foreign import ccall "SDL.h SDL_FillRect" fillRectFFI :: Ptr Surface -> Ptr Rect -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_FillRects" fillRectsFFI :: Ptr Surface -> Ptr Rect -> CInt -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_FreeSurface" freeSurfaceFFI :: Ptr Surface -> IO () +foreign import ccall "SDL.h SDL_GetClipRect" getClipRectFFI :: Ptr Surface -> Ptr Rect -> IO () +foreign import ccall "SDL.h SDL_GetColorKey" getColorKeyFFI :: Ptr Surface -> Ptr Word32 -> IO CInt +foreign import ccall "SDL.h SDL_GetSurfaceAlphaMod" getSurfaceAlphaModFFI :: Ptr Surface -> Ptr Word8 -> IO CInt +foreign import ccall "SDL.h SDL_GetSurfaceBlendMode" getSurfaceBlendModeFFI :: Ptr Surface -> Ptr BlendMode -> IO CInt +foreign import ccall "SDL.h SDL_GetSurfaceColorMod" getSurfaceColorModFFI :: Ptr Surface -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO CInt +foreign import ccall "SDL.h SDL_LoadBMP_RW" loadBMP_RWFFI :: Ptr RWops -> CInt -> IO (Ptr Surface) +foreign import ccall "SDL.h SDL_LockSurface" lockSurfaceFFI :: Ptr Surface -> IO CInt +foreign import ccall "SDL.h SDL_LowerBlit" lowerBlitFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_LowerBlitScaled" lowerBlitScaledFFI :: Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> IO CInt +foreign import ccall "SDL.h SDL_SaveBMP_RW" saveBMP_RWFFI :: Ptr Surface -> Ptr RWops -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_SetClipRect" setClipRectFFI :: Ptr Surface -> Ptr Rect -> IO Bool +foreign import ccall "SDL.h SDL_SetColorKey" setColorKeyFFI :: Ptr Surface -> CInt -> Word32 -> IO CInt +foreign import ccall "SDL.h SDL_SetSurfaceAlphaMod" setSurfaceAlphaModFFI :: Ptr Surface -> Word8 -> IO CInt +foreign import ccall "SDL.h SDL_SetSurfaceBlendMode" setSurfaceBlendModeFFI :: Ptr Surface -> BlendMode -> IO CInt +foreign import ccall "SDL.h SDL_SetSurfaceColorMod" setSurfaceColorModFFI :: Ptr Surface -> Word8 -> Word8 -> Word8 -> IO CInt +foreign import ccall "SDL.h SDL_SetSurfacePalette" setSurfacePaletteFFI :: Ptr Surface -> Ptr Palette -> IO CInt +foreign import ccall "SDL.h SDL_SetSurfaceRLE" setSurfaceRLEFFI :: Ptr Surface -> CInt -> IO CInt +foreign import ccall "SDL.h SDL_UnlockSurface" unlockSurfaceFFI :: Ptr Surface -> IO () + +foreign import ccall "SDL.h SDL_GetWindowWMInfo" getWindowWMInfoFFI :: Window -> SysWMinfo -> IO Bool + +foreign import ccall "SDL.h SDL_GetClipboardText" getClipboardTextFFI :: IO CString +foreign import ccall "SDL.h SDL_HasClipboardText" hasClipboardTextFFI :: IO Bool +foreign import ccall "SDL.h SDL_SetClipboardText" setClipboardTextFFI :: CString -> IO CInt + +createWindow :: MonadIO m => CString -> CInt -> CInt -> CInt -> CInt -> Word32 -> m Window +createWindow v1 v2 v3 v4 v5 v6 = liftIO $ createWindowFFI v1 v2 v3 v4 v5 v6 +{-# INLINE createWindow #-} + +createWindowAndRenderer :: MonadIO m => CInt -> CInt -> Word32 -> Ptr Window -> Ptr Renderer -> m CInt +createWindowAndRenderer v1 v2 v3 v4 v5 = liftIO $ createWindowAndRendererFFI v1 v2 v3 v4 v5 +{-# INLINE createWindowAndRenderer #-} + +createWindowFrom :: MonadIO m => Ptr () -> m Window +createWindowFrom v1 = liftIO $ createWindowFromFFI v1 +{-# INLINE createWindowFrom #-} + +destroyWindow :: MonadIO m => Window -> m () +destroyWindow v1 = liftIO $ destroyWindowFFI v1 +{-# INLINE destroyWindow #-} + +disableScreenSaver :: MonadIO m => m () +disableScreenSaver = liftIO disableScreenSaverFFI +{-# INLINE disableScreenSaver #-} + +enableScreenSaver :: MonadIO m => m () +enableScreenSaver = liftIO enableScreenSaverFFI +{-# INLINE enableScreenSaver #-} + +glBindTexture :: MonadIO m => Texture -> Ptr CFloat -> Ptr CFloat -> m CInt +glBindTexture v1 v2 v3 = liftIO $ glBindTextureFFI v1 v2 v3 +{-# INLINE glBindTexture #-} + +glCreateContext :: MonadIO m => Window -> m GLContext +glCreateContext v1 = liftIO $ glCreateContextFFI v1 +{-# INLINE glCreateContext #-} + +glDeleteContext :: MonadIO m => GLContext -> m () +glDeleteContext v1 = liftIO $ glDeleteContextFFI v1 +{-# INLINE glDeleteContext #-} + +glExtensionSupported :: MonadIO m => CString -> m Bool +glExtensionSupported v1 = liftIO $ glExtensionSupportedFFI v1 +{-# INLINE glExtensionSupported #-} + +glGetAttribute :: MonadIO m => GLattr -> Ptr CInt -> m CInt +glGetAttribute v1 v2 = liftIO $ glGetAttributeFFI v1 v2 +{-# INLINE glGetAttribute #-} + +glGetCurrentContext :: MonadIO m => m GLContext +glGetCurrentContext = liftIO glGetCurrentContextFFI +{-# INLINE glGetCurrentContext #-} + +glGetCurrentWindow :: MonadIO m => m Window +glGetCurrentWindow = liftIO glGetCurrentWindowFFI +{-# INLINE glGetCurrentWindow #-} + +glGetDrawableSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () +glGetDrawableSize v1 v2 v3 = liftIO $ glGetDrawableSizeFFI v1 v2 v3 +{-# INLINE glGetDrawableSize #-} + +glGetProcAddress :: MonadIO m => CString -> m (Ptr ()) +glGetProcAddress v1 = liftIO $ glGetProcAddressFFI v1 +{-# INLINE glGetProcAddress #-} + +glGetSwapInterval :: MonadIO m => m CInt +glGetSwapInterval = liftIO glGetSwapIntervalFFI +{-# INLINE glGetSwapInterval #-} + +glLoadLibrary :: MonadIO m => CString -> m CInt +glLoadLibrary v1 = liftIO $ glLoadLibraryFFI v1 +{-# INLINE glLoadLibrary #-} + +glMakeCurrent :: MonadIO m => Window -> GLContext -> m CInt +glMakeCurrent v1 v2 = liftIO $ glMakeCurrentFFI v1 v2 +{-# INLINE glMakeCurrent #-} + +glResetAttributes :: MonadIO m => m () +glResetAttributes = liftIO glResetAttributesFFI +{-# INLINE glResetAttributes #-} + +glSetAttribute :: MonadIO m => GLattr -> CInt -> m CInt +glSetAttribute v1 v2 = liftIO $ glSetAttributeFFI v1 v2 +{-# INLINE glSetAttribute #-} + +glSetSwapInterval :: MonadIO m => CInt -> m CInt +glSetSwapInterval v1 = liftIO $ glSetSwapIntervalFFI v1 +{-# INLINE glSetSwapInterval #-} + +glSwapWindow :: MonadIO m => Window -> m () +glSwapWindow v1 = liftIO $ glSwapWindowFFI v1 +{-# INLINE glSwapWindow #-} + +glUnbindTexture :: MonadIO m => Texture -> m CInt +glUnbindTexture v1 = liftIO $ glUnbindTextureFFI v1 +{-# INLINE glUnbindTexture #-} + +glUnloadLibrary :: MonadIO m => m () +glUnloadLibrary = liftIO glUnloadLibraryFFI +{-# INLINE glUnloadLibrary #-} + +getClosestDisplayMode :: MonadIO m => CInt -> Ptr DisplayMode -> Ptr DisplayMode -> m (Ptr DisplayMode) +getClosestDisplayMode v1 v2 v3 = liftIO $ getClosestDisplayModeFFI v1 v2 v3 +{-# INLINE getClosestDisplayMode #-} + +getCurrentDisplayMode :: MonadIO m => CInt -> Ptr DisplayMode -> m CInt +getCurrentDisplayMode v1 v2 = liftIO $ getCurrentDisplayModeFFI v1 v2 +{-# INLINE getCurrentDisplayMode #-} + +getCurrentVideoDriver :: MonadIO m => m CString +getCurrentVideoDriver = liftIO getCurrentVideoDriverFFI +{-# INLINE getCurrentVideoDriver #-} + +getDesktopDisplayMode :: MonadIO m => CInt -> Ptr DisplayMode -> m CInt +getDesktopDisplayMode v1 v2 = liftIO $ getDesktopDisplayModeFFI v1 v2 +{-# INLINE getDesktopDisplayMode #-} + +getDisplayBounds :: MonadIO m => CInt -> Ptr Rect -> m CInt +getDisplayBounds v1 v2 = liftIO $ getDisplayBoundsFFI v1 v2 +{-# INLINE getDisplayBounds #-} + +getDisplayMode :: MonadIO m => CInt -> CInt -> Ptr DisplayMode -> m CInt +getDisplayMode v1 v2 v3 = liftIO $ getDisplayModeFFI v1 v2 v3 +{-# INLINE getDisplayMode #-} + +getDisplayName :: MonadIO m => CInt -> m CString +getDisplayName v1 = liftIO $ getDisplayNameFFI v1 +{-# INLINE getDisplayName #-} + +getNumDisplayModes :: MonadIO m => CInt -> m CInt +getNumDisplayModes v1 = liftIO $ getNumDisplayModesFFI v1 +{-# INLINE getNumDisplayModes #-} + +getNumVideoDisplays :: MonadIO m => m CInt +getNumVideoDisplays = liftIO getNumVideoDisplaysFFI +{-# INLINE getNumVideoDisplays #-} + +getNumVideoDrivers :: MonadIO m => m CInt +getNumVideoDrivers = liftIO getNumVideoDriversFFI +{-# INLINE getNumVideoDrivers #-} + +getVideoDriver :: MonadIO m => CInt -> m CString +getVideoDriver v1 = liftIO $ getVideoDriverFFI v1 +{-# INLINE getVideoDriver #-} + +getWindowBrightness :: MonadIO m => Window -> m CFloat +getWindowBrightness v1 = liftIO $ getWindowBrightnessFFI v1 +{-# INLINE getWindowBrightness #-} + +getWindowData :: MonadIO m => Window -> CString -> m (Ptr ()) +getWindowData v1 v2 = liftIO $ getWindowDataFFI v1 v2 +{-# INLINE getWindowData #-} + +getWindowDisplayIndex :: MonadIO m => Window -> m CInt +getWindowDisplayIndex v1 = liftIO $ getWindowDisplayIndexFFI v1 +{-# INLINE getWindowDisplayIndex #-} + +getWindowDisplayMode :: MonadIO m => Window -> Ptr DisplayMode -> m CInt +getWindowDisplayMode v1 v2 = liftIO $ getWindowDisplayModeFFI v1 v2 +{-# INLINE getWindowDisplayMode #-} + +getWindowFlags :: MonadIO m => Window -> m Word32 +getWindowFlags v1 = liftIO $ getWindowFlagsFFI v1 +{-# INLINE getWindowFlags #-} + +getWindowFromID :: MonadIO m => Word32 -> m Window +getWindowFromID v1 = liftIO $ getWindowFromIDFFI v1 +{-# INLINE getWindowFromID #-} + +getWindowGammaRamp :: MonadIO m => Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> m CInt +getWindowGammaRamp v1 v2 v3 v4 = liftIO $ getWindowGammaRampFFI v1 v2 v3 v4 +{-# INLINE getWindowGammaRamp #-} + +getWindowGrab :: MonadIO m => Window -> m Bool +getWindowGrab v1 = liftIO $ getWindowGrabFFI v1 +{-# INLINE getWindowGrab #-} + +getWindowID :: MonadIO m => Window -> m Word32 +getWindowID v1 = liftIO $ getWindowIDFFI v1 +{-# INLINE getWindowID #-} + +getWindowMaximumSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () +getWindowMaximumSize v1 v2 v3 = liftIO $ getWindowMaximumSizeFFI v1 v2 v3 +{-# INLINE getWindowMaximumSize #-} + +getWindowMinimumSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () +getWindowMinimumSize v1 v2 v3 = liftIO $ getWindowMinimumSizeFFI v1 v2 v3 +{-# INLINE getWindowMinimumSize #-} + +getWindowPixelFormat :: MonadIO m => Window -> m Word32 +getWindowPixelFormat v1 = liftIO $ getWindowPixelFormatFFI v1 +{-# INLINE getWindowPixelFormat #-} + +getWindowPosition :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () +getWindowPosition v1 v2 v3 = liftIO $ getWindowPositionFFI v1 v2 v3 +{-# INLINE getWindowPosition #-} + +getWindowSize :: MonadIO m => Window -> Ptr CInt -> Ptr CInt -> m () +getWindowSize v1 v2 v3 = liftIO $ getWindowSizeFFI v1 v2 v3 +{-# INLINE getWindowSize #-} + +getWindowSurface :: MonadIO m => Window -> m (Ptr Surface) +getWindowSurface v1 = liftIO $ getWindowSurfaceFFI v1 +{-# INLINE getWindowSurface #-} + +getWindowTitle :: MonadIO m => Window -> m CString +getWindowTitle v1 = liftIO $ getWindowTitleFFI v1 +{-# INLINE getWindowTitle #-} + +hideWindow :: MonadIO m => Window -> m () +hideWindow v1 = liftIO $ hideWindowFFI v1 +{-# INLINE hideWindow #-} + +isScreenSaverEnabled :: MonadIO m => m Bool +isScreenSaverEnabled = liftIO isScreenSaverEnabledFFI +{-# INLINE isScreenSaverEnabled #-} + +maximizeWindow :: MonadIO m => Window -> m () +maximizeWindow v1 = liftIO $ maximizeWindowFFI v1 +{-# INLINE maximizeWindow #-} + +minimizeWindow :: MonadIO m => Window -> m () +minimizeWindow v1 = liftIO $ minimizeWindowFFI v1 +{-# INLINE minimizeWindow #-} + +raiseWindow :: MonadIO m => Window -> m () +raiseWindow v1 = liftIO $ raiseWindowFFI v1 +{-# INLINE raiseWindow #-} + +restoreWindow :: MonadIO m => Window -> m () +restoreWindow v1 = liftIO $ restoreWindowFFI v1 +{-# INLINE restoreWindow #-} + +setWindowBordered :: MonadIO m => Window -> Bool -> m () +setWindowBordered v1 v2 = liftIO $ setWindowBorderedFFI v1 v2 +{-# INLINE setWindowBordered #-} + +setWindowBrightness :: MonadIO m => Window -> CFloat -> m CInt +setWindowBrightness v1 v2 = liftIO $ setWindowBrightnessFFI v1 v2 +{-# INLINE setWindowBrightness #-} + +setWindowData :: MonadIO m => Window -> CString -> Ptr () -> m (Ptr ()) +setWindowData v1 v2 v3 = liftIO $ setWindowDataFFI v1 v2 v3 +{-# INLINE setWindowData #-} + +setWindowDisplayMode :: MonadIO m => Window -> Ptr DisplayMode -> m CInt +setWindowDisplayMode v1 v2 = liftIO $ setWindowDisplayModeFFI v1 v2 +{-# INLINE setWindowDisplayMode #-} + +setWindowFullscreen :: MonadIO m => Window -> Word32 -> m CInt +setWindowFullscreen v1 v2 = liftIO $ setWindowFullscreenFFI v1 v2 +{-# INLINE setWindowFullscreen #-} + +setWindowGammaRamp :: MonadIO m => Window -> Ptr Word16 -> Ptr Word16 -> Ptr Word16 -> m CInt +setWindowGammaRamp v1 v2 v3 v4 = liftIO $ setWindowGammaRampFFI v1 v2 v3 v4 +{-# INLINE setWindowGammaRamp #-} + +setWindowGrab :: MonadIO m => Window -> Bool -> m () +setWindowGrab v1 v2 = liftIO $ setWindowGrabFFI v1 v2 +{-# INLINE setWindowGrab #-} + +setWindowIcon :: MonadIO m => Window -> Ptr Surface -> m () +setWindowIcon v1 v2 = liftIO $ setWindowIconFFI v1 v2 +{-# INLINE setWindowIcon #-} + +setWindowMaximumSize :: MonadIO m => Window -> CInt -> CInt -> m () +setWindowMaximumSize v1 v2 v3 = liftIO $ setWindowMaximumSizeFFI v1 v2 v3 +{-# INLINE setWindowMaximumSize #-} + +setWindowMinimumSize :: MonadIO m => Window -> CInt -> CInt -> m () +setWindowMinimumSize v1 v2 v3 = liftIO $ setWindowMinimumSizeFFI v1 v2 v3 +{-# INLINE setWindowMinimumSize #-} + +setWindowPosition :: MonadIO m => Window -> CInt -> CInt -> m () +setWindowPosition v1 v2 v3 = liftIO $ setWindowPositionFFI v1 v2 v3 +{-# INLINE setWindowPosition #-} + +setWindowSize :: MonadIO m => Window -> CInt -> CInt -> m () +setWindowSize v1 v2 v3 = liftIO $ setWindowSizeFFI v1 v2 v3 +{-# INLINE setWindowSize #-} + +setWindowTitle :: MonadIO m => Window -> CString -> m () +setWindowTitle v1 v2 = liftIO $ setWindowTitleFFI v1 v2 +{-# INLINE setWindowTitle #-} + +showMessageBox :: MonadIO m => Ptr MessageBoxData -> Ptr CInt -> m CInt +showMessageBox v1 v2 = liftIO $ showMessageBoxFFI v1 v2 +{-# INLINE showMessageBox #-} + +showSimpleMessageBox :: MonadIO m => Word32 -> CString -> CString -> Window -> m CInt +showSimpleMessageBox v1 v2 v3 v4 = liftIO $ showSimpleMessageBoxFFI v1 v2 v3 v4 +{-# INLINE showSimpleMessageBox #-} + +showWindow :: MonadIO m => Window -> m () +showWindow v1 = liftIO $ showWindowFFI v1 +{-# INLINE showWindow #-} + +updateWindowSurface :: MonadIO m => Window -> m CInt +updateWindowSurface v1 = liftIO $ updateWindowSurfaceFFI v1 +{-# INLINE updateWindowSurface #-} + +updateWindowSurfaceRects :: MonadIO m => Window -> Ptr Rect -> CInt -> m CInt +updateWindowSurfaceRects v1 v2 v3 = liftIO $ updateWindowSurfaceRectsFFI v1 v2 v3 +{-# INLINE updateWindowSurfaceRects #-} + +videoInit :: MonadIO m => CString -> m CInt +videoInit v1 = liftIO $ videoInitFFI v1 +{-# INLINE videoInit #-} + +videoQuit :: MonadIO m => m () +videoQuit = liftIO videoQuitFFI +{-# INLINE videoQuit #-} + +createRenderer :: MonadIO m => Window -> CInt -> Word32 -> m Renderer +createRenderer v1 v2 v3 = liftIO $ createRendererFFI v1 v2 v3 +{-# INLINE createRenderer #-} + +createSoftwareRenderer :: MonadIO m => Ptr Surface -> m Renderer +createSoftwareRenderer v1 = liftIO $ createSoftwareRendererFFI v1 +{-# INLINE createSoftwareRenderer #-} + +createTexture :: MonadIO m => Renderer -> Word32 -> CInt -> CInt -> CInt -> m Texture +createTexture v1 v2 v3 v4 v5 = liftIO $ createTextureFFI v1 v2 v3 v4 v5 +{-# INLINE createTexture #-} + +createTextureFromSurface :: MonadIO m => Renderer -> Ptr Surface -> m Texture +createTextureFromSurface v1 v2 = liftIO $ createTextureFromSurfaceFFI v1 v2 +{-# INLINE createTextureFromSurface #-} + +destroyRenderer :: MonadIO m => Renderer -> m () +destroyRenderer v1 = liftIO $ destroyRendererFFI v1 +{-# INLINE destroyRenderer #-} + +destroyTexture :: MonadIO m => Texture -> m () +destroyTexture v1 = liftIO $ destroyTextureFFI v1 +{-# INLINE destroyTexture #-} + +getNumRenderDrivers :: MonadIO m => m CInt +getNumRenderDrivers = liftIO getNumRenderDriversFFI +{-# INLINE getNumRenderDrivers #-} + +getRenderDrawBlendMode :: MonadIO m => Renderer -> Ptr BlendMode -> m Int +getRenderDrawBlendMode v1 v2 = liftIO $ getRenderDrawBlendModeFFI v1 v2 +{-# INLINE getRenderDrawBlendMode #-} + +getRenderDrawColor :: MonadIO m => Renderer -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m CInt +getRenderDrawColor v1 v2 v3 v4 v5 = liftIO $ getRenderDrawColorFFI v1 v2 v3 v4 v5 +{-# INLINE getRenderDrawColor #-} + +getRenderDriverInfo :: MonadIO m => CInt -> Ptr RendererInfo -> m CInt +getRenderDriverInfo v1 v2 = liftIO $ getRenderDriverInfoFFI v1 v2 +{-# INLINE getRenderDriverInfo #-} + +getRenderTarget :: MonadIO m => Renderer -> m Texture +getRenderTarget v1 = liftIO $ getRenderTargetFFI v1 +{-# INLINE getRenderTarget #-} + +getRenderer :: MonadIO m => Window -> m Renderer +getRenderer v1 = liftIO $ getRendererFFI v1 +{-# INLINE getRenderer #-} + +getRendererInfo :: MonadIO m => Renderer -> Ptr RendererInfo -> m CInt +getRendererInfo v1 v2 = liftIO $ getRendererInfoFFI v1 v2 +{-# INLINE getRendererInfo #-} + +getRendererOutputSize :: MonadIO m => Renderer -> Ptr CInt -> Ptr CInt -> m CInt +getRendererOutputSize v1 v2 v3 = liftIO $ getRendererOutputSizeFFI v1 v2 v3 +{-# INLINE getRendererOutputSize #-} + +getTextureAlphaMod :: MonadIO m => Texture -> Ptr Word8 -> m CInt +getTextureAlphaMod v1 v2 = liftIO $ getTextureAlphaModFFI v1 v2 +{-# INLINE getTextureAlphaMod #-} + +getTextureBlendMode :: MonadIO m => Texture -> Ptr BlendMode -> m CInt +getTextureBlendMode v1 v2 = liftIO $ getTextureBlendModeFFI v1 v2 +{-# INLINE getTextureBlendMode #-} + +getTextureColorMod :: MonadIO m => Texture -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m CInt +getTextureColorMod v1 v2 v3 v4 = liftIO $ getTextureColorModFFI v1 v2 v3 v4 +{-# INLINE getTextureColorMod #-} + +lockTexture :: MonadIO m => Texture -> Ptr Rect -> Ptr (Ptr ()) -> Ptr CInt -> m CInt +lockTexture v1 v2 v3 v4 = liftIO $ lockTextureFFI v1 v2 v3 v4 +{-# INLINE lockTexture #-} + +queryTexture :: MonadIO m => Texture -> Ptr Word32 -> Ptr CInt -> Ptr CInt -> Ptr CInt -> m CInt +queryTexture v1 v2 v3 v4 v5 = liftIO $ queryTextureFFI v1 v2 v3 v4 v5 +{-# INLINE queryTexture #-} + +renderClear :: MonadIO m => Renderer -> m CInt +renderClear v1 = liftIO $ renderClearFFI v1 +{-# INLINE renderClear #-} + +renderCopy :: MonadIO m => Renderer -> Texture -> Ptr Rect -> Ptr Rect -> m CInt +renderCopy v1 v2 v3 v4 = liftIO $ renderCopyFFI v1 v2 v3 v4 +{-# INLINE renderCopy #-} + +renderCopyEx :: MonadIO m => Renderer -> Texture -> Ptr Rect -> Ptr Rect -> CDouble -> Ptr Point -> RendererFlip -> m CInt +renderCopyEx v1 v2 v3 v4 v5 v6 v7 = liftIO $ renderCopyExFFI v1 v2 v3 v4 v5 v6 v7 +{-# INLINE renderCopyEx #-} + +renderDrawLine :: MonadIO m => Renderer -> CInt -> CInt -> CInt -> CInt -> m CInt +renderDrawLine v1 v2 v3 v4 v5 = liftIO $ renderDrawLineFFI v1 v2 v3 v4 v5 +{-# INLINE renderDrawLine #-} + +renderDrawLines :: MonadIO m => Renderer -> Ptr Point -> CInt -> m CInt +renderDrawLines v1 v2 v3 = liftIO $ renderDrawLinesFFI v1 v2 v3 +{-# INLINE renderDrawLines #-} + +renderDrawPoint :: MonadIO m => Renderer -> CInt -> CInt -> m CInt +renderDrawPoint v1 v2 v3 = liftIO $ renderDrawPointFFI v1 v2 v3 +{-# INLINE renderDrawPoint #-} + +renderDrawPoints :: MonadIO m => Renderer -> Ptr Point -> CInt -> m CInt +renderDrawPoints v1 v2 v3 = liftIO $ renderDrawPointsFFI v1 v2 v3 +{-# INLINE renderDrawPoints #-} + +renderDrawRect :: MonadIO m => Renderer -> Ptr Rect -> m CInt +renderDrawRect v1 v2 = liftIO $ renderDrawRectFFI v1 v2 +{-# INLINE renderDrawRect #-} + +renderDrawRects :: MonadIO m => Renderer -> Ptr Rect -> CInt -> m CInt +renderDrawRects v1 v2 v3 = liftIO $ renderDrawRectsFFI v1 v2 v3 +{-# INLINE renderDrawRects #-} + +renderFillRect :: MonadIO m => Renderer -> Ptr Rect -> m CInt +renderFillRect v1 v2 = liftIO $ renderFillRectFFI v1 v2 +{-# INLINE renderFillRect #-} + +renderFillRects :: MonadIO m => Renderer -> Ptr Rect -> CInt -> m CInt +renderFillRects v1 v2 v3 = liftIO $ renderFillRectsFFI v1 v2 v3 +{-# INLINE renderFillRects #-} + +renderGetClipRect :: MonadIO m => Renderer -> Ptr Rect -> m () +renderGetClipRect v1 v2 = liftIO $ renderGetClipRectFFI v1 v2 +{-# INLINE renderGetClipRect #-} + +renderGetLogicalSize :: MonadIO m => Renderer -> Ptr CInt -> Ptr CInt -> m () +renderGetLogicalSize v1 v2 v3 = liftIO $ renderGetLogicalSizeFFI v1 v2 v3 +{-# INLINE renderGetLogicalSize #-} + +renderGetScale :: MonadIO m => Renderer -> Ptr CFloat -> Ptr CFloat -> m () +renderGetScale v1 v2 v3 = liftIO $ renderGetScaleFFI v1 v2 v3 +{-# INLINE renderGetScale #-} + +renderGetViewport :: MonadIO m => Renderer -> Ptr Rect -> m () +renderGetViewport v1 v2 = liftIO $ renderGetViewportFFI v1 v2 +{-# INLINE renderGetViewport #-} + +renderPresent :: MonadIO m => Renderer -> m () +renderPresent v1 = liftIO $ renderPresentFFI v1 +{-# INLINE renderPresent #-} + +renderReadPixels :: MonadIO m => Renderer -> Ptr Rect -> Word32 -> Ptr () -> CInt -> m CInt +renderReadPixels v1 v2 v3 v4 v5 = liftIO $ renderReadPixelsFFI v1 v2 v3 v4 v5 +{-# INLINE renderReadPixels #-} + +renderSetClipRect :: MonadIO m => Renderer -> Ptr Rect -> m CInt +renderSetClipRect v1 v2 = liftIO $ renderSetClipRectFFI v1 v2 +{-# INLINE renderSetClipRect #-} + +renderSetLogicalSize :: MonadIO m => Renderer -> CInt -> CInt -> m CInt +renderSetLogicalSize v1 v2 v3 = liftIO $ renderSetLogicalSizeFFI v1 v2 v3 +{-# INLINE renderSetLogicalSize #-} + +renderSetScale :: MonadIO m => Renderer -> CFloat -> CFloat -> m CInt +renderSetScale v1 v2 v3 = liftIO $ renderSetScaleFFI v1 v2 v3 +{-# INLINE renderSetScale #-} + +renderSetViewport :: MonadIO m => Renderer -> Ptr Rect -> m CInt +renderSetViewport v1 v2 = liftIO $ renderSetViewportFFI v1 v2 +{-# INLINE renderSetViewport #-} + +renderTargetSupported :: MonadIO m => Renderer -> m Bool +renderTargetSupported v1 = liftIO $ renderTargetSupportedFFI v1 +{-# INLINE renderTargetSupported #-} + +setRenderDrawBlendMode :: MonadIO m => Renderer -> BlendMode -> m CInt +setRenderDrawBlendMode v1 v2 = liftIO $ setRenderDrawBlendModeFFI v1 v2 +{-# INLINE setRenderDrawBlendMode #-} + +setRenderDrawColor :: MonadIO m => Renderer -> Word8 -> Word8 -> Word8 -> Word8 -> m CInt +setRenderDrawColor v1 v2 v3 v4 v5 = liftIO $ setRenderDrawColorFFI v1 v2 v3 v4 v5 +{-# INLINE setRenderDrawColor #-} + +setRenderTarget :: MonadIO m => Renderer -> Texture -> m CInt +setRenderTarget v1 v2 = liftIO $ setRenderTargetFFI v1 v2 +{-# INLINE setRenderTarget #-} + +setTextureAlphaMod :: MonadIO m => Texture -> Word8 -> m CInt +setTextureAlphaMod v1 v2 = liftIO $ setTextureAlphaModFFI v1 v2 +{-# INLINE setTextureAlphaMod #-} + +setTextureBlendMode :: MonadIO m => Texture -> BlendMode -> m CInt +setTextureBlendMode v1 v2 = liftIO $ setTextureBlendModeFFI v1 v2 +{-# INLINE setTextureBlendMode #-} + +setTextureColorMod :: MonadIO m => Texture -> Word8 -> Word8 -> Word8 -> m CInt +setTextureColorMod v1 v2 v3 v4 = liftIO $ setTextureColorModFFI v1 v2 v3 v4 +{-# INLINE setTextureColorMod #-} + +unlockTexture :: MonadIO m => Texture -> m () +unlockTexture v1 = liftIO $ unlockTextureFFI v1 +{-# INLINE unlockTexture #-} + +updateTexture :: MonadIO m => Texture -> Ptr Rect -> Ptr () -> CInt -> m CInt +updateTexture v1 v2 v3 v4 = liftIO $ updateTextureFFI v1 v2 v3 v4 +{-# INLINE updateTexture #-} + +updateYUVTexture :: MonadIO m => Texture -> Ptr Rect -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> m CInt +updateYUVTexture v1 v2 v3 v4 v5 v6 v7 v8 = liftIO $ updateYUVTextureFFI v1 v2 v3 v4 v5 v6 v7 v8 +{-# INLINE updateYUVTexture #-} + +allocFormat :: MonadIO m => Word32 -> m (Ptr PixelFormat) +allocFormat v1 = liftIO $ allocFormatFFI v1 +{-# INLINE allocFormat #-} + +allocPalette :: MonadIO m => CInt -> m (Ptr Palette) +allocPalette v1 = liftIO $ allocPaletteFFI v1 +{-# INLINE allocPalette #-} + +calculateGammaRamp :: MonadIO m => CFloat -> Ptr Word16 -> m () +calculateGammaRamp v1 v2 = liftIO $ calculateGammaRampFFI v1 v2 +{-# INLINE calculateGammaRamp #-} + +freeFormat :: MonadIO m => Ptr PixelFormat -> m () +freeFormat v1 = liftIO $ freeFormatFFI v1 +{-# INLINE freeFormat #-} + +freePalette :: MonadIO m => Ptr Palette -> m () +freePalette v1 = liftIO $ freePaletteFFI v1 +{-# INLINE freePalette #-} + +getPixelFormatName :: MonadIO m => Word32 -> m CString +getPixelFormatName v1 = liftIO $ getPixelFormatNameFFI v1 +{-# INLINE getPixelFormatName #-} + +getRGB :: MonadIO m => Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m () +getRGB v1 v2 v3 v4 v5 = liftIO $ getRGBFFI v1 v2 v3 v4 v5 +{-# INLINE getRGB #-} + +getRGBA :: MonadIO m => Word32 -> Ptr PixelFormat -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m () +getRGBA v1 v2 v3 v4 v5 v6 = liftIO $ getRGBAFFI v1 v2 v3 v4 v5 v6 +{-# INLINE getRGBA #-} + +mapRGB :: MonadIO m => Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> m Word32 +mapRGB v1 v2 v3 v4 = liftIO $ mapRGBFFI v1 v2 v3 v4 +{-# INLINE mapRGB #-} + +mapRGBA :: MonadIO m => Ptr PixelFormat -> Word8 -> Word8 -> Word8 -> Word8 -> m Word32 +mapRGBA v1 v2 v3 v4 v5 = liftIO $ mapRGBAFFI v1 v2 v3 v4 v5 +{-# INLINE mapRGBA #-} + +masksToPixelFormatEnum :: MonadIO m => CInt -> Word32 -> Word32 -> Word32 -> Word32 -> m Word32 +masksToPixelFormatEnum v1 v2 v3 v4 v5 = liftIO $ masksToPixelFormatEnumFFI v1 v2 v3 v4 v5 +{-# INLINE masksToPixelFormatEnum #-} + +pixelFormatEnumToMasks :: MonadIO m => Word32 -> Ptr CInt -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> Ptr Word32 -> m Bool +pixelFormatEnumToMasks v1 v2 v3 v4 v5 v6 = liftIO $ pixelFormatEnumToMasksFFI v1 v2 v3 v4 v5 v6 +{-# INLINE pixelFormatEnumToMasks #-} + +setPaletteColors :: MonadIO m => Ptr Palette -> Ptr Color -> CInt -> CInt -> m CInt +setPaletteColors v1 v2 v3 v4 = liftIO $ setPaletteColorsFFI v1 v2 v3 v4 +{-# INLINE setPaletteColors #-} + +setPixelFormatPalette :: MonadIO m => Ptr PixelFormat -> Ptr Palette -> m CInt +setPixelFormatPalette v1 v2 = liftIO $ setPixelFormatPaletteFFI v1 v2 +{-# INLINE setPixelFormatPalette #-} + +enclosePoints :: MonadIO m => Ptr Point -> CInt -> Ptr Rect -> Ptr Rect -> m Bool +enclosePoints v1 v2 v3 v4 = liftIO $ enclosePointsFFI v1 v2 v3 v4 +{-# INLINE enclosePoints #-} + +hasIntersection :: MonadIO m => Ptr Rect -> Ptr Rect -> m Bool +hasIntersection v1 v2 = liftIO $ hasIntersectionFFI v1 v2 +{-# INLINE hasIntersection #-} + +intersectRect :: MonadIO m => Ptr Rect -> Ptr Rect -> Ptr Rect -> m Bool +intersectRect v1 v2 v3 = liftIO $ intersectRectFFI v1 v2 v3 +{-# INLINE intersectRect #-} + +intersectRectAndLine :: MonadIO m => Ptr Rect -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> m Bool +intersectRectAndLine v1 v2 v3 v4 v5 = liftIO $ intersectRectAndLineFFI v1 v2 v3 v4 v5 +{-# INLINE intersectRectAndLine #-} + +unionRect :: MonadIO m => Ptr Rect -> Ptr Rect -> Ptr Rect -> m () +unionRect v1 v2 v3 = liftIO $ unionRectFFI v1 v2 v3 +{-# INLINE unionRect #-} + +blitScaled :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt +blitScaled v1 v2 v3 v4 = liftIO $ blitScaledFFI v1 v2 v3 v4 +{-# INLINE blitScaled #-} + +blitSurface :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt +blitSurface v1 v2 v3 v4 = liftIO $ blitSurfaceFFI v1 v2 v3 v4 +{-# INLINE blitSurface #-} + +convertPixels :: MonadIO m => CInt -> CInt -> Word32 -> Ptr () -> CInt -> Word32 -> Ptr () -> CInt -> m CInt +convertPixels v1 v2 v3 v4 v5 v6 v7 v8 = liftIO $ convertPixelsFFI v1 v2 v3 v4 v5 v6 v7 v8 +{-# INLINE convertPixels #-} + +convertSurface :: MonadIO m => Ptr Surface -> Ptr PixelFormat -> Word32 -> m (Ptr Surface) +convertSurface v1 v2 v3 = liftIO $ convertSurfaceFFI v1 v2 v3 +{-# INLINE convertSurface #-} + +convertSurfaceFormat :: MonadIO m => Ptr Surface -> Word32 -> Word32 -> m (Ptr Surface) +convertSurfaceFormat v1 v2 v3 = liftIO $ convertSurfaceFormatFFI v1 v2 v3 +{-# INLINE convertSurfaceFormat #-} + +createRGBSurface :: MonadIO m => Word32 -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> m (Ptr Surface) +createRGBSurface v1 v2 v3 v4 v5 v6 v7 v8 = liftIO $ createRGBSurfaceFFI v1 v2 v3 v4 v5 v6 v7 v8 +{-# INLINE createRGBSurface #-} + +createRGBSurfaceFrom :: MonadIO m => Ptr () -> CInt -> CInt -> CInt -> CInt -> Word32 -> Word32 -> Word32 -> Word32 -> m (Ptr Surface) +createRGBSurfaceFrom v1 v2 v3 v4 v5 v6 v7 v8 v9 = liftIO $ createRGBSurfaceFromFFI v1 v2 v3 v4 v5 v6 v7 v8 v9 +{-# INLINE createRGBSurfaceFrom #-} + +fillRect :: MonadIO m => Ptr Surface -> Ptr Rect -> Word32 -> m CInt +fillRect v1 v2 v3 = liftIO $ fillRectFFI v1 v2 v3 +{-# INLINE fillRect #-} + +fillRects :: MonadIO m => Ptr Surface -> Ptr Rect -> CInt -> Word32 -> m CInt +fillRects v1 v2 v3 v4 = liftIO $ fillRectsFFI v1 v2 v3 v4 +{-# INLINE fillRects #-} + +freeSurface :: MonadIO m => Ptr Surface -> m () +freeSurface v1 = liftIO $ freeSurfaceFFI v1 +{-# INLINE freeSurface #-} + +getClipRect :: MonadIO m => Ptr Surface -> Ptr Rect -> m () +getClipRect v1 v2 = liftIO $ getClipRectFFI v1 v2 +{-# INLINE getClipRect #-} + +getColorKey :: MonadIO m => Ptr Surface -> Ptr Word32 -> m CInt +getColorKey v1 v2 = liftIO $ getColorKeyFFI v1 v2 +{-# INLINE getColorKey #-} + +getSurfaceAlphaMod :: MonadIO m => Ptr Surface -> Ptr Word8 -> m CInt +getSurfaceAlphaMod v1 v2 = liftIO $ getSurfaceAlphaModFFI v1 v2 +{-# INLINE getSurfaceAlphaMod #-} + +getSurfaceBlendMode :: MonadIO m => Ptr Surface -> Ptr BlendMode -> m CInt +getSurfaceBlendMode v1 v2 = liftIO $ getSurfaceBlendModeFFI v1 v2 +{-# INLINE getSurfaceBlendMode #-} + +getSurfaceColorMod :: MonadIO m => Ptr Surface -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> m CInt +getSurfaceColorMod v1 v2 v3 v4 = liftIO $ getSurfaceColorModFFI v1 v2 v3 v4 +{-# INLINE getSurfaceColorMod #-} + +loadBMP :: MonadIO m => CString -> m (Ptr Surface) +loadBMP file = liftIO $ do + rw <- withCString "rb" $ rwFromFile file + loadBMP_RW rw 1 +{-# INLINE loadBMP #-} + +loadBMP_RW :: MonadIO m => Ptr RWops -> CInt -> m (Ptr Surface) +loadBMP_RW v1 v2 = liftIO $ loadBMP_RWFFI v1 v2 +{-# INLINE loadBMP_RW #-} + +lockSurface :: MonadIO m => Ptr Surface -> m CInt +lockSurface v1 = liftIO $ lockSurfaceFFI v1 +{-# INLINE lockSurface #-} + +lowerBlit :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt +lowerBlit v1 v2 v3 v4 = liftIO $ lowerBlitFFI v1 v2 v3 v4 +{-# INLINE lowerBlit #-} + +lowerBlitScaled :: MonadIO m => Ptr Surface -> Ptr Rect -> Ptr Surface -> Ptr Rect -> m CInt +lowerBlitScaled v1 v2 v3 v4 = liftIO $ lowerBlitScaledFFI v1 v2 v3 v4 +{-# INLINE lowerBlitScaled #-} + +saveBMP :: MonadIO m => Ptr Surface -> CString -> m CInt +saveBMP surface file = liftIO $ do + rw <- withCString "wb" $ rwFromFile file + saveBMP_RW surface rw 1 +{-# INLINE saveBMP #-} + +saveBMP_RW :: MonadIO m => Ptr Surface -> Ptr RWops -> CInt -> m CInt +saveBMP_RW v1 v2 v3 = liftIO $ saveBMP_RWFFI v1 v2 v3 +{-# INLINE saveBMP_RW #-} + +setClipRect :: MonadIO m => Ptr Surface -> Ptr Rect -> m Bool +setClipRect v1 v2 = liftIO $ setClipRectFFI v1 v2 +{-# INLINE setClipRect #-} + +setColorKey :: MonadIO m => Ptr Surface -> CInt -> Word32 -> m CInt +setColorKey v1 v2 v3 = liftIO $ setColorKeyFFI v1 v2 v3 +{-# INLINE setColorKey #-} + +setSurfaceAlphaMod :: MonadIO m => Ptr Surface -> Word8 -> m CInt +setSurfaceAlphaMod v1 v2 = liftIO $ setSurfaceAlphaModFFI v1 v2 +{-# INLINE setSurfaceAlphaMod #-} + +setSurfaceBlendMode :: MonadIO m => Ptr Surface -> BlendMode -> m CInt +setSurfaceBlendMode v1 v2 = liftIO $ setSurfaceBlendModeFFI v1 v2 +{-# INLINE setSurfaceBlendMode #-} + +setSurfaceColorMod :: MonadIO m => Ptr Surface -> Word8 -> Word8 -> Word8 -> m CInt +setSurfaceColorMod v1 v2 v3 v4 = liftIO $ setSurfaceColorModFFI v1 v2 v3 v4 +{-# INLINE setSurfaceColorMod #-} + +setSurfacePalette :: MonadIO m => Ptr Surface -> Ptr Palette -> m CInt +setSurfacePalette v1 v2 = liftIO $ setSurfacePaletteFFI v1 v2 +{-# INLINE setSurfacePalette #-} + +setSurfaceRLE :: MonadIO m => Ptr Surface -> CInt -> m CInt +setSurfaceRLE v1 v2 = liftIO $ setSurfaceRLEFFI v1 v2 +{-# INLINE setSurfaceRLE #-} + +unlockSurface :: MonadIO m => Ptr Surface -> m () +unlockSurface v1 = liftIO $ unlockSurfaceFFI v1 +{-# INLINE unlockSurface #-} + +getWindowWMInfo :: MonadIO m => Window -> SysWMinfo -> m Bool +getWindowWMInfo v1 v2 = liftIO $ getWindowWMInfoFFI v1 v2 +{-# INLINE getWindowWMInfo #-} + +getClipboardText :: MonadIO m => m CString +getClipboardText = liftIO getClipboardTextFFI +{-# INLINE getClipboardText #-} + +hasClipboardText :: MonadIO m => m Bool +hasClipboardText = liftIO hasClipboardTextFFI +{-# INLINE hasClipboardText #-} + +setClipboardText :: MonadIO m => CString -> m CInt +setClipboardText v1 = liftIO $ setClipboardTextFFI v1 +{-# INLINE setClipboardText #-} diff --git a/src/SDL/Time.hs b/src/SDL/Time.hs --- a/src/SDL/Time.hs +++ b/src/SDL/Time.hs @@ -1,95 +1,95 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -module SDL.Time - ( -- * Time Measurement - ticks - , time - - -- * Timer - , delay - , TimerCallback - , Timer - , RetriggerTimer(..) - , addTimer - , removeTimer - ) where - -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Data (Data) -import Data.Typeable -import Data.Word -import Foreign -import GHC.Generics (Generic) - -import SDL.Exception - -import qualified SDL.Raw.Timer as Raw -import qualified SDL.Raw.Types as Raw - --- | Number of milliseconds since library initialization. --- --- See @@ for C documentation. -ticks :: MonadIO m => m Word32 -ticks = Raw.getTicks - --- | The current time in seconds since some arbitrary starting point (consist over the life of the application). --- --- This time is derived from the system's performance counter - see @@ and @@ for C documentation about the implementation. -time :: (Fractional a, MonadIO m) => m a -time = do - freq <- Raw.getPerformanceFrequency - cnt <- Raw.getPerformanceCounter - return $ fromIntegral cnt / fromIntegral freq - --- | Wait a specified number of milliseconds before returning. --- --- Users are generally recommended to use 'threadDelay' instead, to take advantage of the abilities of the Haskell runtime. --- --- See @@ for C documentation. -delay :: MonadIO m => Word32 -> m () -delay = Raw.delay - --- | 'RetriggerTimer' allows a callback to inform SDL if the timer should be retriggered or cancelled -data RetriggerTimer - = Reschedule Word32 - -- ^ Retrigger the timer again in a given number of milliseconds. - | Cancel - -- ^ Cancel future invocations of this timer. - deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) - --- | A 'TimerCallback' is called with the interval size of the callback. It can return information as to whether or not the timer should continue to exist. -type TimerCallback = Word32 -> IO RetriggerTimer - --- | A timer created by 'addTimer'. This 'Timer' can be removed with 'removeTimer'. -newtype Timer = - Timer {runTimerRemoval :: IO Bool} - --- | Set up a callback function to be run on a separate thread after the specified number of milliseconds has elapsed. --- --- See @@ for C documentation. -addTimer :: MonadIO m => Word32 -> TimerCallback -> m Timer -addTimer timeout callback = liftIO $ do - cb <- Raw.mkTimerCallback wrappedCb - tid <- throwIf0 "addTimer" "SDL_AddTimer" $ Raw.addTimer timeout cb nullPtr - return (Timer $ auxRemove cb tid) - where - wrappedCb :: Word32 -> Ptr () -> IO Word32 - wrappedCb w _ = do - next <- callback w - return $ case next of - Cancel -> 0 - Reschedule n -> n - - auxRemove :: Raw.TimerCallback -> Raw.TimerID -> IO Bool - auxRemove cb tid = do - isSuccess <- Raw.removeTimer tid - if (isSuccess) - then freeHaskellFunPtr cb >> return True - else return False - --- | Remove a 'Timer'. --- --- See @@ for C documentation. -removeTimer :: MonadIO m => Timer -> m Bool -removeTimer f = liftIO $ runTimerRemoval f +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +module SDL.Time + ( -- * Time Measurement + ticks + , time + + -- * Timer + , delay + , TimerCallback + , Timer + , RetriggerTimer(..) + , addTimer + , removeTimer + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Data (Data) +import Data.Typeable +import Data.Word +import Foreign +import GHC.Generics (Generic) + +import SDL.Exception + +import qualified SDL.Raw.Timer as Raw +import qualified SDL.Raw.Types as Raw + +-- | Number of milliseconds since library initialization. +-- +-- See @@ for C documentation. +ticks :: MonadIO m => m Word32 +ticks = Raw.getTicks + +-- | The current time in seconds since some arbitrary starting point (consist over the life of the application). +-- +-- This time is derived from the system's performance counter - see @@ and @@ for C documentation about the implementation. +time :: (Fractional a, MonadIO m) => m a +time = do + freq <- Raw.getPerformanceFrequency + cnt <- Raw.getPerformanceCounter + return $ fromIntegral cnt / fromIntegral freq + +-- | Wait a specified number of milliseconds before returning. +-- +-- Users are generally recommended to use 'threadDelay' instead, to take advantage of the abilities of the Haskell runtime. +-- +-- See @@ for C documentation. +delay :: MonadIO m => Word32 -> m () +delay = Raw.delay + +-- | 'RetriggerTimer' allows a callback to inform SDL if the timer should be retriggered or cancelled +data RetriggerTimer + = Reschedule Word32 + -- ^ Retrigger the timer again in a given number of milliseconds. + | Cancel + -- ^ Cancel future invocations of this timer. + deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A 'TimerCallback' is called with the interval size of the callback. It can return information as to whether or not the timer should continue to exist. +type TimerCallback = Word32 -> IO RetriggerTimer + +-- | A timer created by 'addTimer'. This 'Timer' can be removed with 'removeTimer'. +newtype Timer = + Timer {runTimerRemoval :: IO Bool} + +-- | Set up a callback function to be run on a separate thread after the specified number of milliseconds has elapsed. +-- +-- See @@ for C documentation. +addTimer :: MonadIO m => Word32 -> TimerCallback -> m Timer +addTimer timeout callback = liftIO $ do + cb <- Raw.mkTimerCallback wrappedCb + tid <- throwIf0 "addTimer" "SDL_AddTimer" $ Raw.addTimer timeout cb nullPtr + return (Timer $ auxRemove cb tid) + where + wrappedCb :: Word32 -> Ptr () -> IO Word32 + wrappedCb w _ = do + next <- callback w + return $ case next of + Cancel -> 0 + Reschedule n -> n + + auxRemove :: Raw.TimerCallback -> Raw.TimerID -> IO Bool + auxRemove cb tid = do + isSuccess <- Raw.removeTimer tid + if (isSuccess) + then freeHaskellFunPtr cb >> return True + else return False + +-- | Remove a 'Timer'. +-- +-- See @@ for C documentation. +removeTimer :: MonadIO m => Timer -> m Bool +removeTimer f = liftIO $ runTimerRemoval f diff --git a/src/SDL/Video.hs b/src/SDL/Video.hs --- a/src/SDL/Video.hs +++ b/src/SDL/Video.hs @@ -1,581 +1,581 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -module SDL.Video - ( module SDL.Video.OpenGL - , module SDL.Video.Renderer - - -- * Window Management - , Window - , createWindow - , defaultWindow - , WindowConfig(..) - , WindowMode(..) - , WindowPosition(..) - , destroyWindow - - -- * Window Actions - , hideWindow - , raiseWindow - , showWindow - - -- * Window Attributes - , windowMinimumSize - , windowMaximumSize - , windowSize - , windowBordered - , windowBrightness - , windowGammaRamp - , windowGrab - , setWindowMode - , getWindowAbsolutePosition - , setWindowPosition - , windowTitle - , windowData - , getWindowConfig - , getWindowPixelFormat - , PixelFormat(..) - - -- * Renderer Management - , createRenderer - , destroyRenderer - - -- * Clipboard Handling - , getClipboardText - , hasClipboardText - , setClipboardText - - -- * Display - , getDisplays - , Display(..) - , DisplayMode(..) - , VideoDriver(..) - - -- * Screen Savers - -- | Screen savers should be disabled when the sudden enablement of the - -- monitor's power saving features would be inconvenient for when the user - -- hasn't provided any input for some period of time, such as during video - -- playback. - -- - -- Screen savers are disabled by default upon the initialization of the - -- video subsystem. - , disableScreenSaver - , enableScreenSaver - , isScreenSaverEnabled - - -- * Message Box - , showSimpleMessageBox - , MessageKind(..) - ) where - -import Prelude hiding (all, foldl, foldr, mapM_) - -import Data.StateVar -import Control.Applicative -import Control.Exception -import Control.Monad (forM, unless, void) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bits -import Data.Data (Data) -import Data.Foldable -import Data.Maybe (isJust, fromMaybe) -import Data.Monoid (First(..)) -import Data.Text (Text) -import Data.Typeable -import Foreign hiding (void, throwIfNull, throwIfNeg, throwIfNeg_) -import Foreign.C -import GHC.Generics (Generic) -import Linear -import Linear.Affine (Point(P)) -import SDL.Exception -import SDL.Internal.Numbered -import SDL.Internal.Types -import SDL.Video.OpenGL -import SDL.Video.Renderer - -import qualified Data.ByteString as BS -import qualified Data.Text.Encoding as Text -import qualified Data.Vector.Storable as SV -import qualified SDL.Raw as Raw - --- | Create a window with the given title and configuration. --- --- Throws 'SDLException' on failure. -createWindow :: MonadIO m => Text -> WindowConfig -> m Window -createWindow title config = liftIO $ do - case windowOpenGL config of - Just glcfg -> setGLAttributes glcfg - Nothing -> return () - - BS.useAsCString (Text.encodeUtf8 title) $ \title' -> do - let create = Raw.createWindow title' - let create' (V2 w h) = case windowPosition config of - Centered -> let u = Raw.SDL_WINDOWPOS_CENTERED in create u u w h - Wherever -> let u = Raw.SDL_WINDOWPOS_UNDEFINED in create u u w h - Absolute (P (V2 x y)) -> create x y w h - create' (windowInitialSize config) flags >>= return . Window - where - flags = foldr (.|.) 0 - [ if windowBorder config then 0 else Raw.SDL_WINDOW_BORDERLESS - , if windowHighDPI config then Raw.SDL_WINDOW_ALLOW_HIGHDPI else 0 - , if windowInputGrabbed config then Raw.SDL_WINDOW_INPUT_GRABBED else 0 - , toNumber $ windowMode config - , if isJust $ windowOpenGL config then Raw.SDL_WINDOW_OPENGL else 0 - , if windowResizable config then Raw.SDL_WINDOW_RESIZABLE else 0 - ] - setGLAttributes (OpenGLConfig (V4 r g b a) d s p) = do - let (msk, v0, v1, flg) = case p of - Core Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_CORE, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) - Core Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_CORE, v0', v1', 0) - Compatibility Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) - Compatibility Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, v0', v1', 0) - ES Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_ES, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) - ES Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_ES, v0', v1', 0) - mapM_ (throwIfNeg_ "SDL.Video.createWindow" "SDL_GL_SetAttribute" . uncurry Raw.glSetAttribute) $ - [ (Raw.SDL_GL_RED_SIZE, r) - , (Raw.SDL_GL_GREEN_SIZE, g) - , (Raw.SDL_GL_BLUE_SIZE, b) - , (Raw.SDL_GL_ALPHA_SIZE, a) - , (Raw.SDL_GL_DEPTH_SIZE, d) - , (Raw.SDL_GL_STENCIL_SIZE, s) - , (Raw.SDL_GL_CONTEXT_PROFILE_MASK, msk) - , (Raw.SDL_GL_CONTEXT_MAJOR_VERSION, v0) - , (Raw.SDL_GL_CONTEXT_MINOR_VERSION, v1) - , (Raw.SDL_GL_CONTEXT_FLAGS, flg) - ] - --- | Default configuration for windows. Use the record update syntax to --- override any of the defaults. --- --- @ --- 'defaultWindow' = 'WindowConfig' --- { 'windowBorder' = True --- , 'windowHighDPI' = False --- , 'windowInputGrabbed' = False --- , 'windowMode' = 'Windowed' --- , 'windowOpenGL' = Nothing --- , 'windowPosition' = 'Wherever' --- , 'windowResizable' = False --- , 'windowInitialSize' = V2 800 600 --- } --- @ -defaultWindow :: WindowConfig -defaultWindow = WindowConfig - { windowBorder = True - , windowHighDPI = False - , windowInputGrabbed = False - , windowMode = Windowed - , windowOpenGL = Nothing - , windowPosition = Wherever - , windowResizable = False - , windowInitialSize = V2 800 600 - } - -data WindowConfig = WindowConfig - { windowBorder :: Bool -- ^ Defaults to 'True'. - , windowHighDPI :: Bool -- ^ Defaults to 'False'. Can not be changed after window creation. - , windowInputGrabbed :: Bool -- ^ Defaults to 'False'. Whether the mouse shall be confined to the window. - , windowMode :: WindowMode -- ^ Defaults to 'Windowed'. - , windowOpenGL :: Maybe OpenGLConfig -- ^ Defaults to 'Nothing'. Can not be changed after window creation. - , windowPosition :: WindowPosition -- ^ Defaults to 'Wherever'. - , windowResizable :: Bool -- ^ Defaults to 'False'. Whether the window can be resized by the user. It is still possible to programatically change the size with 'setWindowSize'. - , windowInitialSize :: V2 CInt -- ^ Defaults to @(800, 600)@. - } deriving (Eq, Generic, Ord, Read, Show, Typeable) - -data WindowMode - = Fullscreen -- ^ Real fullscreen with a video mode change - | FullscreenDesktop -- ^ Fake fullscreen that takes the size of the desktop - | Maximized - | Minimized - | Windowed - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - -instance ToNumber WindowMode Word32 where - toNumber Fullscreen = Raw.SDL_WINDOW_FULLSCREEN - toNumber FullscreenDesktop = Raw.SDL_WINDOW_FULLSCREEN_DESKTOP - toNumber Maximized = Raw.SDL_WINDOW_MAXIMIZED - toNumber Minimized = Raw.SDL_WINDOW_MINIMIZED - toNumber Windowed = 0 - -instance FromNumber WindowMode Word32 where - fromNumber n = fromMaybe Windowed . getFirst $ - foldMap First [ - sdlWindowFullscreen - , sdlWindowFullscreenDesktop - , sdlWindowMaximized - , sdlWindowMinimized - ] - where - maybeBit val msk = if n .&. msk > 0 then Just val else Nothing - sdlWindowFullscreen = maybeBit Fullscreen Raw.SDL_WINDOW_FULLSCREEN - sdlWindowFullscreenDesktop = maybeBit FullscreenDesktop Raw.SDL_WINDOW_FULLSCREEN_DESKTOP - sdlWindowMaximized = maybeBit Maximized Raw.SDL_WINDOW_MAXIMIZED - sdlWindowMinimized = maybeBit Minimized Raw.SDL_WINDOW_MINIMIZED - -data WindowPosition - = Centered - | Wherever -- ^ Let the window mananger decide where it's best to place the window. - | Absolute (Point V2 CInt) - deriving (Eq, Generic, Ord, Read, Show, Typeable) - --- | Destroy the given window. The 'Window' handler may not be used --- afterwards. -destroyWindow :: MonadIO m => Window -> m () -destroyWindow (Window w) = Raw.destroyWindow w - --- | Get or set if the window should have a border. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. -windowBordered :: Window -> StateVar Bool -windowBordered (Window w) = makeStateVar getWindowBordered setWindowBordered - where - getWindowBordered = fmap ((== 0) . (.&. Raw.SDL_WINDOW_BORDERLESS)) (Raw.getWindowFlags w) - setWindowBordered = Raw.setWindowBordered w - --- | Get or set the window's brightness, where 0.0 is completely dark and 1.0 is normal brightness. --- --- Throws 'SDLException' if the hardware does not support gamma --- correction, or if the system has run out of memory. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. -windowBrightness :: Window -> StateVar Float -windowBrightness (Window w) = makeStateVar getWindowBrightness setWindowBrightness - where - setWindowBrightness brightness = do - throwIfNot0_ "SDL.Video.setWindowBrightness" "SDL_SetWindowBrightness" $ - Raw.setWindowBrightness w $ realToFrac brightness - - getWindowBrightness = - return . realToFrac =<< Raw.getWindowBrightness w - --- | Get or set whether the mouse shall be confined to the window. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. -windowGrab :: Window -> StateVar Bool -windowGrab (Window w) = makeStateVar getWindowGrab setWindowGrab - where - setWindowGrab = Raw.setWindowGrab w - getWindowGrab = Raw.getWindowGrab w - --- | Change between window modes. --- --- Throws 'SDLException' on failure. -setWindowMode :: MonadIO m => Window -> WindowMode -> m () -setWindowMode (Window w) mode = - liftIO . throwIfNot0_ "SDL.Video.setWindowMode" "SDL_SetWindowFullscreen" $ - case mode of - Fullscreen -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN - FullscreenDesktop -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN_DESKTOP - Maximized -> Raw.setWindowFullscreen w 0 <* Raw.maximizeWindow w - Minimized -> Raw.minimizeWindow w >> return 0 - Windowed -> Raw.restoreWindow w >> return 0 - --- | Set the position of the window. -setWindowPosition :: MonadIO m => Window -> WindowPosition -> m () -setWindowPosition (Window w) pos = case pos of - Centered -> let u = Raw.SDL_WINDOWPOS_CENTERED in Raw.setWindowPosition w u u - Wherever -> let u = Raw.SDL_WINDOWPOS_UNDEFINED in Raw.setWindowPosition w u u - Absolute (P (V2 x y)) -> Raw.setWindowPosition w x y - --- | Get the position of the window. -getWindowAbsolutePosition :: MonadIO m => Window -> m (V2 CInt) -getWindowAbsolutePosition (Window w) = - liftIO $ - alloca $ \wPtr -> - alloca $ \hPtr -> do - Raw.getWindowPosition w wPtr hPtr - V2 <$> peek wPtr <*> peek hPtr - - --- | Get or set the size of a window's client area. Values beyond the maximum supported size are clamped. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -windowSize :: Window -> StateVar (V2 CInt) -windowSize (Window win) = makeStateVar getWindowSize setWindowSize - where - setWindowSize (V2 w h) = Raw.setWindowSize win w h - - getWindowSize = - liftIO $ - alloca $ \wptr -> - alloca $ \hptr -> do - Raw.getWindowSize win wptr hptr - V2 <$> peek wptr <*> peek hptr - --- | Get or set the title of the window. If the window has no title, then an empty string is returned. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -windowTitle :: Window -> StateVar Text -windowTitle (Window w) = makeStateVar getWindowTitle setWindowTitle - where - setWindowTitle title = - liftIO . BS.useAsCString (Text.encodeUtf8 title) $ - Raw.setWindowTitle w - - getWindowTitle = liftIO $ do - cstr <- Raw.getWindowTitle w - Text.decodeUtf8 <$> BS.packCString cstr - --- | Get or set the pointer to arbitrary user data associated with the given --- window and name. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -windowData :: Window -> CString -> StateVar (Ptr ()) -windowData (Window w) key = makeStateVar getWindowData setWindowData - where - setWindowData = void . Raw.setWindowData w key - getWindowData = Raw.getWindowData w key - --- | Retrieve the configuration of the given window. --- --- Note that 'Nothing' will be returned instead of potential OpenGL parameters --- used during the creation of the window. -getWindowConfig :: MonadIO m => Window -> m WindowConfig -getWindowConfig (Window w) = do - wFlags <- Raw.getWindowFlags w - - wSize <- get (windowSize (Window w)) - wPos <- getWindowAbsolutePosition (Window w) - - return WindowConfig { - windowBorder = wFlags .&. Raw.SDL_WINDOW_BORDERLESS == 0 - , windowHighDPI = wFlags .&. Raw.SDL_WINDOW_ALLOW_HIGHDPI > 0 - , windowInputGrabbed = wFlags .&. Raw.SDL_WINDOW_INPUT_GRABBED > 0 - , windowMode = fromNumber wFlags - -- Should we store the openGL config that was used to create the window? - , windowOpenGL = Nothing - , windowPosition = Absolute (P wPos) - , windowResizable = wFlags .&. Raw.SDL_WINDOW_RESIZABLE > 0 - , windowInitialSize = wSize - } - --- | Get the pixel format that is used for the given window. -getWindowPixelFormat :: MonadIO m => Window -> m PixelFormat -getWindowPixelFormat (Window w) = return . fromNumber =<< Raw.getWindowPixelFormat w - --- | Get the text from the clipboard. --- --- Throws 'SDLException' on failure. -getClipboardText :: MonadIO m => m Text -getClipboardText = liftIO . mask_ $ do - cstr <- throwIfNull "SDL.Video.getClipboardText" "SDL_GetClipboardText" - Raw.getClipboardText - finally (Text.decodeUtf8 <$> BS.packCString cstr) (free cstr) - --- | Checks if the clipboard exists, and has some text in it. -hasClipboardText :: MonadIO m => m Bool -hasClipboardText = Raw.hasClipboardText - --- | Replace the contents of the clipboard with the given text. --- --- Throws 'SDLException' on failure. -setClipboardText :: MonadIO m => Text -> m () -setClipboardText str = liftIO $ do - throwIfNot0_ "SDL.Video.setClipboardText" "SDL_SetClipboardText" $ - BS.useAsCString (Text.encodeUtf8 str) Raw.setClipboardText - --- | Hide a window. --- --- See @@ for C documentation. -hideWindow :: MonadIO m => Window -> m () -hideWindow (Window w) = Raw.hideWindow w - --- | Raise the window above other windows and set the input focus. --- --- See @@ for C documentation. -raiseWindow :: MonadIO m => Window -> m () -raiseWindow (Window w) = Raw.raiseWindow w - --- | Prevent the screen from being blanked by a screen saver. If you disable the screensaver, it is automatically re-enabled when SDL quits. --- --- See @@ for C documentation. -disableScreenSaver :: MonadIO m => m () -disableScreenSaver = Raw.disableScreenSaver - --- | Allow the screen to be blanked by a screen saver. --- --- See @@ for C documentation. -enableScreenSaver :: MonadIO m => m () -enableScreenSaver = Raw.enableScreenSaver - --- | Check whether screen savers are enabled . --- --- See @@ for C documentation. -isScreenSaverEnabled :: MonadIO m => m Bool -isScreenSaverEnabled = Raw.isScreenSaverEnabled - --- | Show a window. --- --- See @@ for C documentation. -showWindow :: MonadIO m => Window -> m () -showWindow (Window w) = Raw.showWindow w - --- | Gets or sets the gamma ramp for the display that owns a given window. --- --- Note that the data for the gamma ramp - the 'V3' ('SV.Vector' 'Word16') - must contain 256 element arrays. This triple is a set of translation vectors for each of the 16-bit red, green and blue channels. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- Despite the name and signature, this method retrieves the gamma ramp of the entire display, not an individual window. A window is considered to be owned by the display that contains the window's center pixel. -windowGammaRamp :: Window -> StateVar (V3 (SV.Vector Word16)) -windowGammaRamp (Window w) = makeStateVar getWindowGammaRamp setWindowGammaRamp - where - getWindowGammaRamp = - allocaArray 256 $ \rPtr -> - allocaArray 256 $ \gPtr -> - allocaArray 256 $ \bPtr -> do - throwIfNeg_ "SDL.Video.getWindowGammaRamp" "SDL_GetWindowGammaRamp" - (Raw.getWindowGammaRamp w rPtr gPtr bPtr) - liftA3 V3 (fmap SV.fromList (peekArray 256 rPtr)) - (fmap SV.fromList (peekArray 256 gPtr)) - (fmap SV.fromList (peekArray 256 bPtr)) - - - setWindowGammaRamp (V3 r g b) = liftIO $ do - unless (all ((== 256) . SV.length) [r,g,b]) $ - error "setWindowGammaRamp requires 256 element in each colour channel" - - SV.unsafeWith r $ \rPtr -> - SV.unsafeWith b $ \bPtr -> - SV.unsafeWith g $ \gPtr -> - throwIfNeg_ "SDL.Video.setWindowGammaRamp" "SDL_SetWindowGammaRamp" $ - Raw.setWindowGammaRamp w rPtr gPtr bPtr - -data Display = Display { - displayName :: String - , displayBoundsPosition :: Point V2 CInt - -- ^ Position of the desktop area represented by the display, - -- with the primary display located at @(0, 0)@. - , displayBoundsSize :: V2 CInt - -- ^ Size of the desktop area represented by the display. - , displayModes :: [DisplayMode] - } - deriving (Eq, Generic, Ord, Read, Show, Typeable) - -data DisplayMode = DisplayMode { - displayModeFormat :: PixelFormat - , displayModeSize :: V2 CInt - , displayModeRefreshRate :: CInt -- ^ Display's refresh rate in hertz, or @0@ if unspecified. - } - deriving (Eq, Generic, Ord, Read, Show, Typeable) - -data VideoDriver = VideoDriver { - videoDriverName :: String - } - deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) - --- | Throws 'SDLException' on failure. -getDisplays :: MonadIO m => m [Display] -getDisplays = liftIO $ do - numDisplays <- throwIfNeg "SDL.Video.getDisplays" "SDL_GetNumVideoDisplays" - Raw.getNumVideoDisplays - - forM [0..numDisplays - 1] $ \displayId -> do - name <- throwIfNull "SDL.Video.getDisplays" "SDL_GetDisplayName" $ - Raw.getDisplayName displayId - - name' <- peekCString name - - Raw.Rect x y w h <- alloca $ \rect -> do - throwIfNot0_ "SDL.Video.getDisplays" "SDL_GetDisplayBounds" $ - Raw.getDisplayBounds displayId rect - peek rect - - numModes <- throwIfNeg "SDL.Video.getDisplays" "SDL_GetNumDisplayModes" $ - Raw.getNumDisplayModes displayId - - modes <- forM [0..numModes - 1] $ \modeId -> do - Raw.DisplayMode format w' h' refreshRate _ <- alloca $ \mode -> do - throwIfNot0_ "SDL.Video.getDisplays" "SDL_GetDisplayMode" $ - Raw.getDisplayMode displayId modeId mode - peek mode - - return $ DisplayMode { - displayModeFormat = fromNumber format - , displayModeSize = V2 w' h' - , displayModeRefreshRate = refreshRate - } - - return $ Display { - displayName = name' - , displayBoundsPosition = P (V2 x y) - , displayBoundsSize = V2 w h - , displayModes = modes - } - --- | Show a simple message box with the given title and a message. Consider --- writing your messages to @stderr@ too. --- --- Throws 'SDLException' if there are no available video targets. -showSimpleMessageBox :: MonadIO m => Maybe Window -> MessageKind -> Text -> Text -> m () -showSimpleMessageBox window kind title message = - liftIO . throwIfNot0_ "SDL.Video.showSimpleMessageBox" "SDL_ShowSimpleMessageBox" $ do - BS.useAsCString (Text.encodeUtf8 title) $ \title' -> - BS.useAsCString (Text.encodeUtf8 message) $ \message' -> - Raw.showSimpleMessageBox (toNumber kind) title' message' $ - windowId window - where - windowId (Just (Window w)) = w - windowId Nothing = nullPtr - -data MessageKind - = Error - | Warning - | Information - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - -instance ToNumber MessageKind Word32 where - toNumber Error = Raw.SDL_MESSAGEBOX_ERROR - toNumber Warning = Raw.SDL_MESSAGEBOX_WARNING - toNumber Information = Raw.SDL_MESSAGEBOX_INFORMATION - --- | Get or set the maximum size of a window's client area. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -windowMaximumSize :: Window -> StateVar (V2 CInt) -windowMaximumSize (Window win) = makeStateVar getWindowMaximumSize setWindowMaximumSize - where - setWindowMaximumSize (V2 w h) = Raw.setWindowMaximumSize win w h - - getWindowMaximumSize = - liftIO $ - alloca $ \wptr -> - alloca $ \hptr -> do - Raw.getWindowMaximumSize win wptr hptr - V2 <$> peek wptr <*> peek hptr - --- | Get or set the minimum size of a window's client area. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -windowMinimumSize :: Window -> StateVar (V2 CInt) -windowMinimumSize (Window win) = makeStateVar getWindowMinimumSize setWindowMinimumSize - where - setWindowMinimumSize (V2 w h) = Raw.setWindowMinimumSize win w h - - getWindowMinimumSize = - liftIO $ - alloca $ \wptr -> - alloca $ \hptr -> do - Raw.getWindowMinimumSize win wptr hptr - V2 <$> peek wptr <*> peek hptr - -createRenderer :: MonadIO m => Window -> CInt -> RendererConfig -> m Renderer -createRenderer (Window w) driver config = - liftIO . fmap Renderer $ - throwIfNull "SDL.Video.createRenderer" "SDL_CreateRenderer" $ - Raw.createRenderer w driver (toNumber config) - -destroyRenderer :: MonadIO m => Renderer -> m () -destroyRenderer (Renderer r) = Raw.destroyRenderer r +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +module SDL.Video + ( module SDL.Video.OpenGL + , module SDL.Video.Renderer + + -- * Window Management + , Window + , createWindow + , defaultWindow + , WindowConfig(..) + , WindowMode(..) + , WindowPosition(..) + , destroyWindow + + -- * Window Actions + , hideWindow + , raiseWindow + , showWindow + + -- * Window Attributes + , windowMinimumSize + , windowMaximumSize + , windowSize + , windowBordered + , windowBrightness + , windowGammaRamp + , windowGrab + , setWindowMode + , getWindowAbsolutePosition + , setWindowPosition + , windowTitle + , windowData + , getWindowConfig + , getWindowPixelFormat + , PixelFormat(..) + + -- * Renderer Management + , createRenderer + , destroyRenderer + + -- * Clipboard Handling + , getClipboardText + , hasClipboardText + , setClipboardText + + -- * Display + , getDisplays + , Display(..) + , DisplayMode(..) + , VideoDriver(..) + + -- * Screen Savers + -- | Screen savers should be disabled when the sudden enablement of the + -- monitor's power saving features would be inconvenient for when the user + -- hasn't provided any input for some period of time, such as during video + -- playback. + -- + -- Screen savers are disabled by default upon the initialization of the + -- video subsystem. + , disableScreenSaver + , enableScreenSaver + , isScreenSaverEnabled + + -- * Message Box + , showSimpleMessageBox + , MessageKind(..) + ) where + +import Prelude hiding (all, foldl, foldr, mapM_) + +import Data.StateVar +import Control.Applicative +import Control.Exception +import Control.Monad (forM, unless, void) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bits +import Data.Data (Data) +import Data.Foldable +import Data.Maybe (isJust, fromMaybe) +import Data.Monoid (First(..)) +import Data.Text (Text) +import Data.Typeable +import Foreign hiding (void, throwIfNull, throwIfNeg, throwIfNeg_) +import Foreign.C +import GHC.Generics (Generic) +import Linear +import Linear.Affine (Point(P)) +import SDL.Exception +import SDL.Internal.Numbered +import SDL.Internal.Types +import SDL.Video.OpenGL +import SDL.Video.Renderer + +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as Text +import qualified Data.Vector.Storable as SV +import qualified SDL.Raw as Raw + +-- | Create a window with the given title and configuration. +-- +-- Throws 'SDLException' on failure. +createWindow :: MonadIO m => Text -> WindowConfig -> m Window +createWindow title config = liftIO $ do + case windowOpenGL config of + Just glcfg -> setGLAttributes glcfg + Nothing -> return () + + BS.useAsCString (Text.encodeUtf8 title) $ \title' -> do + let create = Raw.createWindow title' + let create' (V2 w h) = case windowPosition config of + Centered -> let u = Raw.SDL_WINDOWPOS_CENTERED in create u u w h + Wherever -> let u = Raw.SDL_WINDOWPOS_UNDEFINED in create u u w h + Absolute (P (V2 x y)) -> create x y w h + create' (windowInitialSize config) flags >>= return . Window + where + flags = foldr (.|.) 0 + [ if windowBorder config then 0 else Raw.SDL_WINDOW_BORDERLESS + , if windowHighDPI config then Raw.SDL_WINDOW_ALLOW_HIGHDPI else 0 + , if windowInputGrabbed config then Raw.SDL_WINDOW_INPUT_GRABBED else 0 + , toNumber $ windowMode config + , if isJust $ windowOpenGL config then Raw.SDL_WINDOW_OPENGL else 0 + , if windowResizable config then Raw.SDL_WINDOW_RESIZABLE else 0 + ] + setGLAttributes (OpenGLConfig (V4 r g b a) d s p) = do + let (msk, v0, v1, flg) = case p of + Core Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_CORE, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) + Core Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_CORE, v0', v1', 0) + Compatibility Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) + Compatibility Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_COMPATIBILITY, v0', v1', 0) + ES Debug v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_ES, v0', v1', Raw.SDL_GL_CONTEXT_DEBUG_FLAG) + ES Normal v0' v1' -> (Raw.SDL_GL_CONTEXT_PROFILE_ES, v0', v1', 0) + mapM_ (throwIfNeg_ "SDL.Video.createWindow" "SDL_GL_SetAttribute" . uncurry Raw.glSetAttribute) $ + [ (Raw.SDL_GL_RED_SIZE, r) + , (Raw.SDL_GL_GREEN_SIZE, g) + , (Raw.SDL_GL_BLUE_SIZE, b) + , (Raw.SDL_GL_ALPHA_SIZE, a) + , (Raw.SDL_GL_DEPTH_SIZE, d) + , (Raw.SDL_GL_STENCIL_SIZE, s) + , (Raw.SDL_GL_CONTEXT_PROFILE_MASK, msk) + , (Raw.SDL_GL_CONTEXT_MAJOR_VERSION, v0) + , (Raw.SDL_GL_CONTEXT_MINOR_VERSION, v1) + , (Raw.SDL_GL_CONTEXT_FLAGS, flg) + ] + +-- | Default configuration for windows. Use the record update syntax to +-- override any of the defaults. +-- +-- @ +-- 'defaultWindow' = 'WindowConfig' +-- { 'windowBorder' = True +-- , 'windowHighDPI' = False +-- , 'windowInputGrabbed' = False +-- , 'windowMode' = 'Windowed' +-- , 'windowOpenGL' = Nothing +-- , 'windowPosition' = 'Wherever' +-- , 'windowResizable' = False +-- , 'windowInitialSize' = V2 800 600 +-- } +-- @ +defaultWindow :: WindowConfig +defaultWindow = WindowConfig + { windowBorder = True + , windowHighDPI = False + , windowInputGrabbed = False + , windowMode = Windowed + , windowOpenGL = Nothing + , windowPosition = Wherever + , windowResizable = False + , windowInitialSize = V2 800 600 + } + +data WindowConfig = WindowConfig + { windowBorder :: Bool -- ^ Defaults to 'True'. + , windowHighDPI :: Bool -- ^ Defaults to 'False'. Can not be changed after window creation. + , windowInputGrabbed :: Bool -- ^ Defaults to 'False'. Whether the mouse shall be confined to the window. + , windowMode :: WindowMode -- ^ Defaults to 'Windowed'. + , windowOpenGL :: Maybe OpenGLConfig -- ^ Defaults to 'Nothing'. Can not be changed after window creation. + , windowPosition :: WindowPosition -- ^ Defaults to 'Wherever'. + , windowResizable :: Bool -- ^ Defaults to 'False'. Whether the window can be resized by the user. It is still possible to programatically change the size with 'setWindowSize'. + , windowInitialSize :: V2 CInt -- ^ Defaults to @(800, 600)@. + } deriving (Eq, Generic, Ord, Read, Show, Typeable) + +data WindowMode + = Fullscreen -- ^ Real fullscreen with a video mode change + | FullscreenDesktop -- ^ Fake fullscreen that takes the size of the desktop + | Maximized + | Minimized + | Windowed + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +instance ToNumber WindowMode Word32 where + toNumber Fullscreen = Raw.SDL_WINDOW_FULLSCREEN + toNumber FullscreenDesktop = Raw.SDL_WINDOW_FULLSCREEN_DESKTOP + toNumber Maximized = Raw.SDL_WINDOW_MAXIMIZED + toNumber Minimized = Raw.SDL_WINDOW_MINIMIZED + toNumber Windowed = 0 + +instance FromNumber WindowMode Word32 where + fromNumber n = fromMaybe Windowed . getFirst $ + foldMap First [ + sdlWindowFullscreen + , sdlWindowFullscreenDesktop + , sdlWindowMaximized + , sdlWindowMinimized + ] + where + maybeBit val msk = if n .&. msk > 0 then Just val else Nothing + sdlWindowFullscreen = maybeBit Fullscreen Raw.SDL_WINDOW_FULLSCREEN + sdlWindowFullscreenDesktop = maybeBit FullscreenDesktop Raw.SDL_WINDOW_FULLSCREEN_DESKTOP + sdlWindowMaximized = maybeBit Maximized Raw.SDL_WINDOW_MAXIMIZED + sdlWindowMinimized = maybeBit Minimized Raw.SDL_WINDOW_MINIMIZED + +data WindowPosition + = Centered + | Wherever -- ^ Let the window mananger decide where it's best to place the window. + | Absolute (Point V2 CInt) + deriving (Eq, Generic, Ord, Read, Show, Typeable) + +-- | Destroy the given window. The 'Window' handler may not be used +-- afterwards. +destroyWindow :: MonadIO m => Window -> m () +destroyWindow (Window w) = Raw.destroyWindow w + +-- | Get or set if the window should have a border. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +windowBordered :: Window -> StateVar Bool +windowBordered (Window w) = makeStateVar getWindowBordered setWindowBordered + where + getWindowBordered = fmap ((== 0) . (.&. Raw.SDL_WINDOW_BORDERLESS)) (Raw.getWindowFlags w) + setWindowBordered = Raw.setWindowBordered w + +-- | Get or set the window's brightness, where 0.0 is completely dark and 1.0 is normal brightness. +-- +-- Throws 'SDLException' if the hardware does not support gamma +-- correction, or if the system has run out of memory. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +windowBrightness :: Window -> StateVar Float +windowBrightness (Window w) = makeStateVar getWindowBrightness setWindowBrightness + where + setWindowBrightness brightness = do + throwIfNot0_ "SDL.Video.setWindowBrightness" "SDL_SetWindowBrightness" $ + Raw.setWindowBrightness w $ realToFrac brightness + + getWindowBrightness = + return . realToFrac =<< Raw.getWindowBrightness w + +-- | Get or set whether the mouse shall be confined to the window. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +windowGrab :: Window -> StateVar Bool +windowGrab (Window w) = makeStateVar getWindowGrab setWindowGrab + where + setWindowGrab = Raw.setWindowGrab w + getWindowGrab = Raw.getWindowGrab w + +-- | Change between window modes. +-- +-- Throws 'SDLException' on failure. +setWindowMode :: MonadIO m => Window -> WindowMode -> m () +setWindowMode (Window w) mode = + liftIO . throwIfNot0_ "SDL.Video.setWindowMode" "SDL_SetWindowFullscreen" $ + case mode of + Fullscreen -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN + FullscreenDesktop -> Raw.setWindowFullscreen w Raw.SDL_WINDOW_FULLSCREEN_DESKTOP + Maximized -> Raw.setWindowFullscreen w 0 <* Raw.maximizeWindow w + Minimized -> Raw.minimizeWindow w >> return 0 + Windowed -> Raw.restoreWindow w >> return 0 + +-- | Set the position of the window. +setWindowPosition :: MonadIO m => Window -> WindowPosition -> m () +setWindowPosition (Window w) pos = case pos of + Centered -> let u = Raw.SDL_WINDOWPOS_CENTERED in Raw.setWindowPosition w u u + Wherever -> let u = Raw.SDL_WINDOWPOS_UNDEFINED in Raw.setWindowPosition w u u + Absolute (P (V2 x y)) -> Raw.setWindowPosition w x y + +-- | Get the position of the window. +getWindowAbsolutePosition :: MonadIO m => Window -> m (V2 CInt) +getWindowAbsolutePosition (Window w) = + liftIO $ + alloca $ \wPtr -> + alloca $ \hPtr -> do + Raw.getWindowPosition w wPtr hPtr + V2 <$> peek wPtr <*> peek hPtr + + +-- | Get or set the size of a window's client area. Values beyond the maximum supported size are clamped. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +windowSize :: Window -> StateVar (V2 CInt) +windowSize (Window win) = makeStateVar getWindowSize setWindowSize + where + setWindowSize (V2 w h) = Raw.setWindowSize win w h + + getWindowSize = + liftIO $ + alloca $ \wptr -> + alloca $ \hptr -> do + Raw.getWindowSize win wptr hptr + V2 <$> peek wptr <*> peek hptr + +-- | Get or set the title of the window. If the window has no title, then an empty string is returned. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +windowTitle :: Window -> StateVar Text +windowTitle (Window w) = makeStateVar getWindowTitle setWindowTitle + where + setWindowTitle title = + liftIO . BS.useAsCString (Text.encodeUtf8 title) $ + Raw.setWindowTitle w + + getWindowTitle = liftIO $ do + cstr <- Raw.getWindowTitle w + Text.decodeUtf8 <$> BS.packCString cstr + +-- | Get or set the pointer to arbitrary user data associated with the given +-- window and name. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +windowData :: Window -> CString -> StateVar (Ptr ()) +windowData (Window w) key = makeStateVar getWindowData setWindowData + where + setWindowData = void . Raw.setWindowData w key + getWindowData = Raw.getWindowData w key + +-- | Retrieve the configuration of the given window. +-- +-- Note that 'Nothing' will be returned instead of potential OpenGL parameters +-- used during the creation of the window. +getWindowConfig :: MonadIO m => Window -> m WindowConfig +getWindowConfig (Window w) = do + wFlags <- Raw.getWindowFlags w + + wSize <- get (windowSize (Window w)) + wPos <- getWindowAbsolutePosition (Window w) + + return WindowConfig { + windowBorder = wFlags .&. Raw.SDL_WINDOW_BORDERLESS == 0 + , windowHighDPI = wFlags .&. Raw.SDL_WINDOW_ALLOW_HIGHDPI > 0 + , windowInputGrabbed = wFlags .&. Raw.SDL_WINDOW_INPUT_GRABBED > 0 + , windowMode = fromNumber wFlags + -- Should we store the openGL config that was used to create the window? + , windowOpenGL = Nothing + , windowPosition = Absolute (P wPos) + , windowResizable = wFlags .&. Raw.SDL_WINDOW_RESIZABLE > 0 + , windowInitialSize = wSize + } + +-- | Get the pixel format that is used for the given window. +getWindowPixelFormat :: MonadIO m => Window -> m PixelFormat +getWindowPixelFormat (Window w) = return . fromNumber =<< Raw.getWindowPixelFormat w + +-- | Get the text from the clipboard. +-- +-- Throws 'SDLException' on failure. +getClipboardText :: MonadIO m => m Text +getClipboardText = liftIO . mask_ $ do + cstr <- throwIfNull "SDL.Video.getClipboardText" "SDL_GetClipboardText" + Raw.getClipboardText + finally (Text.decodeUtf8 <$> BS.packCString cstr) (free cstr) + +-- | Checks if the clipboard exists, and has some text in it. +hasClipboardText :: MonadIO m => m Bool +hasClipboardText = Raw.hasClipboardText + +-- | Replace the contents of the clipboard with the given text. +-- +-- Throws 'SDLException' on failure. +setClipboardText :: MonadIO m => Text -> m () +setClipboardText str = liftIO $ do + throwIfNot0_ "SDL.Video.setClipboardText" "SDL_SetClipboardText" $ + BS.useAsCString (Text.encodeUtf8 str) Raw.setClipboardText + +-- | Hide a window. +-- +-- See @@ for C documentation. +hideWindow :: MonadIO m => Window -> m () +hideWindow (Window w) = Raw.hideWindow w + +-- | Raise the window above other windows and set the input focus. +-- +-- See @@ for C documentation. +raiseWindow :: MonadIO m => Window -> m () +raiseWindow (Window w) = Raw.raiseWindow w + +-- | Prevent the screen from being blanked by a screen saver. If you disable the screensaver, it is automatically re-enabled when SDL quits. +-- +-- See @@ for C documentation. +disableScreenSaver :: MonadIO m => m () +disableScreenSaver = Raw.disableScreenSaver + +-- | Allow the screen to be blanked by a screen saver. +-- +-- See @@ for C documentation. +enableScreenSaver :: MonadIO m => m () +enableScreenSaver = Raw.enableScreenSaver + +-- | Check whether screen savers are enabled . +-- +-- See @@ for C documentation. +isScreenSaverEnabled :: MonadIO m => m Bool +isScreenSaverEnabled = Raw.isScreenSaverEnabled + +-- | Show a window. +-- +-- See @@ for C documentation. +showWindow :: MonadIO m => Window -> m () +showWindow (Window w) = Raw.showWindow w + +-- | Gets or sets the gamma ramp for the display that owns a given window. +-- +-- Note that the data for the gamma ramp - the 'V3' ('SV.Vector' 'Word16') - must contain 256 element arrays. This triple is a set of translation vectors for each of the 16-bit red, green and blue channels. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- Despite the name and signature, this method retrieves the gamma ramp of the entire display, not an individual window. A window is considered to be owned by the display that contains the window's center pixel. +windowGammaRamp :: Window -> StateVar (V3 (SV.Vector Word16)) +windowGammaRamp (Window w) = makeStateVar getWindowGammaRamp setWindowGammaRamp + where + getWindowGammaRamp = + allocaArray 256 $ \rPtr -> + allocaArray 256 $ \gPtr -> + allocaArray 256 $ \bPtr -> do + throwIfNeg_ "SDL.Video.getWindowGammaRamp" "SDL_GetWindowGammaRamp" + (Raw.getWindowGammaRamp w rPtr gPtr bPtr) + liftA3 V3 (fmap SV.fromList (peekArray 256 rPtr)) + (fmap SV.fromList (peekArray 256 gPtr)) + (fmap SV.fromList (peekArray 256 bPtr)) + + + setWindowGammaRamp (V3 r g b) = liftIO $ do + unless (all ((== 256) . SV.length) [r,g,b]) $ + error "setWindowGammaRamp requires 256 element in each colour channel" + + SV.unsafeWith r $ \rPtr -> + SV.unsafeWith b $ \bPtr -> + SV.unsafeWith g $ \gPtr -> + throwIfNeg_ "SDL.Video.setWindowGammaRamp" "SDL_SetWindowGammaRamp" $ + Raw.setWindowGammaRamp w rPtr gPtr bPtr + +data Display = Display { + displayName :: String + , displayBoundsPosition :: Point V2 CInt + -- ^ Position of the desktop area represented by the display, + -- with the primary display located at @(0, 0)@. + , displayBoundsSize :: V2 CInt + -- ^ Size of the desktop area represented by the display. + , displayModes :: [DisplayMode] + } + deriving (Eq, Generic, Ord, Read, Show, Typeable) + +data DisplayMode = DisplayMode { + displayModeFormat :: PixelFormat + , displayModeSize :: V2 CInt + , displayModeRefreshRate :: CInt -- ^ Display's refresh rate in hertz, or @0@ if unspecified. + } + deriving (Eq, Generic, Ord, Read, Show, Typeable) + +data VideoDriver = VideoDriver { + videoDriverName :: String + } + deriving (Data, Eq, Generic, Ord, Read, Show, Typeable) + +-- | Throws 'SDLException' on failure. +getDisplays :: MonadIO m => m [Display] +getDisplays = liftIO $ do + numDisplays <- throwIfNeg "SDL.Video.getDisplays" "SDL_GetNumVideoDisplays" + Raw.getNumVideoDisplays + + forM [0..numDisplays - 1] $ \displayId -> do + name <- throwIfNull "SDL.Video.getDisplays" "SDL_GetDisplayName" $ + Raw.getDisplayName displayId + + name' <- peekCString name + + Raw.Rect x y w h <- alloca $ \rect -> do + throwIfNot0_ "SDL.Video.getDisplays" "SDL_GetDisplayBounds" $ + Raw.getDisplayBounds displayId rect + peek rect + + numModes <- throwIfNeg "SDL.Video.getDisplays" "SDL_GetNumDisplayModes" $ + Raw.getNumDisplayModes displayId + + modes <- forM [0..numModes - 1] $ \modeId -> do + Raw.DisplayMode format w' h' refreshRate _ <- alloca $ \mode -> do + throwIfNot0_ "SDL.Video.getDisplays" "SDL_GetDisplayMode" $ + Raw.getDisplayMode displayId modeId mode + peek mode + + return $ DisplayMode { + displayModeFormat = fromNumber format + , displayModeSize = V2 w' h' + , displayModeRefreshRate = refreshRate + } + + return $ Display { + displayName = name' + , displayBoundsPosition = P (V2 x y) + , displayBoundsSize = V2 w h + , displayModes = modes + } + +-- | Show a simple message box with the given title and a message. Consider +-- writing your messages to @stderr@ too. +-- +-- Throws 'SDLException' if there are no available video targets. +showSimpleMessageBox :: MonadIO m => Maybe Window -> MessageKind -> Text -> Text -> m () +showSimpleMessageBox window kind title message = + liftIO . throwIfNot0_ "SDL.Video.showSimpleMessageBox" "SDL_ShowSimpleMessageBox" $ do + BS.useAsCString (Text.encodeUtf8 title) $ \title' -> + BS.useAsCString (Text.encodeUtf8 message) $ \message' -> + Raw.showSimpleMessageBox (toNumber kind) title' message' $ + windowId window + where + windowId (Just (Window w)) = w + windowId Nothing = nullPtr + +data MessageKind + = Error + | Warning + | Information + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +instance ToNumber MessageKind Word32 where + toNumber Error = Raw.SDL_MESSAGEBOX_ERROR + toNumber Warning = Raw.SDL_MESSAGEBOX_WARNING + toNumber Information = Raw.SDL_MESSAGEBOX_INFORMATION + +-- | Get or set the maximum size of a window's client area. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +windowMaximumSize :: Window -> StateVar (V2 CInt) +windowMaximumSize (Window win) = makeStateVar getWindowMaximumSize setWindowMaximumSize + where + setWindowMaximumSize (V2 w h) = Raw.setWindowMaximumSize win w h + + getWindowMaximumSize = + liftIO $ + alloca $ \wptr -> + alloca $ \hptr -> do + Raw.getWindowMaximumSize win wptr hptr + V2 <$> peek wptr <*> peek hptr + +-- | Get or set the minimum size of a window's client area. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +windowMinimumSize :: Window -> StateVar (V2 CInt) +windowMinimumSize (Window win) = makeStateVar getWindowMinimumSize setWindowMinimumSize + where + setWindowMinimumSize (V2 w h) = Raw.setWindowMinimumSize win w h + + getWindowMinimumSize = + liftIO $ + alloca $ \wptr -> + alloca $ \hptr -> do + Raw.getWindowMinimumSize win wptr hptr + V2 <$> peek wptr <*> peek hptr + +createRenderer :: MonadIO m => Window -> CInt -> RendererConfig -> m Renderer +createRenderer (Window w) driver config = + liftIO . fmap Renderer $ + throwIfNull "SDL.Video.createRenderer" "SDL_CreateRenderer" $ + Raw.createRenderer w driver (toNumber config) + +destroyRenderer :: MonadIO m => Renderer -> m () +destroyRenderer (Renderer r) = Raw.destroyRenderer r diff --git a/src/SDL/Video/OpenGL.hs b/src/SDL/Video/OpenGL.hs --- a/src/SDL/Video/OpenGL.hs +++ b/src/SDL/Video/OpenGL.hs @@ -1,171 +1,171 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} - -module SDL.Video.OpenGL - ( -- * Creating and Configuring OpenGL Contexts - defaultOpenGL - , OpenGLConfig(..) - , GLContext - , glCreateContext - , Profile(..) - , Mode(..) - , glMakeCurrent - , glDeleteContext - - -- * Swapping - -- | The process of \"swapping\" means to move the back-buffer into the window contents itself. - , glSwapWindow - , SwapInterval(..) - , swapInterval - - -- * Function Loading - , Raw.glGetProcAddress - ) where - -import Control.Monad.IO.Class (MonadIO) -import Data.Data (Data) -import Data.StateVar -import Data.Typeable -import Foreign.C.Types -import GHC.Generics (Generic) -import Linear -import SDL.Exception -import SDL.Internal.Numbered -import SDL.Internal.Types -import qualified SDL.Raw as Raw - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- | A set of default options for 'OpenGLConfig' --- --- @ --- 'defaultOpenGL' = 'OpenGLConfig' --- { 'glColorPrecision' = V4 8 8 8 0 --- , 'glDepthPrecision' = 24 --- , 'glStencilPrecision' = 8 --- , 'glProfile' = 'Compatibility' 'Normal' 2 1 --- } --- @ -defaultOpenGL :: OpenGLConfig -defaultOpenGL = OpenGLConfig - { glColorPrecision = V4 8 8 8 0 - , glDepthPrecision = 24 - , glStencilPrecision = 8 - , glProfile = Compatibility Normal 2 1 - } - --- | Configuration used when creating an OpenGL rendering context. -data OpenGLConfig = OpenGLConfig - { glColorPrecision :: V4 CInt -- ^ Defaults to 'V4' @8 8 8 0@. - , glDepthPrecision :: CInt -- ^ Defaults to @24@. - , glStencilPrecision :: CInt -- ^ Defaults to @8@. - , glProfile :: Profile -- ^ Defaults to 'Compatibility' 'Normal' @2 1@. - } deriving (Eq, Generic, Ord, Read, Show, Typeable) - --- | The profile a driver should use when creating an OpenGL context. -data Profile - = Core Mode CInt CInt - -- ^ Use the OpenGL core profile, with a given major and minor version - | Compatibility Mode CInt CInt - -- ^ Use the compatibilty profile with a given major and minor version. The compatibility profile allows you to use deprecated functions such as immediate mode - | ES Mode CInt CInt - -- ^ Use an OpenGL profile for embedded systems - deriving (Eq, Generic, Ord, Read, Show, Typeable) - --- | The mode a driver should use when creating an OpenGL context. -data Mode - = Normal - -- ^ A normal profile with no special debugging support - | Debug - -- ^ Use a debug context, allowing the usage of extensions such as @GL_ARB_debug_output@ - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - --- | A created OpenGL context. -newtype GLContext = GLContext Raw.GLContext - deriving (Eq, Typeable) - --- | Create a new OpenGL context and makes it the current context for the --- window. --- --- Throws 'SDLException' if the window wasn't configured with OpenGL --- support, or if context creation fails. --- --- See @@ for C documentation. -glCreateContext :: (Functor m, MonadIO m) => Window -> m GLContext -glCreateContext (Window w) = - GLContext <$> throwIfNull "SDL.Video.glCreateContext" "SDL_GL_CreateContext" - (Raw.glCreateContext w) - --- | Set up an OpenGL context for rendering into an OpenGL window. --- --- Throws 'SDLException' on failure. --- --- See @@ for C documentation. -glMakeCurrent :: (Functor m, MonadIO m) => Window -> GLContext -> m () -glMakeCurrent (Window w) (GLContext ctx) = - throwIfNeg_ "SDL.Video.OpenGL.glMakeCurrent" "SDL_GL_MakeCurrent" $ - Raw.glMakeCurrent w ctx - --- | Delete the given OpenGL context. --- --- You /must/ make sure that there are no pending commands in the OpenGL --- command queue, the driver may still be processing commands even if you have --- stopped issuing them! --- --- The @glFinish@ command will block until the command queue has been fully --- processed. You should call that function before deleting a context. --- --- See @@ for C documentation. -glDeleteContext :: MonadIO m => GLContext -> m () -glDeleteContext (GLContext ctx) = Raw.glDeleteContext ctx - --- | Replace the contents of the front buffer with the back buffer's. The --- contents of the back buffer are undefined, clear them with @glClear@ or --- equivalent before drawing to them again. --- --- See @@ for C documentation. -glSwapWindow :: MonadIO m => Window -> m () -glSwapWindow (Window w) = Raw.glSwapWindow w - --- | The swap interval for the current OpenGL context. -data SwapInterval - = ImmediateUpdates - -- ^ No vertical retrace synchronization - | SynchronizedUpdates - -- ^ The buffer swap is synchronized with the vertical retrace - | LateSwapTearing - deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) - -instance ToNumber SwapInterval CInt where - toNumber ImmediateUpdates = 0 - toNumber SynchronizedUpdates = 1 - toNumber LateSwapTearing = -1 - -instance FromNumber SwapInterval CInt where - fromNumber n' = - case n' of - 0 -> ImmediateUpdates - 1 -> SynchronizedUpdates - -1 -> LateSwapTearing - _ -> - error ("Unknown SwapInterval: " ++ show n') - --- | Get or set the swap interval for the current OpenGL context. --- --- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. --- --- See @@ and @@ for C documentation. -swapInterval :: StateVar SwapInterval -swapInterval = makeStateVar glGetSwapInterval glSetSwapInterval - where - glGetSwapInterval = fmap fromNumber $ Raw.glGetSwapInterval - - glSetSwapInterval i = - throwIfNeg_ "SDL.Video.glSetSwapInterval" "SDL_GL_SetSwapInterval" $ - Raw.glSetSwapInterval (toNumber i) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module SDL.Video.OpenGL + ( -- * Creating and Configuring OpenGL Contexts + defaultOpenGL + , OpenGLConfig(..) + , GLContext + , glCreateContext + , Profile(..) + , Mode(..) + , glMakeCurrent + , glDeleteContext + + -- * Swapping + -- | The process of \"swapping\" means to move the back-buffer into the window contents itself. + , glSwapWindow + , SwapInterval(..) + , swapInterval + + -- * Function Loading + , Raw.glGetProcAddress + ) where + +import Control.Monad.IO.Class (MonadIO) +import Data.Data (Data) +import Data.StateVar +import Data.Typeable +import Foreign.C.Types +import GHC.Generics (Generic) +import Linear +import SDL.Exception +import SDL.Internal.Numbered +import SDL.Internal.Types +import qualified SDL.Raw as Raw + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +-- | A set of default options for 'OpenGLConfig' +-- +-- @ +-- 'defaultOpenGL' = 'OpenGLConfig' +-- { 'glColorPrecision' = V4 8 8 8 0 +-- , 'glDepthPrecision' = 24 +-- , 'glStencilPrecision' = 8 +-- , 'glProfile' = 'Compatibility' 'Normal' 2 1 +-- } +-- @ +defaultOpenGL :: OpenGLConfig +defaultOpenGL = OpenGLConfig + { glColorPrecision = V4 8 8 8 0 + , glDepthPrecision = 24 + , glStencilPrecision = 8 + , glProfile = Compatibility Normal 2 1 + } + +-- | Configuration used when creating an OpenGL rendering context. +data OpenGLConfig = OpenGLConfig + { glColorPrecision :: V4 CInt -- ^ Defaults to 'V4' @8 8 8 0@. + , glDepthPrecision :: CInt -- ^ Defaults to @24@. + , glStencilPrecision :: CInt -- ^ Defaults to @8@. + , glProfile :: Profile -- ^ Defaults to 'Compatibility' 'Normal' @2 1@. + } deriving (Eq, Generic, Ord, Read, Show, Typeable) + +-- | The profile a driver should use when creating an OpenGL context. +data Profile + = Core Mode CInt CInt + -- ^ Use the OpenGL core profile, with a given major and minor version + | Compatibility Mode CInt CInt + -- ^ Use the compatibilty profile with a given major and minor version. The compatibility profile allows you to use deprecated functions such as immediate mode + | ES Mode CInt CInt + -- ^ Use an OpenGL profile for embedded systems + deriving (Eq, Generic, Ord, Read, Show, Typeable) + +-- | The mode a driver should use when creating an OpenGL context. +data Mode + = Normal + -- ^ A normal profile with no special debugging support + | Debug + -- ^ Use a debug context, allowing the usage of extensions such as @GL_ARB_debug_output@ + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +-- | A created OpenGL context. +newtype GLContext = GLContext Raw.GLContext + deriving (Eq, Typeable) + +-- | Create a new OpenGL context and makes it the current context for the +-- window. +-- +-- Throws 'SDLException' if the window wasn't configured with OpenGL +-- support, or if context creation fails. +-- +-- See @@ for C documentation. +glCreateContext :: (Functor m, MonadIO m) => Window -> m GLContext +glCreateContext (Window w) = + GLContext <$> throwIfNull "SDL.Video.glCreateContext" "SDL_GL_CreateContext" + (Raw.glCreateContext w) + +-- | Set up an OpenGL context for rendering into an OpenGL window. +-- +-- Throws 'SDLException' on failure. +-- +-- See @@ for C documentation. +glMakeCurrent :: (Functor m, MonadIO m) => Window -> GLContext -> m () +glMakeCurrent (Window w) (GLContext ctx) = + throwIfNeg_ "SDL.Video.OpenGL.glMakeCurrent" "SDL_GL_MakeCurrent" $ + Raw.glMakeCurrent w ctx + +-- | Delete the given OpenGL context. +-- +-- You /must/ make sure that there are no pending commands in the OpenGL +-- command queue, the driver may still be processing commands even if you have +-- stopped issuing them! +-- +-- The @glFinish@ command will block until the command queue has been fully +-- processed. You should call that function before deleting a context. +-- +-- See @@ for C documentation. +glDeleteContext :: MonadIO m => GLContext -> m () +glDeleteContext (GLContext ctx) = Raw.glDeleteContext ctx + +-- | Replace the contents of the front buffer with the back buffer's. The +-- contents of the back buffer are undefined, clear them with @glClear@ or +-- equivalent before drawing to them again. +-- +-- See @@ for C documentation. +glSwapWindow :: MonadIO m => Window -> m () +glSwapWindow (Window w) = Raw.glSwapWindow w + +-- | The swap interval for the current OpenGL context. +data SwapInterval + = ImmediateUpdates + -- ^ No vertical retrace synchronization + | SynchronizedUpdates + -- ^ The buffer swap is synchronized with the vertical retrace + | LateSwapTearing + deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable) + +instance ToNumber SwapInterval CInt where + toNumber ImmediateUpdates = 0 + toNumber SynchronizedUpdates = 1 + toNumber LateSwapTearing = -1 + +instance FromNumber SwapInterval CInt where + fromNumber n' = + case n' of + 0 -> ImmediateUpdates + 1 -> SynchronizedUpdates + -1 -> LateSwapTearing + _ -> + error ("Unknown SwapInterval: " ++ show n') + +-- | Get or set the swap interval for the current OpenGL context. +-- +-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'. +-- +-- See @@ and @@ for C documentation. +swapInterval :: StateVar SwapInterval +swapInterval = makeStateVar glGetSwapInterval glSetSwapInterval + where + glGetSwapInterval = fmap fromNumber $ Raw.glGetSwapInterval + + glSetSwapInterval i = + throwIfNeg_ "SDL.Video.glSetSwapInterval" "SDL_GL_SetSwapInterval" $ + Raw.glSetSwapInterval (toNumber i) diff --git a/src/SDL/Video/Renderer.hs b/src/SDL/Video/Renderer.hs --- a/src/SDL/Video/Renderer.hs +++ b/src/SDL/Video/Renderer.hs @@ -78,6 +78,8 @@ , formatPalette , mapRGB , setPaletteColors + , pixelFormatToMasks + , masksToPixelFormat -- * Textures , Texture @@ -304,31 +306,31 @@ -- | Allocate a new RGB surface. -- -- See @@ for C documentation. -createRGBSurface :: (Functor m,MonadIO m) +createRGBSurface :: (Functor m, MonadIO m) => V2 CInt -- ^ The size of the surface - -> CInt -- ^ The bit-depth of the surface - -> V4 Word32 -- ^ The red, green, blue and alpha mask for the pixels + -> PixelFormat -- ^ The bit depth, red, green, blue and alpha mask for the pixels -> m Surface -createRGBSurface (V2 w h) d (V4 r g b a) = +createRGBSurface (V2 w h) pf = fmap unmanagedSurface $ - throwIfNull "SDL.Video.createRGBSurface" "SDL_CreateRGBSurface" $ - Raw.createRGBSurface 0 w h d r g b a + throwIfNull "SDL.Video.createRGBSurface" "SDL_CreateRGBSurface" $ do + (bpp, V4 r g b a) <- pixelFormatToMasks pf + Raw.createRGBSurface 0 w h bpp r g b a -- | Allocate a new RGB surface with existing pixel data. -- -- See @@ for C documentation. -createRGBSurfaceFrom :: (Functor m,MonadIO m) +createRGBSurfaceFrom :: (Functor m, MonadIO m) => MSV.IOVector Word8 -- ^ The existing pixel data -> V2 CInt -- ^ The size of the surface - -> CInt -- ^ The bit-depth of the surface -> CInt -- ^ The pitch - the length of a row of pixels in bytes - -> V4 Word32 -- ^ The red, green blue and alpha mask for the pixels + -> PixelFormat -- ^ The bit depth, red, green, blue and alpha mask for the pixels -> m Surface -createRGBSurfaceFrom pixels (V2 w h) d p (V4 r g b a) = liftIO $ +createRGBSurfaceFrom pixels (V2 w h) p pf = liftIO $ fmap (managedSurface pixels) $ - throwIfNull "SDL.Video.createRGBSurfaceFrom" "SDL_CreateRGBSurfaceFrom" $ - MSV.unsafeWith pixels $ \pixelPtr -> - Raw.createRGBSurfaceFrom (castPtr pixelPtr) w h d p r g b a + throwIfNull "SDL.Video.createRGBSurfaceFrom" "SDL_CreateRGBSurfaceFrom" $ do + (bpp, V4 r g b a) <- pixelFormatToMasks pf + MSV.unsafeWith pixels $ \pixelPtr -> + Raw.createRGBSurfaceFrom (castPtr pixelPtr) w h bpp p r g b a -- | Perform a fast fill of a rectangle with a specific color. -- @@ -721,7 +723,7 @@ -> Maybe (Rectangle CInt) -- ^ The destination rectangle to copy to, or 'Nothing' for the whole rendering target. The texture will be stretched to fill the given rectangle. -> CDouble -- ^ An angle in degrees that indicates the point around which the destination rectangle will be rotated. -> Maybe (Point V2 CInt) -- ^ The point of rotation - -> V2 Bool -- ^ Whether to flip in the X or Y axis. -- ^ The point of rotation + -> V2 Bool -- ^ Whether to flip in the X or Y axis. -> m () -- ^ Whether to flip in the X or Y axis. copyEx (Renderer r) (Texture t) srcRect dstRect theta center flips = liftIO $ @@ -1193,3 +1195,26 @@ -- See @@ for C documentation. renderTargetSupported :: (MonadIO m) => Renderer -> m Bool renderTargetSupported (Renderer r) = Raw.renderTargetSupported r + +-- | Convert the given the enumerated pixel format to a bpp value and RGBA masks. +-- +-- See @@ for C documentation. +pixelFormatToMasks :: (MonadIO m) => PixelFormat -> m (CInt, V4 Word32) +pixelFormatToMasks pf = liftIO $ + alloca $ \bpp -> + alloca $ \r -> + alloca $ \g -> + alloca $ \b -> + alloca $ \a -> do + throwIf_ not "SDL.Video.pixelFormatEnumToMasks" "SDL_PixelFormatEnumToMasks" $ + Raw.pixelFormatEnumToMasks (toNumber pf) bpp r g b a + wrap <$> peek bpp <*> peek r <*> peek g <*> peek b <*> peek a + where + wrap bpp r g b a = (bpp, V4 r g b a) + +-- | Convert a bpp value and RGBA masks to an enumerated pixel format. +-- +-- See @@ for C documentation. +masksToPixelFormat :: (MonadIO m) => CInt -> V4 Word32 -> m PixelFormat +masksToPixelFormat bpp (V4 r g b a) = liftIO $ + fromNumber <$> Raw.masksToPixelFormatEnum bpp r g b a