neocturne/htanks
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Aim with mouse in DefaultPlayer

Browse source
This commit is contained in:
Matthias Schiffer 2010-03-05 04:38:31 +01:00
parent 1020310190
commit 0fb75af682
5 changed files with 73 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
DefaultPlayer.hs
View file

@ -14,22 +14,22 @@ import Player
import Tank import Tank
data DefaultPlayer = DefaultPlayer (S.Set Key) Micro Micro data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float
deriving (Typeable, Show) deriving (Typeable, Show)
instance Player DefaultPlayer where 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 handleEvent (DefaultPlayer keys aimx aimy) ev
| Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert 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 (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 | 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

10
GLDriver.hs
View file

@ -6,10 +6,10 @@ module GLDriver ( Driver(..)
, SomeEvent(..) , SomeEvent(..)
, fromEvent , fromEvent
, QuitEvent(..) , QuitEvent(..)
--, ResizeEvent(..)
, Key(..) , Key(..)
, KeyPressEvent(..) , KeyPressEvent(..)
, KeyReleaseEvent(..) , KeyReleaseEvent(..)
, MouseMotionEvent(..)
) where ) where
import Data.Typeable import Data.Typeable
@ -23,7 +23,7 @@ class Driver a where
swapBuffers :: a -> IO () swapBuffers :: a -> IO ()
nextEvent :: a -> IO (Maybe SomeEvent) nextEvent :: a -> IO (a, Maybe SomeEvent)
data SomeDriver = forall d. Driver d => SomeDriver d data SomeDriver = forall d. Driver d => SomeDriver d
@ -32,7 +32,7 @@ instance Driver SomeDriver where
initGL (SomeDriver d) = initGL d >>= return . SomeDriver initGL (SomeDriver d) = initGL d >>= return . SomeDriver
deinitGL (SomeDriver d) = deinitGL d deinitGL (SomeDriver d) = deinitGL d
swapBuffers (SomeDriver d) = swapBuffers 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 class (Typeable a, Show a) => Event a
@ -57,3 +57,7 @@ instance Event KeyPressEvent
data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show) data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show)
instance Event KeyReleaseEvent instance Event KeyReleaseEvent
data MouseMotionEvent = MouseMotionEvent Float Float deriving (Typeable, Show)
instance Event MouseMotionEvent

87
GLX.hs
View file

