{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
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 b) => C CInt (Maybe b) where
fromC :: CInt -> Maybe b
fromC CInt
i | CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_DONT_CARE = Maybe b
forall a. Maybe a
Nothing
| Bool
otherwise = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ CInt -> b
forall c h. C c h => c -> h
fromC CInt
i
toC :: Maybe b -> CInt
toC = CInt -> (b -> CInt) -> Maybe b -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CInt
forall a. Num a => a
c'GLFW_DONT_CARE b -> CInt
forall c h. C c h => h -> c
toC
instance C CInt Char where
fromC :: CInt -> Char
fromC = Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toC :: Char -> CInt
toC = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
instance C CUInt Char where
fromC :: CUInt -> Char
fromC = Int -> Char
chr (Int -> Char) -> (CUInt -> Int) -> CUInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toC :: Char -> CUInt
toC = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Char -> Int) -> Char -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
instance C CDouble Double where
fromC :: CDouble -> Double
fromC = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
toC :: Double -> CDouble
toC = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance C CInt Int where
fromC :: CInt -> Int
fromC = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toC :: Int -> CInt
toC = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance C CUInt Int where
fromC :: CUInt -> Int
fromC = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toC :: Int -> CUInt
toC = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance C CUShort Int where
fromC :: CUShort -> Int
fromC = CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
toC :: Int -> CUShort
toC = Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance C CFloat Double where
fromC :: CFloat -> Double
fromC = CFloat -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
toC :: Double -> CFloat
toC = Double -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance C (Ptr C'GLFWmonitor) Monitor where
fromC :: Ptr C'GLFWmonitor -> Monitor
fromC = Ptr C'GLFWmonitor -> Monitor
Monitor
toC :: Monitor -> Ptr C'GLFWmonitor
toC = Monitor -> Ptr C'GLFWmonitor
unMonitor
instance C (Ptr C'GLFWwindow) Window where
fromC :: Ptr C'GLFWwindow -> Window
fromC = Ptr C'GLFWwindow -> Window
Window
toC :: Window -> Ptr C'GLFWwindow
toC = Window -> Ptr C'GLFWwindow
unWindow
instance C CInt ModifierKeys where
fromC :: CInt -> ModifierKeys
fromC CInt
v = ModifierKeys
{ modifierKeysShift :: Bool
modifierKeysShift = (CInt
v CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
forall a. Num a => a
c'GLFW_MOD_SHIFT) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
, modifierKeysControl :: Bool
modifierKeysControl = (CInt
v CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
forall a. Num a => a
c'GLFW_MOD_CONTROL) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
, modifierKeysAlt :: Bool
modifierKeysAlt = (CInt
v CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
forall a. Num a => a
c'GLFW_MOD_ALT) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
, modifierKeysSuper :: Bool
modifierKeysSuper = (CInt
v CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
forall a. Num a => a
c'GLFW_MOD_SUPER) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
, modifierKeysCapsLock :: Bool
modifierKeysCapsLock = (CInt
v CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
forall a. Num a => a
c'GLFW_MOD_CAPS_LOCK) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
, modifierKeysNumLock :: Bool
modifierKeysNumLock = (CInt
v CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
forall a. Num a => a
c'GLFW_MOD_NUM_LOCK) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
}
toC :: ModifierKeys -> CInt
toC = ModifierKeys -> CInt
forall a. HasCallStack => a
undefined
instance C C'GLFWvidmode VideoMode where
fromC :: C'GLFWvidmode -> VideoMode
fromC C'GLFWvidmode
gvm = VideoMode
{ videoModeWidth :: Int
videoModeWidth = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ C'GLFWvidmode -> CInt
c'GLFWvidmode'width C'GLFWvidmode
gvm
, videoModeHeight :: Int
videoModeHeight = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ C'GLFWvidmode -> CInt
c'GLFWvidmode'height C'GLFWvidmode
gvm
, videoModeRedBits :: Int
videoModeRedBits = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ C'GLFWvidmode -> CInt
c'GLFWvidmode'redBits C'GLFWvidmode
gvm
, videoModeGreenBits :: Int
videoModeGreenBits = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ C'GLFWvidmode -> CInt
c'GLFWvidmode'greenBits C'GLFWvidmode
gvm
, videoModeBlueBits :: Int
videoModeBlueBits = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ C'GLFWvidmode -> CInt
c'GLFWvidmode'blueBits C'GLFWvidmode
gvm
, videoModeRefreshRate :: Int
videoModeRefreshRate = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ C'GLFWvidmode -> CInt
c'GLFWvidmode'refreshRate C'GLFWvidmode
gvm
}
toC :: VideoMode -> C'GLFWvidmode
toC = VideoMode -> C'GLFWvidmode
forall a. HasCallStack => a
undefined
instance C CInt StandardCursorShape where
fromC :: CInt -> StandardCursorShape
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_ARROW_CURSOR = StandardCursorShape
StandardCursorShape'Arrow
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_IBEAM_CURSOR = StandardCursorShape
StandardCursorShape'IBeam
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_CROSSHAIR_CURSOR = StandardCursorShape
StandardCursorShape'Crosshair
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_HAND_CURSOR = StandardCursorShape
StandardCursorShape'Hand
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_HRESIZE_CURSOR = StandardCursorShape
StandardCursorShape'HResize
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_VRESIZE_CURSOR = StandardCursorShape
StandardCursorShape'VResize
| Bool
otherwise = [Char] -> StandardCursorShape
forall a. HasCallStack => [Char] -> a
error ([Char] -> StandardCursorShape) -> [Char] -> StandardCursorShape
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt StandardCursorShape fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: StandardCursorShape -> CInt
toC StandardCursorShape
StandardCursorShape'Arrow = CInt
forall a. Num a => a
c'GLFW_ARROW_CURSOR
toC StandardCursorShape
StandardCursorShape'IBeam = CInt
forall a. Num a => a
c'GLFW_IBEAM_CURSOR
toC StandardCursorShape
StandardCursorShape'Crosshair = CInt
forall a. Num a => a
c'GLFW_CROSSHAIR_CURSOR
toC StandardCursorShape
StandardCursorShape'Hand = CInt
forall a. Num a => a
c'GLFW_HAND_CURSOR
toC StandardCursorShape
StandardCursorShape'HResize = CInt
forall a. Num a => a
c'GLFW_HRESIZE_CURSOR
toC StandardCursorShape
StandardCursorShape'VResize = CInt
forall a. Num a => a
c'GLFW_VRESIZE_CURSOR
instance C CInt Bool where
fromC :: CInt -> Bool
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FALSE = Bool
False
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_TRUE = Bool
True
| Bool
otherwise = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt Bool fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: Bool -> CInt
toC Bool
False = CInt
forall a. Num a => a
c'GLFW_FALSE
toC Bool
True = CInt
forall a. Num a => a
c'GLFW_TRUE
instance C CInt Error where
fromC :: CInt -> Error
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NOT_INITIALIZED = Error
Error'NotInitialized
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NO_CURRENT_CONTEXT = Error
Error'NoCurrentContext
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_INVALID_ENUM = Error
Error'InvalidEnum
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_INVALID_VALUE = Error
Error'InvalidValue
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OUT_OF_MEMORY = Error
Error'OutOfMemory
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_API_UNAVAILABLE = Error
Error'ApiUnavailable
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_VERSION_UNAVAILABLE = Error
Error'VersionUnavailable
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_PLATFORM_ERROR = Error
Error'PlatformError
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FORMAT_UNAVAILABLE = Error
Error'FormatUnavailable
| Bool
otherwise = [Char] -> Error
forall a. HasCallStack => [Char] -> a
error ([Char] -> Error) -> [Char] -> Error
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt Error fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: Error -> CInt
toC Error
Error'NotInitialized = CInt
forall a. Num a => a
c'GLFW_NOT_INITIALIZED
toC Error
Error'NoCurrentContext = CInt
forall a. Num a => a
c'GLFW_NO_CURRENT_CONTEXT
toC Error
Error'InvalidEnum = CInt
forall a. Num a => a
c'GLFW_INVALID_ENUM
toC Error
Error'InvalidValue = CInt
forall a. Num a => a
c'GLFW_INVALID_VALUE
toC Error
Error'OutOfMemory = CInt
forall a. Num a => a
c'GLFW_OUT_OF_MEMORY
toC Error
Error'ApiUnavailable = CInt
forall a. Num a => a
c'GLFW_API_UNAVAILABLE
toC Error
Error'VersionUnavailable = CInt
forall a. Num a => a
c'GLFW_VERSION_UNAVAILABLE
toC Error
Error'PlatformError = CInt
forall a. Num a => a
c'GLFW_PLATFORM_ERROR
toC Error
Error'FormatUnavailable = CInt
forall a. Num a => a
c'GLFW_FORMAT_UNAVAILABLE
instance C CInt InitHint where
fromC :: CInt -> InitHint
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_HAT_BUTTONS = InitHint
InitHint'JoystickHatButtons
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_COCOA_CHDIR_RESOURCES = InitHint
InitHint'CocoaChdirResources
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_COCOA_MENUBAR = InitHint
InitHint'CocoaMenubar
| Bool
otherwise = [Char] -> InitHint
forall a. HasCallStack => [Char] -> a
error ([Char] -> InitHint) -> [Char] -> InitHint
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt InitHint fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: InitHint -> CInt
toC InitHint
InitHint'JoystickHatButtons = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_HAT_BUTTONS
toC InitHint
InitHint'CocoaChdirResources = CInt
forall a. Num a => a
c'GLFW_COCOA_CHDIR_RESOURCES
toC InitHint
InitHint'CocoaMenubar = CInt
forall a. Num a => a
c'GLFW_COCOA_MENUBAR
instance C CInt MonitorState where
fromC :: CInt -> MonitorState
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_CONNECTED = MonitorState
MonitorState'Connected
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_DISCONNECTED = MonitorState
MonitorState'Disconnected
| Bool
otherwise = [Char] -> MonitorState
forall a. HasCallStack => [Char] -> a
error ([Char] -> MonitorState) -> [Char] -> MonitorState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt MonitorState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: MonitorState -> CInt
toC MonitorState
MonitorState'Connected = CInt
forall a. Num a => a
c'GLFW_CONNECTED
toC MonitorState
MonitorState'Disconnected = CInt
forall a. Num a => a
c'GLFW_DISCONNECTED
instance C CInt ContextRobustness where
fromC :: CInt -> ContextRobustness
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NO_ROBUSTNESS = ContextRobustness
ContextRobustness'NoRobustness
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NO_RESET_NOTIFICATION = ContextRobustness
ContextRobustness'NoResetNotification
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_LOSE_CONTEXT_ON_RESET = ContextRobustness
ContextRobustness'LoseContextOnReset
| Bool
otherwise = [Char] -> ContextRobustness
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContextRobustness) -> [Char] -> ContextRobustness
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt ContextRobustness fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: ContextRobustness -> CInt
toC ContextRobustness
ContextRobustness'NoRobustness = CInt
forall a. Num a => a
c'GLFW_NO_ROBUSTNESS
toC ContextRobustness
ContextRobustness'NoResetNotification = CInt
forall a. Num a => a
c'GLFW_NO_RESET_NOTIFICATION
toC ContextRobustness
ContextRobustness'LoseContextOnReset = CInt
forall a. Num a => a
c'GLFW_LOSE_CONTEXT_ON_RESET
instance C CInt ContextReleaseBehavior where
fromC :: CInt -> ContextReleaseBehavior
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_ANY_RELEASE_BEHAVIOR = ContextReleaseBehavior
ContextReleaseBehavior'Any
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_RELEASE_BEHAVIOR_NONE = ContextReleaseBehavior
ContextReleaseBehavior'None
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_RELEASE_BEHAVIOR_FLUSH = ContextReleaseBehavior
ContextReleaseBehavior'Flush
| Bool
otherwise = [Char] -> ContextReleaseBehavior
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContextReleaseBehavior)
-> [Char] -> ContextReleaseBehavior
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt ContextReleaseBehavior fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: ContextReleaseBehavior -> CInt
toC ContextReleaseBehavior
ContextReleaseBehavior'Any = CInt
forall a. Num a => a
c'GLFW_ANY_RELEASE_BEHAVIOR
toC ContextReleaseBehavior
ContextReleaseBehavior'None = CInt
forall a. Num a => a
c'GLFW_RELEASE_BEHAVIOR_NONE
toC ContextReleaseBehavior
ContextReleaseBehavior'Flush = CInt
forall a. Num a => a
c'GLFW_RELEASE_BEHAVIOR_FLUSH
instance C CInt OpenGLProfile where
fromC :: CInt -> OpenGLProfile
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OPENGL_ANY_PROFILE = OpenGLProfile
OpenGLProfile'Any
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OPENGL_COMPAT_PROFILE = OpenGLProfile
OpenGLProfile'Compat
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OPENGL_CORE_PROFILE = OpenGLProfile
OpenGLProfile'Core
| Bool
otherwise = [Char] -> OpenGLProfile
forall a. HasCallStack => [Char] -> a
error ([Char] -> OpenGLProfile) -> [Char] -> OpenGLProfile
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt OpenGLProfile fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: OpenGLProfile -> CInt
toC OpenGLProfile
OpenGLProfile'Any = CInt
forall a. Num a => a
c'GLFW_OPENGL_ANY_PROFILE
toC OpenGLProfile
OpenGLProfile'Compat = CInt
forall a. Num a => a
c'GLFW_OPENGL_COMPAT_PROFILE
toC OpenGLProfile
OpenGLProfile'Core = CInt
forall a. Num a => a
c'GLFW_OPENGL_CORE_PROFILE
instance C CInt ClientAPI where
fromC :: CInt -> ClientAPI
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NO_API = ClientAPI
ClientAPI'NoAPI
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OPENGL_API = ClientAPI
ClientAPI'OpenGL
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OPENGL_ES_API = ClientAPI
ClientAPI'OpenGLES
| Bool
otherwise = [Char] -> ClientAPI
forall a. HasCallStack => [Char] -> a
error ([Char] -> ClientAPI) -> [Char] -> ClientAPI
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt ClientAPI fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: ClientAPI -> CInt
toC ClientAPI
ClientAPI'NoAPI = CInt
forall a. Num a => a
c'GLFW_NO_API
toC ClientAPI
ClientAPI'OpenGL = CInt
forall a. Num a => a
c'GLFW_OPENGL_API
toC ClientAPI
ClientAPI'OpenGLES = CInt
forall a. Num a => a
c'GLFW_OPENGL_ES_API
instance C CInt ContextCreationAPI where
fromC :: CInt -> ContextCreationAPI
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NATIVE_CONTEXT_API = ContextCreationAPI
ContextCreationAPI'Native
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_EGL_CONTEXT_API = ContextCreationAPI
ContextCreationAPI'EGL
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_OSMESA_CONTEXT_API = ContextCreationAPI
ContextCreationAPI'OSMesa
| Bool
otherwise = [Char] -> ContextCreationAPI
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContextCreationAPI) -> [Char] -> ContextCreationAPI
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt ContextCreationAPI fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: ContextCreationAPI -> CInt
toC ContextCreationAPI
ContextCreationAPI'Native = CInt
forall a. Num a => a
c'GLFW_NATIVE_CONTEXT_API
toC ContextCreationAPI
ContextCreationAPI'EGL = CInt
forall a. Num a => a
c'GLFW_EGL_CONTEXT_API
toC ContextCreationAPI
ContextCreationAPI'OSMesa = CInt
forall a. Num a => a
c'GLFW_OSMESA_CONTEXT_API
instance C CInt Key where
fromC :: CInt -> Key
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_UNKNOWN = Key
Key'Unknown
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_SPACE = Key
Key'Space
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_APOSTROPHE = Key
Key'Apostrophe
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_COMMA = Key
Key'Comma
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_MINUS = Key
Key'Minus
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_PERIOD = Key
Key'Period
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_SLASH = Key
Key'Slash
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_0 = Key
Key'0
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_1 = Key
Key'1
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_2 = Key
Key'2
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_3 = Key
Key'3
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_4 = Key
Key'4
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_5 = Key
Key'5
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_6 = Key
Key'6
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_7 = Key
Key'7
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_8 = Key
Key'8
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_9 = Key
Key'9
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_SEMICOLON = Key
Key'Semicolon
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_EQUAL = Key
Key'Equal
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_A = Key
Key'A
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_B = Key
Key'B
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_C = Key
Key'C
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_D = Key
Key'D
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_E = Key
Key'E
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F = Key
Key'F
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_G = Key
Key'G
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_H = Key
Key'H
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_I = Key
Key'I
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_J = Key
Key'J
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_K = Key
Key'K
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_L = Key
Key'L
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_M = Key
Key'M
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_N = Key
Key'N
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_O = Key
Key'O
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_P = Key
Key'P
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_Q = Key
Key'Q
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_R = Key
Key'R
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_S = Key
Key'S
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_T = Key
Key'T
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_U = Key
Key'U
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_V = Key
Key'V
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_W = Key
Key'W
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_X = Key
Key'X
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_Y = Key
Key'Y
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_Z = Key
Key'Z
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_BRACKET = Key
Key'LeftBracket
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_BACKSLASH = Key
Key'Backslash
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_BRACKET = Key
Key'RightBracket
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_GRAVE_ACCENT = Key
Key'GraveAccent
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_WORLD_1 = Key
Key'World1
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_WORLD_2 = Key
Key'World2
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_ESCAPE = Key
Key'Escape
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_ENTER = Key
Key'Enter
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_TAB = Key
Key'Tab
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_BACKSPACE = Key
Key'Backspace
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_INSERT = Key
Key'Insert
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_DELETE = Key
Key'Delete
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT = Key
Key'Right
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_LEFT = Key
Key'Left
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_DOWN = Key
Key'Down
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_UP = Key
Key'Up
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_PAGE_UP = Key
Key'PageUp
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_PAGE_DOWN = Key
Key'PageDown
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_HOME = Key
Key'Home
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_END = Key
Key'End
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_CAPS_LOCK = Key
Key'CapsLock
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_SCROLL_LOCK = Key
Key'ScrollLock
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_NUM_LOCK = Key
Key'NumLock
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_PRINT_SCREEN = Key
Key'PrintScreen
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_PAUSE = Key
Key'Pause
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F1 = Key
Key'F1
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F2 = Key
Key'F2
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F3 = Key
Key'F3
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F4 = Key
Key'F4
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F5 = Key
Key'F5
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F6 = Key
Key'F6
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F7 = Key
Key'F7
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F8 = Key
Key'F8
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F9 = Key
Key'F9
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F10 = Key
Key'F10
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F11 = Key
Key'F11
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F12 = Key
Key'F12
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F13 = Key
Key'F13
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F14 = Key
Key'F14
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F15 = Key
Key'F15
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F16 = Key
Key'F16
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F17 = Key
Key'F17
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F18 = Key
Key'F18
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F19 = Key
Key'F19
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F20 = Key
Key'F20
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F21 = Key
Key'F21
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F22 = Key
Key'F22
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F23 = Key
Key'F23
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F24 = Key
Key'F24
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_F25 = Key
Key'F25
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_0 = Key
Key'Pad0
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_1 = Key
Key'Pad1
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_2 = Key
Key'Pad2
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_3 = Key
Key'Pad3
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_4 = Key
Key'Pad4
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_5 = Key
Key'Pad5
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_6 = Key
Key'Pad6
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_7 = Key
Key'Pad7
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_8 = Key
Key'Pad8
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_9 = Key
Key'Pad9
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_DECIMAL = Key
Key'PadDecimal
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_DIVIDE = Key
Key'PadDivide
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_MULTIPLY = Key
Key'PadMultiply
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_SUBTRACT = Key
Key'PadSubtract
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_ADD = Key
Key'PadAdd
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_ENTER = Key
Key'PadEnter
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_KP_EQUAL = Key
Key'PadEqual
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_SHIFT = Key
Key'LeftShift
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_CONTROL = Key
Key'LeftControl
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_ALT = Key
Key'LeftAlt
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_SUPER = Key
Key'LeftSuper
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_SHIFT = Key
Key'RightShift
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_CONTROL = Key
Key'RightControl
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_ALT = Key
Key'RightAlt
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_SUPER = Key
Key'RightSuper
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_KEY_MENU = Key
Key'Menu
| Bool
otherwise = [Char] -> Key
forall a. HasCallStack => [Char] -> a
error ([Char] -> Key) -> [Char] -> Key
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt Key fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: Key -> CInt
toC Key
Key'Unknown = CInt
forall a. Num a => a
c'GLFW_KEY_UNKNOWN
toC Key
Key'Space = CInt
forall a. Num a => a
c'GLFW_KEY_SPACE
toC Key
Key'Apostrophe = CInt
forall a. Num a => a
c'GLFW_KEY_APOSTROPHE
toC Key
Key'Comma = CInt
forall a. Num a => a
c'GLFW_KEY_COMMA
toC Key
Key'Minus = CInt
forall a. Num a => a
c'GLFW_KEY_MINUS
toC Key
Key'Period = CInt
forall a. Num a => a
c'GLFW_KEY_PERIOD
toC Key
Key'Slash = CInt
forall a. Num a => a
c'GLFW_KEY_SLASH
toC Key
Key'0 = CInt
forall a. Num a => a
c'GLFW_KEY_0
toC Key
Key'1 = CInt
forall a. Num a => a
c'GLFW_KEY_1
toC Key
Key'2 = CInt
forall a. Num a => a
c'GLFW_KEY_2
toC Key
Key'3 = CInt
forall a. Num a => a
c'GLFW_KEY_3
toC Key
Key'4 = CInt
forall a. Num a => a
c'GLFW_KEY_4
toC Key
Key'5 = CInt
forall a. Num a => a
c'GLFW_KEY_5
toC Key
Key'6 = CInt
forall a. Num a => a
c'GLFW_KEY_6
toC Key
Key'7 = CInt
forall a. Num a => a
c'GLFW_KEY_7
toC Key
Key'8 = CInt
forall a. Num a => a
c'GLFW_KEY_8
toC Key
Key'9 = CInt
forall a. Num a => a
c'GLFW_KEY_9
toC Key
Key'Semicolon = CInt
forall a. Num a => a
c'GLFW_KEY_SEMICOLON
toC Key
Key'Equal = CInt
forall a. Num a => a
c'GLFW_KEY_EQUAL
toC Key
Key'A = CInt
forall a. Num a => a
c'GLFW_KEY_A
toC Key
Key'B = CInt
forall a. Num a => a
c'GLFW_KEY_B
toC Key
Key'C = CInt
forall a. Num a => a
c'GLFW_KEY_C
toC Key
Key'D = CInt
forall a. Num a => a
c'GLFW_KEY_D
toC Key
Key'E = CInt
forall a. Num a => a
c'GLFW_KEY_E
toC Key
Key'F = CInt
forall a. Num a => a
c'GLFW_KEY_F
toC Key
Key'G = CInt
forall a. Num a => a
c'GLFW_KEY_G
toC Key
Key'H = CInt
forall a. Num a => a
c'GLFW_KEY_H
toC Key
Key'I = CInt
forall a. Num a => a
c'GLFW_KEY_I
toC Key
Key'J = CInt
forall a. Num a => a
c'GLFW_KEY_J
toC Key
Key'K = CInt
forall a. Num a => a
c'GLFW_KEY_K
toC Key
Key'L = CInt
forall a. Num a => a
c'GLFW_KEY_L
toC Key
Key'M = CInt
forall a. Num a => a
c'GLFW_KEY_M
toC Key
Key'N = CInt
forall a. Num a => a
c'GLFW_KEY_N
toC Key
Key'O = CInt
forall a. Num a => a
c'GLFW_KEY_O
toC Key
Key'P = CInt
forall a. Num a => a
c'GLFW_KEY_P
toC Key
Key'Q = CInt
forall a. Num a => a
c'GLFW_KEY_Q
toC Key
Key'R = CInt
forall a. Num a => a
c'GLFW_KEY_R
toC Key
Key'S = CInt
forall a. Num a => a
c'GLFW_KEY_S
toC Key
Key'T = CInt
forall a. Num a => a
c'GLFW_KEY_T
toC Key
Key'U = CInt
forall a. Num a => a
c'GLFW_KEY_U
toC Key
Key'V = CInt
forall a. Num a => a
c'GLFW_KEY_V
toC Key
Key'W = CInt
forall a. Num a => a
c'GLFW_KEY_W
toC Key
Key'X = CInt
forall a. Num a => a
c'GLFW_KEY_X
toC Key
Key'Y = CInt
forall a. Num a => a
c'GLFW_KEY_Y
toC Key
Key'Z = CInt
forall a. Num a => a
c'GLFW_KEY_Z
toC Key
Key'LeftBracket = CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_BRACKET
toC Key
Key'Backslash = CInt
forall a. Num a => a
c'GLFW_KEY_BACKSLASH
toC Key
Key'RightBracket = CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_BRACKET
toC Key
Key'GraveAccent = CInt
forall a. Num a => a
c'GLFW_KEY_GRAVE_ACCENT
toC Key
Key'World1 = CInt
forall a. Num a => a
c'GLFW_KEY_WORLD_1
toC Key
Key'World2 = CInt
forall a. Num a => a
c'GLFW_KEY_WORLD_2
toC Key
Key'Escape = CInt
forall a. Num a => a
c'GLFW_KEY_ESCAPE
toC Key
Key'Enter = CInt
forall a. Num a => a
c'GLFW_KEY_ENTER
toC Key
Key'Tab = CInt
forall a. Num a => a
c'GLFW_KEY_TAB
toC Key
Key'Backspace = CInt
forall a. Num a => a
c'GLFW_KEY_BACKSPACE
toC Key
Key'Insert = CInt
forall a. Num a => a
c'GLFW_KEY_INSERT
toC Key
Key'Delete = CInt
forall a. Num a => a
c'GLFW_KEY_DELETE
toC Key
Key'Right = CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT
toC Key
Key'Left = CInt
forall a. Num a => a
c'GLFW_KEY_LEFT
toC Key
Key'Down = CInt
forall a. Num a => a
c'GLFW_KEY_DOWN
toC Key
Key'Up = CInt
forall a. Num a => a
c'GLFW_KEY_UP
toC Key
Key'PageUp = CInt
forall a. Num a => a
c'GLFW_KEY_PAGE_UP
toC Key
Key'PageDown = CInt
forall a. Num a => a
c'GLFW_KEY_PAGE_DOWN
toC Key
Key'Home = CInt
forall a. Num a => a
c'GLFW_KEY_HOME
toC Key
Key'End = CInt
forall a. Num a => a
c'GLFW_KEY_END
toC Key
Key'CapsLock = CInt
forall a. Num a => a
c'GLFW_KEY_CAPS_LOCK
toC Key
Key'ScrollLock = CInt
forall a. Num a => a
c'GLFW_KEY_SCROLL_LOCK
toC Key
Key'NumLock = CInt
forall a. Num a => a
c'GLFW_KEY_NUM_LOCK
toC Key
Key'PrintScreen = CInt
forall a. Num a => a
c'GLFW_KEY_PRINT_SCREEN
toC Key
Key'Pause = CInt
forall a. Num a => a
c'GLFW_KEY_PAUSE
toC Key
Key'F1 = CInt
forall a. Num a => a
c'GLFW_KEY_F1
toC Key
Key'F2 = CInt
forall a. Num a => a
c'GLFW_KEY_F2
toC Key
Key'F3 = CInt
forall a. Num a => a
c'GLFW_KEY_F3
toC Key
Key'F4 = CInt
forall a. Num a => a
c'GLFW_KEY_F4
toC Key
Key'F5 = CInt
forall a. Num a => a
c'GLFW_KEY_F5
toC Key
Key'F6 = CInt
forall a. Num a => a
c'GLFW_KEY_F6
toC Key
Key'F7 = CInt
forall a. Num a => a
c'GLFW_KEY_F7
toC Key
Key'F8 = CInt
forall a. Num a => a
c'GLFW_KEY_F8
toC Key
Key'F9 = CInt
forall a. Num a => a
c'GLFW_KEY_F9
toC Key
Key'F10 = CInt
forall a. Num a => a
c'GLFW_KEY_F10
toC Key
Key'F11 = CInt
forall a. Num a => a
c'GLFW_KEY_F11
toC Key
Key'F12 = CInt
forall a. Num a => a
c'GLFW_KEY_F12
toC Key
Key'F13 = CInt
forall a. Num a => a
c'GLFW_KEY_F13
toC Key
Key'F14 = CInt
forall a. Num a => a
c'GLFW_KEY_F14
toC Key
Key'F15 = CInt
forall a. Num a => a
c'GLFW_KEY_F15
toC Key
Key'F16 = CInt
forall a. Num a => a
c'GLFW_KEY_F16
toC Key
Key'F17 = CInt
forall a. Num a => a
c'GLFW_KEY_F17
toC Key
Key'F18 = CInt
forall a. Num a => a
c'GLFW_KEY_F18
toC Key
Key'F19 = CInt
forall a. Num a => a
c'GLFW_KEY_F19
toC Key
Key'F20 = CInt
forall a. Num a => a
c'GLFW_KEY_F20
toC Key
Key'F21 = CInt
forall a. Num a => a
c'GLFW_KEY_F21
toC Key
Key'F22 = CInt
forall a. Num a => a
c'GLFW_KEY_F22
toC Key
Key'F23 = CInt
forall a. Num a => a
c'GLFW_KEY_F23
toC Key
Key'F24 = CInt
forall a. Num a => a
c'GLFW_KEY_F24
toC Key
Key'F25 = CInt
forall a. Num a => a
c'GLFW_KEY_F25
toC Key
Key'Pad0 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_0
toC Key
Key'Pad1 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_1
toC Key
Key'Pad2 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_2
toC Key
Key'Pad3 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_3
toC Key
Key'Pad4 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_4
toC Key
Key'Pad5 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_5
toC Key
Key'Pad6 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_6
toC Key
Key'Pad7 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_7
toC Key
Key'Pad8 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_8
toC Key
Key'Pad9 = CInt
forall a. Num a => a
c'GLFW_KEY_KP_9
toC Key
Key'PadDecimal = CInt
forall a. Num a => a
c'GLFW_KEY_KP_DECIMAL
toC Key
Key'PadDivide = CInt
forall a. Num a => a
c'GLFW_KEY_KP_DIVIDE
toC Key
Key'PadMultiply = CInt
forall a. Num a => a
c'GLFW_KEY_KP_MULTIPLY
toC Key
Key'PadSubtract = CInt
forall a. Num a => a
c'GLFW_KEY_KP_SUBTRACT
toC Key
Key'PadAdd = CInt
forall a. Num a => a
c'GLFW_KEY_KP_ADD
toC Key
Key'PadEnter = CInt
forall a. Num a => a
c'GLFW_KEY_KP_ENTER
toC Key
Key'PadEqual = CInt
forall a. Num a => a
c'GLFW_KEY_KP_EQUAL
toC Key
Key'LeftShift = CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_SHIFT
toC Key
Key'LeftControl = CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_CONTROL
toC Key
Key'LeftAlt = CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_ALT
toC Key
Key'LeftSuper = CInt
forall a. Num a => a
c'GLFW_KEY_LEFT_SUPER
toC Key
Key'RightShift = CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_SHIFT
toC Key
Key'RightControl = CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_CONTROL
toC Key
Key'RightAlt = CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_ALT
toC Key
Key'RightSuper = CInt
forall a. Num a => a
c'GLFW_KEY_RIGHT_SUPER
toC Key
Key'Menu = CInt
forall a. Num a => a
c'GLFW_KEY_MENU
instance C CInt KeyState where
fromC :: CInt -> KeyState
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_PRESS = KeyState
KeyState'Pressed
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_RELEASE = KeyState
KeyState'Released
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_REPEAT = KeyState
KeyState'Repeating
| Bool
otherwise = [Char] -> KeyState
forall a. HasCallStack => [Char] -> a
error ([Char] -> KeyState) -> [Char] -> KeyState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt KeyState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: KeyState -> CInt
toC KeyState
KeyState'Pressed = CInt
forall a. Num a => a
c'GLFW_PRESS
toC KeyState
KeyState'Released = CInt
forall a. Num a => a
c'GLFW_RELEASE
toC KeyState
KeyState'Repeating = CInt
forall a. Num a => a
c'GLFW_REPEAT
instance C CInt Joystick where
fromC :: CInt -> Joystick
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_1 = Joystick
Joystick'1
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_2 = Joystick
Joystick'2
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_3 = Joystick
Joystick'3
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_4 = Joystick
Joystick'4
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_5 = Joystick
Joystick'5
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_6 = Joystick
Joystick'6
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_7 = Joystick
Joystick'7
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_8 = Joystick
Joystick'8
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_9 = Joystick
Joystick'9
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_10 = Joystick
Joystick'10
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_11 = Joystick
Joystick'11
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_12 = Joystick
Joystick'12
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_13 = Joystick
Joystick'13
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_14 = Joystick
Joystick'14
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_15 = Joystick
Joystick'15
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_JOYSTICK_16 = Joystick
Joystick'16
| Bool
otherwise = [Char] -> Joystick
forall a. HasCallStack => [Char] -> a
error ([Char] -> Joystick) -> [Char] -> Joystick
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt Joystick fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: Joystick -> CInt
toC Joystick
Joystick'1 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_1
toC Joystick
Joystick'2 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_2
toC Joystick
Joystick'3 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_3
toC Joystick
Joystick'4 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_4
toC Joystick
Joystick'5 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_5
toC Joystick
Joystick'6 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_6
toC Joystick
Joystick'7 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_7
toC Joystick
Joystick'8 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_8
toC Joystick
Joystick'9 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_9
toC Joystick
Joystick'10 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_10
toC Joystick
Joystick'11 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_11
toC Joystick
Joystick'12 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_12
toC Joystick
Joystick'13 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_13
toC Joystick
Joystick'14 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_14
toC Joystick
Joystick'15 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_15
toC Joystick
Joystick'16 = CInt
forall a. Num a => a
c'GLFW_JOYSTICK_16
instance C CUChar JoystickHatState where
fromC :: CUChar -> JoystickHatState
fromC CUChar
v
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_CENTERED = JoystickHatState
JoystickHatState'Centered
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_UP = JoystickHatState
JoystickHatState'Up
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_RIGHT = JoystickHatState
JoystickHatState'Right
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_DOWN = JoystickHatState
JoystickHatState'Down
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_LEFT = JoystickHatState
JoystickHatState'Left
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_RIGHT_UP = JoystickHatState
JoystickHatState'RightUp
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_RIGHT_DOWN = JoystickHatState
JoystickHatState'RightDown
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_LEFT_UP = JoystickHatState
JoystickHatState'LeftUp
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_HAT_LEFT_DOWN = JoystickHatState
JoystickHatState'LeftDown
| Bool
otherwise = [Char] -> JoystickHatState
forall a. HasCallStack => [Char] -> a
error ([Char] -> JoystickHatState) -> [Char] -> JoystickHatState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CUChar JoystickHatState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CUChar -> [Char]
forall a. Show a => a -> [Char]
show CUChar
v
toC :: JoystickHatState -> CUChar
toC JoystickHatState
JoystickHatState'Centered = CUChar
forall a. Num a => a
c'GLFW_HAT_CENTERED
toC JoystickHatState
JoystickHatState'Up = CUChar
forall a. Num a => a
c'GLFW_HAT_UP
toC JoystickHatState
JoystickHatState'Right = CUChar
forall a. Num a => a
c'GLFW_HAT_RIGHT
toC JoystickHatState
JoystickHatState'Down = CUChar
forall a. Num a => a
c'GLFW_HAT_DOWN
toC JoystickHatState
JoystickHatState'Left = CUChar
forall a. Num a => a
c'GLFW_HAT_LEFT
toC JoystickHatState
JoystickHatState'RightUp = CUChar
forall a. Num a => a
c'GLFW_HAT_RIGHT_UP
toC JoystickHatState
JoystickHatState'RightDown = CUChar
forall a. Num a => a
c'GLFW_HAT_RIGHT_DOWN
toC JoystickHatState
JoystickHatState'LeftUp = CUChar
forall a. Num a => a
c'GLFW_HAT_LEFT_UP
toC JoystickHatState
JoystickHatState'LeftDown = CUChar
forall a. Num a => a
c'GLFW_HAT_LEFT_DOWN
instance C CUChar JoystickButtonState where
fromC :: CUChar -> JoystickButtonState
fromC CUChar
v
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_PRESS = JoystickButtonState
JoystickButtonState'Pressed
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_RELEASE = JoystickButtonState
JoystickButtonState'Released
| Bool
otherwise = [Char] -> JoystickButtonState
forall a. HasCallStack => [Char] -> a
error ([Char] -> JoystickButtonState) -> [Char] -> JoystickButtonState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CUChar JoystickButtonState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CUChar -> [Char]
forall a. Show a => a -> [Char]
show CUChar
v
toC :: JoystickButtonState -> CUChar
toC JoystickButtonState
JoystickButtonState'Pressed = CUChar
forall a. Num a => a
c'GLFW_PRESS
toC JoystickButtonState
JoystickButtonState'Released = CUChar
forall a. Num a => a
c'GLFW_RELEASE
instance C CInt JoystickState where
fromC :: CInt -> JoystickState
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_CONNECTED = JoystickState
JoystickState'Connected
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_DISCONNECTED = JoystickState
JoystickState'Disconnected
| Bool
otherwise = [Char] -> JoystickState
forall a. HasCallStack => [Char] -> a
error ([Char] -> JoystickState) -> [Char] -> JoystickState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt JoystickState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: JoystickState -> CInt
toC JoystickState
JoystickState'Connected = CInt
forall a. Num a => a
c'GLFW_CONNECTED
toC JoystickState
JoystickState'Disconnected = CInt
forall a. Num a => a
c'GLFW_DISCONNECTED
instance C CInt GamepadButton where
fromC :: CInt -> GamepadButton
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_A = GamepadButton
GamepadButton'A
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_B = GamepadButton
GamepadButton'B
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_X = GamepadButton
GamepadButton'X
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_Y = GamepadButton
GamepadButton'Y
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_LEFT_BUMPER = GamepadButton
GamepadButton'LeftBumper
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_RIGHT_BUMPER = GamepadButton
GamepadButton'RightBumper
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_BACK = GamepadButton
GamepadButton'Back
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_START = GamepadButton
GamepadButton'Start
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_GUIDE = GamepadButton
GamepadButton'Guide
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_LEFT_THUMB = GamepadButton
GamepadButton'LeftThumb
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_RIGHT_THUMB = GamepadButton
GamepadButton'RightThumb
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_UP = GamepadButton
GamepadButton'DpadUp
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_RIGHT = GamepadButton
GamepadButton'DpadRight
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_DOWN = GamepadButton
GamepadButton'DpadDown
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_LEFT = GamepadButton
GamepadButton'DpadLeft
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_CROSS = GamepadButton
GamepadButton'Cross
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_CIRCLE = GamepadButton
GamepadButton'Circle
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_SQUARE = GamepadButton
GamepadButton'Square
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_TRIANGLE = GamepadButton
GamepadButton'Triangle
| Bool
otherwise = [Char] -> GamepadButton
forall a. HasCallStack => [Char] -> a
error ([Char] -> GamepadButton) -> [Char] -> GamepadButton
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt GamepadButton fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: GamepadButton -> CInt
toC GamepadButton
GamepadButton'A = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_A
toC GamepadButton
GamepadButton'B = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_B
toC GamepadButton
GamepadButton'X = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_X
toC GamepadButton
GamepadButton'Y = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_Y
toC GamepadButton
GamepadButton'LeftBumper = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_LEFT_BUMPER
toC GamepadButton
GamepadButton'RightBumper = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_RIGHT_BUMPER
toC GamepadButton
GamepadButton'Back = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_BACK
toC GamepadButton
GamepadButton'Start = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_START
toC GamepadButton
GamepadButton'Guide = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_GUIDE
toC GamepadButton
GamepadButton'LeftThumb = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_LEFT_THUMB
toC GamepadButton
GamepadButton'RightThumb = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_RIGHT_THUMB
toC GamepadButton
GamepadButton'DpadUp = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_UP
toC GamepadButton
GamepadButton'DpadRight = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_RIGHT
toC GamepadButton
GamepadButton'DpadDown = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_DOWN
toC GamepadButton
GamepadButton'DpadLeft = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_DPAD_LEFT
toC GamepadButton
GamepadButton'Cross = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_CROSS
toC GamepadButton
GamepadButton'Circle = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_CIRCLE
toC GamepadButton
GamepadButton'Square = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_SQUARE
toC GamepadButton
GamepadButton'Triangle = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_BUTTON_TRIANGLE
instance C CUChar GamepadButtonState where
fromC :: CUChar -> GamepadButtonState
fromC CUChar
v
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_PRESS = GamepadButtonState
GamepadButtonState'Pressed
| CUChar
v CUChar -> CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== CUChar
forall a. Num a => a
c'GLFW_RELEASE = GamepadButtonState
GamepadButtonState'Released
| Bool
otherwise = [Char] -> GamepadButtonState
forall a. HasCallStack => [Char] -> a
error ([Char] -> GamepadButtonState) -> [Char] -> GamepadButtonState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CUChar GamepadButtonState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CUChar -> [Char]
forall a. Show a => a -> [Char]
show CUChar
v
toC :: GamepadButtonState -> CUChar
toC GamepadButtonState
GamepadButtonState'Pressed = CUChar
forall a. Num a => a
c'GLFW_PRESS
toC GamepadButtonState
GamepadButtonState'Released = CUChar
forall a. Num a => a
c'GLFW_RELEASE
instance C CInt GamepadAxis where
fromC :: CInt -> GamepadAxis
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_LEFT_X = GamepadAxis
GamepadAxis'LeftX
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_RIGHT_X = GamepadAxis
GamepadAxis'RightX
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_LEFT_Y = GamepadAxis
GamepadAxis'LeftY
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_RIGHT_Y = GamepadAxis
GamepadAxis'RightY
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_LEFT_TRIGGER = GamepadAxis
GamepadAxis'LeftTrigger
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_RIGHT_TRIGGER = GamepadAxis
GamepadAxis'RightTrigger
| Bool
otherwise = [Char] -> GamepadAxis
forall a. HasCallStack => [Char] -> a
error ([Char] -> GamepadAxis) -> [Char] -> GamepadAxis
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt GamepadAxis fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: GamepadAxis -> CInt
toC GamepadAxis
GamepadAxis'LeftX = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_LEFT_X
toC GamepadAxis
GamepadAxis'RightX = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_RIGHT_X
toC GamepadAxis
GamepadAxis'LeftY = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_LEFT_Y
toC GamepadAxis
GamepadAxis'RightY = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_RIGHT_Y
toC GamepadAxis
GamepadAxis'LeftTrigger = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_LEFT_TRIGGER
toC GamepadAxis
GamepadAxis'RightTrigger = CInt
forall a. Num a => a
c'GLFW_GAMEPAD_AXIS_RIGHT_TRIGGER
instance C CInt MouseButton where
fromC :: CInt -> MouseButton
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_1 = MouseButton
MouseButton'1
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_2 = MouseButton
MouseButton'2
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_3 = MouseButton
MouseButton'3
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_4 = MouseButton
MouseButton'4
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_5 = MouseButton
MouseButton'5
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_6 = MouseButton
MouseButton'6
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_7 = MouseButton
MouseButton'7
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_8 = MouseButton
MouseButton'8
| Bool
otherwise = [Char] -> MouseButton
forall a. HasCallStack => [Char] -> a
error ([Char] -> MouseButton) -> [Char] -> MouseButton
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt MouseButton fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: MouseButton -> CInt
toC MouseButton
MouseButton'1 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_1
toC MouseButton
MouseButton'2 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_2
toC MouseButton
MouseButton'3 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_3
toC MouseButton
MouseButton'4 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_4
toC MouseButton
MouseButton'5 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_5
toC MouseButton
MouseButton'6 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_6
toC MouseButton
MouseButton'7 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_7
toC MouseButton
MouseButton'8 = CInt
forall a. Num a => a
c'GLFW_MOUSE_BUTTON_8
instance C CInt MouseButtonState where
fromC :: CInt -> MouseButtonState
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_PRESS = MouseButtonState
MouseButtonState'Pressed
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_RELEASE = MouseButtonState
MouseButtonState'Released
| Bool
otherwise = [Char] -> MouseButtonState
forall a. HasCallStack => [Char] -> a
error ([Char] -> MouseButtonState) -> [Char] -> MouseButtonState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt MouseButtonState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: MouseButtonState -> CInt
toC MouseButtonState
MouseButtonState'Pressed = CInt
forall a. Num a => a
c'GLFW_PRESS
toC MouseButtonState
MouseButtonState'Released = CInt
forall a. Num a => a
c'GLFW_RELEASE
instance C CInt CursorState where
fromC :: CInt -> CursorState
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_TRUE = CursorState
CursorState'InWindow
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FALSE = CursorState
CursorState'NotInWindow
| Bool
otherwise = [Char] -> CursorState
forall a. HasCallStack => [Char] -> a
error ([Char] -> CursorState) -> [Char] -> CursorState
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt CursorState fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: CursorState -> CInt
toC CursorState
CursorState'InWindow = CInt
forall a. Num a => a
c'GLFW_TRUE
toC CursorState
CursorState'NotInWindow = CInt
forall a. Num a => a
c'GLFW_FALSE
instance C CInt CursorInputMode where
fromC :: CInt -> CursorInputMode
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_CURSOR_NORMAL = CursorInputMode
CursorInputMode'Normal
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_CURSOR_HIDDEN = CursorInputMode
CursorInputMode'Hidden
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_CURSOR_DISABLED = CursorInputMode
CursorInputMode'Disabled
| Bool
otherwise = [Char] -> CursorInputMode
forall a. HasCallStack => [Char] -> a
error ([Char] -> CursorInputMode) -> [Char] -> CursorInputMode
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt CursorInputMode fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: CursorInputMode -> CInt
toC CursorInputMode
CursorInputMode'Normal = CInt
forall a. Num a => a
c'GLFW_CURSOR_NORMAL
toC CursorInputMode
CursorInputMode'Hidden = CInt
forall a. Num a => a
c'GLFW_CURSOR_HIDDEN
toC CursorInputMode
CursorInputMode'Disabled = CInt
forall a. Num a => a
c'GLFW_CURSOR_DISABLED
instance C CInt StickyKeysInputMode where
fromC :: CInt -> StickyKeysInputMode
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_TRUE = StickyKeysInputMode
StickyKeysInputMode'Enabled
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FALSE = StickyKeysInputMode
StickyKeysInputMode'Disabled
| Bool
otherwise = [Char] -> StickyKeysInputMode
forall a. HasCallStack => [Char] -> a
error ([Char] -> StickyKeysInputMode) -> [Char] -> StickyKeysInputMode
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt StickyKeysInputMode fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: StickyKeysInputMode -> CInt
toC StickyKeysInputMode
StickyKeysInputMode'Enabled = CInt
forall a. Num a => a
c'GLFW_TRUE
toC StickyKeysInputMode
StickyKeysInputMode'Disabled = CInt
forall a. Num a => a
c'GLFW_FALSE
instance C CInt StickyMouseButtonsInputMode where
fromC :: CInt -> StickyMouseButtonsInputMode
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_TRUE = StickyMouseButtonsInputMode
StickyMouseButtonsInputMode'Enabled
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FALSE = StickyMouseButtonsInputMode
StickyMouseButtonsInputMode'Disabled
| Bool
otherwise = [Char] -> StickyMouseButtonsInputMode
forall a. HasCallStack => [Char] -> a
error ([Char] -> StickyMouseButtonsInputMode)
-> [Char] -> StickyMouseButtonsInputMode
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt StickyMouseButtonsInputMode fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: StickyMouseButtonsInputMode -> CInt
toC StickyMouseButtonsInputMode
StickyMouseButtonsInputMode'Enabled = CInt
forall a. Num a => a
c'GLFW_TRUE
toC StickyMouseButtonsInputMode
StickyMouseButtonsInputMode'Disabled = CInt
forall a. Num a => a
c'GLFW_FALSE
instance C CInt WindowAttrib where
fromC :: CInt -> WindowAttrib
fromC CInt
v
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_DECORATED = WindowAttrib
WindowAttrib'Decorated
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_RESIZABLE = WindowAttrib
WindowAttrib'Resizable
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FLOATING = WindowAttrib
WindowAttrib'Floating
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_AUTO_ICONIFY = WindowAttrib
WindowAttrib'AutoIconify
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_FOCUS_ON_SHOW = WindowAttrib
WindowAttrib'FocusOnShow
| CInt
v CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_HOVERED = WindowAttrib
WindowAttrib'Hovered
| Bool
otherwise = [Char] -> WindowAttrib
forall a. HasCallStack => [Char] -> a
error ([Char] -> WindowAttrib) -> [Char] -> WindowAttrib
forall a b. (a -> b) -> a -> b
$ [Char]
"C CInt WindowAttrib fromC: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
v
toC :: WindowAttrib -> CInt
toC WindowAttrib
WindowAttrib'Decorated = CInt
forall a. Num a => a
c'GLFW_DECORATED
toC WindowAttrib
WindowAttrib'Resizable = CInt
forall a. Num a => a
c'GLFW_RESIZABLE
toC WindowAttrib
WindowAttrib'Floating = CInt
forall a. Num a => a
c'GLFW_FLOATING
toC WindowAttrib
WindowAttrib'AutoIconify = CInt
forall a. Num a => a
c'GLFW_AUTO_ICONIFY
toC WindowAttrib
WindowAttrib'FocusOnShow = CInt
forall a. Num a => a
c'GLFW_FOCUS_ON_SHOW
toC WindowAttrib
WindowAttrib'Hovered = CInt
forall a. Num a => a
c'GLFW_HOVERED
{-# ANN module "HLint: ignore Use camelCase" #-}