blob: 63e647da36e092181df0b9af99ba99047053073f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
{-# LANGUAGE PatternGuards #-}
import Game
import Level
import MainLoop
import Render
import Player
import CPUPlayer
import DefaultPlayer
import Simulation
import Tank
import GLDriver
import GLX
import Control.Concurrent (threadDelay)
import Control.Monad.State
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Time
main :: IO ()
main = do
let theLevel = testLevel
gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel)
when (initialized gl) $ do
currentTime <- getCurrentTime
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ SomePlayer $ DefaultPlayer S.empty 0 0 False
, SomePlayer $ CPUPlayer 0
]}
gameState = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 2 270 False 3 1 5
, Tank 5.0 3.5 0 0 2 270 False 3 1 5
], bullets = [], textures = M.empty}
runGame gameState $ do
setup
runMain mainState mainLoop
deinitGL gl
minFrameTime :: NominalDiffTime
minFrameTime = 0.01
mainLoop :: Main ()
mainLoop = do
gl <- gets driver
t <- gets time
handleEvents
lift render
liftIO $ swapBuffers gl
rtime <- liftIO getCurrentTime
let drender = diffUTCTime rtime t
when (drender < minFrameTime) $
liftIO $ threadDelay $ truncate $ 1e6*(minFrameTime - drender)
currenttime <- liftIO getCurrentTime
let d = round $ 1e2*(diffUTCTime currenttime t)
replicateM_ d simulationStep
let newtime = addUTCTime ((1e-2)*(fromIntegral d)) t
modify $ \state -> state {time = newtime}
runnext <- gets run
when runnext mainLoop
handleEvents :: Main ()
handleEvents = do
(newgl, event) <- gets driver >>= liftIO . nextEvent
modify $ \state -> state {driver = newgl}
when (isJust event) $ do
Main.handleEvent $ fromJust event
modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state}
handleEvents
handleEvent :: SomeEvent -> Main ()
handleEvent ev
| Just QuitEvent <- fromEvent ev = modify $ \state -> state {run = False}
| otherwise = return ()
|
