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

Added player cursor

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-10 14:17:08 +02:00
parent 083619cc87
commit 546da85814
8 changed files with 60 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/Game.hs
View file

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

10
src/HTanks.hs
View file

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

3
src/MainLoop.hs
View file

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

6
src/Player.hs
View file

@ -13,10 +13,13 @@ 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

21
src/Render.hs
View file

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

2
src/Texture.hs
View file

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

40
src/WiimotePlayer.hs
View file

@ -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,22 +44,33 @@ 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
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)
in if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing
else
Nothing
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
@ -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

BIN
tex/Crosshair.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 568 B