summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--htanks.cabal8
-rw-r--r--src/CPUPlayer.hs11
-rw-r--r--src/Collision.hs93
-rw-r--r--src/DefaultPlayer.hs15
-rw-r--r--src/Game.hs26
-rw-r--r--src/HTanks.hs11
-rw-r--r--src/HWiidPlayer.hs12
-rw-r--r--src/Player.hs5
-rw-r--r--src/Render.hs13
-rw-r--r--src/Simulation.hs82
-rw-r--r--src/Tank.hs30
-rw-r--r--src/Transformable.hs37
-rw-r--r--src/Vector.hs59
13 files changed, 258 insertions, 144 deletions
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 13:11:18 +0100