Implemented correct turning

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

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

Makefile

@@ -10,4 +10,4 @@ HTanks : $(HSFILES)
 	hsc2hs $<
 
 clean :
-	rm -f HTanks $(HSFILES:%.hs=%.o) $(HSFILES:%.hs=%.hi) $(HSCFILES:%.hsc=%.hs)
+	rm -f HTanks $(HSFILES:%.hs=%.o) $(HSFILES:%.hs=%.hi) $(HSCFILES:%.hsc=%.hs)

Tank.hs

@@ -9,4 +9,6 @@ data Tank = Tank
           , dir   :: !Micro
           , aim   :: !Micro
           , speed :: !Micro
+          , turnspeed :: !Micro
+          , moving :: !Bool
           } deriving Show