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

Added Wiimote support

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-07 13:28:38 +02:00
parent 736ad91b32
commit c0d2d54ea1
8 changed files with 76 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
htanks.cabal
View file

@ -7,14 +7,14 @@ license: GPL-3
license-file: LICENSE
author: Matthias Schiffer
maintainer: matthias@gamezock.de
build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL
build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL, hwiid
build-type: Simple
data-files: tex/*.png
executable: HTanks
hs-source-dirs: src
main-is: HTanks.hs
other-modules: Collision, CPUPlayer, DefaultPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris, Tank,
Bindings.GLX, Bindings.GLPng
ghc-options: -threaded -O2
other-modules: Collision, CPUPlayer, DefaultPlayer, WiimotePlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris,
Tank, Bindings.GLX, Bindings.GLPng
--ghc-options: -threaded
extra-libraries: glpng

3
src/CPUPlayer.hs
View file

@ -16,4 +16,5 @@ data CPUPlayer = CPUPlayer Micro
deriving (Typeable, Show)
instance Player CPUPlayer where
playerUpdate (CPUPlayer angle) _ = (CPUPlayer (if (angle+0.2) > 180 then angle-359.8 else angle+0.2), Just angle, True, Just (-angle), False)
-- playerUpdate (CPUPlayer angle) _ = return (CPUPlayer (if (angle+0.2) > 180 then angle-359.8 else angle+0.2), Just angle, True, Just (-angle), ((fromIntegral . round $ angle) == angle) && ((round $ angle) `mod` 2 == 0))
playerUpdate (CPUPlayer angle) _ = return (CPUPlayer (if (angle+0.2) > 180 then angle-359.8 else angle+0.2), Just angle, True, Just (-angle), False)

2
src/DefaultPlayer.hs
View file

@ -26,7 +26,7 @@ instance Player DefaultPlayer where
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 False, angle, move, aangle, shoot)
in return (DefaultPlayer keys aimx aimy False, angle, move, aangle, shoot)
handleEvent (DefaultPlayer keys aimx aimy shoot) ev
| Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy shoot

10
src/HTanks.hs
View file

@ -7,6 +7,7 @@ import Render
import Player
import CPUPlayer
import DefaultPlayer
import WiimotePlayer
import Simulation
import Tank
@ -20,20 +21,21 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.Time
main :: IO ()
main = do
let theLevel = testLevel
wiimotePlayer <- newWiimotePlayer
gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel)
when (initialized gl) $ do
currentTime <- getCurrentTime
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ SomePlayer $ DefaultPlayer S.empty 0 0 False
[ --SomePlayer $ DefaultPlayer S.empty 0 0 False
SomePlayer $ wiimotePlayer
, SomePlayer $ CPUPlayer 0
]}
gameState = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 2 270 False 3 1 5 1
, Tank 5.0 3.5 0 0 2 270 False 3 1 5 1
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}
runGame gameState $ do

8
src/Player.hs
View file

@ -12,7 +12,7 @@ import GLDriver (SomeEvent)
class Player a where
playerUpdate :: a -> Tank -> (a, Maybe Micro, Bool, Maybe Micro, Bool)
playerUpdate :: a -> Tank -> IO (a, Maybe Micro, Bool, Maybe Micro, Bool)
handleEvent :: a -> SomeEvent -> a
handleEvent player _ = player
@ -21,7 +21,7 @@ class Player a where
data SomePlayer = forall a. Player a => SomePlayer a
instance Player SomePlayer where
playerUpdate (SomePlayer player) tank =
let (p, angle, move, aangle, shoot) = playerUpdate player tank
in (SomePlayer p, angle, move, aangle, shoot)
playerUpdate (SomePlayer player) tank = do
(p, angle, move, aangle, shoot) <- playerUpdate player tank
return (SomePlayer p, angle, move, aangle, shoot)
handleEvent (SomePlayer player) event = SomePlayer $ handleEvent player event

18
src/Render.hs
View file

@ -100,10 +100,10 @@ render = do
vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat)
forM_ tanklist $ \tank -> unsafePreservingMatrix $ do
let x = fromReal . tankX $ tank
y = fromReal . tankY $ tank
rotDir = fromReal . tankDir $ tank
rotAim = fromReal . tankAim $ tank
let x = realToFrac . tankX $ tank
y = realToFrac . tankY $ tank
rotDir = realToFrac . tankDir $ tank
rotAim = realToFrac . tankAim $ tank
translate $ Vector3 x y (0 :: GLfloat)
rotate rotDir $ Vector3 0 0 (1 :: GLfloat)
@ -141,9 +141,9 @@ render = do
vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)
forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
let x = fromReal . bulletX $ bullet
y = fromReal . bulletY $ bullet
rotDir = fromReal . bulletDir $ bullet
let x = realToFrac . bulletX $ bullet
y = realToFrac . bulletY $ bullet
rotDir = realToFrac . bulletDir $ bullet
translate $ Vector3 x y (0 :: GLfloat)
rotate rotDir $ Vector3 0 0 (1 :: GLfloat)
@ -162,7 +162,3 @@ render = do
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (0.1 :: GLfloat) (-0.1 :: GLfloat)
fromReal :: (Real a, Fractional b) => a -> b
fromReal = fromRational . toRational

14
src/Simulation.hs
View file

@ -93,7 +93,8 @@ updateBullet game = do
dir = bulletDir bullet
bounces = bulletBouncesLeft bullet
(newx, dir2, bounces2) = if x < 0 then (-x, (signum dir)*180 - dir, bounces-1) else if x > lw then (2*lw-x, (signum dir)*180 - dir, bounces-1) else (x, dir, bounces)
sg = if dir < 0 then -1 else 1
(newx, dir2, bounces2) = if x < 0 then (-x, sg*180 - dir, bounces-1) else if x > lw then (2*lw-x, sg*180 - dir, bounces-1) else (x, dir, bounces)
(newy, dir3, bounces3) = if y < 0 then (-y, -dir2, bounces2-1) else if y > lh then (2*lh-y, -dir2, bounces2-1) else (y, dir2, bounces2)
put bullet {bulletX = newx, bulletY = newy, bulletDir = dir3, bulletBouncesLeft = bounces3}
@ -107,8 +108,8 @@ simulationStep = do
game <- lift get
let oldtanks = tanks game
let (p, t, s) = unzip3 $ map (updateTank' game) $ zip oldplayers oldtanks
ts = zip3 t s [0..]
(p, t, s) <- liftIO $ liftM unzip3 $ mapM (updateTank' game) $ zip oldplayers oldtanks
let ts = zip3 t s [0..]
shootingtanks = map (\(tank, _, n) -> (tank, n)) $ filter (\(tank, shoot, _) -> shoot && (tankBulletsLeft tank) > 0) $ ts
newtanks = map (\(tank, shoot, _) -> if (shoot && (tankBulletsLeft tank) > 0) then tank {tankBulletsLeft = (tankBulletsLeft tank) - 1} else tank) $ ts
newbullets = map (\(tank, n) -> Bullet
@ -145,8 +146,9 @@ simulationStep = do
hitBullets [] = []
hitBullets ((b, b', t, t'):xs) = (collisionBulletTank (b, b') (t, t'), b', t'):(hitBullets xs)
updateTank' game (player, tank) = let (p, angle, move, aangle, shoot) = playerUpdate player tank
t = execState (updateTank game angle move aangle) tank
in if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False)
updateTank' game (player, tank) = do
(p, angle, move, aangle, shoot) <- playerUpdate player tank
let t = execState (updateTank game angle move aangle) tank
return $ if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False)
countLostTankBullets n (x:xs) = (if ((not . fst $ x) && (n == (bulletTank . snd $ x))) then 1 else 0) + (countLostTankBullets n xs)
countLostTankBullets n [] = 0

44
src/WiimotePlayer.hs Normal file
View file

@ -0,0 +1,44 @@
{-# LANGUAGE DeriveDataTypeable #-}
module WiimotePlayer ( WiimotePlayer(..)
, newWiimotePlayer
) where
import Control.Monad
import Data.Bits
import Data.Ratio ((%))
import Data.Typeable
import HWiid
import Player
data WiimotePlayer = WiimotePlayer Wiimote
deriving (Typeable, Show)
instance Player WiimotePlayer where
playerUpdate (WiimotePlayer wiimote) tank = do
buttons <- hwiidGetState wiimote >>= return . stateButtons
messages <- hwiidGetMesg wiimote
let shoot = any (\m -> (mesgType m == hwiidMesgTypeButton) && (test (mesgButtons m) hwiidButtonB)) $ messages
x = (if (test buttons hwiidButtonLeft) then (-1) else 0) + (if (test buttons hwiidButtonRight) then 1 else 0)
y = (if (test buttons hwiidButtonDown) then (-1) else 0) + (if (test buttons hwiidButtonUp) then 1 else 0)
--ax = aimx - (fromRational . toRational . tankX $ tank)
--ay = aimy - (fromRational . toRational . tankY $ 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
return (WiimotePlayer wiimote, angle, move, Nothing, shoot)
newWiimotePlayer :: IO WiimotePlayer
newWiimotePlayer = do
wiimote <- hwiidOpen bdAddrAny (hwiidFlagMesgInterface .|. hwiidFlagNonblock)
when (wiimote == nullWiimote) $ fail "Wiimote error"
hwiidSetReportMode wiimote hwiidReportButtons
return $ WiimotePlayer wiimote
test :: (Bits a) => a -> a -> Bool
test field bits = (field .&. bits) == bits