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
89
90
91
92
93
|
{-# LANGUAGE PatternGuards #-}
import Game
import Level
import MainLoop
import Render
import Player
import CPUPlayer
import DefaultPlayer
import HWiidPlayer
import Simulation
import Tank
import Vector
import GLDriver
import GLX
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
--humanPlayer <- newHWiidPlayer
let humanPlayer = DefaultPlayer S.empty 0 0 False
gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel)
when (initialized gl) $ do
currentTime <- getCurrentTime
let gamestate = GameState {level = theLevel, tanks = [ Tank (Vertex 7.0 4.0) zeroV zeroV 1.5 (270*pi/180) False 3 1 5 1
, Tank (Vertex 4.0 4.0) zeroV zeroV 1.5 (270*pi/180) False 3 1 5 1
, Tank (Vertex 10.0 4.0) zeroV zeroV 1.5 (270*pi/180) False 3 1 5 1
], bullets = []}
mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ SomePlayer humanPlayer
, SomePlayer $ CPUPlayer $ fromAngle $ -pi/2
, SomePlayer $ CPUPlayer $ fromAngle $ pi/2
], textures = M.empty, models = M.empty, gameState = gamestate}
runMain mainstate $ do
setup
mainLoop
deinitGL gl
minFrameTime :: NominalDiffTime
minFrameTime = 0.02
mainLoop :: Main ()
mainLoop = do
gl <- gets driver
t <- gets time
handleEvents
render
liftIO $ swapBuffers gl
rtime <- liftIO getCurrentTime
let drender = diffUTCTime rtime t
when (drender < minFrameTime) $
liftIO $ usleep gl $ 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 ()
|
