Implemented correct turning
This commit is contained in:
parent
6a381a238a
commit
d4db00ce9b
5 changed files with 70 additions and 23 deletions
12
GLDriver.hs
12
GLDriver.hs
|
@ -35,26 +35,28 @@ instance Driver SomeDriver where
|
||||||
nextEvent (SomeDriver d) = nextEvent d
|
nextEvent (SomeDriver d) = nextEvent d
|
||||||
|
|
||||||
|
|
||||||
class Typeable a => Event a
|
class (Typeable a, Show a) => Event a
|
||||||
|
|
||||||
data SomeEvent = forall a. Event a => SomeEvent a
|
data SomeEvent = forall a. Event a => SomeEvent a
|
||||||
|
instance Show SomeEvent where
|
||||||
|
show (SomeEvent a) = show a
|
||||||
|
|
||||||
fromEvent :: Event a => SomeEvent -> Maybe a
|
fromEvent :: Event a => SomeEvent -> Maybe a
|
||||||
fromEvent (SomeEvent a) = cast a
|
fromEvent (SomeEvent a) = cast a
|
||||||
|
|
||||||
|
|
||||||
data QuitEvent = QuitEvent deriving Typeable
|
data QuitEvent = QuitEvent deriving (Typeable, Show)
|
||||||
instance Event QuitEvent
|
instance Event QuitEvent
|
||||||
|
|
||||||
data ResizeEvent = ResizeEvent Int Int deriving Typeable
|
data ResizeEvent = ResizeEvent Int Int deriving (Typeable, Show)
|
||||||
instance Event ResizeEvent
|
instance Event ResizeEvent
|
||||||
|
|
||||||
|
|
||||||
data Key = KeyLeft | KeyRight | KeyUp | KeyDown
|
data Key = KeyLeft | KeyRight | KeyUp | KeyDown
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
data KeyPressEvent = KeyPressEvent Key deriving Typeable
|
data KeyPressEvent = KeyPressEvent Key deriving (Typeable, Show)
|
||||||
instance Event KeyPressEvent
|
instance Event KeyPressEvent
|
||||||
|
|
||||||
data KeyReleaseEvent = KeyReleaseEvent Key deriving Typeable
|
data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show)
|
||||||
instance Event KeyReleaseEvent
|
instance Event KeyReleaseEvent
|
||||||
|
|
67
HTanks.hs
67
HTanks.hs
|
@ -10,6 +10,7 @@ import GLX
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Data.Fixed
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Ratio
|
import Data.Ratio
|
||||||
|
@ -40,7 +41,7 @@ main = do
|
||||||
when (initialized gl) $ do
|
when (initialized gl) $ do
|
||||||
currentTime <- getCurrentTime
|
currentTime <- getCurrentTime
|
||||||
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, keyset = S.empty}
|
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, keyset = S.empty}
|
||||||
gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2], textures = M.empty}
|
gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2 360 False], textures = M.empty}
|
||||||
|
|
||||||
runGame gameState $ do
|
runGame gameState $ do
|
||||||
setup 800 600
|
setup 800 600
|
||||||
|
@ -70,7 +71,6 @@ mainLoop = do
|
||||||
let d = round $ 1e3*(diffUTCTime currenttime t)
|
let d = round $ 1e3*(diffUTCTime currenttime t)
|
||||||
|
|
||||||
replicateM_ d simulationStep
|
replicateM_ d simulationStep
|
||||||
--liftIO $ print $ d
|
|
||||||
|
|
||||||
let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t
|
let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t
|
||||||
|
|
||||||
|
@ -80,27 +80,70 @@ mainLoop = do
|
||||||
when runnext mainLoop
|
when runnext mainLoop
|
||||||
|
|
||||||
|
|
||||||
simulationStep :: Main ()
|
playerMovement :: Main (Maybe Micro, Bool)
|
||||||
simulationStep = do
|
playerMovement = do
|
||||||
keys <- gets keyset
|
keys <- gets keyset
|
||||||
|
|
||||||
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)
|
||||||
|
|
||||||
let lengthsq = ((x*x)+(y*y))
|
if (x /= 0 || y /= 0)
|
||||||
|
then return (Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000, True)
|
||||||
|
else return (Nothing, False)
|
||||||
|
|
||||||
when (lengthsq /= 0) $ do
|
|
||||||
let length = sqrt lengthsq
|
|
||||||
|
|
||||||
oldtank <- lift $ gets (head . tanks)
|
simulationStep :: Main ()
|
||||||
|
simulationStep = do
|
||||||
|
(angle, move) <- playerMovement
|
||||||
|
|
||||||
let dx = (speed oldtank) * fromRational (round (x*1000/length)%1000000)
|
when (isJust angle) $ do
|
||||||
dy = (speed oldtank) * fromRational (round (y*1000/length)%1000000)
|
tank <- lift $ gets (head . tanks)
|
||||||
|
let oldangle = dir tank
|
||||||
|
|
||||||
let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank, dir = fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000}
|
let diff = fromJust angle - oldangle
|
||||||
|
let diff360 = if (diff > 180)
|
||||||
|
then (diff-360)
|
||||||
|
else if (diff <= -180)
|
||||||
|
then (diff+360)
|
||||||
|
else diff
|
||||||
|
|
||||||
lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)}
|
let (diff180, angle180) = if (diff360 > 90)
|
||||||
|
then (diff360-180, oldangle+180)
|
||||||
|
else if (diff360 <= -90)
|
||||||
|
then (diff360+180, oldangle-180)
|
||||||
|
else (diff360, oldangle)
|
||||||
|
|
||||||
|
let tspeed = (turnspeed tank)/1000
|
||||||
|
let turn = if (diff180 > tspeed)
|
||||||
|
then tspeed
|
||||||
|
else if (diff180 < -tspeed)
|
||||||
|
then (-tspeed)
|
||||||
|
else diff180
|
||||||
|
|
||||||
|
let newangle = angle180 + turn
|
||||||
|
|
||||||
|
let newangle180 = if (newangle > 180)
|
||||||
|
then (newangle-360)
|
||||||
|
else if (newangle <= -180)
|
||||||
|
then (newangle+360)
|
||||||
|
else newangle
|
||||||
|
|
||||||
|
lift $ modify $ \state -> state {tanks = (tank {dir = newangle180}):(tail . tanks $ state)}
|
||||||
|
|
||||||
|
when move $ do
|
||||||
|
tank <- lift $ gets (head . tanks)
|
||||||
|
let moved = moving tank
|
||||||
|
|
||||||
|
when (isNothing angle || (isJust angle && (dir tank == fromJust angle)) || moved) $ do
|
||||||
|
let angle = (fromRational . toRational $ dir tank)*pi/180
|
||||||
|
x = (speed tank) * fromRational (round ((cos angle)*1000)%1000000)
|
||||||
|
y = (speed tank) * fromRational (round ((sin angle)*1000)%1000000)
|
||||||
|
|
||||||
|
lift $ modify $ \state -> state {tanks = (tank {posx = x + posx tank, posy = y + posy tank, moving = True}):(tail . tanks $ state)}
|
||||||
|
|
||||||
|
when (not move) $ do
|
||||||
|
tank <- lift $ gets (head . tanks)
|
||||||
|
lift $ modify $ \state -> state {tanks = (tank {moving = False}):(tail . tanks $ state)}
|
||||||
|
|
||||||
handleEvents :: Main ()
|
handleEvents :: Main ()
|
||||||
handleEvents = do
|
handleEvents = do
|
||||||
|
|
2
Tank.hs
2
Tank.hs
|
@ -9,4 +9,6 @@ data Tank = Tank
|
||||||
, dir :: !Micro
|
, dir :: !Micro
|
||||||
, aim :: !Micro
|
, aim :: !Micro
|
||||||
, speed :: !Micro
|
, speed :: !Micro
|
||||||
|
, turnspeed :: !Micro
|
||||||
|
, moving :: !Bool
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
BIN
tex/Tank.png
BIN
tex/Tank.png
Binary file not shown.
Before Width: | Height: | Size: 423 B After Width: | Height: | Size: 537 B |
Reference in a new issue