neocturne/htanks
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added Transformable class to simplify collision calculation

Browse source
This commit is contained in:
Matthias Schiffer 2011-06-24 21:50:32 +02:00
parent d7971385e8
commit 83f0606ea9
13 changed files with 258 additions and 144 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
htanks.cabal
View file

@ -6,14 +6,14 @@ category: Game
license: GPL-3 license: GPL-3
license-file: LICENSE license-file: LICENSE
author: Matthias Schiffer author: Matthias Schiffer
maintainer: matthias@gamezock.de maintainer: mschiffer@universe-factory.net
build-depends: base >= 4, syb, containers, mtl, time, X11, OpenGL, hwiid, obj-model, obj-model-opengl 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 build-type: Simple
data-files: tex/*.png model/*.obj data-files: tex/*.png model/*.obj
executable: HTanks executable: HTanks
hs-source-dirs: src hs-source-dirs: src
main-is: HTanks.hs main-is: HTanks.hs
other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, 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, Transformable, Debris,
Tank, Model, Bindings.GLX, Bindings.GLPng Tank, Model, Vector, Bindings.GLX, Bindings.GLPng
extra-libraries: glpng extra-libraries: glpng

11
src/CPUPlayer.hs
View file

@ -4,17 +4,20 @@ module CPUPlayer ( CPUPlayer(..)
) where ) where
import Data.Fixed
import Data.Ratio ((%))
import Data.Typeable import Data.Typeable
import Transformable
import Vector
import GLDriver import GLDriver
import Player import Player
data CPUPlayer = CPUPlayer Micro data CPUPlayer = CPUPlayer Vector
deriving (Typeable, Show) deriving (Typeable, Show)
instance Player CPUPlayer where 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), ((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'))

83
src/Collision.hs
View file

@ -5,68 +5,63 @@ module Collision ( collisionTankBorder
import Tank import Tank
import Game import Game
import Transformable
import Data.Fixed import qualified Vector as V
import Data.Ratio import Data.VectorSpace
tankWidth :: Micro tankWidth :: Coord
tankWidth = 0.4 tankWidth = 0.4
tankLength :: Micro tankLength :: Coord
tankLength = 0.95 tankLength = 0.95
bulletDiameter :: Micro bulletDiameter :: Coord
bulletDiameter = 0.05 bulletDiameter = 0.05
collisionTankBorder :: Micro -> Micro -> Tank -> Tank collisionTankBorder :: Coord -> Coord -> Tank -> Tank
collisionTankBorder lw lh tank = tank {tankX = newx, tankY = newy} collisionTankBorder lw lh tank = (translate dx dy) >< tank
where where
dir = (fromRational . toRational . tankDir $ tank)*pi/180 corners = [ V.Vector (tankLength/2) (tankWidth/2)
cosd = fromRational (round ((cos dir)*1000000)%1000000) , V.Vector (-tankLength/2) (tankWidth/2)
sind = fromRational (round ((sin dir)*1000000)%1000000) , V.Vector (-tankLength/2) (-tankWidth/2)
, V.Vector (tankLength/2) (-tankWidth/2)
]
points = [ (tankLength/2, tankWidth/2) rotp v = V.rotateV (tankDir tank) >< v
, (-tankLength/2, tankWidth/2) transp v = V.translateV v >< tankPos tank
, (-tankLength/2, -tankWidth/2)
, (tankLength/2, -tankWidth/2)
]
rotp (x, y) = (cosd*x - sind*y, sind*x + cosd*y) points = map (transp . rotp) corners
transp (x, y) = (x + tankX tank, y + tankY tank) minx = minimum $ map V.vertexX points
maxx = maximum $ map V.vertexX points
miny = minimum $ map V.vertexY points
maxy = maximum $ map V.vertexY points
pointst = map (transp . rotp) points dx = if minx < 0 then (-minx) else if maxx > lw then (-maxx+lw) else 0
minx = minimum $ map fst pointst dy = if miny < 0 then (-miny) else if maxy > lh then (-maxy+lh) else 0
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
collisionBulletBullet :: (Bullet, Bullet) -> (Bullet, Bullet) -> Bool collisionBulletBullet :: (Bullet, Bullet) -> (Bullet, Bullet) -> Bool
collisionBulletBullet (b1, b1') (b2, b2') = distancesq < (bulletDiameter^2) collisionBulletBullet (b1, b1') (b2, b2') = distancesq < (bulletDiameter^2)
where where
distancesq = (bulletX b1' - bulletX b2')^2 + (bulletY b1' - bulletY b2')^2 distancesq = (bulletX b1' - bulletX b2')^2 + (bulletY b1' - bulletY b2')^2
collisionBulletTank :: (Bullet, Bullet) -> (Tank, Tank) -> Bool 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)) collisionBulletTank (b, b') (tank, tank') = (not ((between bx minx maxx) && (between by miny maxy))) && ((between bx' minx maxx) && (between by' miny maxy))
where where
between x a b = x >= a && x <= b between x a b = x >= a && x <= b
dir t = (fromRational . toRational . tankDir $ t)*pi/180 rotp t v = V.rotateV' (tankDir t) >< v
cosd t = fromRational (round ((cos $ dir t)*1000000)%1000000) transp t v = V.diffV (tankPos t) v
sind t = fromRational (round ((sin $ dir t)*1000000)%1000000)
rotp t (x, y) = ((cosd t)*x + (sind t)*y, -(sind t)*x + (cosd t)*y) V.Vector bx by = (rotp tank) . (transp tank) $ bulletPos b
transp t (x, y) = (x - tankX t, y - tankY t) V.Vector bx' by' = (rotp tank') . (transp tank') $ bulletPos b'
(bx, by) = (rotp tank) . (transp tank) $ (bulletX b, bulletY b) minx = -tankLength/2
(bx', by') = (rotp tank') . (transp tank') $ (bulletX b', bulletY b') 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
minx = -tankLength/2
maxx = tankLength/2
miny = -tankWidth/2
maxy = tankWidth/2

15
src/DefaultPlayer.hs
View file

@ -16,8 +16,9 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec
import Tank import Tank
import GLDriver import GLDriver
import Player import Player
import Vector
import Transformable (Coord)
import Data.VectorSpace
data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool
deriving (Typeable, Show) deriving (Typeable, Show)
@ -26,12 +27,12 @@ instance Player DefaultPlayer where
playerUpdate (DefaultPlayer keys aimx aimy shoot) tank = 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) 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) 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) ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank)
ay = aimy - (fromRational . toRational . tankY $ tank) ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank)
move = (x /= 0 || y /= 0) move = (x /= 0 || y /= 0)
angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing dir = if move then Just (normalized $ Vector x y) else Nothing
aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing adir = if (ax /= 0 || ay /= 0) then Just (normalized $ Vector ax ay) else Nothing
in return (DefaultPlayer keys aimx aimy False, angle, move, aangle, shoot) in return (DefaultPlayer keys aimx aimy False, dir, move, adir, shoot)
handleEvent (DefaultPlayer keys aimx aimy shoot) ev handleEvent (DefaultPlayer keys aimx aimy shoot) ev
| Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy shoot | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy shoot

26
src/Game.hs
View file

@ -1,26 +1,36 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Game ( Bullet(..) module Game ( Bullet(..)
, bulletX
, bulletY
, GameState(..) , GameState(..)
) where ) where
import Level import Level
import Tank import Tank
import Transformable
import Control.Monad import Vector
import Control.Monad.State
import Data.Fixed
data Bullet = Bullet data Bullet = Bullet
{ bulletX :: !Micro { bulletPos :: !Vertex
, bulletY :: !Micro , bulletDir :: !Vector
, bulletDir :: !Micro , bulletSpeed :: !Coord
, bulletSpeed :: !Micro
, bulletBouncesLeft :: !Int , bulletBouncesLeft :: !Int
, bulletTank :: !Int , bulletTank :: !Int
} deriving (Eq, Show) } 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 data GameState = GameState
{ level :: !Level { level :: !Level
, tanks :: ![Tank] , tanks :: ![Tank]

11
src/HTanks.hs
View file

@ -20,6 +20,7 @@ import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Time import Data.Time
import Vector
main :: IO () main :: IO ()
main = do main = do
@ -30,14 +31,14 @@ main = do
when (initialized gl) $ do when (initialized gl) $ do
currentTime <- getCurrentTime currentTime <- getCurrentTime
let gamestate = GameState {level = theLevel, tanks = [ Tank 7.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 4.0 4.0 0 0 1.5 270 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 10.0 4.0 0 0 1.5 270 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 = []} ], bullets = []}
mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ SomePlayer humanPlayer [ SomePlayer humanPlayer
, SomePlayer $ CPUPlayer (-90) , SomePlayer $ CPUPlayer $ Vector 0 (-1)
, SomePlayer $ CPUPlayer 90 , SomePlayer $ CPUPlayer $ Vector 0 1
], textures = M.empty, models = M.empty, gameState = gamestate} ], textures = M.empty, models = M.empty, gameState = gamestate}
runMain mainstate $ do runMain mainstate $ do

12
src/HWiidPlayer.hs
View file

@ -20,6 +20,8 @@ import Graphics.Rendering.OpenGL.GL.VertexSpec
import Player import Player
import Tank import Tank
import qualified Transformable as T
import qualified Vector as V
data HWiidPlayer = HWiidPlayer Wiimote WiimoteAccCal [(Float, Float)] data HWiidPlayer = HWiidPlayer Wiimote WiimoteAccCal [(Float, Float)]
@ -51,15 +53,15 @@ instance Player HWiidPlayer where
then take irSkipSmooth newaims then take irSkipSmooth newaims
else newaims else newaims
(aimx, aimy) = if null aims then (0, 0) else mulV (1/(fromIntegral $ length aims)) (foldr addV (0, 0) aims) (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) ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank)
ay = aimy - (fromRational . toRational . tankY $ tank) ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank)
aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing aim = if (ax /= 0 || ay /= 0) then Just $ V.Vector ax ay else Nothing
move = (mx /= 0 || my /= 0) move = (mx /= 0 || my /= 0)
angle = atan2 my mx 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 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 _ _ []) = return ()
renderPlayer (HWiidPlayer _ _ aims) = unsafePreservingMatrix $ do renderPlayer (HWiidPlayer _ _ aims) = unsafePreservingMatrix $ do

5
src/Player.hs
View file

@ -4,7 +4,8 @@ module Player ( Player(..)
, SomePlayer(..) , SomePlayer(..)
) where ) where
import Data.Fixed import Transformable
import Vector
import Data.Typeable import Data.Typeable
import Tank import Tank
@ -12,7 +13,7 @@ import GLDriver (SomeEvent)
class Player a where 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 :: a -> SomeEvent -> a
handleEvent player _ = player handleEvent player _ = player

13
src/Render.hs
View file

@ -10,6 +10,7 @@ import Player
import Tank import Tank
import Texture import Texture
import Model import Model
import qualified Vector as V
import Control.Monad.State import Control.Monad.State
@ -148,11 +149,11 @@ render = do
forM_ tanklist $ \tank -> unsafePreservingMatrix $ do forM_ tanklist $ \tank -> unsafePreservingMatrix $ do
let x = realToFrac . tankX $ tank let x = realToFrac . tankX $ tank
y = realToFrac . tankY $ tank y = realToFrac . tankY $ tank
rotDir = realToFrac . tankDir $ tank rotDir = realToFrac . V.toAngle . tankDir $ tank
rotAim = realToFrac . tankAim $ tank rotAim = realToFrac . V.toAngle . tankAim $ tank
translate $ Vector3 x y (0 :: GLfloat) 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 textureBinding Texture2D $= Just textureTank
@ -160,7 +161,7 @@ render = do
rotate 90 $ Vector3 1 0 (0 :: GLfloat) rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelTank 1 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 textureBinding Texture2D $= Just textureCannon
@ -174,10 +175,10 @@ render = do
forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
let x = realToFrac . bulletX $ bullet let x = realToFrac . bulletX $ bullet
y = realToFrac . bulletY $ bullet y = realToFrac . bulletY $ bullet
rotDir = realToFrac . bulletDir $ bullet rotDir = realToFrac . V.toAngle . bulletDir $ bullet
translate $ Vector3 x y (0.25 :: GLfloat) 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 unsafePreservingMatrix $ do
drawObject modelBullet 0 drawObject modelBullet 0

82
src/Simulation.hs
View file

@ -7,31 +7,33 @@ import Level
import MainLoop import MainLoop
import Player import Player
import Tank import Tank
import Transformable
import Vector
import Control.Monad.State import Control.Monad.State
import Data.Fixed
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Ratio import Data.VectorSpace
updateAngle :: Micro -> Tank -> Tank updateAngle :: Vector -> Tank -> Tank
updateAngle angle tank = tank {tankDir = newangle180} updateAngle dir tank = tank {tankDir = rotate newangle >< Vector 1 0}
where where
oldangle = tankDir tank oldangle = toAngle . tankDir $ tank
angle = toAngle dir
tspeed = (tankTurnspeed tank)/100 tspeed = (tankTurnspeed tank)/100
diff = angle - oldangle diff = angle - oldangle
diff360 = if (diff > 180) diff360 = if (diff > pi)
then (diff-360) then (diff-2*pi)
else if (diff <= -180) else if (diff <= -pi)
then (diff+360) then (diff+2*pi)
else diff else diff
(diff180, angle180) = if (diff360 > 90) (diff180, angle180) = if (diff360 > pi/2)
then (diff360-180, oldangle+180) then (diff360-180, oldangle+pi)
else if (diff360 <= -90) else if (diff360 <= -pi/2)
then (diff360+180, oldangle-180) then (diff360+pi, oldangle-pi)
else (diff360, oldangle) else (diff360, oldangle)
turn = if (diff180 > tspeed) turn = if (diff180 > tspeed)
@ -42,20 +44,18 @@ updateAngle angle tank = tank {tankDir = newangle180}
newangle = angle180 + turn newangle = angle180 + turn
newangle180 = if (newangle > 180) approx :: Vector -> Vector -> Bool
then (newangle-360) approx (Vector x1 y1) (Vector x2 y2) = x1 `approx'` x2 && y1 `approx'` y2
else if (newangle <= -180) where
then (newangle+360) approx' a b = (abs (a-b)) < 0.000001
else newangle
updateTank :: GameState -> Maybe Vector -> Bool -> Maybe Vector -> State Tank ()
updateTank game dir move aim = do
when (isJust dir) $
modify $ updateAngle $ fromJust dir
updateTank :: GameState -> Maybe Micro -> Bool -> Maybe Micro -> State Tank () when (isJust aim) $
updateTank game angle move aangle = do modify $ \tank -> tank {tankAim = fromJust aim}
when (isJust angle) $
modify $ updateAngle $ fromJust angle
when (isJust aangle) $
modify $ \tank -> tank {tankAim = fromJust aangle}
when move $ do when move $ do
tank <- get tank <- get
@ -63,12 +63,8 @@ updateTank game angle move aangle = do
tspeed = tankSpeed tank tspeed = tankSpeed tank
moved = tankMoving tank moved = tankMoving tank
when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do when (isNothing dir || (isJust dir && (tdir `approx` fromJust dir) || moved)) $
let anglej = (fromRational . toRational $ tdir)*pi/180 put $ translateV (tdir ^* (tspeed/100)) >< tank {tankMoving = True}
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 (not move) $ do when (not move) $ do
modify $ \tank -> tank {tankMoving = False} modify $ \tank -> tank {tankMoving = False}
@ -79,22 +75,17 @@ updateTank game angle move aangle = do
updateBullet :: GameState -> Bullet -> (Bullet, Bool) 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 where
angle = (fromRational . toRational . bulletDir $ bullet)*pi/180
speed = bulletSpeed bullet speed = bulletSpeed bullet
dx = speed * fromRational (round ((cos angle)*1000)%100000) d@(Vector dx dy) = bulletDir bullet
dy = speed * fromRational (round ((sin angle)*1000)%100000) Vertex x y = translateV (d ^* (speed/100)) >< bulletPos bullet
x = dx + bulletX bullet bounces = bulletBouncesLeft bullet
y = dy + bulletY bullet
lw = fromIntegral . levelWidth . level $ game lw = fromIntegral . levelWidth . level $ game
lh = fromIntegral . levelHeight . level $ game lh = fromIntegral . levelHeight . level $ game
dir = bulletDir bullet
bounces = bulletBouncesLeft bullet
sg = if dir < 0 then -1 else 1 (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)
(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) (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)
(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)
gameStep :: [(Tank, Bool)] -> GameState -> GameState gameStep :: [(Tank, Bool)] -> GameState -> GameState
gameStep tanksshoot state = state {tanks = thetanks, bullets = newbullets ++ (map snd . filter fst $ leftbullets2)} 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..] 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 newtanks = map (\(tank, shoot, _) -> if (shoot && (tankBulletsLeft tank) > 0) then tank {tankBulletsLeft = (tankBulletsLeft tank) - 1} else tank) $ ts
newbullets = map (\(tank, n) -> Bullet newbullets = map (\(tank, n) -> Bullet
{ bulletX = tankX tank { bulletPos = tankPos tank
, bulletY = tankY tank
, bulletDir = tankAim tank , bulletDir = tankAim tank
, bulletSpeed = tankBulletSpeed tank , bulletSpeed = tankBulletSpeed tank
, bulletBouncesLeft = tankBulletBounces tank , bulletBouncesLeft = tankBulletBounces tank
@ -144,6 +134,6 @@ simulationStep = do
modify $ \state -> state {players = p, gameState = gameStep (zip t s) (gameState state)} modify $ \state -> state {players = p, gameState = gameStep (zip t s) (gameState state)}
where where
updateTank' game (player, tank) = do updateTank' game (player, tank) = do
(p, angle, move, aangle, shoot) <- playerUpdate player tank (p, dir, move, aim, shoot) <- playerUpdate player tank
let t = execState (updateTank game angle move aangle) tank let t = execState (updateTank game dir move aim) tank
return $ if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False) return $ if (tankLife tank > 0) then (p, t, shoot) else (player, tank, False)

30
src/Tank.hs
View file

@ -1,18 +1,32 @@
module Tank ( Tank(..) module Tank ( Tank(..)
, tankX
, tankY
) where ) where
import Data.Fixed import Transformable
import Vector
data Tank = Tank data Tank = Tank
{ tankX :: !Micro { tankPos :: !Vertex
, tankY :: !Micro , tankDir :: !Vector
, tankDir :: !Micro , tankAim :: !Vector
, tankAim :: !Micro , tankSpeed :: !Coord
, tankSpeed :: !Micro , tankTurnspeed :: !Coord
, tankTurnspeed :: !Micro
, tankMoving :: !Bool , tankMoving :: !Bool
, tankBulletSpeed :: !Micro , tankBulletSpeed :: !Coord
, tankBulletBounces :: !Int , tankBulletBounces :: !Int
, tankBulletsLeft :: !Int , tankBulletsLeft :: !Int
, tankLife :: !Int , tankLife :: !Int
} deriving (Eq, Show) } 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

37
src/Transformable.hs Normal file
View file

@ -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)

59
src/Vector.hs Normal file
View file

@ -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)