From d4db00ce9bce4410becfc4ee71264fc607b96c5b Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Tue, 2 Mar 2010 06:10:34 +0100 Subject: [PATCH] Implemented correct turning --- GLDriver.hs | 12 ++++---- HTanks.hs | 77 +++++++++++++++++++++++++++++++++++++++------------ Makefile | 2 +- Tank.hs | 2 ++ tex/Tank.png | Bin 423 -> 537 bytes 5 files changed, 70 insertions(+), 23 deletions(-) diff --git a/GLDriver.hs b/GLDriver.hs index 2b55c6f..44964d8 100644 --- a/GLDriver.hs +++ b/GLDriver.hs @@ -35,26 +35,28 @@ instance Driver SomeDriver where 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 +instance Show SomeEvent where + show (SomeEvent a) = show a fromEvent :: Event a => SomeEvent -> Maybe a fromEvent (SomeEvent a) = cast a -data QuitEvent = QuitEvent deriving Typeable +data QuitEvent = QuitEvent deriving (Typeable, Show) instance Event QuitEvent -data ResizeEvent = ResizeEvent Int Int deriving Typeable +data ResizeEvent = ResizeEvent Int Int deriving (Typeable, Show) instance Event ResizeEvent data Key = KeyLeft | KeyRight | KeyUp | KeyDown deriving (Eq, Ord, Show) -data KeyPressEvent = KeyPressEvent Key deriving Typeable +data KeyPressEvent = KeyPressEvent Key deriving (Typeable, Show) instance Event KeyPressEvent -data KeyReleaseEvent = KeyReleaseEvent Key deriving Typeable +data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show) instance Event KeyReleaseEvent diff --git a/HTanks.hs b/HTanks.hs index a6ade4f..22b8309 100644 --- a/HTanks.hs +++ b/HTanks.hs @@ -10,6 +10,7 @@ import GLX import Control.Concurrent (threadDelay) import Control.Monad.State +import Data.Fixed import Data.Maybe import qualified Data.Map as M import Data.Ratio @@ -40,7 +41,7 @@ main = do when (initialized gl) $ do currentTime <- getCurrentTime 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 setup 800 600 @@ -70,7 +71,6 @@ mainLoop = do let d = round $ 1e3*(diffUTCTime currenttime t) replicateM_ d simulationStep - --liftIO $ print $ d let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t @@ -80,28 +80,71 @@ mainLoop = do when runnext mainLoop -simulationStep :: Main () -simulationStep = do +playerMovement :: Main (Maybe Micro, Bool) +playerMovement = do keys <- gets keyset 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) - let lengthsq = ((x*x)+(y*y)) - - when (lengthsq /= 0) $ do - let length = sqrt lengthsq - - oldtank <- lift $ gets (head . tanks) - - let dx = (speed oldtank) * fromRational (round (x*1000/length)%1000000) - dy = (speed oldtank) * fromRational (round (y*1000/length)%1000000) - - let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank, dir = fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000} - - lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)} + if (x /= 0 || y /= 0) + then return (Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000, True) + else return (Nothing, False) +simulationStep :: Main () +simulationStep = do + (angle, move) <- playerMovement + + when (isJust angle) $ do + tank <- lift $ gets (head . tanks) + let oldangle = dir tank + + let diff = fromJust angle - oldangle + let diff360 = if (diff > 180) + then (diff-360) + else if (diff <= -180) + then (diff+360) + else diff + + 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 = do event <- gets driver >>= liftIO . nextEvent diff --git a/Makefile b/Makefile index 8de3dc4..f28968b 100644 --- a/Makefile +++ b/Makefile @@ -10,4 +10,4 @@ HTanks : $(HSFILES) hsc2hs $< clean : - rm -f HTanks $(HSFILES:%.hs=%.o) $(HSFILES:%.hs=%.hi) $(HSCFILES:%.hsc=%.hs) \ No newline at end of file + rm -f HTanks $(HSFILES:%.hs=%.o) $(HSFILES:%.hs=%.hi) $(HSCFILES:%.hsc=%.hs) diff --git a/Tank.hs b/Tank.hs index 28f286c..4b68889 100644 --- a/Tank.hs +++ b/Tank.hs @@ -9,4 +9,6 @@ data Tank = Tank , dir :: !Micro , aim :: !Micro , speed :: !Micro + , turnspeed :: !Micro + , moving :: !Bool } deriving Show diff --git a/tex/Tank.png b/tex/Tank.png index 0e60bc1ff0c139323c70bace4e4023bc0fcfff0f..3e7b6b3543694496cf085f2b4d8a8a03115a17bc 100644 GIT binary patch delta 416 zcmV;R0bl;71DOPnUkL*O1SA{oT&Euswd zq98u@DkU+gwhAu4#?JfUkrXxpyd+ly06sNmER;7Ju1(J$PTRRZTzy+(=|=yPfD_*XC=1*OKw^Iz{M_@c%0-MG5Ms*H5P(1=s7|#mIivryIx`$~j4Gfd5I2=PMuBO-rY@MU zwnWI1nO^CqEt;}OE_~VC$cr#l;iUJhfNg_KCL&Dnw53g^w-=?(S8hWT#Fz{K0000< KMNUMnLSTXkp}gP# delta 301 zcmbQqvYdHBJSUSRv$WwQzSXG{Gc@X%JY5_^DsH{K?#Opofyd=y-~0OKFZXq6IrS)h zh;(bLl5<=5>k9Avns`yy%!LPnv#xSC@vn^(zI~hbeB1T)i#}w{Sbk)yH^V%!=j`v7 zrCx0K@G8c+b^l%4gPpG}3-iilweEe@Y1lF=DdgTe~DWM4f;AnnD