diff options
Diffstat (limited to 'HTanks.hs')
| -rw-r--r-- | HTanks.hs | 66 |
1 files changed, 44 insertions, 22 deletions
@@ -11,12 +11,16 @@ import GLX import Control.Concurrent (threadDelay) import Control.Monad.State import Data.Maybe +import Data.Ratio +import qualified Data.Set as S import Data.Time.Clock data MainState = MainState - { driver :: !SomeDriver + { run :: !Bool + , driver :: !SomeDriver , time :: !UTCTime + , keyset :: !(S.Set Key) } newtype MainT m a = MainT (StateT MainState m a) @@ -34,8 +38,8 @@ main = do when (initialized gl) $ do currentTime <- getCurrentTime - let mainState = MainState {driver = SomeDriver gl, time = currentTime} - gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0]} + 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]} setup 800 600 runGame gameState $ runMain mainState $ mainLoop @@ -49,7 +53,7 @@ mainLoop :: Main () mainLoop = do gl <- gets driver t <- gets time - run <- liftIO $ handleEvents gl + handleEvents lift render @@ -63,30 +67,48 @@ mainLoop = do currenttime <- liftIO getCurrentTime let d = round $ 1e3*(diffUTCTime currenttime t) - lift $ modify $ \state -> state {tanks = (Tank ((posx . head . tanks $ state)+(0.0001* fromIntegral d)) 0.0 0):(tail . tanks $ state)} - - liftIO $ print $ d + replicateM_ d simulationStep + --liftIO $ print $ d let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t modify $ \state -> state {time = newtime} - when run $ mainLoop + runnext <- gets run + when runnext mainLoop + + +simulationStep :: Main () +simulationStep = 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 + + let dx = fromRational (round (x*1000/length)%1000000) + dy = fromRational (round (y*1000/length)%1000000) + + oldtank <- lift $ gets (head . tanks) + let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank} + + lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)} -handleEvents :: Driver a => a -> IO Bool -handleEvents gl = do - event <- nextEvent gl - if (isJust event) - then - handleEvent $ fromJust event - else - return True +handleEvents :: Main () +handleEvents = do + event <- gets driver >>= liftIO . nextEvent + when (isJust event) $ + handleEvent $ fromJust event -handleEvent :: SomeEvent -> IO Bool +handleEvent :: SomeEvent -> Main () handleEvent ev - | Just (ResizeEvent w h) <- fromEvent ev = do - resize w h - return True - | Just QuitEvent <- fromEvent ev = return False - | otherwise = return True + | Just (ResizeEvent w h) <- fromEvent ev = liftIO $ resize w h + | Just (KeyPressEvent key) <- fromEvent ev = modify $ \state -> state {keyset = S.insert key (keyset state)} + | Just (KeyReleaseEvent key) <- fromEvent ev = modify $ \state -> state {keyset = S.delete key (keyset state)} + | Just QuitEvent <- fromEvent ev = modify $ \state -> state {run = False} + | otherwise = return () |