diff --git a/GLFW-b.cabal b/GLFW-b.cabal --- a/GLFW-b.cabal +++ b/GLFW-b.cabal @@ -1,5 +1,5 @@ name: GLFW-b -version: 1.1.0 +version: 1.2.0 category: Graphics author: Brian Lewis @@ -45,25 +45,12 @@ Graphics.UI.GLFW other-modules: - Graphics.UI.GLFW.Internal.C - Graphics.UI.GLFW.Internal.C.TH - Graphics.UI.GLFW.Internal.Instances.C - Graphics.UI.GLFW.Internal.Instances.Data - Graphics.UI.GLFW.Internal.Instances.Lift - Graphics.UI.GLFW.Internal.Tables + Graphics.UI.GLFW.C Graphics.UI.GLFW.Types build-depends: - base < 5, - bindings-GLFW == 0.0.*, - th-lift == 0.5.* - - if impl(ghc < 7.6) - build-depends: - template-haskell == 2.7.* - else - build-depends: - template-haskell == 2.8.* + base < 5, + bindings-GLFW == 0.0.* -------------------------------------------------------------------------------- @@ -78,20 +65,12 @@ main-is: Test.hs build-depends: - GLFW-b == 1.1.*, + GLFW-b == 1.2.*, HUnit == 1.2.*, base < 5, bindings-GLFW == 0.0.*, test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - th-lift == 0.5.* - - if impl(ghc < 7.6) - build-depends: - template-haskell == 2.7.* - else - build-depends: - template-haskell == 2.8.* + test-framework-hunit == 0.3.* -------------------------------------------------------------------------------- diff --git a/Graphics/UI/GLFW.hs b/Graphics/UI/GLFW.hs --- a/Graphics/UI/GLFW.hs +++ b/Graphics/UI/GLFW.hs @@ -146,8 +146,7 @@ import Foreign.Storable (Storable (..)) import System.IO.Unsafe (unsafePerformIO) -import Graphics.UI.GLFW.Internal.C (C (..)) -import Graphics.UI.GLFW.Internal.Instances.C () +import Graphics.UI.GLFW.C import Graphics.UI.GLFW.Types import Bindings.GLFW diff --git a/Graphics/UI/GLFW/C.hs b/Graphics/UI/GLFW/C.hs new file mode 100644 --- /dev/null +++ b/Graphics/UI/GLFW/C.hs @@ -0,0 +1,533 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +-------------------------------------------------------------------------------- + +-- This code is generated by util/genC.hs. + +-------------------------------------------------------------------------------- + +module Graphics.UI.GLFW.C where + +-------------------------------------------------------------------------------- + +import Data.Bits ((.&.)) +import Data.Char (chr, ord) +import Foreign.C.Types (CDouble, CFloat, CInt, CUChar, CUInt, CUShort) +import Foreign.Ptr (Ptr) + +import Bindings.GLFW +import Graphics.UI.GLFW.Types + +-------------------------------------------------------------------------------- + +class C c h where + fromC :: c -> h + toC :: h -> c + +-------------------------------------------------------------------------------- + +instance C CInt Char where + fromC = chr . fromIntegral + toC = fromIntegral . ord + +instance C CUInt Char where + fromC = chr . fromIntegral + toC = fromIntegral . ord + +instance C CDouble Double where + fromC = realToFrac + toC = realToFrac + +instance C CInt Int where + fromC = fromIntegral + toC = fromIntegral + +instance C CUInt Int where + fromC = fromIntegral + toC = fromIntegral + +instance C CUShort Int where + fromC = fromIntegral + toC = fromIntegral + +instance C CFloat Double where + fromC = realToFrac + toC = realToFrac + +instance C (Ptr C'GLFWmonitor) Monitor where + fromC = Monitor + toC = unMonitor + +instance C (Ptr C'GLFWwindow) Window where + fromC = Window + toC = unWindow + +instance C CInt ModifierKeys where + fromC v = ModifierKeys + { modifierKeysShift = (v .&. c'GLFW_MOD_SHIFT) /= 0 + , modifierKeysControl = (v .&. c'GLFW_MOD_CONTROL) /= 0 + , modifierKeysAlt = (v .&. c'GLFW_MOD_ALT) /= 0 + , modifierKeysSuper = (v .&. c'GLFW_MOD_SUPER) /= 0 + } + toC = undefined + +instance C C'GLFWvidmode VideoMode where + fromC gvm = VideoMode + { videoModeWidth = fromIntegral $ c'GLFWvidmode'width gvm + , videoModeHeight = fromIntegral $ c'GLFWvidmode'height gvm + , videoModeRedBits = fromIntegral $ c'GLFWvidmode'redBits gvm + , videoModeGreenBits = fromIntegral $ c'GLFWvidmode'greenBits gvm + , videoModeBlueBits = fromIntegral $ c'GLFWvidmode'blueBits gvm + , videoModeRefreshRate = fromIntegral $ c'GLFWvidmode'refreshRate gvm + } + toC = undefined + +-------------------------------------------------------------------------------- + +instance C CInt Bool where + fromC v + | v == c'GL_FALSE = False + | v == c'GL_TRUE = True + | otherwise = error $ "C CInt Bool fromC: " ++ show v + toC False = c'GL_FALSE + toC True = c'GL_TRUE + +instance C CInt Error where + fromC v + | v == c'GLFW_NOT_INITIALIZED = Error'NotInitialized + | v == c'GLFW_NO_CURRENT_CONTEXT = Error'NoCurrentContext + | v == c'GLFW_INVALID_ENUM = Error'InvalidEnum + | v == c'GLFW_INVALID_VALUE = Error'InvalidValue + | v == c'GLFW_OUT_OF_MEMORY = Error'OutOfMemory + | v == c'GLFW_API_UNAVAILABLE = Error'ApiUnavailable + | v == c'GLFW_VERSION_UNAVAILABLE = Error'VersionUnavailable + | v == c'GLFW_PLATFORM_ERROR = Error'PlatformError + | v == c'GLFW_FORMAT_UNAVAILABLE = Error'FormatUnavailable + | otherwise = error $ "C CInt Error fromC: " ++ show v + toC Error'NotInitialized = c'GLFW_NOT_INITIALIZED + toC Error'NoCurrentContext = c'GLFW_NO_CURRENT_CONTEXT + toC Error'InvalidEnum = c'GLFW_INVALID_ENUM + toC Error'InvalidValue = c'GLFW_INVALID_VALUE + toC Error'OutOfMemory = c'GLFW_OUT_OF_MEMORY + toC Error'ApiUnavailable = c'GLFW_API_UNAVAILABLE + toC Error'VersionUnavailable = c'GLFW_VERSION_UNAVAILABLE + toC Error'PlatformError = c'GLFW_PLATFORM_ERROR + toC Error'FormatUnavailable = c'GLFW_FORMAT_UNAVAILABLE + +instance C CInt MonitorState where + fromC v + | v == c'GL_TRUE = MonitorState'Connected + | v == c'GL_FALSE = MonitorState'Disconnected + | otherwise = error $ "C CInt MonitorState fromC: " ++ show v + toC MonitorState'Connected = c'GL_TRUE + toC MonitorState'Disconnected = c'GL_FALSE + +instance C CInt FocusState where + fromC v + | v == c'GL_TRUE = FocusState'Focused + | v == c'GL_FALSE = FocusState'Defocused + | otherwise = error $ "C CInt FocusState fromC: " ++ show v + toC FocusState'Focused = c'GL_TRUE + toC FocusState'Defocused = c'GL_FALSE + +instance C CInt IconifyState where + fromC v + | v == c'GL_TRUE = IconifyState'Iconified + | v == c'GL_FALSE = IconifyState'NotIconified + | otherwise = error $ "C CInt IconifyState fromC: " ++ show v + toC IconifyState'Iconified = c'GL_TRUE + toC IconifyState'NotIconified = c'GL_FALSE + +instance C CInt ContextRobustness where + fromC v + | v == c'GLFW_NO_ROBUSTNESS = ContextRobustness'NoRobustness + | v == c'GLFW_NO_RESET_NOTIFICATION = ContextRobustness'NoResetNotification + | v == c'GLFW_LOSE_CONTEXT_ON_RESET = ContextRobustness'LoseContextOnReset + | otherwise = error $ "C CInt ContextRobustness fromC: " ++ show v + toC ContextRobustness'NoRobustness = c'GLFW_NO_ROBUSTNESS + toC ContextRobustness'NoResetNotification = c'GLFW_NO_RESET_NOTIFICATION + toC ContextRobustness'LoseContextOnReset = c'GLFW_LOSE_CONTEXT_ON_RESET + +instance C CInt OpenGLProfile where + fromC v + | v == c'GLFW_OPENGL_ANY_PROFILE = OpenGLProfile'Any + | v == c'GLFW_OPENGL_COMPAT_PROFILE = OpenGLProfile'Compat + | v == c'GLFW_OPENGL_CORE_PROFILE = OpenGLProfile'Core + | otherwise = error $ "C CInt OpenGLProfile fromC: " ++ show v + toC OpenGLProfile'Any = c'GLFW_OPENGL_ANY_PROFILE + toC OpenGLProfile'Compat = c'GLFW_OPENGL_COMPAT_PROFILE + toC OpenGLProfile'Core = c'GLFW_OPENGL_CORE_PROFILE + +instance C CInt ClientAPI where + fromC v + | v == c'GLFW_OPENGL_API = ClientAPI'OpenGL + | v == c'GLFW_OPENGL_ES_API = ClientAPI'OpenGLES + | otherwise = error $ "C CInt ClientAPI fromC: " ++ show v + toC ClientAPI'OpenGL = c'GLFW_OPENGL_API + toC ClientAPI'OpenGLES = c'GLFW_OPENGL_ES_API + +instance C CInt Key where + fromC v + | v == c'GLFW_KEY_UNKNOWN = Key'Unknown + | v == c'GLFW_KEY_SPACE = Key'Space + | v == c'GLFW_KEY_APOSTROPHE = Key'Apostrophe + | v == c'GLFW_KEY_COMMA = Key'Comma + | v == c'GLFW_KEY_MINUS = Key'Minus + | v == c'GLFW_KEY_PERIOD = Key'Period + | v == c'GLFW_KEY_SLASH = Key'Slash + | v == c'GLFW_KEY_0 = Key'0 + | v == c'GLFW_KEY_1 = Key'1 + | v == c'GLFW_KEY_2 = Key'2 + | v == c'GLFW_KEY_3 = Key'3 + | v == c'GLFW_KEY_4 = Key'4 + | v == c'GLFW_KEY_5 = Key'5 + | v == c'GLFW_KEY_6 = Key'6 + | v == c'GLFW_KEY_7 = Key'7 + | v == c'GLFW_KEY_8 = Key'8 + | v == c'GLFW_KEY_9 = Key'9 + | v == c'GLFW_KEY_SEMICOLON = Key'Semicolon + | v == c'GLFW_KEY_EQUAL = Key'Equal + | v == c'GLFW_KEY_A = Key'A + | v == c'GLFW_KEY_B = Key'B + | v == c'GLFW_KEY_C = Key'C + | v == c'GLFW_KEY_D = Key'D + | v == c'GLFW_KEY_E = Key'E + | v == c'GLFW_KEY_F = Key'F + | v == c'GLFW_KEY_G = Key'G + | v == c'GLFW_KEY_H = Key'H + | v == c'GLFW_KEY_I = Key'I + | v == c'GLFW_KEY_J = Key'J + | v == c'GLFW_KEY_K = Key'K + | v == c'GLFW_KEY_L = Key'L + | v == c'GLFW_KEY_M = Key'M + | v == c'GLFW_KEY_N = Key'N + | v == c'GLFW_KEY_O = Key'O + | v == c'GLFW_KEY_P = Key'P + | v == c'GLFW_KEY_Q = Key'Q + | v == c'GLFW_KEY_R = Key'R + | v == c'GLFW_KEY_S = Key'S + | v == c'GLFW_KEY_T = Key'T + | v == c'GLFW_KEY_U = Key'U + | v == c'GLFW_KEY_V = Key'V + | v == c'GLFW_KEY_W = Key'W + | v == c'GLFW_KEY_X = Key'X + | v == c'GLFW_KEY_Y = Key'Y + | v == c'GLFW_KEY_Z = Key'Z + | v == c'GLFW_KEY_LEFT_BRACKET = Key'LeftBracket + | v == c'GLFW_KEY_BACKSLASH = Key'Backslash + | v == c'GLFW_KEY_RIGHT_BRACKET = Key'RightBracket + | v == c'GLFW_KEY_GRAVE_ACCENT = Key'GraveAccent + | v == c'GLFW_KEY_WORLD_1 = Key'World1 + | v == c'GLFW_KEY_WORLD_2 = Key'World2 + | v == c'GLFW_KEY_ESCAPE = Key'Escape + | v == c'GLFW_KEY_ENTER = Key'Enter + | v == c'GLFW_KEY_TAB = Key'Tab + | v == c'GLFW_KEY_BACKSPACE = Key'Backspace + | v == c'GLFW_KEY_INSERT = Key'Insert + | v == c'GLFW_KEY_DELETE = Key'Delete + | v == c'GLFW_KEY_RIGHT = Key'Right + | v == c'GLFW_KEY_LEFT = Key'Left + | v == c'GLFW_KEY_DOWN = Key'Down + | v == c'GLFW_KEY_UP = Key'Up + | v == c'GLFW_KEY_PAGE_UP = Key'PageUp + | v == c'GLFW_KEY_PAGE_DOWN = Key'PageDown + | v == c'GLFW_KEY_HOME = Key'Home + | v == c'GLFW_KEY_END = Key'End + | v == c'GLFW_KEY_CAPS_LOCK = Key'CapsLock + | v == c'GLFW_KEY_SCROLL_LOCK = Key'ScrollLock + | v == c'GLFW_KEY_NUM_LOCK = Key'NumLock + | v == c'GLFW_KEY_PRINT_SCREEN = Key'PrintScreen + | v == c'GLFW_KEY_PAUSE = Key'Pause + | v == c'GLFW_KEY_F1 = Key'F1 + | v == c'GLFW_KEY_F2 = Key'F2 + | v == c'GLFW_KEY_F3 = Key'F3 + | v == c'GLFW_KEY_F4 = Key'F4 + | v == c'GLFW_KEY_F5 = Key'F5 + | v == c'GLFW_KEY_F6 = Key'F6 + | v == c'GLFW_KEY_F7 = Key'F7 + | v == c'GLFW_KEY_F8 = Key'F8 + | v == c'GLFW_KEY_F9 = Key'F9 + | v == c'GLFW_KEY_F10 = Key'F10 + | v == c'GLFW_KEY_F11 = Key'F11 + | v == c'GLFW_KEY_F12 = Key'F12 + | v == c'GLFW_KEY_F13 = Key'F13 + | v == c'GLFW_KEY_F14 = Key'F14 + | v == c'GLFW_KEY_F15 = Key'F15 + | v == c'GLFW_KEY_F16 = Key'F16 + | v == c'GLFW_KEY_F17 = Key'F17 + | v == c'GLFW_KEY_F18 = Key'F18 + | v == c'GLFW_KEY_F19 = Key'F19 + | v == c'GLFW_KEY_F20 = Key'F20 + | v == c'GLFW_KEY_F21 = Key'F21 + | v == c'GLFW_KEY_F22 = Key'F22 + | v == c'GLFW_KEY_F23 = Key'F23 + | v == c'GLFW_KEY_F24 = Key'F24 + | v == c'GLFW_KEY_F25 = Key'F25 + | v == c'GLFW_KEY_KP_0 = Key'Pad0 + | v == c'GLFW_KEY_KP_1 = Key'Pad1 + | v == c'GLFW_KEY_KP_2 = Key'Pad2 + | v == c'GLFW_KEY_KP_3 = Key'Pad3 + | v == c'GLFW_KEY_KP_4 = Key'Pad4 + | v == c'GLFW_KEY_KP_5 = Key'Pad5 + | v == c'GLFW_KEY_KP_6 = Key'Pad6 + | v == c'GLFW_KEY_KP_7 = Key'Pad7 + | v == c'GLFW_KEY_KP_8 = Key'Pad8 + | v == c'GLFW_KEY_KP_9 = Key'Pad9 + | v == c'GLFW_KEY_KP_DECIMAL = Key'PadDecimal + | v == c'GLFW_KEY_KP_DIVIDE = Key'PadDivide + | v == c'GLFW_KEY_KP_MULTIPLY = Key'PadMultiply + | v == c'GLFW_KEY_KP_SUBTRACT = Key'PadSubtract + | v == c'GLFW_KEY_KP_ADD = Key'PadAdd + | v == c'GLFW_KEY_KP_ENTER = Key'PadEnter + | v == c'GLFW_KEY_KP_EQUAL = Key'PadEqual + | v == c'GLFW_KEY_LEFT_SHIFT = Key'LeftShift + | v == c'GLFW_KEY_LEFT_CONTROL = Key'LeftControl + | v == c'GLFW_KEY_LEFT_ALT = Key'LeftAlt + | v == c'GLFW_KEY_LEFT_SUPER = Key'LeftSuper + | v == c'GLFW_KEY_RIGHT_SHIFT = Key'RightShift + | v == c'GLFW_KEY_RIGHT_CONTROL = Key'RightControl + | v == c'GLFW_KEY_RIGHT_ALT = Key'RightAlt + | v == c'GLFW_KEY_RIGHT_SUPER = Key'RightSuper + | v == c'GLFW_KEY_MENU = Key'Menu + | otherwise = error $ "C CInt Key fromC: " ++ show v + toC Key'Unknown = c'GLFW_KEY_UNKNOWN + toC Key'Space = c'GLFW_KEY_SPACE + toC Key'Apostrophe = c'GLFW_KEY_APOSTROPHE + toC Key'Comma = c'GLFW_KEY_COMMA + toC Key'Minus = c'GLFW_KEY_MINUS + toC Key'Period = c'GLFW_KEY_PERIOD + toC Key'Slash = c'GLFW_KEY_SLASH + toC Key'0 = c'GLFW_KEY_0 + toC Key'1 = c'GLFW_KEY_1 + toC Key'2 = c'GLFW_KEY_2 + toC Key'3 = c'GLFW_KEY_3 + toC Key'4 = c'GLFW_KEY_4 + toC Key'5 = c'GLFW_KEY_5 + toC Key'6 = c'GLFW_KEY_6 + toC Key'7 = c'GLFW_KEY_7 + toC Key'8 = c'GLFW_KEY_8 + toC Key'9 = c'GLFW_KEY_9 + toC Key'Semicolon = c'GLFW_KEY_SEMICOLON + toC Key'Equal = c'GLFW_KEY_EQUAL + toC Key'A = c'GLFW_KEY_A + toC Key'B = c'GLFW_KEY_B + toC Key'C = c'GLFW_KEY_C + toC Key'D = c'GLFW_KEY_D + toC Key'E = c'GLFW_KEY_E + toC Key'F = c'GLFW_KEY_F + toC Key'G = c'GLFW_KEY_G + toC Key'H = c'GLFW_KEY_H + toC Key'I = c'GLFW_KEY_I + toC Key'J = c'GLFW_KEY_J + toC Key'K = c'GLFW_KEY_K + toC Key'L = c'GLFW_KEY_L + toC Key'M = c'GLFW_KEY_M + toC Key'N = c'GLFW_KEY_N + toC Key'O = c'GLFW_KEY_O + toC Key'P = c'GLFW_KEY_P + toC Key'Q = c'GLFW_KEY_Q + toC Key'R = c'GLFW_KEY_R + toC Key'S = c'GLFW_KEY_S + toC Key'T = c'GLFW_KEY_T + toC Key'U = c'GLFW_KEY_U + toC Key'V = c'GLFW_KEY_V + toC Key'W = c'GLFW_KEY_W + toC Key'X = c'GLFW_KEY_X + toC Key'Y = c'GLFW_KEY_Y + toC Key'Z = c'GLFW_KEY_Z + toC Key'LeftBracket = c'GLFW_KEY_LEFT_BRACKET + toC Key'Backslash = c'GLFW_KEY_BACKSLASH + toC Key'RightBracket = c'GLFW_KEY_RIGHT_BRACKET + toC Key'GraveAccent = c'GLFW_KEY_GRAVE_ACCENT + toC Key'World1 = c'GLFW_KEY_WORLD_1 + toC Key'World2 = c'GLFW_KEY_WORLD_2 + toC Key'Escape = c'GLFW_KEY_ESCAPE + toC Key'Enter = c'GLFW_KEY_ENTER + toC Key'Tab = c'GLFW_KEY_TAB + toC Key'Backspace = c'GLFW_KEY_BACKSPACE + toC Key'Insert = c'GLFW_KEY_INSERT + toC Key'Delete = c'GLFW_KEY_DELETE + toC Key'Right = c'GLFW_KEY_RIGHT + toC Key'Left = c'GLFW_KEY_LEFT + toC Key'Down = c'GLFW_KEY_DOWN + toC Key'Up = c'GLFW_KEY_UP + toC Key'PageUp = c'GLFW_KEY_PAGE_UP + toC Key'PageDown = c'GLFW_KEY_PAGE_DOWN + toC Key'Home = c'GLFW_KEY_HOME + toC Key'End = c'GLFW_KEY_END + toC Key'CapsLock = c'GLFW_KEY_CAPS_LOCK + toC Key'ScrollLock = c'GLFW_KEY_SCROLL_LOCK + toC Key'NumLock = c'GLFW_KEY_NUM_LOCK + toC Key'PrintScreen = c'GLFW_KEY_PRINT_SCREEN + toC Key'Pause = c'GLFW_KEY_PAUSE + toC Key'F1 = c'GLFW_KEY_F1 + toC Key'F2 = c'GLFW_KEY_F2 + toC Key'F3 = c'GLFW_KEY_F3 + toC Key'F4 = c'GLFW_KEY_F4 + toC Key'F5 = c'GLFW_KEY_F5 + toC Key'F6 = c'GLFW_KEY_F6 + toC Key'F7 = c'GLFW_KEY_F7 + toC Key'F8 = c'GLFW_KEY_F8 + toC Key'F9 = c'GLFW_KEY_F9 + toC Key'F10 = c'GLFW_KEY_F10 + toC Key'F11 = c'GLFW_KEY_F11 + toC Key'F12 = c'GLFW_KEY_F12 + toC Key'F13 = c'GLFW_KEY_F13 + toC Key'F14 = c'GLFW_KEY_F14 + toC Key'F15 = c'GLFW_KEY_F15 + toC Key'F16 = c'GLFW_KEY_F16 + toC Key'F17 = c'GLFW_KEY_F17 + toC Key'F18 = c'GLFW_KEY_F18 + toC Key'F19 = c'GLFW_KEY_F19 + toC Key'F20 = c'GLFW_KEY_F20 + toC Key'F21 = c'GLFW_KEY_F21 + toC Key'F22 = c'GLFW_KEY_F22 + toC Key'F23 = c'GLFW_KEY_F23 + toC Key'F24 = c'GLFW_KEY_F24 + toC Key'F25 = c'GLFW_KEY_F25 + toC Key'Pad0 = c'GLFW_KEY_KP_0 + toC Key'Pad1 = c'GLFW_KEY_KP_1 + toC Key'Pad2 = c'GLFW_KEY_KP_2 + toC Key'Pad3 = c'GLFW_KEY_KP_3 + toC Key'Pad4 = c'GLFW_KEY_KP_4 + toC Key'Pad5 = c'GLFW_KEY_KP_5 + toC Key'Pad6 = c'GLFW_KEY_KP_6 + toC Key'Pad7 = c'GLFW_KEY_KP_7 + toC Key'Pad8 = c'GLFW_KEY_KP_8 + toC Key'Pad9 = c'GLFW_KEY_KP_9 + toC Key'PadDecimal = c'GLFW_KEY_KP_DECIMAL + toC Key'PadDivide = c'GLFW_KEY_KP_DIVIDE + toC Key'PadMultiply = c'GLFW_KEY_KP_MULTIPLY + toC Key'PadSubtract = c'GLFW_KEY_KP_SUBTRACT + toC Key'PadAdd = c'GLFW_KEY_KP_ADD + toC Key'PadEnter = c'GLFW_KEY_KP_ENTER + toC Key'PadEqual = c'GLFW_KEY_KP_EQUAL + toC Key'LeftShift = c'GLFW_KEY_LEFT_SHIFT + toC Key'LeftControl = c'GLFW_KEY_LEFT_CONTROL + toC Key'LeftAlt = c'GLFW_KEY_LEFT_ALT + toC Key'LeftSuper = c'GLFW_KEY_LEFT_SUPER + toC Key'RightShift = c'GLFW_KEY_RIGHT_SHIFT + toC Key'RightControl = c'GLFW_KEY_RIGHT_CONTROL + toC Key'RightAlt = c'GLFW_KEY_RIGHT_ALT + toC Key'RightSuper = c'GLFW_KEY_RIGHT_SUPER + toC Key'Menu = c'GLFW_KEY_MENU + +instance C CInt KeyState where + fromC v + | v == c'GLFW_PRESS = KeyState'Pressed + | v == c'GLFW_RELEASE = KeyState'Released + | v == c'GLFW_REPEAT = KeyState'Repeating + | otherwise = error $ "C CInt KeyState fromC: " ++ show v + toC KeyState'Pressed = c'GLFW_PRESS + toC KeyState'Released = c'GLFW_RELEASE + toC KeyState'Repeating = c'GLFW_REPEAT + +instance C CInt Joystick where + fromC v + | v == c'GLFW_JOYSTICK_1 = Joystick'1 + | v == c'GLFW_JOYSTICK_2 = Joystick'2 + | v == c'GLFW_JOYSTICK_3 = Joystick'3 + | v == c'GLFW_JOYSTICK_4 = Joystick'4 + | v == c'GLFW_JOYSTICK_5 = Joystick'5 + | v == c'GLFW_JOYSTICK_6 = Joystick'6 + | v == c'GLFW_JOYSTICK_7 = Joystick'7 + | v == c'GLFW_JOYSTICK_8 = Joystick'8 + | v == c'GLFW_JOYSTICK_9 = Joystick'9 + | v == c'GLFW_JOYSTICK_10 = Joystick'10 + | v == c'GLFW_JOYSTICK_11 = Joystick'11 + | v == c'GLFW_JOYSTICK_12 = Joystick'12 + | v == c'GLFW_JOYSTICK_13 = Joystick'13 + | v == c'GLFW_JOYSTICK_14 = Joystick'14 + | v == c'GLFW_JOYSTICK_15 = Joystick'15 + | v == c'GLFW_JOYSTICK_16 = Joystick'16 + | otherwise = error $ "C CInt Joystick fromC: " ++ show v + toC Joystick'1 = c'GLFW_JOYSTICK_1 + toC Joystick'2 = c'GLFW_JOYSTICK_2 + toC Joystick'3 = c'GLFW_JOYSTICK_3 + toC Joystick'4 = c'GLFW_JOYSTICK_4 + toC Joystick'5 = c'GLFW_JOYSTICK_5 + toC Joystick'6 = c'GLFW_JOYSTICK_6 + toC Joystick'7 = c'GLFW_JOYSTICK_7 + toC Joystick'8 = c'GLFW_JOYSTICK_8 + toC Joystick'9 = c'GLFW_JOYSTICK_9 + toC Joystick'10 = c'GLFW_JOYSTICK_10 + toC Joystick'11 = c'GLFW_JOYSTICK_11 + toC Joystick'12 = c'GLFW_JOYSTICK_12 + toC Joystick'13 = c'GLFW_JOYSTICK_13 + toC Joystick'14 = c'GLFW_JOYSTICK_14 + toC Joystick'15 = c'GLFW_JOYSTICK_15 + toC Joystick'16 = c'GLFW_JOYSTICK_16 + +instance C CUChar JoystickButtonState where + fromC v + | v == c'GLFW_PRESS = JoystickButtonState'Pressed + | v == c'GLFW_RELEASE = JoystickButtonState'Released + | otherwise = error $ "C CUChar JoystickButtonState fromC: " ++ show v + toC JoystickButtonState'Pressed = c'GLFW_PRESS + toC JoystickButtonState'Released = c'GLFW_RELEASE + +instance C CInt MouseButton where + fromC v + | v == c'GLFW_MOUSE_BUTTON_1 = MouseButton'1 + | v == c'GLFW_MOUSE_BUTTON_2 = MouseButton'2 + | v == c'GLFW_MOUSE_BUTTON_3 = MouseButton'3 + | v == c'GLFW_MOUSE_BUTTON_4 = MouseButton'4 + | v == c'GLFW_MOUSE_BUTTON_5 = MouseButton'5 + | v == c'GLFW_MOUSE_BUTTON_6 = MouseButton'6 + | v == c'GLFW_MOUSE_BUTTON_7 = MouseButton'7 + | v == c'GLFW_MOUSE_BUTTON_8 = MouseButton'8 + | otherwise = error $ "C CInt MouseButton fromC: " ++ show v + toC MouseButton'1 = c'GLFW_MOUSE_BUTTON_1 + toC MouseButton'2 = c'GLFW_MOUSE_BUTTON_2 + toC MouseButton'3 = c'GLFW_MOUSE_BUTTON_3 + toC MouseButton'4 = c'GLFW_MOUSE_BUTTON_4 + toC MouseButton'5 = c'GLFW_MOUSE_BUTTON_5 + toC MouseButton'6 = c'GLFW_MOUSE_BUTTON_6 + toC MouseButton'7 = c'GLFW_MOUSE_BUTTON_7 + toC MouseButton'8 = c'GLFW_MOUSE_BUTTON_8 + +instance C CInt MouseButtonState where + fromC v + | v == c'GLFW_PRESS = MouseButtonState'Pressed + | v == c'GLFW_RELEASE = MouseButtonState'Released + | otherwise = error $ "C CInt MouseButtonState fromC: " ++ show v + toC MouseButtonState'Pressed = c'GLFW_PRESS + toC MouseButtonState'Released = c'GLFW_RELEASE + +instance C CInt CursorState where + fromC v + | v == c'GL_TRUE = CursorState'InWindow + | v == c'GL_FALSE = CursorState'NotInWindow + | otherwise = error $ "C CInt CursorState fromC: " ++ show v + toC CursorState'InWindow = c'GL_TRUE + toC CursorState'NotInWindow = c'GL_FALSE + +instance C CInt CursorInputMode where + fromC v + | v == c'GLFW_CURSOR_NORMAL = CursorInputMode'Normal + | v == c'GLFW_CURSOR_HIDDEN = CursorInputMode'Hidden + | v == c'GLFW_CURSOR_DISABLED = CursorInputMode'Disabled + | otherwise = error $ "C CInt CursorInputMode fromC: " ++ show v + toC CursorInputMode'Normal = c'GLFW_CURSOR_NORMAL + toC CursorInputMode'Hidden = c'GLFW_CURSOR_HIDDEN + toC CursorInputMode'Disabled = c'GLFW_CURSOR_DISABLED + +instance C CInt StickyKeysInputMode where + fromC v + | v == c'GL_TRUE = StickyKeysInputMode'Enabled + | v == c'GL_FALSE = StickyKeysInputMode'Disabled + | otherwise = error $ "C CInt StickyKeysInputMode fromC: " ++ show v + toC StickyKeysInputMode'Enabled = c'GL_TRUE + toC StickyKeysInputMode'Disabled = c'GL_FALSE + +instance C CInt StickyMouseButtonsInputMode where + fromC v + | v == c'GL_TRUE = StickyMouseButtonsInputMode'Enabled + | v == c'GL_FALSE = StickyMouseButtonsInputMode'Disabled + | otherwise = error $ "C CInt StickyMouseButtonsInputMode fromC: " ++ show v + toC StickyMouseButtonsInputMode'Enabled = c'GL_TRUE + toC StickyMouseButtonsInputMode'Disabled = c'GL_FALSE + +-------------------------------------------------------------------------------- + +{-# ANN module "HLint: ignore Use camelCase" #-} diff --git a/Graphics/UI/GLFW/Internal/C.hs b/Graphics/UI/GLFW/Internal/C.hs deleted file mode 100644 --- a/Graphics/UI/GLFW/Internal/C.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} - -module Graphics.UI.GLFW.Internal.C where - --- A class for converting between C-type c and Haskell-type h. For example, --- suppose you have a Haskell Joystick, but need the CInt, or vice versa. -class C c h where - fromC :: c -> h - toC :: h -> c diff --git a/Graphics/UI/GLFW/Internal/C/TH.hs b/Graphics/UI/GLFW/Internal/C/TH.hs deleted file mode 100644 --- a/Graphics/UI/GLFW/Internal/C/TH.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - --- deriveC creates an instance of C c h from [(c, h)]. --- --- Example: --- --- > pairs :: [(CInt, Bool)] --- > pairs = [(0, False), (1, True)] --- > --- > deriveC ''CInt ''Bool pairs --- --- would derive --- --- > instance C CInt Bool where --- > fromC 0 = False --- > fromC 1 = True --- > fromC _ = error ... --- > --- > toC False = 0 --- > toC True = 1 - -module Graphics.UI.GLFW.Internal.C.TH - ( deriveC - ) where - --------------------------------------------------------------------------------- - -import Data.Data (Data) -import Data.Tuple (swap) -import Language.Haskell.TH (Dec, Name, Q, appT, clause, conT, cxt, funD, global, instanceD, mkName, nameBase, normalB, varP) -import Language.Haskell.TH.Quote (dataToPatQ) -import Language.Haskell.TH.Syntax (Lift(..)) - --------------------------------------------------------------------------------- - -deriveC :: (Data c, Data h, Lift c, Lift h) => Name -> Name -> [(c, h)] -> Q [Dec] -deriveC ctype htype pairs = - (:[]) `fmap` deriveC1 ctype htype pairs - --------------------------------------------------------------------------------- - -deriveC1 :: (Data c, Data h, Lift c, Lift h) => Name -> Name -> [(c, h)] -> Q Dec -deriveC1 _ _ [] = - error "deriveC: no pairs!" -deriveC1 ctype htype pairs = - instanceD - (cxt []) - (appT - (appT (conT cname) (conT ctype)) - (conT htype) - ) - [ funD frname frClauses - , funD toname toClauses - ] - where - cname = mkName "C" - frname = mkName "fromC" - toname = mkName "toC" - vname = mkName "v" - - frClauses = map genPairClause pairs ++ [genErrorClause] - toClauses = map (genPairClause . swap) pairs - - genPairClause (v0, v1) = - clause [pat] body [] - where - pat = dataToPatQ (const Nothing) v0 - body = normalB [|v1|] - - genErrorClause = - clause [pat] body [] - where - pat = varP vname - body = normalB [| error $ msg ++ show $(global vname) |] - -- e.g., "C CInt Bool fromC: " - msg = unwords (map nameBase [cname, ctype, htype, frname]) ++ ": " diff --git a/Graphics/UI/GLFW/Internal/Instances/C.hs b/Graphics/UI/GLFW/Internal/Instances/C.hs deleted file mode 100644 --- a/Graphics/UI/GLFW/Internal/Instances/C.hs +++ /dev/null @@ -1,98 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Graphics.UI.GLFW.Internal.Instances.C where - --------------------------------------------------------------------------------- - -import Data.Bits ((.&.)) -import Data.Char (chr, ord) -import Foreign.C.Types (CDouble, CFloat, CInt, CUChar, CUInt, CUShort) -import Foreign.Ptr (Ptr) - -import Bindings.GLFW -import Graphics.UI.GLFW.Internal.C (C(..)) -import Graphics.UI.GLFW.Internal.C.TH (deriveC) -import Graphics.UI.GLFW.Internal.Instances.Data () -import Graphics.UI.GLFW.Internal.Instances.Lift () -import Graphics.UI.GLFW.Internal.Tables -import Graphics.UI.GLFW.Types - --------------------------------------------------------------------------------- - -deriveC ''CInt ''Bool table_C_CInt_Bool -deriveC ''CInt ''ClientAPI table_C_CInt_ClientAPI -deriveC ''CInt ''ContextRobustness table_C_CInt_ContextRobustness -deriveC ''CInt ''CursorInputMode table_C_CInt_CursorInputMode -deriveC ''CInt ''CursorState table_C_CInt_CursorState -deriveC ''CInt ''Error table_C_CInt_Error -deriveC ''CInt ''FocusState table_C_CInt_FocusState -deriveC ''CInt ''IconifyState table_C_CInt_IconifyState -deriveC ''CInt ''Joystick table_C_CInt_Joystick -deriveC ''CInt ''Key table_C_CInt_Key -deriveC ''CInt ''KeyState table_C_CInt_KeyState -deriveC ''CInt ''MonitorState table_C_CInt_MonitorState -deriveC ''CInt ''MouseButton table_C_CInt_MouseButton -deriveC ''CInt ''MouseButtonState table_C_CInt_MouseButtonState -deriveC ''CInt ''OpenGLProfile table_C_CInt_OpenGLProfile -deriveC ''CInt ''StickyKeysInputMode table_C_CInt_StickyKeysInputMode -deriveC ''CInt ''StickyMouseButtonsInputMode table_C_CInt_StickyMouseButtonsInputMode -deriveC ''CUChar ''JoystickButtonState table_C_CUChar_JoystickButtonState - -instance C CInt Char where - fromC = chr . fromIntegral - toC = fromIntegral . ord - -instance C CUInt Char where - fromC = chr . fromIntegral - toC = fromIntegral . ord - -instance C CDouble Double where - fromC = realToFrac - toC = realToFrac - -instance C CInt Int where - fromC = fromIntegral - toC = fromIntegral - -instance C CUInt Int where - fromC = fromIntegral - toC = fromIntegral - -instance C CUShort Int where - fromC = fromIntegral - toC = fromIntegral - -instance C CFloat Double where - fromC = realToFrac - toC = realToFrac - -instance C (Ptr C'GLFWmonitor) Monitor where - fromC = Monitor - toC = unMonitor - -instance C (Ptr C'GLFWwindow) Window where - fromC = Window - toC = unWindow - -instance C CInt ModifierKeys where - fromC v = ModifierKeys - { modifierKeysShift = (v .&. c'GLFW_MOD_SHIFT) /= 0 - , modifierKeysControl = (v .&. c'GLFW_MOD_CONTROL) /= 0 - , modifierKeysAlt = (v .&. c'GLFW_MOD_ALT) /= 0 - , modifierKeysSuper = (v .&. c'GLFW_MOD_SUPER) /= 0 - } - toC = undefined - -instance C C'GLFWvidmode VideoMode where - fromC gvm = VideoMode - { videoModeWidth = fromIntegral $ c'GLFWvidmode'width gvm - , videoModeHeight = fromIntegral $ c'GLFWvidmode'height gvm - , videoModeRedBits = fromIntegral $ c'GLFWvidmode'redBits gvm - , videoModeGreenBits = fromIntegral $ c'GLFWvidmode'greenBits gvm - , videoModeBlueBits = fromIntegral $ c'GLFWvidmode'blueBits gvm - , videoModeRefreshRate = fromIntegral $ c'GLFWvidmode'refreshRate gvm - } - toC = undefined diff --git a/Graphics/UI/GLFW/Internal/Instances/Data.hs b/Graphics/UI/GLFW/Internal/Instances/Data.hs deleted file mode 100644 --- a/Graphics/UI/GLFW/Internal/Instances/Data.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- To derive instances of C c h with deriveC, c and h must be instances of --- Data. - -module Graphics.UI.GLFW.Internal.Instances.Data where - --------------------------------------------------------------------------------- - -import Data.Data (Data) -import Foreign.C.Types (CInt(..), CUChar(..)) - --------------------------------------------------------------------------------- - -deriving instance Data CInt -deriving instance Data CUChar diff --git a/Graphics/UI/GLFW/Internal/Instances/Lift.hs b/Graphics/UI/GLFW/Internal/Instances/Lift.hs deleted file mode 100644 --- a/Graphics/UI/GLFW/Internal/Instances/Lift.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- To derive instances of C c h with deriveC, c and h must be instances of --- Lift. - -module Graphics.UI.GLFW.Internal.Instances.Lift where - --------------------------------------------------------------------------------- - -import Foreign.C.Types (CInt, CUChar) -import Language.Haskell.TH.Lift (deriveLiftMany) -import Language.Haskell.TH.Syntax (Exp(LitE), Lift(..), Lit(IntegerL)) - -import Graphics.UI.GLFW.Types - --------------------------------------------------------------------------------- - -instance Lift CInt where - lift x = return (LitE (IntegerL (fromIntegral x))) - -instance Lift CUChar where - lift x = return (LitE (IntegerL (fromIntegral x))) - -deriveLiftMany - [ ''ClientAPI - , ''ContextRobustness - , ''CursorInputMode - , ''CursorState - , ''Error - , ''FocusState - , ''IconifyState - , ''Joystick - , ''JoystickButtonState - , ''Key - , ''KeyState - , ''MonitorState - , ''MouseButton - , ''MouseButtonState - , ''OpenGLProfile - , ''StickyKeysInputMode - , ''StickyMouseButtonsInputMode - ] diff --git a/Graphics/UI/GLFW/Internal/Tables.hs b/Graphics/UI/GLFW/Internal/Tables.hs deleted file mode 100644 --- a/Graphics/UI/GLFW/Internal/Tables.hs +++ /dev/null @@ -1,282 +0,0 @@ --- Lists of pairs for use with deriveC. - -module Graphics.UI.GLFW.Internal.Tables where - --------------------------------------------------------------------------------- - -import Foreign.C.Types (CInt, CUChar) - -import Bindings.GLFW -import Graphics.UI.GLFW.Types - --------------------------------------------------------------------------------- - -table_C_CInt_Bool :: [(CInt, Bool)] -table_C_CInt_Bool = - [ ( c'GL_FALSE, False ) - , ( c'GL_TRUE, True ) - ] - --------------------------------------------------------------------------------- - -table_C_CInt_Error :: [(CInt, Error)] -table_C_CInt_Error = - [ ( c'GLFW_NOT_INITIALIZED, Error'NotInitialized ) - , ( c'GLFW_NO_CURRENT_CONTEXT, Error'NoCurrentContext ) - , ( c'GLFW_INVALID_ENUM, Error'InvalidEnum ) - , ( c'GLFW_INVALID_VALUE, Error'InvalidValue ) - , ( c'GLFW_OUT_OF_MEMORY, Error'OutOfMemory ) - , ( c'GLFW_API_UNAVAILABLE, Error'ApiUnavailable ) - , ( c'GLFW_VERSION_UNAVAILABLE, Error'VersionUnavailable ) - , ( c'GLFW_PLATFORM_ERROR, Error'PlatformError ) - , ( c'GLFW_FORMAT_UNAVAILABLE, Error'FormatUnavailable ) - ] - --------------------------------------------------------------------------------- - -table_C_CInt_MonitorState :: [(CInt, MonitorState)] -table_C_CInt_MonitorState = - [ ( c'GL_TRUE, MonitorState'Connected ) - , ( c'GL_FALSE, MonitorState'Disconnected ) - ] - --------------------------------------------------------------------------------- - -table_C_CInt_FocusState :: [(CInt, FocusState)] -table_C_CInt_FocusState = - [ ( c'GL_TRUE, FocusState'Focused ) - , ( c'GL_FALSE, FocusState'Defocused ) - ] - -table_C_CInt_IconifyState :: [(CInt, IconifyState)] -table_C_CInt_IconifyState = - [ ( c'GL_TRUE, IconifyState'Iconified ) - , ( c'GL_FALSE, IconifyState'NotIconified ) - ] - -table_C_CInt_ContextRobustness :: [(CInt, ContextRobustness)] -table_C_CInt_ContextRobustness = - [ ( c'GLFW_NO_ROBUSTNESS, ContextRobustness'NoRobustness ) - , ( c'GLFW_NO_RESET_NOTIFICATION, ContextRobustness'NoResetNotification ) - , ( c'GLFW_LOSE_CONTEXT_ON_RESET, ContextRobustness'LoseContextOnReset ) - ] - -table_C_CInt_OpenGLProfile :: [(CInt, OpenGLProfile)] -table_C_CInt_OpenGLProfile = - [ ( c'GLFW_OPENGL_ANY_PROFILE, OpenGLProfile'Any ) - , ( c'GLFW_OPENGL_COMPAT_PROFILE, OpenGLProfile'Compat ) - , ( c'GLFW_OPENGL_CORE_PROFILE, OpenGLProfile'Core ) - ] - -table_C_CInt_ClientAPI :: [(CInt, ClientAPI)] -table_C_CInt_ClientAPI = - [ ( c'GLFW_OPENGL_API, ClientAPI'OpenGL ) - , ( c'GLFW_OPENGL_ES_API, ClientAPI'OpenGLES ) - ] - --------------------------------------------------------------------------------- - -table_C_CInt_Key :: [(CInt, Key)] -table_C_CInt_Key = - [ ( c'GLFW_KEY_UNKNOWN, Key'Unknown ) - , ( c'GLFW_KEY_SPACE, Key'Space ) - , ( c'GLFW_KEY_APOSTROPHE, Key'Apostrophe ) - , ( c'GLFW_KEY_COMMA, Key'Comma ) - , ( c'GLFW_KEY_MINUS, Key'Minus ) - , ( c'GLFW_KEY_PERIOD, Key'Period ) - , ( c'GLFW_KEY_SLASH, Key'Slash ) - , ( c'GLFW_KEY_0, Key'0 ) - , ( c'GLFW_KEY_1, Key'1 ) - , ( c'GLFW_KEY_2, Key'2 ) - , ( c'GLFW_KEY_3, Key'3 ) - , ( c'GLFW_KEY_4, Key'4 ) - , ( c'GLFW_KEY_5, Key'5 ) - , ( c'GLFW_KEY_6, Key'6 ) - , ( c'GLFW_KEY_7, Key'7 ) - , ( c'GLFW_KEY_8, Key'8 ) - , ( c'GLFW_KEY_9, Key'9 ) - , ( c'GLFW_KEY_SEMICOLON, Key'Semicolon ) - , ( c'GLFW_KEY_EQUAL, Key'Equal ) - , ( c'GLFW_KEY_A, Key'A ) - , ( c'GLFW_KEY_B, Key'B ) - , ( c'GLFW_KEY_C, Key'C ) - , ( c'GLFW_KEY_D, Key'D ) - , ( c'GLFW_KEY_E, Key'E ) - , ( c'GLFW_KEY_F, Key'F ) - , ( c'GLFW_KEY_G, Key'G ) - , ( c'GLFW_KEY_H, Key'H ) - , ( c'GLFW_KEY_I, Key'I ) - , ( c'GLFW_KEY_J, Key'J ) - , ( c'GLFW_KEY_K, Key'K ) - , ( c'GLFW_KEY_L, Key'L ) - , ( c'GLFW_KEY_M, Key'M ) - , ( c'GLFW_KEY_N, Key'N ) - , ( c'GLFW_KEY_O, Key'O ) - , ( c'GLFW_KEY_P, Key'P ) - , ( c'GLFW_KEY_Q, Key'Q ) - , ( c'GLFW_KEY_R, Key'R ) - , ( c'GLFW_KEY_S, Key'S ) - , ( c'GLFW_KEY_T, Key'T ) - , ( c'GLFW_KEY_U, Key'U ) - , ( c'GLFW_KEY_V, Key'V ) - , ( c'GLFW_KEY_W, Key'W ) - , ( c'GLFW_KEY_X, Key'X ) - , ( c'GLFW_KEY_Y, Key'Y ) - , ( c'GLFW_KEY_Z, Key'Z ) - , ( c'GLFW_KEY_LEFT_BRACKET, Key'LeftBracket ) - , ( c'GLFW_KEY_BACKSLASH, Key'Backslash ) - , ( c'GLFW_KEY_RIGHT_BRACKET, Key'RightBracket ) - , ( c'GLFW_KEY_GRAVE_ACCENT, Key'GraveAccent ) - , ( c'GLFW_KEY_WORLD_1, Key'World1 ) - , ( c'GLFW_KEY_WORLD_2, Key'World2 ) - , ( c'GLFW_KEY_ESCAPE, Key'Escape ) - , ( c'GLFW_KEY_ENTER, Key'Enter ) - , ( c'GLFW_KEY_TAB, Key'Tab ) - , ( c'GLFW_KEY_BACKSPACE, Key'Backspace ) - , ( c'GLFW_KEY_INSERT, Key'Insert ) - , ( c'GLFW_KEY_DELETE, Key'Delete ) - , ( c'GLFW_KEY_RIGHT, Key'Right ) - , ( c'GLFW_KEY_LEFT, Key'Left ) - , ( c'GLFW_KEY_DOWN, Key'Down ) - , ( c'GLFW_KEY_UP, Key'Up ) - , ( c'GLFW_KEY_PAGE_UP, Key'PageUp ) - , ( c'GLFW_KEY_PAGE_DOWN, Key'PageDown ) - , ( c'GLFW_KEY_HOME, Key'Home ) - , ( c'GLFW_KEY_END, Key'End ) - , ( c'GLFW_KEY_CAPS_LOCK, Key'CapsLock ) - , ( c'GLFW_KEY_SCROLL_LOCK, Key'ScrollLock ) - , ( c'GLFW_KEY_NUM_LOCK, Key'NumLock ) - , ( c'GLFW_KEY_PRINT_SCREEN, Key'PrintScreen ) - , ( c'GLFW_KEY_PAUSE, Key'Pause ) - , ( c'GLFW_KEY_F1, Key'F1 ) - , ( c'GLFW_KEY_F2, Key'F2 ) - , ( c'GLFW_KEY_F3, Key'F3 ) - , ( c'GLFW_KEY_F4, Key'F4 ) - , ( c'GLFW_KEY_F5, Key'F5 ) - , ( c'GLFW_KEY_F6, Key'F6 ) - , ( c'GLFW_KEY_F7, Key'F7 ) - , ( c'GLFW_KEY_F8, Key'F8 ) - , ( c'GLFW_KEY_F9, Key'F9 ) - , ( c'GLFW_KEY_F10, Key'F10 ) - , ( c'GLFW_KEY_F11, Key'F11 ) - , ( c'GLFW_KEY_F12, Key'F12 ) - , ( c'GLFW_KEY_F13, Key'F13 ) - , ( c'GLFW_KEY_F14, Key'F14 ) - , ( c'GLFW_KEY_F15, Key'F15 ) - , ( c'GLFW_KEY_F16, Key'F16 ) - , ( c'GLFW_KEY_F17, Key'F17 ) - , ( c'GLFW_KEY_F18, Key'F18 ) - , ( c'GLFW_KEY_F19, Key'F19 ) - , ( c'GLFW_KEY_F20, Key'F20 ) - , ( c'GLFW_KEY_F21, Key'F21 ) - , ( c'GLFW_KEY_F22, Key'F22 ) - , ( c'GLFW_KEY_F23, Key'F23 ) - , ( c'GLFW_KEY_F24, Key'F24 ) - , ( c'GLFW_KEY_F25, Key'F25 ) - , ( c'GLFW_KEY_KP_0, Key'Pad0 ) - , ( c'GLFW_KEY_KP_1, Key'Pad1 ) - , ( c'GLFW_KEY_KP_2, Key'Pad2 ) - , ( c'GLFW_KEY_KP_3, Key'Pad3 ) - , ( c'GLFW_KEY_KP_4, Key'Pad4 ) - , ( c'GLFW_KEY_KP_5, Key'Pad5 ) - , ( c'GLFW_KEY_KP_6, Key'Pad6 ) - , ( c'GLFW_KEY_KP_7, Key'Pad7 ) - , ( c'GLFW_KEY_KP_8, Key'Pad8 ) - , ( c'GLFW_KEY_KP_9, Key'Pad9 ) - , ( c'GLFW_KEY_KP_DECIMAL, Key'PadDecimal ) - , ( c'GLFW_KEY_KP_DIVIDE, Key'PadDivide ) - , ( c'GLFW_KEY_KP_MULTIPLY, Key'PadMultiply ) - , ( c'GLFW_KEY_KP_SUBTRACT, Key'PadSubtract ) - , ( c'GLFW_KEY_KP_ADD, Key'PadAdd ) - , ( c'GLFW_KEY_KP_ENTER, Key'PadEnter ) - , ( c'GLFW_KEY_KP_EQUAL, Key'PadEqual ) - , ( c'GLFW_KEY_LEFT_SHIFT, Key'LeftShift ) - , ( c'GLFW_KEY_LEFT_CONTROL, Key'LeftControl ) - , ( c'GLFW_KEY_LEFT_ALT, Key'LeftAlt ) - , ( c'GLFW_KEY_LEFT_SUPER, Key'LeftSuper ) - , ( c'GLFW_KEY_RIGHT_SHIFT, Key'RightShift ) - , ( c'GLFW_KEY_RIGHT_CONTROL, Key'RightControl ) - , ( c'GLFW_KEY_RIGHT_ALT, Key'RightAlt ) - , ( c'GLFW_KEY_RIGHT_SUPER, Key'RightSuper ) - , ( c'GLFW_KEY_MENU, Key'Menu ) - ] - -table_C_CInt_KeyState :: [(CInt, KeyState)] -table_C_CInt_KeyState = - [ ( c'GLFW_PRESS, KeyState'Pressed ) - , ( c'GLFW_RELEASE, KeyState'Released ) - , ( c'GLFW_REPEAT, KeyState'Repeating ) - ] - -table_C_CInt_Joystick :: [(CInt, Joystick)] -table_C_CInt_Joystick = - [ ( c'GLFW_JOYSTICK_1, Joystick'1 ) - , ( c'GLFW_JOYSTICK_2, Joystick'2 ) - , ( c'GLFW_JOYSTICK_3, Joystick'3 ) - , ( c'GLFW_JOYSTICK_4, Joystick'4 ) - , ( c'GLFW_JOYSTICK_5, Joystick'5 ) - , ( c'GLFW_JOYSTICK_6, Joystick'6 ) - , ( c'GLFW_JOYSTICK_7, Joystick'7 ) - , ( c'GLFW_JOYSTICK_8, Joystick'8 ) - , ( c'GLFW_JOYSTICK_9, Joystick'9 ) - , ( c'GLFW_JOYSTICK_10, Joystick'10 ) - , ( c'GLFW_JOYSTICK_11, Joystick'11 ) - , ( c'GLFW_JOYSTICK_12, Joystick'12 ) - , ( c'GLFW_JOYSTICK_13, Joystick'13 ) - , ( c'GLFW_JOYSTICK_14, Joystick'14 ) - , ( c'GLFW_JOYSTICK_15, Joystick'15 ) - , ( c'GLFW_JOYSTICK_16, Joystick'16 ) - ] - -table_C_CUChar_JoystickButtonState :: [(CUChar, JoystickButtonState)] -table_C_CUChar_JoystickButtonState = - [ ( c'GLFW_PRESS, JoystickButtonState'Pressed ) - , ( c'GLFW_RELEASE, JoystickButtonState'Released ) - ] - -table_C_CInt_MouseButton :: [(CInt, MouseButton)] -table_C_CInt_MouseButton = - [ ( c'GLFW_MOUSE_BUTTON_1, MouseButton'1 ) - , ( c'GLFW_MOUSE_BUTTON_2, MouseButton'2 ) - , ( c'GLFW_MOUSE_BUTTON_3, MouseButton'3 ) - , ( c'GLFW_MOUSE_BUTTON_4, MouseButton'4 ) - , ( c'GLFW_MOUSE_BUTTON_5, MouseButton'5 ) - , ( c'GLFW_MOUSE_BUTTON_6, MouseButton'6 ) - , ( c'GLFW_MOUSE_BUTTON_7, MouseButton'7 ) - , ( c'GLFW_MOUSE_BUTTON_8, MouseButton'8 ) - ] - -table_C_CInt_MouseButtonState :: [(CInt, MouseButtonState)] -table_C_CInt_MouseButtonState = - [ ( c'GLFW_PRESS, MouseButtonState'Pressed ) - , ( c'GLFW_RELEASE, MouseButtonState'Released ) - ] - -table_C_CInt_CursorState :: [(CInt, CursorState)] -table_C_CInt_CursorState = - [ ( c'GL_TRUE, CursorState'InWindow ) - , ( c'GL_FALSE, CursorState'NotInWindow ) - ] - -table_C_CInt_CursorInputMode :: [(CInt, CursorInputMode)] -table_C_CInt_CursorInputMode = - [ ( c'GLFW_CURSOR_NORMAL, CursorInputMode'Normal ) - , ( c'GLFW_CURSOR_HIDDEN, CursorInputMode'Hidden ) - , ( c'GLFW_CURSOR_DISABLED, CursorInputMode'Disabled ) - ] - -table_C_CInt_StickyKeysInputMode :: [(CInt, StickyKeysInputMode)] -table_C_CInt_StickyKeysInputMode = - [ ( c'GL_TRUE, StickyKeysInputMode'Enabled ) - , ( c'GL_FALSE, StickyKeysInputMode'Disabled ) - ] - -table_C_CInt_StickyMouseButtonsInputMode :: [(CInt, StickyMouseButtonsInputMode)] -table_C_CInt_StickyMouseButtonsInputMode = - [ ( c'GL_TRUE, StickyMouseButtonsInputMode'Enabled ) - , ( c'GL_FALSE, StickyMouseButtonsInputMode'Disabled ) - ] - --------------------------------------------------------------------------------- - -{-# ANN module "HLint: ignore Use camelCase" #-} diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -2,9 +2,6 @@ Improve existing tests. Add more tests. -Is there a better way to accomplish the translation done by the 'C' class that -doesn't require TH? - Coordinate with GLFW C-library maintainer about any strange behavior. 1.) Cursor is in window. Left click. Events seen: