-
Notifications
You must be signed in to change notification settings - Fork 1
/
Move.hs
141 lines (108 loc) · 4.8 KB
/
Move.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
{-# LANGUAGE OverloadedStrings #-}
module Move (
newMoveActor
) where
import HGamer3D
import qualified Data.Text as T
import Control.Concurrent
import qualified Data.Traversable as Tr
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.Unique
import Data
import Actor
-- MOVEMENT ACTOR
-- --------------
data MyActors = MyActors {
collA :: Actor,
musicA :: Actor,
statusA :: Actor
}
newMoveActor :: Actor -> Actor -> Actor -> Keys -> IO Actor
newMoveActor collA mA sA keys = do
let myActors = MyActors collA mA sA
actor <- newActor
runActor actor movementActorF (myActors, keys) 0
return actor
type MoaR = (MyActors, Keys)
type MoaS = (Int)
mapAccumLM f a xs = runStateT (Tr.mapM (StateT . f) xs) a
movementActorF :: Actor -> Message -> ReaderStateIO MoaR MoaS ()
movementActorF moveA m = do
(myActors, keys) <- lift ask
let (kent, kdim, kpos, khits, kanim, kuni) = keys
(c) <- get
case m of
MoveStep gameData colls -> do
let moves = c `div` nWait + (movesRightLeft `div` 2) -- start in the middle
let bMove = (c `mod` nWait == 0) && ((c `div` nWait) < (( 2 * movesRightLeft + 2 ) * movesDown) )
let move = moves `mod` (2 * movesRightLeft + 2)
put (c + 1)
if bMove
then do
liftIO $ doOneRun keys myActors gameData colls move moves
liftIO $ sendMsg (musicA myActors) PlayStep
return ()
else do
liftIO $ removeColls keys myActors gameData colls move moves
return ()
_ -> return ()
removeColls :: Keys -> MyActors -> GameData -> [Unique] -> Int -> Int -> IO ()
removeColls keys myActors gameData colls move moves = do
let (kent, kdim, kpos, khits, kanim, kuni) = keys
gameData' <- mapM (\(nodeType, nodeData) -> do
nodeData' <- case nodeType of
(Invader _) -> do
let i = nodeData ! kuni
if i `elem` (colls)
then do
sendMsg (musicA myActors) PlayExplosion
nodeData' <- liftIO $ deactivateInvader (statusA myActors) nodeType nodeData kpos
liftIO $ moveNode keys nodeData' (nodeData' ! kpos)
return nodeData'
else return nodeData
_ -> return nodeData
return (nodeType, nodeData')
) gameData
sendMsg (collA myActors) $ ActualInvaderData gameData'
doOneRun :: Keys -> MyActors -> GameData -> [Unique] -> Int -> Int -> IO ()
doOneRun keys myActors gameData colls move moves = do
let (kent, kdim, kpos, khits, kanim, kuni) = keys
gameData' <- mapM (\(nodeType, nodeData) -> do
nodeData' <- case nodeType of
(Invader _) -> do
let i = nodeData ! kuni
if i `elem` (colls)
then do
sendMsg (musicA myActors) PlayExplosion
nodeData' <- liftIO $ deactivateInvader (statusA myActors) nodeType nodeData kpos
liftIO $ moveNode keys nodeData' (nodeData' ! kpos)
return nodeData'
else invaderMove keys nodeData move
_ -> return nodeData
return (nodeType, nodeData')
) gameData
let gameData'' = gameData'
sendMsg (collA myActors) $ ActualInvaderData gameData''
nWait = 12 :: Int
movesRightLeft = 10 :: Int
movesDown = 15 :: Int
invaderMove :: Keys -> NodeData -> Int -> IO NodeData
invaderMove keys nd move = do
let (kent, kdim, kpos, khits, kanim, kuni) = keys
if move < movesRightLeft
then moveNode keys nd (2,0)
else if move == movesRightLeft
then moveNode keys nd (0, -5)
else if move <= 2 * movesRightLeft
then moveNode keys nd (-2, 0)
else moveNode keys nd (0, -5)
deactivateInvader :: Actor -> NodeType -> NodeData -> KPos -> IO NodeData
deactivateInvader statusA nt nd kpos = do
case nt of
Invader 1 -> sendMsg statusA (AddCount 10) -- each hit is done twice, before invaders removed
Invader 2 -> sendMsg statusA (AddCount 20)
Invader 3 -> sendMsg statusA (AddCount 30)
return $ setData kpos (-1000, 0) nd