@ -8,6 +8,7 @@ import Control.Monad (when, unless)
import Data.Bits ((.|.)) import Data.Bits ((.|.))
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Ratio
import Graphics.Rendering.OpenGL.GL (($=), GLdouble, Capability(..)) import Graphics.Rendering.OpenGL.GL (($=), GLdouble, Capability(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho) 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.Atom (internAtom)
import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow) 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.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.Misc (keycodeToKeysym, setWMProtocols)
import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName) import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName)
@ -32,7 +33,7 @@ data GLX = GLX
, glxWindow :: !Window , glxWindow :: !Window
, glxContext :: !Context , glxContext :: !Context
, glxDeleteWindow :: !Atom , glxDeleteWindow :: !Atom
, glxScale :: !GLdouble , glxScale :: !Rational
} }
glxDriver :: GLX glxDriver :: GLX
@ -82,14 +83,14 @@ instance Driver GLX where
ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True
makeCurrent disp wnd ctx makeCurrent disp wnd ctx
resize 800 600 s <- resize 800 600
return GLX return GLX
{ glxDisplay = disp { glxDisplay = disp
, glxWindow = wnd , glxWindow = wnd
, glxContext = ctx , glxContext = ctx
, glxDeleteWindow = delwnd , glxDeleteWindow = delwnd
, glxScale = 1 , glxScale = s
} }
deinitGL glx = do deinitGL glx = do
@ -101,68 +102,80 @@ instance Driver GLX where
nextEvent glx = allocaXEvent $ nextEvent' glx nextEvent glx = allocaXEvent $ nextEvent' glx
nextEvent' :: GLX -> XEventPtr -> IO (Maybe SomeEvent) nextEvent' :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent)
nextEvent' glx xevent = do nextEvent' glx xevent = do
p <- pending $ glxDisplay glx p <- pending $ glxDisplay glx
if (p > 0) then do if (p > 0) then do
Graphics.X11.Xlib.Event.nextEvent (glxDisplay glx) xevent Graphics.X11.Xlib.Event.nextEvent (glxDisplay glx) xevent
ev <- handleEvent glx xevent (newglx, ev) <- handleEvent glx xevent
if isJust ev then if isJust ev then
return ev return (newglx, ev)
else else
nextEvent' glx xevent nextEvent' newglx xevent
else else
return Nothing return (glx, Nothing)
handleEvent :: GLX -> XEventPtr -> IO (Maybe SomeEvent) handleEvent :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent)
handleEvent glx xevent = do handleEvent glx xevent = do
event <- getEvent xevent event <- getEvent xevent
let evtype = ev_event_type event let evtype = ev_event_type event
case () of case () of
_ | evtype == configureNotify -> do _ | evtype == configureNotify -> do
resize (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event) s <- resize (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event)
return Nothing return (glx {glxScale = s}, Nothing)
| evtype == keyPress -> do | evtype == keyPress -> do
keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0
case () of case () of
_ | keysym == xK_Escape -> return $ Just $ SomeEvent QuitEvent _ | keysym == xK_Escape -> return (glx, Just $ SomeEvent QuitEvent)
| keysym == xK_Up -> return $ Just $ SomeEvent $ KeyPressEvent KeyUp | keysym == xK_Up -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyUp)
| keysym == xK_Down -> return $ Just $ SomeEvent $ KeyPressEvent KeyDown | keysym == xK_Down -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyDown)
| keysym == xK_Left -> return $ Just $ SomeEvent $ KeyPressEvent KeyLeft | keysym == xK_Left -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyLeft)
| keysym == xK_Right -> return $ Just $ SomeEvent $ KeyPressEvent KeyRight | keysym == xK_Right -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyRight)
| otherwise -> return Nothing | otherwise -> return (glx, Nothing)
| evtype == keyRelease -> do | evtype == keyRelease -> do
keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0
case () of case () of
_ | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyUp _ | keysym == xK_Up -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyUp)
| keysym == xK_Down -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyDown | keysym == xK_Down -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyDown)
| keysym == xK_Left -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyLeft | keysym == xK_Left -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyLeft)
| keysym == xK_Right -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyRight | keysym == xK_Right -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyRight)
| otherwise -> return Nothing | otherwise -> return (glx, Nothing)
| evtype == clientMessage -> do | evtype == clientMessage -> do
if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event)) if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event))
then then
return $ Just $ SomeEvent QuitEvent return (glx, Just $ SomeEvent QuitEvent)
else else
return Nothing return (glx, Nothing)
| otherwise -> return 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 () resize :: Int -> Int -> IO Rational
resize w h = do resize w h = do
let aspect = (fromIntegral w)/(fromIntegral h) let size = 5
s = max (5/aspect) 5 :: GLdouble aspect = (fromIntegral w)%(fromIntegral h)
s = max (size/aspect) size
sf = fromRational s
aspectf = fromRational aspect
matrixMode $= Projection matrixMode $= Projection
loadIdentity loadIdentity
ortho (-s*aspect) (s*aspect) (-s) s (-1) 1 ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1
matrixMode $= Modelview 0 matrixMode $= Modelview 0
viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h))) viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h)))
return $ (fromIntegral h)/(s*2)
waitForMapNotify :: Display -> Window -> IO () waitForMapNotify :: Display -> Window -> IO ()
waitForMapNotify disp wnd = allocaXEvent waitForMapNotify' waitForMapNotify disp wnd = allocaXEvent waitForMapNotify'

3
HTanks.hs
View file

@ -164,7 +164,8 @@ simulationStep = do
handleEvents :: Main () handleEvents :: Main ()
handleEvents = do handleEvents = do
event <- gets driver >>= liftIO . nextEvent (newgl, event) <- gets driver >>= liftIO . nextEvent
modify $ \state -> state {driver = newgl}
when (isJust event) $ do when (isJust event) $ do
Main.handleEvent $ fromJust event Main.handleEvent $ fromJust event
modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state} modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state}

1
Render.hs
View file

@ -1,5 +1,4 @@
module Render ( setup module Render ( setup
--, resize
, render , render
) where ) where