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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-}
import Game
import Level
import Render
import Tank
import GLDriver
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
import qualified Data.Set as S
import Data.Time.Clock
data MainState = MainState
{ run :: !Bool
, driver :: !SomeDriver
, time :: !UTCTime
, keyset :: !(S.Set Key)
}
newtype MainT m a = MainT (StateT MainState m a)
deriving (Monad, MonadState MainState, MonadIO, MonadTrans)
type Main = MainT Game
runMain :: MainState -> Main a -> Game (a, MainState)
runMain st (MainT a) = runStateT a st
main :: IO ()
main = do
gl <- initGL glxDriver
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 360 False], textures = M.empty}
runGame gameState $ do
setup 800 600
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 $ 1e3*(diffUTCTime currenttime t)
replicateM_ d simulationStep
let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t
modify $ \state -> state {time = newtime}
runnext <- gets run
when runnext mainLoop
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)
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 (isJust angle) $ do
tank <- lift $ gets (head . tanks)
let oldangle = dir tank
let diff = fromJust angle - oldangle
let diff360 = if (diff > 180)
then (diff-360)
else if (diff <= -180)
then (diff+360)
else diff
let (diff180, angle180) = if (diff360 > 90)
then (diff360-180, oldangle+180)
else if (diff360 <= -90)
then (diff360+180, oldangle-180)
else (diff360, oldangle)
let tspeed = (turnspeed tank)/1000
let turn = if (diff180 > tspeed)
then tspeed
else if (diff180 < -tspeed)
then (-tspeed)
else diff180
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
event <- gets driver >>= liftIO . nextEvent
when (isJust event) $ do
handleEvent $ fromJust event
handleEvents
handleEvent :: SomeEvent -> Main ()
handleEvent ev
| Just (ResizeEvent w h) <- fromEvent ev = lift $ 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 ()
|
