From d2be8eb4103f266eb2078135960779bcbb82c492 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Sat, 10 Apr 2010 16:25:27 +0200 Subject: Renamed WiimotePlayer to HWiidPlayer --- htanks.cabal | 2 +- src/HTanks.hs | 6 +-- src/HWiidPlayer.hs | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++ src/WiimotePlayer.hs | 148 --------------------------------------------------- 4 files changed, 152 insertions(+), 152 deletions(-) create mode 100644 src/HWiidPlayer.hs delete mode 100644 src/WiimotePlayer.hs diff --git a/htanks.cabal b/htanks.cabal index f0a621c..c6f18be 100644 --- a/htanks.cabal +++ b/htanks.cabal @@ -14,7 +14,7 @@ data-files: tex/*.png executable: HTanks hs-source-dirs: src main-is: HTanks.hs -other-modules: Collision, CPUPlayer, DefaultPlayer, WiimotePlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris, +other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, 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/HTanks.hs b/src/HTanks.hs index e02b247..2fcdb66 100644 --- a/src/HTanks.hs +++ b/src/HTanks.hs @@ -7,7 +7,7 @@ import Render import Player import CPUPlayer import DefaultPlayer -import WiimotePlayer +import HWiidPlayer import Simulation import Tank @@ -27,14 +27,14 @@ import Foreign.C.Types main :: IO () main = do let theLevel = testLevel - wiimotePlayer <- newWiimotePlayer + hwiidPlayer <- newHWiidPlayer 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 $ wiimotePlayer + SomePlayer $ hwiidPlayer , 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 diff --git a/src/HWiidPlayer.hs b/src/HWiidPlayer.hs new file mode 100644 index 0000000..d1df2e5 --- /dev/null +++ b/src/HWiidPlayer.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module HWiidPlayer ( HWiidPlayer + , newHWiidPlayer + ) where + +import Control.Monad +import Data.Bits +import Data.Function (on) +import Data.List (sortBy) +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 HWiidPlayer = HWiidPlayer Wiimote WiimoteAccCal [(Float, Float)] + deriving (Typeable, Show) + +instance Player HWiidPlayer where + playerUpdate (HWiidPlayer wiimote cal oldaims) tank = do + state <- getState wiimote + messages <- getMesg wiimote + + let buttons = stateButtons state + shoot = any (\m -> (mesgType m == mesgTypeButton) && (test (mesgButtons m) buttonB)) $ messages + foo = any (\m -> (mesgType m == mesgTypeButton) && (test (mesgButtons m) buttonA)) $ messages + x = (if (test buttons buttonLeft) then (-1) else 0) + (if (test buttons buttonRight) then 1 else 0) + y = (if (test buttons buttonDown) then (-1) else 0) + (if (test buttons buttonUp) then 1 else 0) + ext = stateExt state + + (mx, my) = if (extType ext) /= extNunchuk + then (x, y) + else + let nx = ((fromIntegral . extNunchukStickX $ ext) - 0x80)/0x80 + ny = ((fromIntegral . extNunchukStickY $ ext) - 0x80)/0x80 + in if (nx*nx + ny*ny) < 0.4 then (x, y) else (x+nx, y+ny) + + iraim = handleIR state cal + newaims = if isJust iraim then take irSmooth ((fromJust iraim):oldaims) else oldaims + newaim = if null newaims then (0, 0) else mulV (1/(fromIntegral $ length newaims)) (foldr addV (0, 0) newaims) + aims = if not (null newaims) && (lengthV $ subV (head newaims) newaim) > irSkip + then take irSkipSmooth newaims + else newaims + (aimx, aimy) = if null aims then (0, 0) else mulV (1/(fromIntegral $ length aims)) (foldr addV (0, 0) aims) + ax = aimx - (fromRational . toRational . tankX $ tank) + ay = aimy - (fromRational . toRational . tankY $ tank) + 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 (HWiidPlayer wiimote cal aims, moveangle, move, aangle, shoot) + + renderPlayer (HWiidPlayer _ _ []) = return () + renderPlayer (HWiidPlayer _ _ aims) = unsafePreservingMatrix $ do + let (x, y) = mulV (1/(fromIntegral $ length aims)) $ foldr addV (0, 0) aims + + 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) + + +irSmooth = 10 +irSkip = 0.2 +irSkipSmooth = 4 + +irXScale :: Float +irXScale = 20 + +irXTranslate :: Float +irXTranslate = 0 + 7 + +irYScale :: Float +irYScale = 20 + +irYTranslate :: Float +irYTranslate = -10 + 8 + +handleIR :: WiimoteState -> WiimoteAccCal -> Maybe (Float, Float) +handleIR state cal = handle $ sortIRSourcesByPos $ take 2 $ sortIRSourcesBySize $ stateIRSources state + where + handle [ira,irb] = let pa = pos ira + pb = pos irb + p = negV pa + b = pb `subV` pa + x = (p `dotV` b)/(lengthV b) + y = (sqrt ((lengthSqV p) - x*x)) * (signum $ sinV b p) + in Just ((x - (lengthV b)/2)*irXScale + irXTranslate, y*irYScale + irYTranslate) + + handle _ = Nothing + + pos src = (((fromIntegral $ irPosX src) - hMaxX)/hMaxX, ((fromIntegral $ irPosY src) - hMaxY)/hMaxY) + + rot (x, y) = let fi = fromIntegral + s = ((fi . stateAccX $ state)-(fi . accCalZeroX $ cal))/((fi . accCalOneX $ cal)-(fi . accCalZeroX $ cal)) + c = ((fi . stateAccZ $ state)-(fi . accCalZeroZ $ cal))/((fi . accCalOneZ $ cal)-(fi . accCalZeroZ $ cal)) + in (c*x + s*y, -s*x + c*y) + + hMaxX = (fromIntegral irMaxX)/2 + hMaxY = (fromIntegral irMaxY)/2 + + sortIRSourcesBySize :: [WiimoteIRSource] -> [WiimoteIRSource] + sortIRSourcesBySize = sortBy (flip compare `on` irSize) + + sortIRSourcesByPos :: [WiimoteIRSource] -> [WiimoteIRSource] + sortIRSourcesByPos = sortBy (compare `on` (fst . rot . pos)) + +negV (a1, a2) = (-a1, -a2) +addV (a1, a2) (b1, b2) = (a1+b1, a2+b2) +subV (a1, a2) (b1, b2) = (a1-b1, a2-b2) +dotV (a1, a2) (b1, b2) = a1*b1 + a2*b2 +mulV x (a1, a2) = (x*a1, x*a2) +sinV (a1, a2) (b1, b2) = (a1 * b2 - b1 * a2) +lengthSqV a = dotV a a +lengthV a = sqrt $ lengthSqV a + + +newHWiidPlayer :: IO HWiidPlayer +newHWiidPlayer = do + wiimote <- open bdAddrAny (flagMesgInterface .|. flagNonblock) + when (wiimote == nullWiimote) $ fail "Wiimote error" + setReportMode wiimote (reportButtons .|. reportAcc .|. reportIR .|. reportNunchuk) + cal <- getAccCal wiimote extNone + return $ HWiidPlayer wiimote cal [] + +test :: (Bits a) => a -> a -> Bool +test field bits = (field .&. bits) == bits diff --git a/src/WiimotePlayer.hs b/src/WiimotePlayer.hs deleted file mode 100644 index 697cdb0..0000000 --- a/src/WiimotePlayer.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module WiimotePlayer ( WiimotePlayer - , newWiimotePlayer - ) where - -import Control.Monad -import Data.Bits -import Data.Function (on) -import Data.List (sortBy) -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 WiimoteAccCal [(Float, Float)] - deriving (Typeable, Show) - -instance Player WiimotePlayer where - playerUpdate (WiimotePlayer wiimote cal oldaims) tank = do - state <- getState wiimote - messages <- getMesg wiimote - - let buttons = stateButtons state - shoot = any (\m -> (mesgType m == mesgTypeButton) && (test (mesgButtons m) buttonB)) $ messages - foo = any (\m -> (mesgType m == mesgTypeButton) && (test (mesgButtons m) buttonA)) $ messages - x = (if (test buttons buttonLeft) then (-1) else 0) + (if (test buttons buttonRight) then 1 else 0) - y = (if (test buttons buttonDown) then (-1) else 0) + (if (test buttons buttonUp) then 1 else 0) - ext = stateExt state - - (mx, my) = if (extType ext) /= extNunchuk - then (x, y) - else - let nx = ((fromIntegral . extNunchukStickX $ ext) - 0x80)/0x80 - ny = ((fromIntegral . extNunchukStickY $ ext) - 0x80)/0x80 - in if (nx*nx + ny*ny) < 0.4 then (x, y) else (x+nx, y+ny) - - iraim = handleIR state cal - newaims = if isJust iraim then take irSmooth ((fromJust iraim):oldaims) else oldaims - newaim = if null newaims then (0, 0) else mulV (1/(fromIntegral $ length newaims)) (foldr addV (0, 0) newaims) - aims = if not (null newaims) && (lengthV $ subV (head newaims) newaim) > irSkip - then take irSkipSmooth newaims - else newaims - (aimx, aimy) = if null aims then (0, 0) else mulV (1/(fromIntegral $ length aims)) (foldr addV (0, 0) aims) - ax = aimx - (fromRational . toRational . tankX $ tank) - ay = aimy - (fromRational . toRational . tankY $ tank) - 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 cal aims, moveangle, move, aangle, shoot) - - renderPlayer (WiimotePlayer _ _ []) = return () - renderPlayer (WiimotePlayer _ _ aims) = unsafePreservingMatrix $ do - let (x, y) = mulV (1/(fromIntegral $ length aims)) $ foldr addV (0, 0) aims - - 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) - - -irSmooth = 10 -irSkip = 0.2 -irSkipSmooth = 4 - -irXScale :: Float -irXScale = 20 - -irXTranslate :: Float -irXTranslate = 0 + 7 - -irYScale :: Float -irYScale = 20 - -irYTranslate :: Float -irYTranslate = -10 + 8 - -handleIR :: WiimoteState -> WiimoteAccCal -> Maybe (Float, Float) -handleIR state cal = handle $ sortIRSourcesByPos $ take 2 $ sortIRSourcesBySize $ stateIRSources state - where - handle [ira,irb] = let pa = pos ira - pb = pos irb - p = negV pa - b = pb `subV` pa - x = (p `dotV` b)/(lengthV b) - y = (sqrt ((lengthSqV p) - x*x)) * (signum $ sinV b p) - in Just ((x - (lengthV b)/2)*irXScale + irXTranslate, y*irYScale + irYTranslate) - - handle _ = Nothing - - pos src = (((fromIntegral $ irPosX src) - hMaxX)/hMaxX, ((fromIntegral $ irPosY src) - hMaxY)/hMaxY) - - rot (x, y) = let fi = fromIntegral - s = ((fi . stateAccX $ state)-(fi . accCalZeroX $ cal))/((fi . accCalOneX $ cal)-(fi . accCalZeroX $ cal)) - c = ((fi . stateAccZ $ state)-(fi . accCalZeroZ $ cal))/((fi . accCalOneZ $ cal)-(fi . accCalZeroZ $ cal)) - in (c*x + s*y, -s*x + c*y) - - hMaxX = (fromIntegral irMaxX)/2 - hMaxY = (fromIntegral irMaxY)/2 - - sortIRSourcesBySize :: [WiimoteIRSource] -> [WiimoteIRSource] - sortIRSourcesBySize = sortBy (flip compare `on` irSize) - - sortIRSourcesByPos :: [WiimoteIRSource] -> [WiimoteIRSource] - sortIRSourcesByPos = sortBy (compare `on` (fst . rot . pos)) - -negV (a1, a2) = (-a1, -a2) -addV (a1, a2) (b1, b2) = (a1+b1, a2+b2) -subV (a1, a2) (b1, b2) = (a1-b1, a2-b2) -dotV (a1, a2) (b1, b2) = a1*b1 + a2*b2 -mulV x (a1, a2) = (x*a1, x*a2) -sinV (a1, a2) (b1, b2) = (a1 * b2 - b1 * a2) -lengthSqV a = dotV a a -lengthV a = sqrt $ lengthSqV a - - -newWiimotePlayer :: IO WiimotePlayer -newWiimotePlayer = do - wiimote <- open bdAddrAny (flagMesgInterface .|. flagNonblock) - when (wiimote == nullWiimote) $ fail "Wiimote error" - setReportMode wiimote (reportButtons .|. reportAcc .|. reportIR .|. reportNunchuk) - cal <- getAccCal wiimote extNone - return $ WiimotePlayer wiimote cal [] - -test :: (Bits a) => a -> a -> Bool -test field bits = (field .&. bits) == bits -- cgit v1.2.3