From 83f0606ea9dfd6b493097dc97330055dff4a2867 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Fri, 24 Jun 2011 21:50:32 +0200 Subject: Added Transformable class to simplify collision calculation --- htanks.cabal | 8 ++--- src/CPUPlayer.hs | 11 ++++--- src/Collision.hs | 93 +++++++++++++++++++++++++--------------------------- src/DefaultPlayer.hs | 15 +++++---- src/Game.hs | 26 ++++++++++----- src/HTanks.hs | 11 ++++--- src/HWiidPlayer.hs | 12 ++++--- src/Player.hs | 5 +-- src/Render.hs | 13 ++++---- src/Simulation.hs | 82 ++++++++++++++++++++------------------------- src/Tank.hs | 30 ++++++++++++----- src/Transformable.hs | 37 +++++++++++++++++++++ src/Vector.hs | 59 +++++++++++++++++++++++++++++++++ 13 files changed, 258 insertions(+), 144 deletions(-) create mode 100644 src/Transformable.hs create mode 100644 src/Vector.hs diff --git a/htanks.cabal b/htanks.cabal index 7785026..86f8ab1 100644 --- a/htanks.cabal +++ b/htanks.cabal @@ -6,14 +6,14 @@ category: Game license: GPL-3 license-file: LICENSE author: Matthias Schiffer -maintainer: matthias@gamezock.de -build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL, hwiid, obj-model, obj-model-opengl +maintainer: mschiffer@universe-factory.net +build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL, hwiid, obj-model, obj-model-opengl, fixed-point, vector-space, fixed-point-vector-space build-type: Simple data-files: tex/*.png model/*.obj executable: HTanks hs-source-dirs: src main-is: HTanks.hs -other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris, - Tank, Model, Bindings.GLX, Bindings.GLPng +other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Transformable, Debris, + Tank, Model, Vector, Bindings.GLX, Bindings.GLPng extra-libraries: glpng diff --git a/src/CPUPlayer.hs b/src/CPUPlayer.hs index a9eb6d8..55722bf 100644 --- a/src/CPUPlayer.hs +++ b/src/CPUPlayer.hs @@ -4,17 +4,20 @@ module CPUPlayer ( CPUPlayer(..) ) where -import Data.Fixed -import Data.Ratio ((%)) import Data.Typeable +import Transformable +import Vector import GLDriver import Player -data CPUPlayer = CPUPlayer Micro +data CPUPlayer = CPUPlayer Vector deriving (Typeable, Show) instance Player CPUPlayer where -- 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) + playerUpdate (CPUPlayer dir) _ = return (CPUPlayer dir', Just dir', True, Just mirrordir, False) + where + dir' = (rotate (0.2*pi/180)) >< dir + mirrordir = Vector (vectorX dir') (-(vectorY dir')) diff --git a/src/Collision.hs b/src/Collision.hs index 3138473..909e7f7 100644 --- a/src/Collision.hs +++ b/src/Collision.hs @@ -5,68 +5,63 @@ module Collision ( collisionTankBorder import Tank import Game +import Transformable -import Data.Fixed -import Data.Ratio +import qualified Vector as V +import Data.VectorSpace -tankWidth :: Micro +tankWidth :: Coord tankWidth = 0.4 -tankLength :: Micro +tankLength :: Coord tankLength = 0.95 -bulletDiameter :: Micro +bulletDiameter :: Coord bulletDiameter = 0.05 -collisionTankBorder :: Micro -> Micro -> Tank -> Tank -collisionTankBorder lw lh tank = tank {tankX = newx, tankY = newy} - where - dir = (fromRational . toRational . tankDir $ tank)*pi/180 - cosd = fromRational (round ((cos dir)*1000000)%1000000) - sind = fromRational (round ((sin dir)*1000000)%1000000) - - points = [ (tankLength/2, tankWidth/2) - , (-tankLength/2, tankWidth/2) - , (-tankLength/2, -tankWidth/2) - , (tankLength/2, -tankWidth/2) - ] - - rotp (x, y) = (cosd*x - sind*y, sind*x + cosd*y) - transp (x, y) = (x + tankX tank, y + tankY tank) - - pointst = map (transp . rotp) points - minx = minimum $ map fst pointst - maxx = maximum $ map fst pointst - miny = minimum $ map snd pointst - maxy = maximum $ map snd pointst - - dx = if minx < 0 then (-minx) else if maxx > lw then (-maxx+lw) else 0 - dy = if miny < 0 then (-miny) else if maxy > lh then (-maxy+lh) else 0 - - newx = (tankX tank) + dx - newy = (tankY tank) + dy +collisionTankBorder :: Coord -> Coord -> Tank -> Tank +collisionTankBorder lw lh tank = (translate dx dy) >< tank + where + corners = [ V.Vector (tankLength/2) (tankWidth/2) + , V.Vector (-tankLength/2) (tankWidth/2) + , V.Vector (-tankLength/2) (-tankWidth/2) + , V.Vector (tankLength/2) (-tankWidth/2) + ] + + rotp v = V.rotateV (tankDir tank) >< v + transp v = V.translateV v >< tankPos tank + + points = map (transp . rotp) corners + minx = minimum $ map V.vertexX points + maxx = maximum $ map V.vertexX points + miny = minimum $ map V.vertexY points + maxy = maximum $ map V.vertexY points + + dx = if minx < 0 then (-minx) else if maxx > lw then (-maxx+lw) else 0 + dy = if miny < 0 then (-miny) else if maxy > lh then (-maxy+lh) else 0 collisionBulletBullet :: (Bullet, Bullet) -> (Bullet, Bullet) -> Bool collisionBulletBullet (b1, b1') (b2, b2') = distancesq < (bulletDiameter^2) - where - distancesq = (bulletX b1' - bulletX b2')^2 + (bulletY b1' - bulletY b2')^2 + where + distancesq = (bulletX b1' - bulletX b2')^2 + (bulletY b1' - bulletY b2')^2 collisionBulletTank :: (Bullet, Bullet) -> (Tank, Tank) -> Bool collisionBulletTank (b, b') (tank, tank') = (not ((between bx minx maxx) && (between by miny maxy))) && ((between bx' minx maxx) && (between by' miny maxy)) - where - between x a b = x >= a && x <= b - - dir t = (fromRational . toRational . tankDir $ t)*pi/180 - cosd t = fromRational (round ((cos $ dir t)*1000000)%1000000) - sind t = fromRational (round ((sin $ dir t)*1000000)%1000000) + where + between x a b = x >= a && x <= b + + rotp t v = V.rotateV' (tankDir t) >< v + transp t v = V.diffV (tankPos t) v - rotp t (x, y) = ((cosd t)*x + (sind t)*y, -(sind t)*x + (cosd t)*y) - transp t (x, y) = (x - tankX t, y - tankY t) + V.Vector bx by = (rotp tank) . (transp tank) $ bulletPos b + V.Vector bx' by' = (rotp tank') . (transp tank') $ bulletPos b' - (bx, by) = (rotp tank) . (transp tank) $ (bulletX b, bulletY b) - (bx', by') = (rotp tank') . (transp tank') $ (bulletX b', bulletY b') - - minx = -tankLength/2 - maxx = tankLength/2 - miny = -tankWidth/2 - maxy = tankWidth/2 + minx = -tankLength/2 + maxx = tankLength/2 + miny = -tankWidth/2 + maxy = tankWidth/2 + +collisionTankTank :: ((Tank, Tank), (Tank, Tank)) -> ((Tank, Tank), (Tank, Tank)) +collisionTankTank ((t1, t1'), (t2, t2')) = ((t1, t1'), (t2, t2')) +-- where + \ No newline at end of file diff --git a/src/DefaultPlayer.hs b/src/DefaultPlayer.hs index e16502a..00dce95 100644 --- a/src/DefaultPlayer.hs +++ b/src/DefaultPlayer.hs @@ -16,8 +16,9 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec import Tank import GLDriver import Player - - +import Vector +import Transformable (Coord) +import Data.VectorSpace data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool deriving (Typeable, Show) @@ -26,12 +27,12 @@ instance Player DefaultPlayer where playerUpdate (DefaultPlayer keys aimx aimy shoot) tank = let x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0) y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0) - ax = aimx - (fromRational . toRational . tankX $ tank) - ay = aimy - (fromRational . toRational . tankY $ tank) + ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank) + ay = realToFrac $ 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 - in return (DefaultPlayer keys aimx aimy False, angle, move, aangle, shoot) + dir = if move then Just (normalized $ Vector x y) else Nothing + adir = if (ax /= 0 || ay /= 0) then Just (normalized $ Vector ax ay) else Nothing + in return (DefaultPlayer keys aimx aimy False, dir, move, adir, 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/Game.hs b/src/Game.hs index 5af2ad2..16b04d8 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -1,26 +1,36 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Game ( Bullet(..) + , bulletX + , bulletY , GameState(..) ) where import Level import Tank - -import Control.Monad -import Control.Monad.State -import Data.Fixed +import Transformable +import Vector data Bullet = Bullet - { bulletX :: !Micro - , bulletY :: !Micro - , bulletDir :: !Micro - , bulletSpeed :: !Micro + { bulletPos :: !Vertex + , bulletDir :: !Vector + , bulletSpeed :: !Coord , bulletBouncesLeft :: !Int , bulletTank :: !Int } deriving (Eq, Show) +bulletX :: Bullet -> Coord +bulletX = vertexX . bulletPos + +bulletY :: Bullet -> Coord +bulletY = vertexY . bulletPos + +instance Transformable Bullet where + t >< b = b { bulletPos = pos, bulletDir = dir } where + pos = t >< bulletPos b + dir = t >< bulletDir b + data GameState = GameState { level :: !Level , tanks :: ![Tank] diff --git a/src/HTanks.hs b/src/HTanks.hs index 110a2b1..0974ffd 100644 --- a/src/HTanks.hs +++ b/src/HTanks.hs @@ -20,6 +20,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Time +import Vector main :: IO () main = do @@ -30,14 +31,14 @@ main = do when (initialized gl) $ do currentTime <- getCurrentTime - let gamestate = GameState {level = theLevel, tanks = [ Tank 7.0 4.0 0 0 1.5 270 False 3 1 5 1 - , Tank 4.0 4.0 0 0 1.5 270 False 3 1 5 1 - , Tank 10.0 4.0 0 0 1.5 270 False 3 1 5 1 + let gamestate = GameState {level = theLevel, tanks = [ Tank (Vertex 7.0 4.0) (Vector 1 0) (Vector 1 0) 1.5 (270*pi/180) False 3 1 5 1 + , Tank (Vertex 4.0 4.0) (Vector 1 0) (Vector 1 0) 1.5 (270*pi/180) False 3 1 5 1 + , Tank (Vertex 10.0 4.0) (Vector 1 0) (Vector 1 0) 1.5 (270*pi/180) False 3 1 5 1 ], bullets = []} mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = [ SomePlayer humanPlayer - , SomePlayer $ CPUPlayer (-90) - , SomePlayer $ CPUPlayer 90 + , SomePlayer $ CPUPlayer $ Vector 0 (-1) + , SomePlayer $ CPUPlayer $ Vector 0 1 ], textures = M.empty, models = M.empty, gameState = gamestate} runMain mainstate $ do diff --git a/src/HWiidPlayer.hs b/src/HWiidPlayer.hs index 04ea38e..d98b9c9 100644 --- a/src/HWiidPlayer.hs +++ b/src/HWiidPlayer.hs @@ -20,6 +20,8 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec import Player import Tank +import qualified Transformable as T +import qualified Vector as V data HWiidPlayer = HWiidPlayer Wiimote WiimoteAccCal [(Float, Float)] @@ -51,15 +53,15 @@ instance Player HWiidPlayer where 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 + ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank) + ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank) + aim = if (ax /= 0 || ay /= 0) then Just $ V.Vector ax ay 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 + dir = if move then Just $ T.rotate (fromRational $ round ((angle - (sin $ 8*x)/8)*1000000*180/pi)%1000000) T.>< V.Vector 1 0 else Nothing when foo $ print state - return (HWiidPlayer wiimote cal aims, moveangle, move, aangle, shoot) + return (HWiidPlayer wiimote cal aims, dir, move, aim, shoot) renderPlayer (HWiidPlayer _ _ []) = return () renderPlayer (HWiidPlayer _ _ aims) = unsafePreservingMatrix $ do diff --git a/src/Player.hs b/src/Player.hs index 4784b8b..67d9f78 100644 --- a/src/Player.hs +++ b/src/Player.hs @@ -4,7 +4,8 @@ module Player ( Player(..) , SomePlayer(..) ) where -import Data.Fixed +import Transformable +import Vector import Data.Typeable import Tank @@ -12,7 +13,7 @@ import GLDriver (SomeEvent) class Player a where - playerUpdate :: a -> Tank -> IO (a, Maybe Micro, Bool, Maybe Micro, Bool) + playerUpdate :: a -> Tank -> IO (a, Maybe Vector, Bool, Maybe Vector, Bool) handleEvent :: a -> SomeEvent -> a handleEvent player _ = player diff --git a/src/Render.hs b/src/Render.hs index de61593..abe652e 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -10,6 +10,7 @@ import Player import Tank import Texture import Model +import qualified Vector as V import Control.Monad.State @@ -148,11 +149,11 @@ render = do forM_ tanklist $ \tank -> unsafePreservingMatrix $ do let x = realToFrac . tankX $ tank y = realToFrac . tankY $ tank - rotDir = realToFrac . tankDir $ tank - rotAim = realToFrac . tankAim $ tank + rotDir = realToFrac . V.toAngle . tankDir $ tank + rotAim = realToFrac . V.toAngle . tankAim $ tank translate $ Vector3 x y (0 :: GLfloat) - rotate rotDir $ Vector3 0 0 (1 :: GLfloat) + rotate (rotDir*180/pi) $ Vector3 0 0 (1 :: GLfloat) textureBinding Texture2D $= Just textureTank @@ -160,7 +161,7 @@ render = do rotate 90 $ Vector3 1 0 (0 :: GLfloat) drawObject modelTank 1 - rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat) + rotate ((rotAim-rotDir)*180/pi) $ Vector3 0 0 (1 :: GLfloat) textureBinding Texture2D $= Just textureCannon @@ -174,10 +175,10 @@ render = do forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do let x = realToFrac . bulletX $ bullet y = realToFrac . bulletY $ bullet - rotDir = realToFrac . bulletDir $ bullet + rotDir = realToFrac . V.toAngle . bulletDir $ bullet translate $ Vector3 x y (0.25 :: GLfloat) - rotate (rotDir-90) $ Vector3 0 0 (1 :: GLfloat) + rotate ((rotDir*180/pi)-90) $ Vector3 0 0 (1 :: GLfloat) unsafePreservingMatrix $ do drawObject modelBullet 0 diff --git a/src/Simulation.hs b/src/Simulation.hs index c1debb2..3cf4fec 100644 --- a/src/Simulation.hs +++ b/src/Simulation.hs @@ -7,31 +7,33 @@ import Level import MainLoop import Player import Tank +import Transformable +import Vector import Control.Monad.State -import Data.Fixed import Data.List import Data.Maybe -import Data.Ratio +import Data.VectorSpace -updateAngle :: Micro -> Tank -> Tank -updateAngle angle tank = tank {tankDir = newangle180} +updateAngle :: Vector -> Tank -> Tank +updateAngle dir tank = tank {tankDir = rotate newangle >< Vector 1 0} where - oldangle = tankDir tank + oldangle = toAngle . tankDir $ tank + angle = toAngle dir tspeed = (tankTurnspeed tank)/100 diff = angle - oldangle - diff360 = if (diff > 180) - then (diff-360) - else if (diff <= -180) - then (diff+360) + diff360 = if (diff > pi) + then (diff-2*pi) + else if (diff <= -pi) + then (diff+2*pi) else diff - (diff180, angle180) = if (diff360 > 90) - then (diff360-180, oldangle+180) - else if (diff360 <= -90) - then (diff360+180, oldangle-180) + (diff180, angle180) = if (diff360 > pi/2) + then (diff360-180, oldangle+pi) + else if (diff360 <= -pi/2) + then (diff360+pi, oldangle-pi) else (diff360, oldangle) turn = if (diff180 > tspeed) @@ -41,21 +43,19 @@ updateAngle angle tank = tank {tankDir = newangle180} else diff180 newangle = angle180 + turn - - newangle180 = if (newangle > 180) - then (newangle-360) - else if (newangle <= -180) - then (newangle+360) - else newangle +approx :: Vector -> Vector -> Bool +approx (Vector x1 y1) (Vector x2 y2) = x1 `approx'` x2 && y1 `approx'` y2 + where + approx' a b = (abs (a-b)) < 0.000001 -updateTank :: GameState -> Maybe Micro -> Bool -> Maybe Micro -> State Tank () -updateTank game angle move aangle = do - when (isJust angle) $ - modify $ updateAngle $ fromJust angle +updateTank :: GameState -> Maybe Vector -> Bool -> Maybe Vector -> State Tank () +updateTank game dir move aim = do + when (isJust dir) $ + modify $ updateAngle $ fromJust dir - when (isJust aangle) $ - modify $ \tank -> tank {tankAim = fromJust aangle} + when (isJust aim) $ + modify $ \tank -> tank {tankAim = fromJust aim} when move $ do tank <- get @@ -63,12 +63,8 @@ updateTank game angle move aangle = do tspeed = tankSpeed tank moved = tankMoving tank - when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do - let anglej = (fromRational . toRational $ tdir)*pi/180 - dx = tspeed * fromRational (round ((cos anglej)*1000)%100000) - dy = tspeed * fromRational (round ((sin anglej)*1000)%100000) - - put tank {tankX = dx + tankX tank, tankY = dy + tankY tank, tankMoving = True} + when (isNothing dir || (isJust dir && (tdir `approx` fromJust dir) || moved)) $ + put $ translateV (tdir ^* (tspeed/100)) >< tank {tankMoving = True} when (not move) $ do modify $ \tank -> tank {tankMoving = False} @@ -79,22 +75,17 @@ updateTank game angle move aangle = do updateBullet :: GameState -> Bullet -> (Bullet, Bool) -updateBullet game bullet = (bullet {bulletX = newx, bulletY = newy, bulletDir = dir3, bulletBouncesLeft = bounces3}, bounces3 >= 0) +updateBullet game bullet = (bullet {bulletPos = Vertex x' y', bulletDir = Vector dx' dy', bulletBouncesLeft = bounces3}, bounces3 >= 0) where - angle = (fromRational . toRational . bulletDir $ bullet)*pi/180 speed = bulletSpeed bullet - dx = speed * fromRational (round ((cos angle)*1000)%100000) - dy = speed * fromRational (round ((sin angle)*1000)%100000) - x = dx + bulletX bullet - y = dy + bulletY bullet + d@(Vector dx dy) = bulletDir bullet + Vertex x y = translateV (d ^* (speed/100)) >< bulletPos bullet + bounces = bulletBouncesLeft bullet lw = fromIntegral . levelWidth . level $ game lh = fromIntegral . levelHeight . level $ game - dir = bulletDir bullet - bounces = bulletBouncesLeft bullet - 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) + (x', dx', bounces2) = if x < 0 then (-x, -dx, bounces-1) else if x > lw then (2*lw-x, -dx, bounces-1) else (x, dx, bounces) + (y', dy', bounces3) = if y < 0 then (-y, -dy, bounces2-1) else if y > lh then (2*lh-y, -dy, bounces2-1) else (y, dy, bounces2) gameStep :: [(Tank, Bool)] -> GameState -> GameState gameStep tanksshoot state = state {tanks = thetanks, bullets = newbullets ++ (map snd . filter fst $ leftbullets2)} @@ -104,8 +95,7 @@ gameStep tanksshoot state = state {tanks = thetanks, bullets = newbullets ++ (ma thetanks = map (\(tank, n) -> tank {tankBulletsLeft = (tankBulletsLeft tank) + (countLostTankBullets n leftbullets2)}) $ zip newtanks2 [0..] newtanks = map (\(tank, shoot, _) -> if (shoot && (tankBulletsLeft tank) > 0) then tank {tankBulletsLeft = (tankBulletsLeft tank) - 1} else tank) $ ts newbullets = map (\(tank, n) -> Bullet - { bulletX = tankX tank - , bulletY = tankY tank + { bulletPos = tankPos tank , bulletDir = tankAim tank , bulletSpeed = tankBulletSpeed tank , bulletBouncesLeft = tankBulletBounces tank @@ -144,6 +134,6 @@ simulationStep = do modify $ \state -> state {players = p, gameState = gameStep (zip t s) (gameState state)} where updateTank' game (player, tank) = do - (p, angle, move, aangle, shoot) <- playerUpdate player tank - let t = execState (updateTank game angle move aangle) tank + (p, dir, move, aim, shoot) <- playerUpdate player tank + let t = execState (updateTank game dir move aim) tank return $ if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False) diff --git a/src/Tank.hs b/src/Tank.hs index 2fbf612..f3230f2 100644 --- a/src/Tank.hs +++ b/src/Tank.hs @@ -1,18 +1,32 @@ module Tank ( Tank(..) + , tankX + , tankY ) where -import Data.Fixed +import Transformable +import Vector data Tank = Tank - { tankX :: !Micro - , tankY :: !Micro - , tankDir :: !Micro - , tankAim :: !Micro - , tankSpeed :: !Micro - , tankTurnspeed :: !Micro + { tankPos :: !Vertex + , tankDir :: !Vector + , tankAim :: !Vector + , tankSpeed :: !Coord + , tankTurnspeed :: !Coord , tankMoving :: !Bool - , tankBulletSpeed :: !Micro + , tankBulletSpeed :: !Coord , tankBulletBounces :: !Int , tankBulletsLeft :: !Int , tankLife :: !Int } deriving (Eq, Show) + +tankX :: Tank -> Coord +tankX = vertexX . tankPos + +tankY :: Tank -> Coord +tankY = vertexY . tankPos + +instance Transformable Tank where + t >< tank = tank { tankPos = pos, tankDir = dir, tankAim = aim } where + pos = t >< tankPos tank + dir = t >< tankDir tank + aim = t >< tankAim tank \ No newline at end of file diff --git a/src/Transformable.hs b/src/Transformable.hs new file mode 100644 index 0000000..2fd64fe --- /dev/null +++ b/src/Transformable.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TypeOperators, TypeSynonymInstances #-} + +module Transformable ( Coord + , Vector3 + , Transform + , Transformable(..) + , translate + , rotate + , scale + ) where + +import Data.LinearMap + +type Coord = Double + +type Vector3 = (Coord, Coord, Coord) +type Transform = Vector3 :-* Vector3 + +class Transformable a where + (><) :: Transform -> a -> a + +instance Transformable Transform where + t1 >< t2 = t1 *.* t2 + +instance Transformable Vector3 where + t >< v = t `lapply` v + +translate :: Coord -> Coord -> Transform +translate dx dy = linear $ \(x, y, w) -> (x + w*dx, y + w*dy, w) + +rotate :: Coord -> Transform +rotate a = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w) where + c = cos a + s = sin a + +scale :: Coord -> Transform +scale s = linear $ \(x, y, w) -> (s*y, s*y, w) diff --git a/src/Vector.hs b/src/Vector.hs new file mode 100644 index 0000000..847be58 --- /dev/null +++ b/src/Vector.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE TypeFamilies #-} + +module Vector ( Vertex(..) + , Vector(..) + , toAngle + , translateV + , translateV' + , rotateV + , rotateV' + , diffV + ) where + +import Transformable + +import Data.AdditiveGroup +import Data.VectorSpace +import Data.LinearMap + +data Vertex = Vertex { vertexX :: Coord, vertexY :: Coord } deriving (Show, Eq) +instance Transformable Vertex where + t >< (Vertex x y) = Vertex x' y' + where + (x', y', _) = t >< (x, y, 1) :: Vector3 + +data Vector = Vector { vectorX :: Coord, vectorY :: Coord } deriving (Show, Eq) +instance Transformable Vector where + t >< (Vector x y) = Vector x' y' + where + (x', y', _) = t >< (x, y, 0) :: Vector3 + +instance AdditiveGroup Vector where + zeroV = Vector 0 0 + Vector x1 y1 ^+^ Vector x2 y2 = Vector (x1+x2) (y1+y2) + negateV (Vector x y) = Vector (-x) (-y) + +instance VectorSpace Vector where + type Scalar Vector = Coord + s *^ Vector x y = Vector (s*x) (s*y) + +instance InnerSpace Vector where + Vector x1 y1 <.> Vector x2 y2 = x1*x2 + y1*y2 + +toAngle :: Vector -> Coord +toAngle (Vector x y) = atan2 y x + +translateV :: Vector -> Transform +translateV (Vector x y) = translate x y + +translateV' :: Vector -> Transform +translateV' = translateV . negateV + +rotateV :: Vector -> Transform +rotateV (Vector c s) = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w) + +rotateV' :: Vector -> Transform +rotateV' (Vector c s) = rotateV $ Vector c (-s) + +diffV :: Vertex -> Vertex -> Vector +diffV (Vertex x1 y1) (Vertex x2 y2) = Vector (x2-x1) (y2-y1) -- cgit v1.2.3