diff options
| -rw-r--r-- | htanks.cabal | 8 | ||||
| -rw-r--r-- | src/CPUPlayer.hs | 3 | ||||
| -rw-r--r-- | src/DefaultPlayer.hs | 2 | ||||
| -rw-r--r-- | src/HTanks.hs | 10 | ||||
| -rw-r--r-- | src/Player.hs | 8 | ||||
| -rw-r--r-- | src/Render.hs | 18 | ||||
| -rw-r--r-- | src/Simulation.hs | 14 | ||||
| -rw-r--r-- | src/WiimotePlayer.hs | 44 |
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 |