Added Wiimote support

htanks.cabal

@@ -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,
+other-modules:       Collision, CPUPlayer, DefaultPlayer, WiimotePlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris,
-                     Bindings.GLX, Bindings.GLPng
+                     Tank, Bindings.GLX, Bindings.GLPng
-ghc-options:         -threaded -O2
+--ghc-options:         -threaded
 extra-libraries:     glpng

src/CPUPlayer.hs

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

src/DefaultPlayer.hs

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

src/HTanks.hs

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

src/Player.hs

@@ -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 = 
+    playerUpdate (SomePlayer player) tank = do
-        let (p, angle, move, aangle, shoot) = playerUpdate player tank
+                             (p, angle, move, aangle, shoot) <- playerUpdate player tank
-        in (SomePlayer p, angle, move, aangle, shoot)
+                             return (SomePlayer p, angle, move, aangle, shoot)
     handleEvent (SomePlayer player) event = SomePlayer $ handleEvent player event

src/Render.hs

@@ -100,10 +100,10 @@ render = do
              vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat)
              
            forM_ tanklist $ \tank -> unsafePreservingMatrix $ do
-                                       let x = fromReal . tankX $ tank
+                                       let x = realToFrac . tankX $ tank
-                                           y = fromReal . tankY $ tank
+                                           y = realToFrac . tankY $ tank
-                                           rotDir = fromReal . tankDir $ tank
+                                           rotDir = realToFrac . tankDir $ tank
-                                           rotAim = fromReal . tankAim $ 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
+                                       let x = realToFrac . bulletX $ bullet
-                                           y = fromReal . bulletY $ bullet
+                                           y = realToFrac . bulletY $ bullet
-                                           rotDir = fromReal . bulletDir $ 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

src/Simulation.hs

@@ -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
+  (p, t, s) <- liftIO $ liftM unzip3 $ mapM (updateTank' game) $ zip oldplayers oldtanks
-      ts = zip3 t s [0..]
+  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
+      updateTank' game (player, tank) = do
-                                            t = execState (updateTank game angle move aangle) tank
+                   (p, angle, move, aangle, shoot) <- playerUpdate player tank
-                                        in if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False)
+                   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

src/WiimotePlayer.hs

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