diff options
| -rw-r--r-- | GLDriver.hs | 12 | ||||
| -rw-r--r-- | HTanks.hs | 69 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | Tank.hs | 2 | ||||
| -rw-r--r-- | tex/Tank.png | bin | 423 -> 537 bytes |
5 files changed, 66 insertions, 19 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 @@ -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,27 +80,70 @@ 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)) + 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 (lengthsq /= 0) $ do - let length = sqrt lengthsq + when (isJust angle) $ do + tank <- lift $ gets (head . tanks) + let oldangle = dir tank - oldtank <- lift $ gets (head . tanks) + let diff = fromJust angle - oldangle + let diff360 = if (diff > 180) + then (diff-360) + else if (diff <= -180) + then (diff+360) + else diff - let dx = (speed oldtank) * fromRational (round (x*1000/length)%1000000) - dy = (speed oldtank) * fromRational (round (y*1000/length)%1000000) + let (diff180, angle180) = if (diff360 > 90) + then (diff360-180, oldangle+180) + else if (diff360 <= -90) + then (diff360+180, oldangle-180) + else (diff360, oldangle) - let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank, dir = fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000} + let tspeed = (turnspeed tank)/1000 + let turn = if (diff180 > tspeed) + then tspeed + else if (diff180 < -tspeed) + then (-tspeed) + else diff180 - lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)} - + 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 @@ -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) @@ -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 Binary files differindex 0e60bc1..3e7b6b3 100644 --- a/tex/Tank.png +++ b/tex/Tank.png |
