gloss-1.13.2.2: Graphics/Gloss/Internals/Interface/Backend/GLFW.hs
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
-- | Support for using GLFW as the window manager backend.
module Graphics.Gloss.Internals.Interface.Backend.GLFW
(GLFWState)
where
import Data.IORef
import Data.Maybe (fromJust)
import Control.Concurrent
import Control.Monad
import Graphics.Gloss.Data.Display
import qualified Graphics.UI.GLFW as GLFW
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Control.Exception as X
-- [Note: FreeGlut]
-- ~~~~~~~~~~~~~~~~
-- We use GLUT for font rendering.
-- On freeglut-based installations (usually linux) we need to explicitly
-- initialize GLUT before we can use any of it's functions.
--
--- We also need to deinitialize (exit) GLUT when we close the GLFW
-- window, otherwise opening a gloss window again from GHCi will crash.
-- For the OS X and Windows version of GLUT there are no such restrictions.
--
-- We assume also assume that only linux installations use freeglut.
--
#ifdef linux_HOST_OS
import qualified Graphics.UI.GLUT as GLUT
#endif
import Graphics.Gloss.Internals.Interface.Backend.Types
-- | State of the GLFW backend library.
data GLFWState
= GLFWState
{ -- | Status of Ctrl, Alt or Shift (Up or Down?)
modifiers :: Modifiers
-- | Latest mouse position
, mousePosition :: (Int,Int)
-- | Latest mousewheel position
, mouseWheelPos :: Int
-- | Does the screen need to be redrawn?
, dirtyScreen :: Bool
-- | Action that draws on the screen
, display :: IO ()
-- | Action perforrmed when idling
, idle :: IO ()
-- | The Window Handle
, optWinHdl :: Maybe GLFW.Window
}
-- | Initial GLFW state.
glfwStateInit :: GLFWState
glfwStateInit
= GLFWState
{ modifiers = Modifiers Up Up Up
, mousePosition = (0, 0)
, mouseWheelPos = 0
, dirtyScreen = True
, display = return ()
, idle = return ()
, optWinHdl = Nothing }
-- | Fetch the window handle from the state if it has been initialized.
winHdl :: GLFWState -> GLFW.Window
winHdl state =
case optWinHdl state of
Just handle -> handle
Nothing -> error "GLFW backend: requested uninitialized window handle"
instance Backend GLFWState where
initBackendState = glfwStateInit
initializeBackend = initializeGLFW
exitBackend = exitGLFW
openWindow = openWindowGLFW
dumpBackendState = dumpStateGLFW
installDisplayCallback = installDisplayCallbackGLFW
installWindowCloseCallback = installWindowCloseCallbackGLFW
installReshapeCallback = installReshapeCallbackGLFW
installKeyMouseCallback = installKeyMouseCallbackGLFW
installMotionCallback = installMotionCallbackGLFW
installIdleCallback = installIdleCallbackGLFW
runMainLoop = runMainLoopGLFW
postRedisplay = postRedisplayGLFW
getWindowDimensions = (\ref -> windowHandle ref >>= \win -> GLFW.getWindowSize win)
getScreenSize = getScreenSizeGLFW
elapsedTime = (\_ -> GLFW.getTime >>= \mt -> return $ fromJust mt)
sleep = (\_ sec -> threadDelay (floor (sec * 1000000.0))) --GLFW.sleep sec)
-- Initialise -----------------------------------------------------------------
-- | Initialise the GLFW backend.
initializeGLFW :: IORef GLFWState -> Bool-> IO ()
initializeGLFW _ debug
= do
let simpleErrorCallback e s =
putStrLn $ unwords [ "GLFW backend: ", show e, show s ]
GLFW.setErrorCallback (Just simpleErrorCallback)
_ <- GLFW.init
glfwVersion <- GLFW.getVersion
#ifdef linux_HOST_OS
-- See [Note: FreeGlut] for why we need this.
(_progName, _args) <- GLUT.getArgsAndInitialize
#endif
when debug
$ putStr $ " glfwVersion = " ++ show glfwVersion ++ "\n"
-- Exit -----------------------------------------------------------------------
-- | Tell the GLFW backend to close the window and exit.
exitGLFW :: IORef GLFWState -> IO ()
exitGLFW ref
= do
#ifdef linux_HOST_OS
-- See [Note: FreeGlut] on why we exit GLUT for Linux
GLUT.exit
#endif
win <- windowHandle ref
GLFW.setWindowShouldClose win True
-- Open Window ----------------------------------------------------------------
-- | Open a new window.
openWindowGLFW
:: IORef GLFWState
-> Display
-> IO ()
openWindowGLFW ref (InWindow title (sizeX, sizeY) pos)
= do win <- GLFW.createWindow
sizeX
sizeY
title
Nothing
Nothing
modifyIORef' ref (\s -> s { optWinHdl = win })
uncurry (GLFW.setWindowPos (fromJust win)) pos
GLFW.makeContextCurrent win
-- Try to enable sync-to-vertical-refresh by setting the number
-- of buffer swaps per vertical refresh to 1.
GLFW.swapInterval 1
openWindowGLFW ref FullScreen
= do mon <- GLFW.getPrimaryMonitor
vmode <- GLFW.getVideoMode (fromJust mon)
let sizeX = GLFW.videoModeWidth (fromJust vmode)
let sizeY = GLFW.videoModeHeight (fromJust vmode)
win <- GLFW.createWindow
sizeX
sizeY
""
mon
Nothing
modifyIORef' ref (\s -> s { optWinHdl = win})
GLFW.makeContextCurrent win
-- Try to enable sync-to-vertical-refresh by setting the number
-- of buffer swaps per vertical refresh to 1.
GLFW.swapInterval 1
--GLFW.enableMouseCursor
GLFW.setCursorInputMode (fromJust win) GLFW.CursorInputMode'Normal
windowHandle :: IORef GLFWState -> IO GLFW.Window
windowHandle ref
= do s <- readIORef ref
return $ winHdl s
getScreenSizeGLFW :: IORef GLFWState -> IO (Int,Int)
getScreenSizeGLFW _state = do
monitor <- GLFW.getPrimaryMonitor
vmode <- GLFW.getVideoMode (fromJust monitor)
let sizeX = GLFW.videoModeWidth (fromJust vmode)
let sizeY = GLFW.videoModeHeight (fromJust vmode)
pure (sizeX, sizeY)
-- Dump State -----------------------------------------------------------------
-- | Print out the internal GLFW state.
dumpStateGLFW :: IORef GLFWState -> IO ()
dumpStateGLFW ref
= do win <- windowHandle ref
(ww,wh) <- GLFW.getWindowSize win
-- GLFW-b does not provide a general function to query windowHints
-- could be added by adding additional getWindowHint which
-- uses glfwGetWindowAttrib behind the scenes as has been done
-- already for e.g. getWindowVisible which uses glfwGetWindowAttrib
{-
r <- GLFW.getWindowHint NumRedBits
g <- GLFW.getWindowHint NumGreenBits
b <- GLFW.getWindowHint NumBlueBits
a <- GLFW.getWindowHint NumAlphaBits
let rgbaBD = [r,g,b,a]
depthBD <- GLFW.getWindowHint NumDepthBits
ra <- GLFW.getWindowHint NumAccumRedBits
ga <- GLFW.getWindowHint NumAccumGreenBits
ba <- GLFW.getWindowHint NumAccumBlueBits
aa <- GLFW.getWindowHint NumAccumAlphaBits
let accumBD = [ra,ga,ba,aa]
stencilBD <- GLFW.getWindowHint NumStencilBits
auxBuffers <- GLFW.getWindowHint NumAuxBuffers
fsaaSamples <- GLFW.getWindowHint NumFsaaSamples
putStr $ "* dumpGlfwState\n"
++ " windowWidth = " ++ show ww ++ "\n"
++ " windowHeight = " ++ show wh ++ "\n"
++ " depth rgba = " ++ show rgbaBD ++ "\n"
++ " depth = " ++ show depthBD ++ "\n"
++ " accum = " ++ show accumBD ++ "\n"
++ " stencil = " ++ show stencilBD ++ "\n"
++ " aux Buffers = " ++ show auxBuffers ++ "\n"
++ " FSAA Samples = " ++ show fsaaSamples ++ "\n"
++ "\n"
-}
putStr $ "* dumpGlfwState\n"
++ " windowWidth = " ++ show ww ++ "\n"
++ " windowHeight = " ++ show wh ++ "\n"
++ "\n"
-- Display Callback -----------------------------------------------------------
-- | Callback for when GLFW needs us to redraw the contents of the window.
installDisplayCallbackGLFW
:: IORef GLFWState -> [Callback] -> IO ()
installDisplayCallbackGLFW stateRef callbacks
= modifyIORef' stateRef $ \s -> s
{ display = callbackDisplay stateRef callbacks }
callbackDisplay
:: IORef GLFWState -> [Callback]
-> IO ()
callbackDisplay stateRef callbacks
= do -- clear the display
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
GL.color $ GL.Color4 0 0 0 (1 :: GL.GLfloat)
-- set the OpenGL viewport to account for any HiDPI discrepancy
(width, height) <- windowHandle stateRef >>= GLFW.getFramebufferSize
GL.viewport $= ( GL.Position 0 0
, GL.Size (fromIntegral width) (fromIntegral height))
-- get the display callbacks from the chain
let funs = [f stateRef | (Display f) <- callbacks]
sequence_ funs
return ()
-- Close Callback -------------------------------------------------------------
-- | Callback for when the user closes the window.
-- We can do some cleanup here.
installWindowCloseCallbackGLFW
:: IORef GLFWState -> IO ()
installWindowCloseCallbackGLFW ref
= do win <- windowHandle ref
GLFW.setWindowCloseCallback win (Just winClosed)
where
winClosed :: GLFW.WindowCloseCallback
winClosed _win = do
#ifdef linux_HOST_OS
-- See [Note: FreeGlut] for why we need this.
GLUT.exit
#endif
return ()
-- Reshape --------------------------------------------------------------------
-- | Callback for when the user reshapes the window.
installReshapeCallbackGLFW
:: IORef GLFWState -> [Callback] -> IO ()
installReshapeCallbackGLFW stateRef callbacks
= do win <- windowHandle stateRef
GLFW.setWindowSizeCallback win (Just $ callbackReshape stateRef callbacks)
callbackReshape
:: IORef GLFWState -> [Callback]
-> GLFW.WindowSizeCallback -- = Window -> Int -> Int -> IO ()
callbackReshape glfwState callbacks _win sizeX sizeY
= sequence_
$ map (\f -> f (sizeX, sizeY))
[f glfwState | Reshape f <- callbacks]
-- KeyMouse -----------------------------------------------------------------------
-- | Callbacks for when the user presses a key or moves / clicks the mouse.
-- This is a bit verbose because we have to do impedence matching between
-- GLFW's event system, and the one use by Gloss which was originally
-- based on GLUT. The main problem is that GLUT only provides a single callback
-- slot for character keys, arrow keys, mouse buttons and mouse wheel movement,
-- while GLFW provides a single slot for each.
--
installKeyMouseCallbackGLFW
:: IORef GLFWState -> [Callback]
-> IO ()
installKeyMouseCallbackGLFW stateRef callbacks
= do win <- windowHandle stateRef
GLFW.setKeyCallback win (Just $ callbackKeyboard stateRef callbacks)
GLFW.setCharCallback win (Just $ callbackChar stateRef callbacks)
GLFW.setMouseButtonCallback win (Just $ callbackMouseButton stateRef callbacks)
GLFW.setScrollCallback win (Just $ callbackMouseWheel stateRef callbacks)
-- GLFW calls this on a non-character keyboard action.
callbackKeyboard
:: IORef GLFWState -> [Callback]
-> GLFW.KeyCallback -- = Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ()
-- -> GLFW.Key -> Bool
-- -> IO ()
callbackKeyboard stateRef callbacks _win key _scancode keystateglfw _modifiers
= do let keystate = keystateglfw == GLFW.KeyState'Pressed
(modsSet, GLFWState mods pos _ _ _ _ _)
<- setModifiers stateRef key keystate
let key' = fromGLFW key
let keystate' = if keystate then Down else Up
let isCharKey (Char _) = True
isCharKey _ = False
-- Call the Gloss KeyMouse actions with the new state.
unless (modsSet || isCharKey key' && keystate)
$ sequence_
$ map (\f -> f key' keystate' mods pos)
[f stateRef | KeyMouse f <- callbacks]
setModifiers
:: IORef GLFWState
-> GLFW.Key -> Bool
-> IO (Bool, GLFWState)
setModifiers stateRef key pressed
= do glfwState <- readIORef stateRef
let mods = modifiers glfwState
let mods' = case key of
GLFW.Key'LeftShift -> mods {shift = if pressed then Down else Up}
GLFW.Key'LeftControl -> mods {ctrl = if pressed then Down else Up}
GLFW.Key'LeftAlt -> mods {alt = if pressed then Down else Up}
_ -> mods
if (mods' /= mods)
then do
let glfwState' = glfwState {modifiers = mods'}
writeIORef stateRef glfwState'
return (True, glfwState')
else return (False, glfwState)
-- GLFW calls this on a when the user presses or releases a character key.
callbackChar
:: IORef GLFWState -> [Callback]
-> GLFW.CharCallback
-- Window -> Char -> IO ()
-- -> Char -> Bool -> IO ()
callbackChar stateRef callbacks _win char -- keystate
= do (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef
let key' = charToSpecial char
-- TODO: is this correct? GLFW does not provide the keystate
-- in a character callback, here we asume that its pressed
let keystate = True
-- Only key presses of characters are passed to this callback,
-- character key releases are caught by the 'keyCallback'. This is an
-- intentional feature of GLFW. What this means that a key press of
-- the '>' char (on a US Intl keyboard) is captured by this callback,
-- but a release is captured as a '.' with the shift-modifier in the
-- keyCallback.
let keystate' = if keystate then Down else Up
-- Call all the Gloss KeyMouse actions with the new state.
sequence_
$ map (\f -> f key' keystate' mods pos)
[f stateRef | KeyMouse f <- callbacks]
-- GLFW calls on this when the user clicks or releases a mouse button.
callbackMouseButton
:: IORef GLFWState -> [Callback]
-> GLFW.MouseButtonCallback -- = Window -> MouseButton -> MouseButtonState -> ModifierKeys -> IO ()
callbackMouseButton stateRef callbacks _win key keystate _modifier
= do (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef
let key' = fromGLFW key
let keystate' = if keystate == GLFW.MouseButtonState'Pressed then Down else Up
-- Call all the Gloss KeyMouse actions with the new state.
sequence_
$ map (\f -> f key' keystate' mods pos)
[f stateRef | KeyMouse f <- callbacks]
-- GLFW calls on this when the user moves the mouse wheel.
callbackMouseWheel
:: IORef GLFWState -> [Callback]
-> GLFW.ScrollCallback
-- -> Int
-- -> IO ()
-- ScrollCallback = Window -> Double -> Double -> IO ()
callbackMouseWheel stateRef callbacks _win x _y
= do (key, keystate) <- setMouseWheel stateRef (floor x)
(GLFWState mods pos _ _ _ _ _) <- readIORef stateRef
-- Call all the Gloss KeyMouse actions with the new state.
sequence_
$ map (\f -> f key keystate mods pos)
[f stateRef | KeyMouse f <- callbacks]
setMouseWheel
:: IORef GLFWState
-> Int
-> IO (Key, KeyState)
setMouseWheel stateRef w
= do glfwState <- readIORef stateRef
writeIORef stateRef $ glfwState {mouseWheelPos = w}
case compare w (mouseWheelPos glfwState) of
LT -> return (MouseButton WheelDown , Down)
GT -> return (MouseButton WheelUp , Down)
EQ -> return (SpecialKey KeyUnknown, Up )
-- Motion Callback ------------------------------------------------------------
-- | Callback for when the user moves the mouse.
installMotionCallbackGLFW
:: IORef GLFWState -> [Callback]
-> IO ()
installMotionCallbackGLFW stateRef callbacks
= do win <- windowHandle stateRef
GLFW.setCursorPosCallback win (Just $ callbackMotion stateRef callbacks)
--CursorPosCallback = Window -> Double -> Double -> IO ()
callbackMotion
:: IORef GLFWState -> [Callback]
-> GLFW.CursorPosCallback
callbackMotion stateRef callbacks _win x y
= do pos <- setMousePos stateRef (floor x) (floor y)
-- Call all the Gloss Motion actions with the new state.
sequence_
$ map (\f -> f pos)
[f stateRef | Motion f <- callbacks]
setMousePos
:: IORef GLFWState
-> Int -> Int
-> IO (Int, Int)
setMousePos stateRef x y
= do let pos = (x,y)
modifyIORef' stateRef $ \s -> s
{ mousePosition = pos }
return pos
-- Idle Callback --------------------------------------------------------------
-- | Callback for when GLFW has finished its jobs and it's time for us to do
-- something for our application.
installIdleCallbackGLFW
:: IORef GLFWState -> [Callback]
-> IO ()
installIdleCallbackGLFW stateRef callbacks
= modifyIORef' stateRef $ \s -> s
{ idle = callbackIdle stateRef callbacks }
callbackIdle
:: IORef GLFWState -> [Callback]
-> IO ()
callbackIdle stateRef callbacks
= sequence_
$ [f stateRef | Idle f <- callbacks]
-- Main Loop ------------------------------------------------------------------
runMainLoopGLFW :: IORef GLFWState -> IO ()
runMainLoopGLFW stateRef = do
X.catch go handleException
GLFW.destroyWindow =<< windowHandle stateRef
GLFW.terminate
where
handleException :: X.SomeException -> IO ()
handleException = print
clearDirtyFlag :: IO ()
clearDirtyFlag = modifyIORef'
stateRef
(\state -> state { dirtyScreen = False })
display' :: IO ()
display' = readIORef stateRef >>= display
idle' :: IO ()
idle' = readIORef stateRef >>= idle
swapBuffers' :: IO ()
swapBuffers' = windowHandle stateRef >>= GLFW.swapBuffers
windowShouldClose :: IO Bool
windowShouldClose = windowHandle stateRef >>= GLFW.windowShouldClose
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM testAction action = do
sentinel <- testAction
unless sentinel action
go :: IO ()
go = do
-- Perform drawing, clear the dirty flag, do idle processing
display'
clearDirtyFlag
idle'
-- Swap buffers. This swaps the GL buffers and will block
-- until the next v-sync. In GLFW, this effectively pegs the
-- maximum frame rate to 60fps, but will also stop the
-- application from consuming 100% CPU.
swapBuffers'
-- Poll for GLFW events; quit if necessary.
GLFW.pollEvents
unlessM windowShouldClose go
-- Redisplay ------------------------------------------------------------------
postRedisplayGLFW
:: IORef GLFWState
-> IO ()
postRedisplayGLFW stateRef
= modifyIORef' stateRef $ \s -> s
{ dirtyScreen = True }
-- Key Code Conversion --------------------------------------------------------
class GLFWKey a where
fromGLFW :: a -> Key
instance GLFWKey GLFW.Key where
fromGLFW key
= case key of
GLFW.Key'A -> charToSpecial 'a'
GLFW.Key'B -> charToSpecial 'b'
GLFW.Key'C -> charToSpecial 'c'
GLFW.Key'D -> charToSpecial 'd'
GLFW.Key'E -> charToSpecial 'e'
GLFW.Key'F -> charToSpecial 'f'
GLFW.Key'G -> charToSpecial 'g'
GLFW.Key'H -> charToSpecial 'h'
GLFW.Key'I -> charToSpecial 'i'
GLFW.Key'J -> charToSpecial 'j'
GLFW.Key'K -> charToSpecial 'k'
GLFW.Key'L -> charToSpecial 'l'
GLFW.Key'M -> charToSpecial 'm'
GLFW.Key'N -> charToSpecial 'n'
GLFW.Key'O -> charToSpecial 'o'
GLFW.Key'P -> charToSpecial 'p'
GLFW.Key'Q -> charToSpecial 'q'
GLFW.Key'R -> charToSpecial 'r'
GLFW.Key'S -> charToSpecial 's'
GLFW.Key'T -> charToSpecial 't'
GLFW.Key'U -> charToSpecial 'u'
GLFW.Key'V -> charToSpecial 'v'
GLFW.Key'W -> charToSpecial 'w'
GLFW.Key'X -> charToSpecial 'x'
GLFW.Key'Y -> charToSpecial 'y'
GLFW.Key'Z -> charToSpecial 'z'
GLFW.Key'Space -> SpecialKey KeySpace
GLFW.Key'Escape -> SpecialKey KeyEsc
GLFW.Key'F1 -> SpecialKey KeyF1
GLFW.Key'F2 -> SpecialKey KeyF2
GLFW.Key'F3 -> SpecialKey KeyF3
GLFW.Key'F4 -> SpecialKey KeyF4
GLFW.Key'F5 -> SpecialKey KeyF5
GLFW.Key'F6 -> SpecialKey KeyF6
GLFW.Key'F7 -> SpecialKey KeyF7
GLFW.Key'F8 -> SpecialKey KeyF8
GLFW.Key'F9 -> SpecialKey KeyF9
GLFW.Key'F10 -> SpecialKey KeyF10
GLFW.Key'F11 -> SpecialKey KeyF11
GLFW.Key'F12 -> SpecialKey KeyF12
GLFW.Key'F13 -> SpecialKey KeyF13
GLFW.Key'F14 -> SpecialKey KeyF14
GLFW.Key'F15 -> SpecialKey KeyF15
GLFW.Key'F16 -> SpecialKey KeyF16
GLFW.Key'F17 -> SpecialKey KeyF17
GLFW.Key'F18 -> SpecialKey KeyF18
GLFW.Key'F19 -> SpecialKey KeyF19
GLFW.Key'F20 -> SpecialKey KeyF20
GLFW.Key'F21 -> SpecialKey KeyF21
GLFW.Key'F22 -> SpecialKey KeyF22
GLFW.Key'F23 -> SpecialKey KeyF23
GLFW.Key'F24 -> SpecialKey KeyF24
GLFW.Key'F25 -> SpecialKey KeyF25
GLFW.Key'Up -> SpecialKey KeyUp
GLFW.Key'Down -> SpecialKey KeyDown
GLFW.Key'Left -> SpecialKey KeyLeft
GLFW.Key'Right -> SpecialKey KeyRight
GLFW.Key'Tab -> SpecialKey KeyTab
GLFW.Key'Enter -> SpecialKey KeyEnter
GLFW.Key'Backspace -> SpecialKey KeyBackspace
GLFW.Key'Insert -> SpecialKey KeyInsert
GLFW.Key'Delete -> SpecialKey KeyDelete
GLFW.Key'PageUp -> SpecialKey KeyPageUp
GLFW.Key'PageDown -> SpecialKey KeyPageDown
GLFW.Key'Home -> SpecialKey KeyHome
GLFW.Key'End -> SpecialKey KeyEnd
GLFW.Key'Pad0 -> SpecialKey KeyPad0
GLFW.Key'Pad1 -> SpecialKey KeyPad1
GLFW.Key'Pad2 -> SpecialKey KeyPad2
GLFW.Key'Pad3 -> SpecialKey KeyPad3
GLFW.Key'Pad4 -> SpecialKey KeyPad4
GLFW.Key'Pad5 -> SpecialKey KeyPad5
GLFW.Key'Pad6 -> SpecialKey KeyPad6
GLFW.Key'Pad7 -> SpecialKey KeyPad7
GLFW.Key'Pad8 -> SpecialKey KeyPad8
GLFW.Key'Pad9 -> SpecialKey KeyPad9
GLFW.Key'PadDivide -> SpecialKey KeyPadDivide
GLFW.Key'PadMultiply -> SpecialKey KeyPadMultiply
GLFW.Key'PadSubtract -> SpecialKey KeyPadSubtract
GLFW.Key'PadAdd -> SpecialKey KeyPadAdd
GLFW.Key'PadDecimal -> SpecialKey KeyPadDecimal
GLFW.Key'PadEqual -> Char '='
GLFW.Key'PadEnter -> SpecialKey KeyPadEnter
_ -> SpecialKey KeyUnknown
-- | Convert char keys to special keys to work around a bug in
-- GLFW 2.7. On OS X, GLFW sometimes registers special keys as char keys,
-- so we convert them back here.
-- GLFW 2.7 is current as of Nov 2011, and is shipped with the Hackage
-- binding GLFW-b 0.2.*
charToSpecial :: Char -> Key
charToSpecial c = case (fromEnum c) of
32 -> SpecialKey KeySpace
63232 -> SpecialKey KeyUp
63233 -> SpecialKey KeyDown
63234 -> SpecialKey KeyLeft
63235 -> SpecialKey KeyRight
63236 -> SpecialKey KeyF1
63237 -> SpecialKey KeyF2
63238 -> SpecialKey KeyF3
63239 -> SpecialKey KeyF4
63240 -> SpecialKey KeyF5
63241 -> SpecialKey KeyF6
63242 -> SpecialKey KeyF7
63243 -> SpecialKey KeyF8
63244 -> SpecialKey KeyF9
63245 -> SpecialKey KeyF10
63246 -> SpecialKey KeyF11
63247 -> SpecialKey KeyF12
63248 -> SpecialKey KeyF13
63272 -> SpecialKey KeyDelete
63273 -> SpecialKey KeyHome
63275 -> SpecialKey KeyEnd
63276 -> SpecialKey KeyPageUp
63277 -> SpecialKey KeyPageDown
_ -> Char c
instance GLFWKey GLFW.MouseButton where
fromGLFW mouse
= case mouse of
GLFW.MouseButton'1 -> MouseButton LeftButton
GLFW.MouseButton'2 -> MouseButton RightButton
GLFW.MouseButton'3 -> MouseButton MiddleButton
GLFW.MouseButton'4 -> MouseButton $ AdditionalButton 4
GLFW.MouseButton'5 -> MouseButton $ AdditionalButton 5
GLFW.MouseButton'6 -> MouseButton $ AdditionalButton 6
GLFW.MouseButton'7 -> MouseButton $ AdditionalButton 7
GLFW.MouseButton'8 -> MouseButton $ AdditionalButton 8