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
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

10
GLDriver.hs
View file

@ -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

87
GLX.hs
View file

@ -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
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 ()
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'

3
HTanks.hs
View file

@ -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}

1
Render.hs
View file

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