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)
ay = realToFrac $ aimy - (fromRational . toRational . tankY $ tank)
move = (x /= 0 || y /= 0)
dir = if move then Just (fromVector $ Vector x y) else Nothing
adir = if (ax /= 0 || ay /= 0) then Just (fromVector $ Vector ax ay) else Nothing
dir = if move then Just (fst . fromVector $ Vector x y) 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)
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)
ax = realToFrac $ aimx - (fromRational . toRational . tankX $ 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)
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
where
approx' a b = (abs (a-b)) < 0.000001
Vector c1 s1 = toVector r1
Vector c2 s2 = toVector r2
Vector c1 s1 = toVector 1 r1
Vector c2 s2 = toVector 1 r2
updateTank :: GameState -> Maybe Rotation -> Bool -> Maybe Rotation -> State Tank ()
updateTank game dir move aim = do
@ -57,7 +57,7 @@ updateTank game dir move aim = do
modify $ updateAngle $ fromJust dir
when (isJust aim) $
modify $ \tank -> tank {tankAim = fromJust aim}
modify $ \tank -> tank { tankAim = fromJust aim }
when move $ do
tank <- get
@ -66,7 +66,7 @@ updateTank game dir move aim = do
moved = tankMoving tank
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
modify $ \tank -> tank {tankMoving = False}
@ -77,17 +77,19 @@ updateTank game dir move aim = do
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
rot180 = fromAngle pi
speed = bulletSpeed bullet
d@(Vector dx dy) = toVector $ bulletDir bullet
Vertex x y = (d ^* (speed/100)) >< bulletPos bullet
dir = bulletDir bullet
Vertex x y = toVector (speed/100) dir >< bulletPos bullet
bounces = bulletBouncesLeft bullet
lw = fromIntegral . levelWidth . 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)
(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)
(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', 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 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 a = Rotation (cos a) (sin a)
toVector :: Rotation -> Vector
toVector (Rotation c s) = Vector c s
toVector :: Coord -> Rotation -> Vector
toVector l (Rotation c s) = l *^ Vector c s
fromVector :: Vector -> Rotation
fromVector v = Rotation x y
fromVector :: Vector -> (Rotation, Coord)
fromVector v = (Rotation x y, magnitude v)
where
Vector x y = normalized v