Moved source files to src directory

1 files changed, 0 insertions, 214 deletions

diff --git a/GLX.hs b/GLX.hs
deleted file mode 100644
index 6f5b0fc..0000000
--- a/GLX.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-module GLX ( glxDriver
-           ) where
-
-import GLDriver
-import Bindings.GLX
-
-import Control.Monad (when, unless)
-
-import Data.Bits ((.|.))
-import Data.Maybe (isJust)
-import Data.Ratio
-
-import Graphics.Rendering.OpenGL.GL (($=), GLdouble, GLfloat, Vector3(..), Capability(..))
-import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate)
-
-import Graphics.X11.Types
-import Graphics.X11.Xlib.Atom (internAtom)
-import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow)
-import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending)
-import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data, ev_x, ev_y, getWindowAttributes, wa_width, wa_height)
-import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols)
-import Graphics.X11.Xlib.Types
-import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName)
-
-import Foreign.Marshal.Utils (with)
-import Foreign.Ptr
-import Foreign.Storable
-
-
-
-data GLX = GLX
-    { glxDisplay     :: !Display
-    , glxWindow      :: !Window
-    , glxContext     :: !Context
-    , glxDeleteWindow :: !Atom
-    , glxScale       :: !Rational
-    , glxLevelWidth  :: !Int
-    , glxLevelHeight :: !Int
-    }
-
-glxDriver :: Int -> Int -> GLX
-glxDriver w h = GLX
-            { glxDisplay = Display nullPtr
-            , glxWindow = 0
-            , glxContext = Context nullPtr
-            , glxDeleteWindow = 0
-            , glxScale = 1
-            , glxLevelWidth = w
-            , glxLevelHeight = h
-            }
-
-
-instance Driver GLX where
-    initialized glx = ((glxContext glx) /= (Context nullPtr))
-    
-    initGL glx = do
-      when (initialized glx) $ fail "GLX already initialized"
-      
-      disp <- openDisplay ""
-      delwnd <- internAtom disp "WM_DELETE_WINDOW" False
-      fbconfigs <- chooseFBConfig disp (fromIntegral . defaultScreen $ disp)
-                    [ (renderType, rgbaBit)
-                    , (drawableType, windowBit)
-                    , (doublebuffer, 1)
-                    , (xRenderable, 1)
-                    , (depthSize, 1)
-                    , (stencilSize, 1)
-                    ]
-      visualinfo <- getVisualFromFBConfig disp (head fbconfigs)
-      rootwindow <- rootWindow disp (fromIntegral $ viScreen visualinfo)
-      cmap <- createColormap disp rootwindow (viVisual visualinfo) allocNone
-      
-      let swa = nullSetWindowAttributes {swaColormap = cmap, swaEventMask = structureNotifyMask .|. keyPressMask .|. keyReleaseMask .|. pointerMotionMask .|. buttonPressMask}
-      
-      wnd <- with swa $ \swaptr ->
-             createWindow disp rootwindow 0 0 800 600 0 (fromIntegral $ viDepth visualinfo) inputOutput (viVisual visualinfo) (cWBorderPixel.|.cWColormap.|.cWEventMask) swaptr
-      
-      setClassHint disp wnd (ClassHint "HTanks" "htanks")
-      setWMProtocols disp wnd [delwnd]
-      
-      storeName disp wnd "HTanks"
-      
-      mapWindow disp wnd
-      
-      waitForMapNotify disp wnd
-      
-      ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True
-      makeCurrent disp wnd ctx
-      
-      wa <- getWindowAttributes disp wnd
-      s <- resize (glxLevelWidth glx) (glxLevelHeight glx) (fromIntegral . wa_width $ wa) (fromIntegral . wa_height $ wa)
-      
-      return glx
-                 { glxDisplay = disp
-                 , glxWindow = wnd
-                 , glxContext = ctx
-                 , glxDeleteWindow = delwnd
-                 , glxScale = s
-                 }
-
-    deinitGL glx = do
-                      destroyWindow (glxDisplay glx) (glxWindow glx)
-                      destroyContext (glxDisplay glx) (glxContext glx)
-    
-    swapBuffers glx = Bindings.GLX.swapBuffers (glxDisplay glx) (glxWindow glx)
-    
-    nextEvent glx = allocaXEvent $ nextEvent' glx
-
-
-nextEvent' :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent)
-nextEvent' glx xevent = do
-  p <- pending $ glxDisplay glx
-  if (p > 0) then do
-               Graphics.X11.Xlib.Event.nextEvent (glxDisplay glx) xevent
-               (newglx, ev) <- handleEvent glx xevent
-               
-               if isJust ev then
-                   return (newglx, ev)
-                            else
-                   nextEvent' newglx xevent
-             else
-               return (glx, Nothing)
-
-
-handleEvent :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent)
-handleEvent glx xevent = do
-  event <- getEvent xevent
-  let evtype = ev_event_type event
-  case () of
-    _ | evtype == configureNotify -> do
-                           s <- resize (glxLevelWidth glx) (glxLevelHeight glx) (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event)
-                           return (glx {glxScale = s}, Nothing)
-      | evtype == keyPress        -> do
-                           keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0
-                           case () of
-                             _ | keysym == xK_Escape -> return (glx, Just $ SomeEvent QuitEvent)
-                               | keysym == xK_Up     -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyUp)
-                               | keysym == xK_Down   -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyDown)
-                               | keysym == xK_Left   -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyLeft)
-                               | keysym == xK_Right  -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyRight)
-                               | keysym == xK_w      -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyUp)
-                               | keysym == xK_s      -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyDown)
-                               | keysym == xK_a      -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyLeft)
-                               | keysym == xK_d      -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyRight)
-                               | otherwise           -> return (glx, Nothing)
-      | evtype == keyRelease      -> do
-                           keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0
-                           case () of
-                             _ | keysym == xK_Up     -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyUp)
-                               | keysym == xK_Down   -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyDown)
-                               | keysym == xK_Left   -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyLeft)
-                               | keysym == xK_Right  -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyRight)
-                               | keysym == xK_w      -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyUp)
-                               | keysym == xK_s      -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyDown)
-                               | keysym == xK_a      -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyLeft)
-                               | keysym == xK_d      -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyRight)
-                               | otherwise           -> return (glx, Nothing)
-      | evtype == clientMessage   -> do
-                           if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event))
-                               then
-                                   return (glx, Just $ SomeEvent QuitEvent)
-                               else
-                                   return (glx, Nothing)
-      | evtype == motionNotify    -> do
-                           (x, y) <- windowToGameCoords glx (ev_x event) (ev_y event)
-                           wa <- getWindowAttributes (glxDisplay glx) (glxWindow glx)
-                           return (glx, Just $ SomeEvent $ MouseMotionEvent x y)
-      | evtype == buttonPress     -> do
-                           (x, y) <- windowToGameCoords glx (ev_x event) (ev_y event)
-                           wa <- getWindowAttributes (glxDisplay glx) (glxWindow glx)
-                           return (glx, Just $ SomeEvent $ MousePressEvent x y)
-
-      | otherwise -> return (glx, Nothing)
-
-
-windowToGameCoords :: Integral a => GLX -> a -> a -> IO (Float, Float)
-windowToGameCoords glx x y = getWindowAttributes (glxDisplay glx) (glxWindow glx) >>= \wa ->
-                             let w = fromIntegral . wa_width $ wa
-                                 h = fromIntegral . wa_height $ wa
-                             in return (((-w/2 + wx)/s + lw/2), ((h/2 - wy)/s + lh/2))
-                                 where s = fromRational . glxScale $ glx
-                                       lw = fromIntegral . glxLevelWidth $ glx
-                                       lh = fromIntegral . glxLevelHeight $ glx
-                                       wx = fromIntegral x
-                                       wy = fromIntegral y
-
-
-resize :: Int -> Int -> Int -> Int -> IO Rational
-resize lw lh w h = do
-  let aspect = (fromIntegral w)%(fromIntegral h)
-      s = (max ((fromIntegral lw)/aspect) (fromIntegral lh))/2
-      sf = fromRational s
-      aspectf = fromRational aspect
-  
-  matrixMode $= Projection
-  loadIdentity
-  ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
-  translate $ Vector3 (-(fromIntegral lw)/2) (-(fromIntegral lh)/2) (0 :: GLfloat)
-  
-  matrixMode $= Modelview 0
-  
-  viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h)))
-  
-  return $ (fromIntegral h)/(2*s)
-
-waitForMapNotify :: Display -> Window -> IO ()
-waitForMapNotify disp wnd = allocaXEvent waitForMapNotify'
-    where
-      waitForMapNotify' event = do
-        Graphics.X11.Xlib.Event.nextEvent disp event
-        window <- get_Window event
-        eventType <- get_EventType event
-        unless (window == wnd && eventType == mapNotify) $
-               waitForMapNotify' event