summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--DefaultPlayer.hs26
-rw-r--r--GLDriver.hs10
-rw-r--r--GLX.hs93
-rw-r--r--HTanks.hs3
-rw-r--r--Render.hs1
5 files changed, 75 insertions, 58 deletions
diff --git a/DefaultPlayer.hs b/DefaultPlayer.hs
index d1c1e24..6f80096 100644
--- a/DefaultPlayer.hs
+++ b/DefaultPlayer.hs
@@ -14,22 +14,22 @@ import Player
import Tank
-data DefaultPlayer = DefaultPlayer (S.Set Key) Micro Micro
+data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float
deriving (Typeable, Show)
instance Player DefaultPlayer where
- playerUpdate (DefaultPlayer keys aimx aimy) tank = playerUpdate' keys aimx aimy tank
+ playerUpdate (DefaultPlayer keys aimx aimy) tank =
+ let x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0)
+ y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0)
+ ax = aimx - (fromRational . toRational $ posx tank)
+ ay = aimy - (fromRational . toRational $ posy tank)
+ move = (x /= 0 || y /= 0)
+ angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing
+ aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing
+ in (DefaultPlayer keys aimx aimy, angle, move, aangle)
handleEvent (DefaultPlayer keys aimx aimy) ev
- | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy
- | Just (KeyReleaseEvent key) <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy
+ | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy
+ | Just (KeyReleaseEvent key) <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy
+ | Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y
| otherwise = DefaultPlayer keys aimx aimy
-
-
-playerUpdate' :: S.Set Key -> Micro -> Micro -> Tank -> (DefaultPlayer, Maybe Micro, Bool, Maybe Micro)
-playerUpdate' keys aimx aimy tank = (DefaultPlayer keys aimx aimy, angle, move, Nothing)
- where
- x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0)
- y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0)
- move = (x /= 0 || y /= 0)
- angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing
diff --git a/GLDriver.hs b/GLDriver.hs
index f4dca5e..ce84563 100644
--- a/GLDriver.hs
+++ b/GLDriver.hs
@@ -6,10 +6,10 @@ module GLDriver ( Driver(..)
, SomeEvent(..)
, fromEvent
, QuitEvent(..)
- --, ResizeEvent(..)
, Key(..)
, KeyPressEvent(..)
, KeyReleaseEvent(..)
+ , MouseMotionEvent(..)
) where
import Data.Typeable
@@ -23,7 +23,7 @@ class Driver a where
swapBuffers :: a -> IO ()
- nextEvent :: a -> IO (Maybe SomeEvent)
+ nextEvent :: a -> IO (a, Maybe SomeEvent)
data SomeDriver = forall d. Driver d => SomeDriver d
@@ -32,7 +32,7 @@ instance Driver SomeDriver where
initGL (SomeDriver d) = initGL d >>= return . SomeDriver
deinitGL (SomeDriver d) = deinitGL d
swapBuffers (SomeDriver d) = swapBuffers d
- nextEvent (SomeDriver d) = nextEvent d
+ nextEvent (SomeDriver d) = nextEvent d >>= \(gl, ev) -> return (SomeDriver gl, ev)
class (Typeable a, Show a) => Event a
@@ -57,3 +57,7 @@ instance Event KeyPressEvent
data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show)
instance Event KeyReleaseEvent
+
+
+data MouseMotionEvent = MouseMotionEvent Float Float deriving (Typeable, Show)
+instance Event MouseMotionEvent \ No newline at end of file
diff --git a/GLX.hs b/GLX.hs
index 4e9abc4..affc185 100644
--- a/GLX.hs
+++ b/GLX.hs
@@ -8,6 +8,7 @@ import Control.Monad (when, unless)
import Data.Bits ((.|.))
import Data.Maybe (isJust)
+import Data.Ratio
import Graphics.Rendering.OpenGL.GL (($=), GLdouble, Capability(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
@@ -16,7 +17,7 @@ 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)
+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)
@@ -32,7 +33,7 @@ data GLX = GLX
, glxWindow :: !Window
, glxContext :: !Context
, glxDeleteWindow :: !Atom
- , glxScale :: !GLdouble
+ , glxScale :: !Rational
}
glxDriver :: GLX
@@ -82,14 +83,14 @@ instance Driver GLX where
ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True
makeCurrent disp wnd ctx
- resize 800 600
+ s <- resize 800 600
return GLX
{ glxDisplay = disp
, glxWindow = wnd
, glxContext = ctx
, glxDeleteWindow = delwnd
- , glxScale = 1
+ , glxScale = s
}
deinitGL glx = do
@@ -101,68 +102,80 @@ instance Driver GLX where
nextEvent glx = allocaXEvent $ nextEvent' glx
-nextEvent' :: GLX -> XEventPtr -> IO (Maybe SomeEvent)
+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
- ev <- handleEvent glx xevent
+ (newglx, ev) <- handleEvent glx xevent
if isJust ev then
- return ev
+ return (newglx, ev)
else
- nextEvent' glx xevent
+ nextEvent' newglx xevent
else
- return Nothing
+ return (glx, Nothing)
-handleEvent :: GLX -> XEventPtr -> IO (Maybe SomeEvent)
+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
- resize (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event)
- return Nothing
+ s <- resize (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 $ Just $ SomeEvent QuitEvent
- | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyPressEvent KeyUp
- | keysym == xK_Down -> return $ Just $ SomeEvent $ KeyPressEvent KeyDown
- | keysym == xK_Left -> return $ Just $ SomeEvent $ KeyPressEvent KeyLeft
- | keysym == xK_Right -> return $ Just $ SomeEvent $ KeyPressEvent KeyRight
- | otherwise -> return Nothing
+ 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)
+ | otherwise -> return (glx, Nothing)
| evtype == keyRelease -> do
- keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0
- case () of
- _ | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyUp
- | keysym == xK_Down -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyDown
- | keysym == xK_Left -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyLeft
- | keysym == xK_Right -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyRight
- | otherwise -> return Nothing
+ 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)
+ | otherwise -> return (glx, Nothing)
| evtype == clientMessage -> do
- if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event))
- then
- return $ Just $ SomeEvent QuitEvent
- else
- return Nothing
- | otherwise -> return Nothing
-
-
-resize :: Int -> Int -> IO ()
+ if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event))
+ then
+ return (glx, Just $ SomeEvent QuitEvent)
+ else
+ return (glx, Nothing)
+ | evtype == motionNotify -> do
+ wa <- getWindowAttributes (glxDisplay glx) (glxWindow glx)
+ let x = fromIntegral . ev_x $ event
+ y = fromIntegral . ev_y $ event
+ w = fromIntegral . wa_width $ wa
+ h = fromIntegral . wa_height $ wa
+ s = fromRational . glxScale $ glx
+ return (glx, Just $ SomeEvent $ MouseMotionEvent ((x-w/2)/s) ((-y+h/2)/s))
+ | otherwise -> return (glx, Nothing)
+
+
+resize :: Int -> Int -> IO Rational
resize w h = do
- let aspect = (fromIntegral w)/(fromIntegral h)
- s = max (5/aspect) 5 :: GLdouble
+ let size = 5
+ aspect = (fromIntegral w)%(fromIntegral h)
+ s = max (size/aspect) size
+ sf = fromRational s
+ aspectf = fromRational aspect
matrixMode $= Projection
loadIdentity
- ortho (-s*aspect) (s*aspect) (-s) s (-1) 1
+ ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
matrixMode $= Modelview 0
viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h)))
-
+
+ return $ (fromIntegral h)/(s*2)
waitForMapNotify :: Display -> Window -> IO ()
waitForMapNotify disp wnd = allocaXEvent waitForMapNotify'
diff --git a/HTanks.hs b/HTanks.hs
index 1bbae03..c27cb81 100644
--- a/HTanks.hs
+++ b/HTanks.hs
@@ -164,7 +164,8 @@ simulationStep = do
handleEvents :: Main ()
handleEvents = do
- event <- gets driver >>= liftIO . nextEvent
+ (newgl, event) <- gets driver >>= liftIO . nextEvent
+ modify $ \state -> state {driver = newgl}
when (isJust event) $ do
Main.handleEvent $ fromJust event
modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state}
diff --git a/Render.hs b/Render.hs
index 145dc8b..6505734 100644
--- a/Render.hs
+++ b/Render.hs
@@ -1,5 +1,4 @@
module Render ( setup
- --, resize
, render
) where