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

Refactored to/fromVector functions

Browse source
This commit is contained in:
Matthias Schiffer 2011-06-26 23:41:53 +02:00
parent ae4a694150
commit cfa9cf9456
4 changed files with 19 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/DefaultPlayer.hs
View file

@ -30,8 +30,8 @@ instance Player DefaultPlayer where
ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank) ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank)
ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank) ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank)
move = (x /= 0 || y /= 0) move = (x /= 0 || y /= 0)
dir = if move then Just (fromVector $ Vector x y) else Nothing dir = if move then Just (fst . fromVector $ Vector x y) else Nothing
adir = if (ax /= 0 || ay /= 0) then Just (fromVector $ Vector ax ay) else Nothing adir = if (ax /= 0 || ay /= 0) then Just (fst . fromVector $ Vector ax ay) else Nothing
in return (DefaultPlayer keys aimx aimy False, dir, move, adir, 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

2
src/HWiidPlayer.hs
View file

@ -55,7 +55,7 @@ instance Player HWiidPlayer where
(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 = realToFrac $ aimx - (fromRational . toRational . tankX $ tank) ax = realToFrac $ aimx - (fromRational . toRational . tankX $ tank)
ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank) ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank)
aim = if (ax /= 0 || ay /= 0) then Just . V.fromVector $ V.Vector ax ay else Nothing aim = if (ax /= 0 || ay /= 0) then Just . fst . V.fromVector $ V.Vector ax ay else Nothing
move = (mx /= 0 || my /= 0) move = (mx /= 0 || my /= 0)
angle = atan2 my mx angle = atan2 my mx

20
src/Simulation.hs
View file

@ -48,8 +48,8 @@ approx :: Rotation -> Rotation -> Bool
approx r1 r2 = c1 `approx'` c2 && s1 `approx'` s2 approx r1 r2 = c1 `approx'` c2 && s1 `approx'` s2
where where
approx' a b = (abs (a-b)) < 0.000001 approx' a b = (abs (a-b)) < 0.000001
Vector c1 s1 = toVector r1 Vector c1 s1 = toVector 1 r1
Vector c2 s2 = toVector r2 Vector c2 s2 = toVector 1 r2
updateTank :: GameState -> Maybe Rotation -> Bool -> Maybe Rotation -> State Tank () updateTank :: GameState -> Maybe Rotation -> Bool -> Maybe Rotation -> State Tank ()
updateTank game dir move aim = do updateTank game dir move aim = do
@ -57,7 +57,7 @@ updateTank game dir move aim = do
modify $ updateAngle $ fromJust dir modify $ updateAngle $ fromJust dir
when (isJust aim) $ when (isJust aim) $
modify $ \tank -> tank {tankAim = fromJust aim} modify $ \tank -> tank { tankAim = fromJust aim }
when move $ do when move $ do
tank <- get tank <- get
@ -66,7 +66,7 @@ updateTank game dir move aim = do
moved = tankMoving tank moved = tankMoving tank
when (isNothing dir || (isJust dir && (tdir `approx` fromJust dir) || moved)) $ when (isNothing dir || (isJust dir && (tdir `approx` fromJust dir) || moved)) $
put $ ((toVector tdir) ^* (tspeed/100)) >< tank {tankMoving = True} put $ toVector (tspeed/100) tdir >< tank {tankMoving = True}
when (not move) $ do when (not move) $ do
modify $ \tank -> tank {tankMoving = False} modify $ \tank -> tank {tankMoving = False}
@ -77,17 +77,19 @@ updateTank game dir move aim = do
updateBullet :: GameState -> Bullet -> (Bullet, Bool) updateBullet :: GameState -> Bullet -> (Bullet, Bool)
updateBullet game bullet = (bullet {bulletPos = Vertex x' y', bulletDir = fromVector $ Vector dx' dy', bulletBouncesLeft = bounces3}, bounces3 >= 0) updateBullet game bullet = (bullet {bulletPos = Vertex x' y', bulletDir = dir'', bulletBouncesLeft = bounces3}, bounces3 >= 0)
where where
rot180 = fromAngle pi
speed = bulletSpeed bullet speed = bulletSpeed bullet
d@(Vector dx dy) = toVector $ bulletDir bullet dir = bulletDir bullet
Vertex x y = (d ^* (speed/100)) >< bulletPos bullet Vertex x y = toVector (speed/100) dir >< bulletPos bullet
bounces = bulletBouncesLeft bullet bounces = bulletBouncesLeft bullet
lw = fromIntegral . levelWidth . level $ game lw = fromIntegral . levelWidth . level $ game
lh = fromIntegral . levelHeight . level $ game lh = fromIntegral . levelHeight . level $ game
(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) (x', dir', bounces2) = if x < 0 then (-x, negateV dir, bounces-1) else if x > lw then (2*lw-x, negateV 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) (y', dir'', bounces3) = if y < 0 then (-y, rot180 ^-^ dir', bounces2-1) else if y > lh then (2*lh-y, rot180 ^-^ dir', bounces2-1) else (y, dir', 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)}

8
src/Vector.hs
View file

@ -81,11 +81,11 @@ toAngle (Rotation c s) = atan2 s c
fromAngle :: Coord -> Rotation fromAngle :: Coord -> Rotation
fromAngle a = Rotation (cos a) (sin a) fromAngle a = Rotation (cos a) (sin a)
toVector :: Rotation -> Vector toVector :: Coord -> Rotation -> Vector
toVector (Rotation c s) = Vector c s toVector l (Rotation c s) = l *^ Vector c s
fromVector :: Vector -> Rotation fromVector :: Vector -> (Rotation, Coord)
fromVector v = Rotation x y fromVector v = (Rotation x y, magnitude v)
where where
Vector x y = normalized v Vector x y = normalized v