module Graphics.UI.GLFW
(
initialize
, terminate
, getVideoMode
, getVideoModes
, VideoMode(..)
, OpenGLProfile(..)
, openGLContextIsForwardCompatible
, openGLContextIsDebugContext
, openGLProfile
, openWindow
, closeWindow
, setWindowTitle
, setWindowDimensions
, setWindowPosition
, iconifyWindow
, restoreWindow
, swapBuffers
, setWindowBufferSwapInterval
, DisplayMode(..)
, DisplayOptions(..)
, defaultDisplayOptions
, windowIsOpen
, windowIsActive
, windowIsIconified
, windowIsResizable
, windowIsHardwareAccelerated
, windowSupportsStereoRendering
, getWindowRefreshRate
, getWindowDimensions
, getWindowValue
, setWindowCloseCallback
, setWindowSizeCallback
, setWindowRefreshCallback
, WindowValue(..)
, WindowCloseCallback
, WindowSizeCallback
, WindowRefreshCallback
, pollEvents
, waitEvents
, keyIsPressed
, setCharCallback
, setKeyCallback
, Key(..)
, CharCallback
, KeyCallback
, mouseButtonIsPressed
, getMousePosition
, getMouseWheel
, setMousePosition
, setMouseWheel
, setMouseButtonCallback
, setMousePositionCallback
, setMouseWheelCallback
, enableMouseCursor
, disableMouseCursor
, MouseButton(..)
, MouseButtonCallback
, MousePositionCallback
, MouseWheelCallback
, joystickIsPresent
, getJoystickPosition
, getNumJoystickAxes
, getNumJoystickButtons
, joystickButtonsArePressed
, Joystick(..)
, getTime
, setTime
, resetTime
, sleep
, getGlfwVersion
, getGlVersion
) where
import Control.Monad (when)
import Data.Char (chr, ord)
import Data.IORef (IORef, atomicModifyIORef, newIORef)
import Data.Maybe (fromJust, isJust)
import Data.Version (Version(..))
import Foreign.C.String (CString, withCString)
import Foreign.C.Types (CDouble, CFloat, CInt, CUChar)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (allocaArray, peekArray)
import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr)
import Foreign.Storable (Storable(..))
import System.IO.Unsafe (unsafePerformIO)
foreign import ccall glfwInit :: IO CInt
foreign import ccall glfwTerminate :: IO ()
foreign import ccall glfwGetVersion :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall glfwOpenWindow :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall glfwOpenWindowHint :: CInt -> CInt -> IO ()
foreign import ccall glfwCloseWindow :: IO ()
foreign import ccall glfwSetWindowCloseCallback :: FunPtr GlfwWindowCloseCallback -> IO ()
foreign import ccall glfwSetWindowTitle :: CString -> IO ()
foreign import ccall glfwSetWindowSize :: CInt -> CInt -> IO ()
foreign import ccall glfwSetWindowPos :: CInt -> CInt -> IO ()
foreign import ccall glfwGetWindowSize :: Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall glfwSetWindowSizeCallback :: FunPtr GlfwWindowSizeCallback -> IO ()
foreign import ccall glfwIconifyWindow :: IO ()
foreign import ccall glfwRestoreWindow :: IO ()
foreign import ccall glfwGetWindowParam :: CInt -> IO CInt
foreign import ccall glfwSwapBuffers :: IO ()
foreign import ccall glfwSwapInterval :: CInt -> IO ()
foreign import ccall glfwSetWindowRefreshCallback :: FunPtr GlfwWindowRefreshCallback -> IO ()
foreign import ccall glfwGetVideoModes :: Ptr VideoMode -> CInt -> IO CInt
foreign import ccall glfwGetDesktopMode :: Ptr VideoMode -> IO ()
foreign import ccall glfwPollEvents :: IO ()
foreign import ccall glfwWaitEvents :: IO ()
foreign import ccall glfwGetKey :: CInt -> IO CInt
foreign import ccall glfwGetMouseButton :: CInt -> IO CInt
foreign import ccall glfwGetMousePos :: Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall glfwSetMousePos :: CInt -> CInt -> IO ()
foreign import ccall glfwGetMouseWheel :: IO CInt
foreign import ccall glfwSetMouseWheel :: CInt -> IO ()
foreign import ccall glfwSetKeyCallback :: FunPtr GlfwKeyCallback -> IO ()
foreign import ccall glfwSetCharCallback :: FunPtr GlfwCharCallback -> IO ()
foreign import ccall glfwSetMouseButtonCallback :: FunPtr GlfwMouseButtonCallback -> IO ()
foreign import ccall glfwSetMousePosCallback :: FunPtr GlfwMousePositionCallback -> IO ()
foreign import ccall glfwSetMouseWheelCallback :: FunPtr GlfwMouseWheelCallback -> IO ()
foreign import ccall glfwGetJoystickParam :: CInt -> CInt -> IO CInt
foreign import ccall glfwGetJoystickPos :: CInt -> Ptr CFloat -> CInt -> IO CInt
foreign import ccall glfwGetJoystickButtons :: CInt -> Ptr CUChar -> CInt -> IO CInt
foreign import ccall glfwGetTime :: IO CDouble
foreign import ccall glfwSetTime :: CDouble -> IO ()
foreign import ccall glfwSleep :: CDouble -> IO ()
foreign import ccall glfwGetGLVersion :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall glfwEnable :: CInt -> IO ()
foreign import ccall glfwDisable :: CInt -> IO ()
type GlfwCharCallback = CInt -> CInt -> IO ()
type GlfwKeyCallback = CInt -> CInt -> IO ()
type GlfwMouseButtonCallback = CInt -> CInt -> IO ()
type GlfwMousePositionCallback = CInt -> CInt -> IO ()
type GlfwMouseWheelCallback = CInt -> IO ()
type GlfwWindowCloseCallback = IO CInt
type GlfwWindowRefreshCallback = IO ()
type GlfwWindowSizeCallback = CInt -> CInt -> IO ()
type CharCallback = Char -> Bool -> IO ()
type KeyCallback = Key -> Bool -> IO ()
type MouseButtonCallback = MouseButton -> Bool -> IO ()
type MousePositionCallback = Int -> Int -> IO ()
type MouseWheelCallback = Int -> IO ()
type WindowCloseCallback = IO Bool
type WindowRefreshCallback = IO ()
type WindowSizeCallback = Int -> Int -> IO ()
foreign import ccall "wrapper" wrapCharCallback :: GlfwCharCallback -> IO (FunPtr GlfwCharCallback)
foreign import ccall "wrapper" wrapKeyCallback :: GlfwKeyCallback -> IO (FunPtr GlfwKeyCallback)
foreign import ccall "wrapper" wrapMouseButtonCallback :: GlfwMouseButtonCallback -> IO (FunPtr GlfwMouseButtonCallback)
foreign import ccall "wrapper" wrapMousePositionCallback :: GlfwMousePositionCallback -> IO (FunPtr GlfwMousePositionCallback)
foreign import ccall "wrapper" wrapMouseWheelCallback :: GlfwMouseWheelCallback -> IO (FunPtr GlfwMouseWheelCallback)
foreign import ccall "wrapper" wrapWindowCloseCallback :: GlfwWindowCloseCallback -> IO (FunPtr GlfwWindowCloseCallback)
foreign import ccall "wrapper" wrapWindowRefreshCallback :: GlfwWindowRefreshCallback -> IO (FunPtr GlfwWindowRefreshCallback)
foreign import ccall "wrapper" wrapWindowSizeCallback :: GlfwWindowSizeCallback -> IO (FunPtr GlfwWindowSizeCallback)
initialize :: IO Bool
initialize =
fromC `fmap` glfwInit
terminate :: IO ()
terminate =
glfwTerminate
getVideoMode :: IO VideoMode
getVideoMode =
alloca $ \ptr -> do
glfwGetDesktopMode ptr
peek ptr
getVideoModes :: IO [VideoMode]
getVideoModes =
allocaArray m $ \ptr -> do
n <- glfwGetVideoModes ptr (toC m)
peekArray (fromC n) ptr
where
m = 256
data VideoMode = VideoMode
{ videoMode_width :: Int
, videoMode_height :: Int
, videoMode_numRedBits :: Int
, videoMode_numGreenBits :: Int
, videoMode_numBlueBits :: Int
} deriving (Eq, Ord, Read, Show)
instance Storable VideoMode where
sizeOf _ = (20)
alignment _ = alignment (undefined :: CInt)
peek ptr = do
w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr :: IO CInt
h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr :: IO CInt
r <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr :: IO CInt
g <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr :: IO CInt
b <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr :: IO CInt
return VideoMode
{ videoMode_width = fromC w
, videoMode_height = fromC h
, videoMode_numRedBits = fromC r
, videoMode_numGreenBits = fromC g
, videoMode_numBlueBits = fromC b
}
data OpenGLProfile
= DefaultProfile
| CoreProfile
| CompatibilityProfile
deriving (Eq, Ord, Bounded, Enum, Read, Show)
instance C OpenGLProfile CInt where
toC op = case op of
DefaultProfile -> 0
CoreProfile -> 327681
CompatibilityProfile -> 327682
fromC i = case i of
(327681) -> CoreProfile
(327682) -> CompatibilityProfile
(0) -> DefaultProfile
_ -> makeFromCError "OpenGLProfile" i
openGLContextIsForwardCompatible :: IO Bool
openGLContextIsForwardCompatible =
fromC `fmap` glfwGetWindowParam (131094)
openGLContextIsDebugContext :: IO Bool
openGLContextIsDebugContext =
fromC `fmap` glfwGetWindowParam (131095)
openGLProfile :: IO OpenGLProfile
openGLProfile =
fromC `fmap` glfwGetWindowParam (131096)
openWindow :: DisplayOptions -> IO Bool
openWindow displayOptions = do
let DisplayOptions
{ displayOptions_width = _displayOptions_width
, displayOptions_height = _displayOptions_height
, displayOptions_numRedBits = _displayOptions_numRedBits
, displayOptions_numGreenBits = _displayOptions_numGreenBits
, displayOptions_numBlueBits = _displayOptions_numBlueBits
, displayOptions_numAlphaBits = _displayOptions_numAlphaBits
, displayOptions_numDepthBits = _displayOptions_numDepthBits
, displayOptions_numStencilBits = _displayOptions_numStencilBits
, displayOptions_displayMode = _displayOptions_displayMode
, displayOptions_refreshRate = _displayOptions_refreshRate
, displayOptions_accumNumRedBits = _displayOptions_accumNumRedBits
, displayOptions_accumNumGreenBits = _displayOptions_accumNumGreenBits
, displayOptions_accumNumBlueBits = _displayOptions_accumNumBlueBits
, displayOptions_accumNumAlphaBits = _displayOptions_accumNumAlphaBits
, displayOptions_numAuxiliaryBuffers = _displayOptions_numAuxiliaryBuffers
, displayOptions_numFsaaSamples = _displayOptions_numFsaaSamples
, displayOptions_windowIsResizable = _displayOptions_windowIsResizable
, displayOptions_stereoRendering = _displayOptions_stereoRendering
, displayOptions_openGLVersion = _displayOptions_openGLVersion
, displayOptions_openGLForwardCompatible = _displayOptions_openGLForwardCompatible
, displayOptions_openGLDebugContext = _displayOptions_openGLDebugContext
, displayOptions_openGLProfile = _displayOptions_openGLProfile
} = displayOptions
when (isJust _displayOptions_refreshRate) $ glfwOpenWindowHint (131083) (toC (fromJust _displayOptions_refreshRate))
when (isJust _displayOptions_accumNumRedBits) $ glfwOpenWindowHint (131084) (toC (fromJust _displayOptions_accumNumRedBits))
when (isJust _displayOptions_accumNumGreenBits) $ glfwOpenWindowHint (131085) (toC (fromJust _displayOptions_accumNumGreenBits))
when (isJust _displayOptions_accumNumBlueBits) $ glfwOpenWindowHint (131086) (toC (fromJust _displayOptions_accumNumBlueBits))
when (isJust _displayOptions_accumNumAlphaBits) $ glfwOpenWindowHint (131087) (toC (fromJust _displayOptions_accumNumAlphaBits))
when (isJust _displayOptions_numAuxiliaryBuffers) $ glfwOpenWindowHint (131088) (toC (fromJust _displayOptions_numAuxiliaryBuffers))
when (isJust _displayOptions_numFsaaSamples) $ glfwOpenWindowHint (131091) (toC (fromJust _displayOptions_numFsaaSamples))
glfwOpenWindowHint (131090) (toC (not _displayOptions_windowIsResizable))
glfwOpenWindowHint (131089) (toC _displayOptions_stereoRendering)
glfwOpenWindowHint (131092) (toC (fst _displayOptions_openGLVersion))
glfwOpenWindowHint (131093) (toC (snd _displayOptions_openGLVersion))
glfwOpenWindowHint (131094) (toC _displayOptions_openGLForwardCompatible)
glfwOpenWindowHint (131095) (toC _displayOptions_openGLDebugContext)
glfwOpenWindowHint (131096) (toC _displayOptions_openGLProfile)
fromC `fmap` glfwOpenWindow
(toC _displayOptions_width)
(toC _displayOptions_height)
(toC _displayOptions_numRedBits)
(toC _displayOptions_numGreenBits)
(toC _displayOptions_numBlueBits)
(toC _displayOptions_numAlphaBits)
(toC _displayOptions_numDepthBits)
(toC _displayOptions_numStencilBits)
(toC _displayOptions_displayMode)
closeWindow :: IO ()
closeWindow =
glfwCloseWindow
setWindowTitle :: String -> IO ()
setWindowTitle t =
withCString t glfwSetWindowTitle
setWindowDimensions :: Int -> Int -> IO ()
setWindowDimensions w h =
glfwSetWindowSize (toC w) (toC h)
setWindowPosition :: Int -> Int -> IO ()
setWindowPosition w h =
glfwSetWindowPos (toC w) (toC h)
iconifyWindow :: IO ()
iconifyWindow =
glfwIconifyWindow
restoreWindow :: IO ()
restoreWindow =
glfwRestoreWindow
swapBuffers :: IO ()
swapBuffers =
glfwSwapBuffers
setWindowBufferSwapInterval :: Int -> IO ()
setWindowBufferSwapInterval =
glfwSwapInterval . toC
data DisplayMode
= Window
| Fullscreen
deriving (Eq, Ord, Bounded, Enum, Read, Show)
instance C DisplayMode CInt where
toC dm = case dm of
Window -> 65537
Fullscreen -> 65538
fromC i = case i of
(65537) -> Window
(65538) -> Fullscreen
_ -> makeFromCError "DisplayMode" i
data DisplayOptions = DisplayOptions
{ displayOptions_width :: Int
, displayOptions_height :: Int
, displayOptions_numRedBits :: Int
, displayOptions_numGreenBits :: Int
, displayOptions_numBlueBits :: Int
, displayOptions_numAlphaBits :: Int
, displayOptions_numDepthBits :: Int
, displayOptions_numStencilBits :: Int
, displayOptions_displayMode :: DisplayMode
, displayOptions_refreshRate :: Maybe Int
, displayOptions_accumNumRedBits :: Maybe Int
, displayOptions_accumNumGreenBits :: Maybe Int
, displayOptions_accumNumBlueBits :: Maybe Int
, displayOptions_accumNumAlphaBits :: Maybe Int
, displayOptions_numAuxiliaryBuffers :: Maybe Int
, displayOptions_numFsaaSamples :: Maybe Int
, displayOptions_windowIsResizable :: Bool
, displayOptions_stereoRendering :: Bool
, displayOptions_openGLVersion :: (Int, Int)
, displayOptions_openGLForwardCompatible :: Bool
, displayOptions_openGLDebugContext :: Bool
, displayOptions_openGLProfile :: OpenGLProfile
} deriving (Eq, Ord, Read, Show)
defaultDisplayOptions :: DisplayOptions
defaultDisplayOptions =
DisplayOptions
{ displayOptions_width = 0
, displayOptions_height = 0
, displayOptions_numRedBits = 0
, displayOptions_numGreenBits = 0
, displayOptions_numBlueBits = 0
, displayOptions_numAlphaBits = 0
, displayOptions_numDepthBits = 0
, displayOptions_numStencilBits = 0
, displayOptions_displayMode = Window
, displayOptions_refreshRate = Nothing
, displayOptions_accumNumRedBits = Nothing
, displayOptions_accumNumGreenBits = Nothing
, displayOptions_accumNumBlueBits = Nothing
, displayOptions_accumNumAlphaBits = Nothing
, displayOptions_numAuxiliaryBuffers = Nothing
, displayOptions_numFsaaSamples = Nothing
, displayOptions_windowIsResizable = True
, displayOptions_stereoRendering = False
, displayOptions_openGLVersion = (1,1)
, displayOptions_openGLForwardCompatible = False
, displayOptions_openGLDebugContext = False
, displayOptions_openGLProfile = DefaultProfile
}
windowIsOpen :: IO Bool
windowIsOpen =
fromC `fmap` glfwGetWindowParam (131073)
windowIsActive :: IO Bool
windowIsActive =
fromC `fmap` glfwGetWindowParam (131074)
windowIsIconified :: IO Bool
windowIsIconified =
fromC `fmap` glfwGetWindowParam (131075)
windowIsResizable :: IO Bool
windowIsResizable =
(not . fromC) `fmap` glfwGetWindowParam (131090)
windowIsHardwareAccelerated :: IO Bool
windowIsHardwareAccelerated =
fromC `fmap` glfwGetWindowParam (131076)
windowSupportsStereoRendering :: IO Bool
windowSupportsStereoRendering =
fromC `fmap` glfwGetWindowParam (131089)
getWindowRefreshRate :: IO Int
getWindowRefreshRate =
fromC `fmap` glfwGetWindowParam (131083)
getWindowDimensions :: IO (Int, Int)
getWindowDimensions =
alloca $ \wp ->
alloca $ \hp -> do
glfwGetWindowSize wp hp
w <- peek wp
h <- peek hp
return (fromC w, fromC h)
getWindowValue :: WindowValue -> IO Int
getWindowValue wn =
fromC `fmap` glfwGetWindowParam (toC wn)
setWindowCloseCallback :: WindowCloseCallback -> IO ()
setWindowCloseCallback cb = do
ccb <- wrapWindowCloseCallback (toC `fmap` cb)
glfwSetWindowCloseCallback ccb
storeCallback windowCloseCallback ccb
setWindowSizeCallback :: WindowSizeCallback -> IO ()
setWindowSizeCallback cb = do
ccb <- wrapWindowSizeCallback (\w h -> cb (fromC w) (fromC h))
glfwSetWindowSizeCallback ccb
storeCallback windowSizeCallback ccb
setWindowRefreshCallback :: WindowRefreshCallback -> IO ()
setWindowRefreshCallback cb = do
ccb <- wrapWindowRefreshCallback cb
glfwSetWindowRefreshCallback ccb
storeCallback windowRefreshCallback ccb
data WindowValue
= NumRedBits
| NumGreenBits
| NumBlueBits
| NumAlphaBits
| NumDepthBits
| NumStencilBits
| NumAccumRedBits
| NumAccumGreenBits
| NumAccumBlueBits
| NumAccumAlphaBits
| NumAuxBuffers
| NumFsaaSamples
deriving (Eq, Ord, Bounded, Enum, Read, Show)
instance C WindowValue CInt where
toC wn = case wn of
NumRedBits -> 131077
NumGreenBits -> 131078
NumBlueBits -> 131079
NumAlphaBits -> 131080
NumDepthBits -> 131081
NumStencilBits -> 131082
NumAccumRedBits -> 131084
NumAccumGreenBits -> 131085
NumAccumBlueBits -> 131086
NumAccumAlphaBits -> 131087
NumAuxBuffers -> 131088
NumFsaaSamples -> 131091
pollEvents :: IO ()
pollEvents =
glfwPollEvents
waitEvents :: IO ()
waitEvents =
glfwWaitEvents
keyIsPressed :: Key -> IO Bool
keyIsPressed k =
fromC `fmap` glfwGetKey (toC k)
setCharCallback :: CharCallback -> IO ()
setCharCallback cb = do
ccb <- wrapCharCallback (\c b -> cb (fromC c) (fromC b))
glfwSetCharCallback ccb
storeCallback charCallback ccb
setKeyCallback :: KeyCallback -> IO ()
setKeyCallback cb = do
ccb <- wrapKeyCallback (\k b -> cb (fromC k) (fromC b))
glfwSetKeyCallback ccb
storeCallback keyCallback ccb
data Key
= CharKey Char
| KeyUnknown
| KeySpace
| KeySpecial
| KeyEsc
| KeyF1
| KeyF2
| KeyF3
| KeyF4
| KeyF5
| KeyF6
| KeyF7
| KeyF8
| KeyF9
| KeyF10
| KeyF11
| KeyF12
| KeyF13
| KeyF14
| KeyF15
| KeyF16
| KeyF17
| KeyF18
| KeyF19
| KeyF20
| KeyF21
| KeyF22
| KeyF23
| KeyF24
| KeyF25
| KeyUp
| KeyDown
| KeyLeft
| KeyRight
| KeyLeftShift
| KeyRightShift
| KeyLeftCtrl
| KeyRightCtrl
| KeyLeftAlt
| KeyRightAlt
| KeyTab
| KeyEnter
| KeyBackspace
| KeyInsert
| KeyDel
| KeyPageup
| KeyPagedown
| KeyHome
| KeyEnd
| KeyPad0
| KeyPad1
| KeyPad2
| KeyPad3
| KeyPad4
| KeyPad5
| KeyPad6
| KeyPad7
| KeyPad8
| KeyPad9
| KeyPadDivide
| KeyPadMultiply
| KeyPadSubtract
| KeyPadAdd
| KeyPadDecimal
| KeyPadEqual
| KeyPadEnter
deriving (Eq, Ord, Read, Show)
instance C Key CInt where
toC k = case k of
CharKey c -> fromIntegral (ord c)
KeyUnknown -> 1
KeySpace -> 32
KeySpecial -> 256
KeyEsc -> 257
KeyF1 -> 258
KeyF2 -> 259
KeyF3 -> 260
KeyF4 -> 261
KeyF5 -> 262
KeyF6 -> 263
KeyF7 -> 264
KeyF8 -> 265
KeyF9 -> 266
KeyF10 -> 267
KeyF11 -> 268
KeyF12 -> 269
KeyF13 -> 270
KeyF14 -> 271
KeyF15 -> 272
KeyF16 -> 273
KeyF17 -> 274
KeyF18 -> 275
KeyF19 -> 276
KeyF20 -> 277
KeyF21 -> 278
KeyF22 -> 279
KeyF23 -> 280
KeyF24 -> 281
KeyF25 -> 282
KeyUp -> 283
KeyDown -> 284
KeyLeft -> 285
KeyRight -> 286
KeyLeftShift -> 287
KeyRightShift -> 288
KeyLeftCtrl -> 289
KeyRightCtrl -> 290
KeyLeftAlt -> 291
KeyRightAlt -> 292
KeyTab -> 293
KeyEnter -> 294
KeyBackspace -> 295
KeyInsert -> 296
KeyDel -> 297
KeyPageup -> 298
KeyPagedown -> 299
KeyHome -> 300
KeyEnd -> 301
KeyPad0 -> 302
KeyPad1 -> 303
KeyPad2 -> 304
KeyPad3 -> 305
KeyPad4 -> 306
KeyPad5 -> 307
KeyPad6 -> 308
KeyPad7 -> 309
KeyPad8 -> 310
KeyPad9 -> 311
KeyPadDivide -> 312
KeyPadMultiply -> 313
KeyPadSubtract -> 314
KeyPadAdd -> 315
KeyPadDecimal -> 316
KeyPadEqual -> 317
KeyPadEnter -> 318
fromC i =
if i < 256
then CharKey (chr (fromIntegral i))
else case i of
(1) -> KeyUnknown
(32) -> KeySpace
(256) -> KeySpecial
(257) -> KeyEsc
(258) -> KeyF1
(259) -> KeyF2
(260) -> KeyF3
(261) -> KeyF4
(262) -> KeyF5
(263) -> KeyF6
(264) -> KeyF7
(265) -> KeyF8
(266) -> KeyF9
(267) -> KeyF10
(268) -> KeyF11
(269) -> KeyF12
(270) -> KeyF13
(271) -> KeyF14
(272) -> KeyF15
(273) -> KeyF16
(274) -> KeyF17
(275) -> KeyF18
(276) -> KeyF19
(277) -> KeyF20
(278) -> KeyF21
(279) -> KeyF22
(280) -> KeyF23
(281) -> KeyF24
(282) -> KeyF25
(283) -> KeyUp
(284) -> KeyDown
(285) -> KeyLeft
(286) -> KeyRight
(287) -> KeyLeftShift
(288) -> KeyRightShift
(289) -> KeyLeftCtrl
(290) -> KeyRightCtrl
(291) -> KeyLeftAlt
(292) -> KeyRightAlt
(293) -> KeyTab
(294) -> KeyEnter
(295) -> KeyBackspace
(296) -> KeyInsert
(297) -> KeyDel
(298) -> KeyPageup
(299) -> KeyPagedown
(300) -> KeyHome
(301) -> KeyEnd
(302) -> KeyPad0
(303) -> KeyPad1
(304) -> KeyPad2
(305) -> KeyPad3
(306) -> KeyPad4
(307) -> KeyPad5
(308) -> KeyPad6
(309) -> KeyPad7
(310) -> KeyPad8
(311) -> KeyPad9
(312) -> KeyPadDivide
(313) -> KeyPadMultiply
(314) -> KeyPadSubtract
(315) -> KeyPadAdd
(316) -> KeyPadDecimal
(317) -> KeyPadEqual
(318) -> KeyPadEnter
_ -> KeyUnknown
mouseButtonIsPressed :: MouseButton -> IO Bool
mouseButtonIsPressed mb =
fromC `fmap` glfwGetMouseButton (toC mb)
getMousePosition :: IO (Int, Int)
getMousePosition =
alloca $ \px ->
alloca $ \py -> do
glfwGetMousePos px py
x <- peek px
y <- peek py
return (fromC x, fromC y)
getMouseWheel :: IO Int
getMouseWheel =
fromC `fmap` glfwGetMouseWheel
setMousePosition :: Int -> Int -> IO ()
setMousePosition x y =
glfwSetMousePos (toC x) (toC y)
setMouseWheel :: Int -> IO ()
setMouseWheel =
glfwSetMouseWheel . toC
setMouseButtonCallback :: MouseButtonCallback -> IO ()
setMouseButtonCallback cb = do
ccb <- wrapMouseButtonCallback (\b p -> cb (fromC b) (fromC p))
glfwSetMouseButtonCallback ccb
storeCallback mouseButtonCallback ccb
setMousePositionCallback :: MousePositionCallback -> IO ()
setMousePositionCallback cb = do
ccb <- wrapMousePositionCallback (\x y -> cb (fromC x) (fromC y))
glfwSetMousePosCallback ccb
storeCallback mousePositionCallback ccb
setMouseWheelCallback :: MouseWheelCallback -> IO ()
setMouseWheelCallback cb = do
ccb <- wrapMouseWheelCallback (cb . fromC)
glfwSetMouseWheelCallback ccb
storeCallback mouseWheelCallback ccb
enableMouseCursor :: IO ()
enableMouseCursor = glfwEnable (196609)
disableMouseCursor :: IO ()
disableMouseCursor = glfwDisable (196609)
data MouseButton
= MouseButton0 | MouseButton1 | MouseButton2 | MouseButton3
| MouseButton4 | MouseButton5 | MouseButton6 | MouseButton7
deriving (Bounded, Enum, Eq, Ord, Read, Show)
instance C MouseButton CInt where
toC mb = case mb of
MouseButton0 -> 0
MouseButton1 -> 1
MouseButton2 -> 2
MouseButton3 -> 3
MouseButton4 -> 4
MouseButton5 -> 5
MouseButton6 -> 6
MouseButton7 -> 7
fromC i = case i of
(0) -> MouseButton0
(1) -> MouseButton1
(2) -> MouseButton2
(3) -> MouseButton3
(4) -> MouseButton4
(5) -> MouseButton5
(6) -> MouseButton6
(7) -> MouseButton7
_ -> makeFromCError "MouseButton" i
joystickIsPresent :: Joystick -> IO Bool
joystickIsPresent j =
fromC `fmap` glfwGetJoystickParam (toC j) (327681)
getNumJoystickAxes :: Joystick -> IO Int
getNumJoystickAxes j =
fromC `fmap` glfwGetJoystickParam (toC j) (327682)
getNumJoystickButtons :: Joystick -> IO Int
getNumJoystickButtons j =
fromC `fmap` glfwGetJoystickParam (toC j) (327683)
getJoystickPosition :: Joystick -> Int -> IO [Float]
getJoystickPosition j m =
if m < 1
then return []
else allocaArray m $ \ptr -> do
n <- fromC `fmap` glfwGetJoystickPos (toC j) ptr (toC m)
a <- peekArray n ptr
return $ map fromC a
joystickButtonsArePressed :: Joystick -> Int -> IO [Bool]
joystickButtonsArePressed j m =
if m < 1
then return []
else allocaArray m $ \ptr -> do
n <- fromC `fmap` glfwGetJoystickButtons (toC j) ptr (toC m)
a <- peekArray n ptr :: IO [CUChar]
return $ map ((glfwPress ==) . fromIntegral) a
data Joystick
= Joystick0 | Joystick1 | Joystick2 | Joystick3
| Joystick4 | Joystick5 | Joystick6 | Joystick7
| Joystick8 | Joystick9 | Joystick10 | Joystick11
| Joystick12 | Joystick13 | Joystick14 | Joystick15
deriving (Bounded, Enum, Eq, Ord, Read, Show)
instance C Joystick CInt where
toC j = case j of
Joystick0 -> 0
Joystick1 -> 1
Joystick2 -> 2
Joystick3 -> 3
Joystick4 -> 4
Joystick5 -> 5
Joystick6 -> 6
Joystick7 -> 7
Joystick8 -> 8
Joystick9 -> 9
Joystick10 -> 10
Joystick11 -> 11
Joystick12 -> 12
Joystick13 -> 13
Joystick14 -> 14
Joystick15 -> 15
fromC i = case i of
(0) -> Joystick0
(1) -> Joystick1
(2) -> Joystick2
(3) -> Joystick3
(4) -> Joystick4
(5) -> Joystick5
(6) -> Joystick6
(7) -> Joystick7
(8) -> Joystick8
(9) -> Joystick9
(10) -> Joystick10
(11) -> Joystick11
(12) -> Joystick12
(13) -> Joystick13
(14) -> Joystick14
(15) -> Joystick15
_ -> makeFromCError "Joystick" i
getTime :: IO Double
getTime =
realToFrac `fmap` glfwGetTime
setTime :: Double -> IO ()
setTime =
glfwSetTime . realToFrac
resetTime :: IO ()
resetTime =
setTime (0 :: Double)
sleep :: Double -> IO ()
sleep =
glfwSleep . realToFrac
getGlfwVersion :: IO Version
getGlfwVersion =
alloca $ \p0 ->
alloca $ \p1 ->
alloca $ \p2 -> do
glfwGetVersion p0 p1 p2
v0 <- fromC `fmap` peek p0
v1 <- fromC `fmap` peek p1
v2 <- fromC `fmap` peek p2
return $ Version [v0, v1, v2] []
getGlVersion :: IO Version
getGlVersion =
alloca $ \p0 ->
alloca $ \p1 ->
alloca $ \p2 -> do
glfwGetGLVersion p0 p1 p2
v0 <- fromC `fmap` peek p0
v1 <- fromC `fmap` peek p1
v2 <- fromC `fmap` peek p2
return $ Version [v0, v1, v2] []
glfwPress :: CInt
glfwPress = 1
class C h c where
toC :: h -> c
fromC :: c -> h
toC = undefined
fromC = undefined
makeFromCError :: (Show c) => String -> c -> a
makeFromCError s c = error (s ++ " fromC: no match for " ++ show c)
instance C Bool CInt where
toC False = 0
toC True = 1
fromC (0) = False
fromC (1) = True
fromC i = makeFromCError "Bool" i
instance C Char CInt where
toC = fromIntegral . ord
fromC = chr . fromIntegral
instance C Float CFloat where
toC = realToFrac
fromC = realToFrac
instance C Int CInt where
toC = fromIntegral
fromC = fromIntegral
charCallback :: IORef (Maybe (FunPtr GlfwCharCallback))
keyCallback :: IORef (Maybe (FunPtr GlfwKeyCallback))
mouseButtonCallback :: IORef (Maybe (FunPtr GlfwMouseButtonCallback))
mousePositionCallback :: IORef (Maybe (FunPtr GlfwMousePositionCallback))
mouseWheelCallback :: IORef (Maybe (FunPtr GlfwMouseWheelCallback))
windowCloseCallback :: IORef (Maybe (FunPtr GlfwWindowCloseCallback))
windowRefreshCallback :: IORef (Maybe (FunPtr GlfwWindowRefreshCallback))
windowSizeCallback :: IORef (Maybe (FunPtr GlfwWindowSizeCallback))
charCallback = unsafePerformIO (newIORef Nothing)
keyCallback = unsafePerformIO (newIORef Nothing)
mouseButtonCallback = unsafePerformIO (newIORef Nothing)
mousePositionCallback = unsafePerformIO (newIORef Nothing)
mouseWheelCallback = unsafePerformIO (newIORef Nothing)
windowCloseCallback = unsafePerformIO (newIORef Nothing)
windowRefreshCallback = unsafePerformIO (newIORef Nothing)
windowSizeCallback = unsafePerformIO (newIORef Nothing)
storeCallback :: IORef (Maybe (FunPtr a)) -> FunPtr a -> IO ()
storeCallback ior cb =
atomicModifyIORef ior (\mcb -> (Just cb, mcb)) >>= maybe (return ()) freeHaskellFunPtr