diff options
| -rw-r--r-- | GLDriver.hs | 15 | ||||
| -rw-r--r-- | GLX.hs | 12 | ||||
| -rw-r--r-- | HTanks.hs | 66 | ||||
| -rw-r--r-- | Tank.hs | 1 |
4 files changed, 71 insertions, 23 deletions
diff --git a/GLDriver.hs b/GLDriver.hs index 9fb2642..2b55c6f 100644 --- a/GLDriver.hs +++ b/GLDriver.hs @@ -4,9 +4,12 @@ module GLDriver ( Driver(..) , SomeDriver(..) , Event , SomeEvent(..) + , fromEvent , QuitEvent(..) , ResizeEvent(..) - , fromEvent + , Key(..) + , KeyPressEvent(..) + , KeyReleaseEvent(..) ) where import Data.Typeable @@ -45,3 +48,13 @@ instance Event QuitEvent data ResizeEvent = ResizeEvent Int Int deriving Typeable instance Event ResizeEvent + + +data Key = KeyLeft | KeyRight | KeyUp | KeyDown + deriving (Eq, Ord, Show) + +data KeyPressEvent = KeyPressEvent Key deriving Typeable +instance Event KeyPressEvent + +data KeyReleaseEvent = KeyReleaseEvent Key deriving Typeable +instance Event KeyReleaseEvent @@ -118,6 +118,18 @@ handleEvent glx disp xevent = do keysym <- keycodeToKeysym disp (ev_keycode event) 0 case () of _ | keysym == xK_Escape -> return $ Just $ SomeEvent QuitEvent + | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyPressEvent KeyUp + | keysym == xK_Down -> return $ Just $ SomeEvent $ KeyPressEvent KeyDown + | keysym == xK_Left -> return $ Just $ SomeEvent $ KeyPressEvent KeyLeft + | keysym == xK_Right -> return $ Just $ SomeEvent $ KeyPressEvent KeyRight + | otherwise -> return Nothing + | evtype == keyRelease -> do + keysym <- keycodeToKeysym disp (ev_keycode event) 0 + case () of + _ | keysym == xK_Up -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyUp + | keysym == xK_Down -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyDown + | keysym == xK_Left -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyLeft + | keysym == xK_Right -> return $ Just $ SomeEvent $ KeyReleaseEvent KeyRight | otherwise -> return Nothing | evtype == clientMessage -> do if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event)) @@ -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 () @@ -7,4 +7,5 @@ data Tank = Tank { posx :: !Micro , posy :: !Micro , dir :: !Micro + , aim :: !Micro } deriving Show |