-
Notifications
You must be signed in to change notification settings - Fork 1
/
Switch.hs
280 lines (218 loc) · 9.88 KB
/
Switch.hs
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
{-# LANGUAGE OverloadedStrings #-}
module Switch (
newSwitchActor
) where
import HGamer3D
import Data
import Actor
import Input
import GameLoop
import Music
import Status
import Fly
import Animate
import qualified Data.Text as T
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
-- SWITCH ACTOR
-- ------------
-- switchA needs to be fast to be repsonsive to single keys
--
data MyActors = MyActors {
keyA :: Actor,
musicA :: Actor,
gameLoopA :: Actor,
animateA :: Actor,
flyingA :: Actor,
statusBarA :: Actor
}
type GsaR = (HG3D)
type GsaS = (MyActors, TextData, T.Text, GameState)
newSwitchActor :: HG3D -> Entity -> IO Actor
newSwitchActor hg3d cam = do
flyA <- newFlyingActor cam
actor <- newActor
runActor actor gameSwitchActorF hg3d (MyActors undefined undefined undefined undefined flyA undefined, undefined, undefined, ProgramInitializing)
return actor
gameSwitchActorF :: Actor -> Message -> ReaderStateIO GsaR GsaS ()
gameSwitchActorF switchA msg = do
hg3d <- lift ask
(myActors, startScreenText, name, gameState) <- get
let returnStay = return ()
let returnMoveTo state = put (myActors, startScreenText, name, state) >> return ()
-- HGamer3D website, space invaders, switch actor
case gameState of
ProgramInitializing ->
case msg of
StartProgram -> do
-- initialize music, keys and start screen
mA <- liftIO $ newMusicActor hg3d
kA <- liftIO $ newKeyActor hg3d switchA
startScreenText' <- liftIO $ showInitScreen hg3d
liftIO $ sendMsg mA StartMusic
-- create hearbeat of program
let cycleLoop n m = do
if n == 0
then sendMsg switchA SlowCycle
else return ()
sendMsg kA PollKeys
sendMsg switchA FastCycle
sleepFor (msecT 30)
cycleLoop (if n == 0 then m else n - 1) m
liftIO $ forkIO $ cycleLoop 0 10
put (myActors {keyA = kA, musicA = mA}, startScreenText', name, InitScreen)
_ -> returnStay
-- end of website text
InitScreen ->
case msg of
SingleKey k -> do
if k == "Return"
then do
-- hide start screen, stop music
name' <- liftIO $ getName startScreenText
liftIO $ hideInitScreen startScreenText
liftIO $ sendMsg (musicA myActors) StopMusic
-- initialize status bar
sA <- liftIO $ newStatusBarActor hg3d 0 name' "building"
-- initialize game data
keys <- liftIO $ genKeys
invaders <- liftIO $ gameDataFromBuildData hg3d keys buildInvadersData
canons <- liftIO $ gameDataFromBuildData hg3d keys buildCanonData
-- start gameloop actors and animation
glA <- liftIO $ newGameLoopActor switchA (musicA myActors) sA keys invaders canons
aA <- liftIO $ newAnimateActor keys invaders
put (myActors {gameLoopA = glA, animateA = aA, statusBarA = sA}, startScreenText, name', PlayGame) >> return ()
-- send data to gameloop actor
liftIO $ sendMsg glA $ ActualInvaderData invaders
liftIO $ sendMsg glA $ ActualCanonData canons
liftIO $ sendMsg sA (SetMode "playing")
else returnStay
_ -> returnStay
PlayGame -> do
-- liftIO $ print ((isJust slotMoveData), (isJust slotCanonData), (isJust slotCollData))
case msg of
SlowCycle -> liftIO $ sendMsg (animateA myActors) SlowCycle
FastCycle -> liftIO $ sendMsg (gameLoopA myActors) FastCycle
SingleKey k -> do
case k of
"Space" -> do
liftIO $ sendMsg (gameLoopA myActors) Shoot
returnStay
"F1" -> liftIO (sendMsg (statusBarA myActors) (SetMode "paused ...")) >> returnMoveTo Flying
"F2" -> liftIO (sendMsg (flyingA myActors) ResetCamPosition) >> returnStay
_ -> returnStay
KeysPressed keys -> do
if ("Left" `elem` keys) && (not ("Right" `elem` keys))
then do
liftIO $ sendMsg (gameLoopA myActors) MoveLeft
returnStay
else returnStay
if ("Right" `elem` keys) && (not ("Left" `elem` keys))
then do
liftIO $ sendMsg (gameLoopA myActors) MoveRight
returnStay
else returnStay
GameLostOverrun -> do
liftIO $ sendMsg (statusBarA myActors) (SetMode "game lost!")
liftIO $ showLost hg3d
returnMoveTo FinalScore
GameWon -> do
liftIO $ sendMsg (statusBarA myActors) (SetMode "game won!")
liftIO $ showWon hg3d
returnMoveTo FinalScore
_ -> returnStay
Flying ->
case msg of
SlowCycle -> liftIO $ sendMsg (animateA myActors) SlowCycle
SingleKey k -> do
case k of
"F1" -> liftIO (sendMsg (statusBarA myActors) (SetMode "playing")) >> returnMoveTo PlayGame
"W" -> liftIO (sendMsg (flyingA myActors) MoreSpeed) >> returnStay
"S" -> liftIO (sendMsg (flyingA myActors) LessSpeed) >> returnStay
"Q" -> liftIO (sendMsg (flyingA myActors) ZeroSpeed) >> returnStay
"F2" -> liftIO (sendMsg (flyingA myActors) ResetCamPosition) >> returnStay
"F3" -> liftIO (sendMsg (flyingA myActors) SaveCamPosition) >> returnStay
"F4" -> liftIO (sendMsg (flyingA myActors) RestoreCamPosition) >> returnStay
_ -> returnStay
KeysPressed keys -> do
mapM (\k -> do
case k of
"A" -> liftIO $ sendMsg (flyingA myActors) YawLeft
"D" -> liftIO $ sendMsg (flyingA myActors) YawRight
"Up" -> liftIO $ sendMsg (flyingA myActors) PitchUp
"Down" -> liftIO $ sendMsg (flyingA myActors) PitchDown
"Left" -> liftIO $ sendMsg (flyingA myActors) RollLeft
"Right" -> liftIO $ sendMsg (flyingA myActors) RollRight
_ -> return ()
) keys
returnStay
_ -> returnStay
FinalScore ->
case msg of
SlowCycle -> liftIO $ sendMsg (animateA myActors) SlowCycle
_ -> returnStay
data TextData = TextData Entity Entity Entity Entity Entity
getName :: TextData -> IO T.Text
getName (TextData _ _ _ _ eName) = readC eName ctEditText
hideInitScreen :: TextData -> IO ()
hideInitScreen (TextData e1 e2 e3 e4 eName) = mapM (\e -> setC e ctScreenRect (ScreenRect (-1000) (-1000) 0 0)) [e1, e2, e3, e4, eName] >> return ()
showResultScreen :: HG3D -> T.Text -> IO ()
showResultScreen hg3d result = do
eT1 <- newE hg3d [
ctStaticText #: result,
ctScreenRect #: ScreenRect 250 200 100 25
]
sleepFor (secT 5)
return ()
showWon hg3d = showResultScreen hg3d "Congratulation, you made it!"
showLost hg3d = showResultScreen hg3d "You lost, try again!"
showInitScreen :: HG3D -> IO TextData
showInitScreen hg3d = do
eT1 <- newE hg3d [
ctStaticText #: "Space Invaders 3D",
ctScreenRect #: ScreenRect 250 100 100 25
]
eT2 <- newE hg3d [
ctStaticText #: "programmed by: Peter Althainz\nusing the fabulous HGamer3D toolset\nSeptember 2016\n\nhttp://www.hgamer3d.org",
ctScreenRect #: ScreenRect 220 150 100 60
]
eT3 <- newE hg3d [
ctStaticText #: "dear brave hero, please type in your name: ",
ctScreenRect #: ScreenRect 220 250 100 60
]
eName <- newE hg3d [
ctEditText #: "The Brave Hero",
ctScreenRect #: ScreenRect 220 280 200 30
]
eT4 <- newE hg3d [
ctStaticText #: (T.pack . unlines $ [
"Keys:",
"F1 - switch pause flight mode - play mode",
"F2 - reset camera position",
"F3 - store camera position (flight mode)",
"F4 - restore camera position (flight mode)\n",
"Flight Mode: WSADQ Up/Down/Left/Right",
"Play Mode: Left/Right/Space" ]),
ctScreenRect #: ScreenRect 220 350 100 60
]
return $ TextData eT1 eT2 eT3 eT4 eName
buildInvadersData :: [BuildElement]
buildInvadersData = [
BEOne Ship (0, 100),
BERow Boulder (-45, -50) 40 4,
BERow (Invader 3) (-60, 85) 15 11,
BERow (Invader 2) (-60, 70) 15 11,
BERow (Invader 2) (-60, 55) 15 11,
BERow (Invader 1) (-60, 40) 15 11,
BERow (Invader 1) (-60, 25) 15 11
]
buildCanonData :: [BuildElement]
buildCanonData = [
BEOne Canon (0, -65),
BERow Canon (-60, -80) 15 2,
BERow Shot (-1000, 0) 5 5
]