1 files changed, 67 insertions, 0 deletions
diff --git a/src/GLDriver.hs b/src/GLDriver.hs
new file mode 100644
index 0000000..7340075
--- /dev/null
+++ b/src/GLDriver.hs
@@ -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