Moved source files to src directory
This commit is contained in:
parent
2bb8561836
commit
7327695ca3
14 changed files with 3 additions and 6 deletions
67
src/GLDriver.hs
Normal file
67
src/GLDriver.hs
Normal file
|
@ -0,0 +1,67 @@
|
|||
{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}
|
||||
|
||||
module GLDriver ( Driver(..)
|
||||
, SomeDriver(..)
|
||||
, Event
|
||||
, SomeEvent(..)
|
||||
, fromEvent
|
||||
, QuitEvent(..)
|
||||
, Key(..)
|
||||
, KeyPressEvent(..)
|
||||
, KeyReleaseEvent(..)
|
||||
, MouseMotionEvent(..)
|
||||
, MousePressEvent(..)
|
||||
) where
|
||||
|
||||
import Data.Typeable
|
||||
|
||||
|
||||
class Driver a where
|
||||
initialized :: a -> Bool
|
||||
|
||||
initGL :: a -> IO a
|
||||
deinitGL :: a -> IO ()
|
||||
|
||||
swapBuffers :: a -> IO ()
|
||||
|
||||
nextEvent :: a -> IO (a, Maybe SomeEvent)
|
||||
|
||||
data SomeDriver = forall d. Driver d => SomeDriver d
|
||||
|
||||
instance Driver SomeDriver where
|
||||
initialized (SomeDriver d) = initialized d
|
||||
initGL (SomeDriver d) = initGL d >>= return . SomeDriver
|
||||
deinitGL (SomeDriver d) = deinitGL d
|
||||
swapBuffers (SomeDriver d) = swapBuffers d
|
||||
nextEvent (SomeDriver d) = nextEvent d >>= \(gl, ev) -> return (SomeDriver gl, ev)
|
||||
|
||||
|
||||
class (Typeable a, Show a) => Event a
|
||||
|
||||
data SomeEvent = forall a. Event a => SomeEvent a
|
||||
instance Show SomeEvent where
|
||||
show (SomeEvent a) = show a
|
||||
|
||||
fromEvent :: Event a => SomeEvent -> Maybe a
|
||||
fromEvent (SomeEvent a) = cast a
|
||||
|
||||
|
||||
data QuitEvent = QuitEvent deriving (Typeable, Show)
|
||||
instance Event QuitEvent
|
||||
|
||||
|
||||
data Key = KeyLeft | KeyRight | KeyUp | KeyDown
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data KeyPressEvent = KeyPressEvent Key deriving (Typeable, Show)
|
||||
instance Event KeyPressEvent
|
||||
|
||||
data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show)
|
||||
instance Event KeyReleaseEvent
|
||||
|
||||
|
||||
data MouseMotionEvent = MouseMotionEvent Float Float deriving (Typeable, Show)
|
||||
instance Event MouseMotionEvent
|
||||
|
||||
data MousePressEvent = MousePressEvent Float Float deriving (Typeable, Show)
|
||||
instance Event MousePressEvent
|
Reference in a new issue