From 546da85814945ed2188e670ddf9c2dfd409d6241 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 10 Apr 2010 14:17:08 +0200 Subject: Added player cursor --- src/Game.hs | 3 --- src/HTanks.hs | 10 +++++----- src/MainLoop.hs | 3 +++ src/Player.hs | 6 +++++- src/Render.hs | 21 +++++++++++++++------ src/Texture.hs | 2 +- src/WiimotePlayer.hs | 46 +++++++++++++++++++++++++++++++--------------- tex/Crosshair.png | Bin 0 -> 568 bytes 8 files changed, 60 insertions(+), 31 deletions(-) create mode 100644 tex/Crosshair.png diff --git a/src/Game.hs b/src/Game.hs index 623e3ad..21fe6cd 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -8,12 +8,10 @@ module Game ( Bullet(..) import Level import Tank -import Texture import Control.Monad import Control.Monad.State import Data.Fixed -import qualified Data.Map as M data Bullet = Bullet @@ -29,7 +27,6 @@ data GameState = GameState { level :: !Level , tanks :: ![Tank] , bullets :: ![Bullet] - , textures :: !(M.Map Texture TextureObject) } deriving (Show) newtype Game a = Game (StateT GameState IO a) diff --git a/src/HTanks.hs b/src/HTanks.hs index f018a8c..e02b247 100644 --- a/src/HTanks.hs +++ b/src/HTanks.hs @@ -36,14 +36,14 @@ main = do [ --SomePlayer $ DefaultPlayer S.empty 0 0 False SomePlayer $ wiimotePlayer , SomePlayer $ CPUPlayer 0 - ]} + ], textures = M.empty} gameState = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 1.5 270 False 3 1 5 1 , Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1 - ], bullets = [], textures = M.empty} + ], bullets = []} - runGame gameState $ do + runGame gameState $ runMain mainState $ do setup - runMain mainState mainLoop + mainLoop deinitGL gl @@ -56,7 +56,7 @@ mainLoop = do t <- gets time handleEvents - lift render + render liftIO $ swapBuffers gl diff --git a/src/MainLoop.hs b/src/MainLoop.hs index 94b5e9d..0ebaa53 100644 --- a/src/MainLoop.hs +++ b/src/MainLoop.hs @@ -9,10 +9,12 @@ module MainLoop ( MainState(..) import Game import GLDriver import Player +import Texture import Control.Monad.State import Control.Monad.Trans import Data.Time +import qualified Data.Map as M data MainState = MainState @@ -20,6 +22,7 @@ data MainState = MainState , driver :: !SomeDriver , time :: !UTCTime , players :: ![SomePlayer] + , textures :: !(M.Map Texture TextureObject) } newtype MainT m a = MainT (StateT MainState m a) diff --git a/src/Player.hs b/src/Player.hs index af7f543..4784b8b 100644 --- a/src/Player.hs +++ b/src/Player.hs @@ -13,9 +13,12 @@ import GLDriver (SomeEvent) class Player a where playerUpdate :: a -> Tank -> IO (a, Maybe Micro, Bool, Maybe Micro, Bool) - handleEvent :: a -> SomeEvent -> a + handleEvent :: a -> SomeEvent -> a handleEvent player _ = player + + renderPlayer :: a -> IO () + renderPlayer _ = return () data SomePlayer = forall a. Player a => SomePlayer a @@ -25,3 +28,4 @@ instance Player SomePlayer where (p, angle, move, aangle, shoot) <- playerUpdate player tank return (SomePlayer p, angle, move, aangle, shoot) handleEvent (SomePlayer player) event = SomePlayer $ handleEvent player event + renderPlayer (SomePlayer player) = renderPlayer player diff --git a/src/Render.hs b/src/Render.hs index 839859e..ec7ae62 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -5,7 +5,9 @@ module Render ( setup import Paths_htanks import Game +import MainLoop import Level +import Player import Tank import Texture @@ -37,8 +39,9 @@ texturePath t = getDataFileName $ path t path TextureTank = "tex/Tank.png" path TextureCannon = "tex/Cannon.png" path TextureBullet = "tex/Bullet.png" + path TextureCrosshair = "tex/Crosshair.png" -getTexture :: Texture -> Game TextureObject +getTexture :: Texture -> Main TextureObject getTexture t = do ts <- gets textures let tobj = M.lookup t ts @@ -53,7 +56,7 @@ getTexture t = do return tex -setup :: Game () +setup :: Main () setup = do liftIO $ do blend $= Enabled @@ -64,21 +67,24 @@ setup = do getTexture TextureTank getTexture TextureCannon getTexture TextureBullet + getTexture TextureCrosshair return () -render :: Game () +render :: Main () render = do - tanklist <- gets tanks - bulletlist <- gets bullets + tanklist <- lift $ gets tanks + bulletlist <- lift $ gets bullets + playerlist <- gets players textureWood <- getTexture TextureWood textureTank <- getTexture TextureTank textureCannon <- getTexture TextureCannon textureBullet <- getTexture TextureBullet + textureCrosshair <- getTexture TextureCrosshair - (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) + (lw, lh) <- lift $ gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) liftIO $ do clear [ColorBuffer] @@ -162,3 +168,6 @@ render = do texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) vertex $ Vertex2 (0.1 :: GLfloat) (-0.1 :: GLfloat) + + textureBinding Texture2D $= Just textureCrosshair + forM_ playerlist renderPlayer diff --git a/src/Texture.hs b/src/Texture.hs index bf89cf9..1e82cdf 100644 --- a/src/Texture.hs +++ b/src/Texture.hs @@ -4,5 +4,5 @@ module Texture ( Texture(..) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) -data Texture = TextureWood | TextureTank | TextureCannon | TextureBullet +data Texture = TextureWood | TextureTank | TextureCannon | TextureBullet | TextureCrosshair deriving (Eq, Ord, Show) diff --git a/src/WiimotePlayer.hs b/src/WiimotePlayer.hs index 035c975..75f923b 100644 --- a/src/WiimotePlayer.hs +++ b/src/WiimotePlayer.hs @@ -12,16 +12,21 @@ import Data.Maybe import Data.Ratio ((%)) import Data.Typeable import HWiid +import Graphics.Rendering.OpenGL.GL (GLfloat, Vector3(..)) +import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..)) +import Graphics.Rendering.OpenGL.GL.CoordTrans (unsafePreservingMatrix, translate) +import Graphics.Rendering.OpenGL.GL.VertexSpec + import Player import Tank -data WiimotePlayer = WiimotePlayer Wiimote +data WiimotePlayer = WiimotePlayer Wiimote (Float, Float) deriving (Typeable, Show) instance Player WiimotePlayer where - playerUpdate (WiimotePlayer wiimote) tank = do + playerUpdate (WiimotePlayer wiimote oldaim) tank = do state <- hwiidGetState wiimote messages <- hwiidGetMesg wiimote @@ -39,23 +44,34 @@ instance Player WiimotePlayer where ny = ((fromIntegral . extNunchukStickY $ ext) - 0x80)/0x80 in if (nx*nx + ny*ny) < 0.4 then (x, y) else (x+nx, y+ny) - aim = handleIR state - aangle = if isJust aim - then - let aimx = fst $ fromJust aim - aimy = snd $ fromJust aim - ax = aimx - (fromRational . toRational . tankX $ tank) - ay = aimy - (fromRational . toRational . tankY $ tank) - in if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing - else - Nothing + iraim = handleIR state + (aimx, aimy) = if isJust iraim then fromJust iraim else oldaim + ax = aimx - (fromRational . toRational . tankX $ tank) + ay = aimy - (fromRational . toRational . tankY $ tank) + aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing move = (mx /= 0 || my /= 0) angle = atan2 my mx moveangle = if move then Just $ fromRational $ round ((angle - (sin $ 8*x)/8)*1000000*180/pi)%1000000 else Nothing when foo $ print $ state - return (WiimotePlayer wiimote, moveangle, move, aangle, shoot) - + return (WiimotePlayer wiimote (aimx, aimy), moveangle, move, aangle, shoot) + + renderPlayer (WiimotePlayer _ (x, y)) = unsafePreservingMatrix $ do + translate $ Vector3 x y (0 :: GLfloat) + + unsafeRenderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (-0.2 :: GLfloat) (-0.2 :: GLfloat) + + texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (-0.2 :: GLfloat) (0.2 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (0.2 :: GLfloat) (0.2 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (0.2 :: GLfloat) (-0.2 :: GLfloat) + irXScale :: Float irXScale = 20 @@ -110,7 +126,7 @@ newWiimotePlayer = do wiimote <- hwiidOpen bdAddrAny (hwiidFlagMesgInterface .|. hwiidFlagNonblock) when (wiimote == nullWiimote) $ fail "Wiimote error" hwiidSetReportMode wiimote (hwiidReportButtons .|. hwiidReportAcc .|. hwiidReportIR .|. hwiidReportNunchuk) - return $ WiimotePlayer wiimote + return $ WiimotePlayer wiimote (0, 0) test :: (Bits a) => a -> a -> Bool test field bits = (field .&. bits) == bits diff --git a/tex/Crosshair.png b/tex/Crosshair.png new file mode 100644 index 0000000..6e05086 Binary files /dev/null and b/tex/Crosshair.png differ -- cgit v1.2.3