summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--htanks.cabal8
-rw-r--r--src/CPUPlayer.hs3
-rw-r--r--src/DefaultPlayer.hs2
-rw-r--r--src/HTanks.hs10
-rw-r--r--src/Player.hs8
-rw-r--r--src/Render.hs18
-rw-r--r--src/Simulation.hs14
-rw-r--r--src/WiimotePlayer.hs44
8 files changed, 76 insertions, 31 deletions
diff --git a/htanks.cabal b/htanks.cabal
index 34eb52c..f0a621c 100644
--- a/htanks.cabal
+++ b/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,
- 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
diff --git a/src/CPUPlayer.hs b/src/CPUPlayer.hs
index 1a6ce70..a9eb6d8 100644
--- a/src/CPUPlayer.hs
+++ b/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)
diff --git a/src/DefaultPlayer.hs b/src/DefaultPlayer.hs
index 49371dc..756ba88 100644
--- a/src/DefaultPlayer.hs
+++ b/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
diff --git a/src/HTanks.hs b/src/HTanks.hs
index c7cf8a8..660f03c 100644
--- a/src/HTanks.hs
+++ b/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
- , 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
diff --git a/src/Player.hs b/src/Player.hs
index 59076dd..af7f543 100644
--- a/src/Player.hs
+++ b/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 =
- 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
diff --git a/src/Render.hs b/src/Render.hs
index a5f5ae9..839859e 100644
--- a/src/Render.hs
+++ b/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
- 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 \ No newline at end of file
diff --git a/src/Simulation.hs b/src/Simulation.hs
index 5d2b47b..7b2505f 100644
--- a/src/Simulation.hs
+++ b/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
- 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
diff --git a/src/WiimotePlayer.hs b/src/WiimotePlayer.hs
new file mode 100644
index 0000000..2487d17
--- /dev/null
+++ b/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 \ No newline at end of file