Browse Source

Some refactoring

Abhinav Sarkar 5 years ago
parent
commit
359f1b83c8
2 changed files with 40 additions and 45 deletions
  1. 1
    0
      hastron.cabal
  2. 39
    45
      src/Hastron/Game/Engine.hs

+ 1
- 0
hastron.cabal View File

@@ -24,6 +24,7 @@ executable hastron
24 24
                        unordered-containers >=0.2.5 && <0.3,
25 25
                        dlist >= 0.7 && <0.8,
26 26
                        mtl >= 2.2 && <2.3,
27
+                       bifunctors >=5 && <6,
27 28
                        hashable >=1.2 && <1.3
28 29
   hs-source-dirs:      src
29 30
   default-language:    Haskell2010

+ 39
- 45
src/Hastron/Game/Engine.hs View File

@@ -6,8 +6,9 @@ import           Control.Applicative    (Applicative)
6 6
 import           Control.Monad.Identity (Identity, runIdentity)
7 7
 import           Control.Monad.Reader   (MonadReader, ask)
8 8
 import           Control.Monad.RWS      (MonadRWS, RWST, execRWST)
9
-import           Control.Monad.State    (MonadState, get, put)
9
+import           Control.Monad.State    (MonadState, get, put, modify)
10 10
 import           Control.Monad.Writer   (MonadWriter, tell)
11
+import           Data.Bifunctor         (second)
11 12
 import           Data.DList             (DList)
12 13
 import qualified Data.DList             as DList
13 14
 import qualified Data.HashMap.Strict    as Map
@@ -16,21 +17,6 @@ import           Data.List              (foldl')
16 17
 import           Hastron.Game.Types
17 18
 import           Prelude                hiding (Left, Right)
18 19
 
19
-leftTurn :: Direction -> Direction
20
-leftTurn Left  = Down
21
-leftTurn Right = Up
22
-leftTurn Up    = Left
23
-leftTurn Down  = Right
24
-
25
-rightTurn :: Direction -> Direction
26
-rightTurn Left  = Up
27
-rightTurn Right = Down
28
-rightTurn Up    = Right
29
-rightTurn Down  = Left
30
-
31
-noTurn :: Direction -> Direction
32
-noTurn = id
33
-
34 20
 newtype GameEngine a =
35 21
   GameEngine { _runGameEngine :: RWST GameSettings (DList OutEvent) (GameMap, Player) Identity a }
36 22
   deriving ( Functor
@@ -54,22 +40,22 @@ move timeElapsed = do
54 40
   settings <- ask
55 41
   go settings state
56 42
   where
57
-    go GameSettings{..}
58
-       (gameMap@GameMap{..}, player@Player{playerBoost = playerBoost@PlayerBoost{..}, ..})
43
+    go GameSettings{ .. } (gameMap@GameMap{ .. }, player@Player{ .. })
59 44
       | playerState /= PlayerAlive    || timeElapsed < 0 = return ()
60
-      | not boostActive || boostFuel >= timeElapsed      = movePlayer
45
+      | not boostActive || boostFuel >= timeElapsed      = move'
61 46
       | otherwise                                        =
62 47
           move boostFuel >> move (timeElapsed - boostFuel)
63 48
       where
64 49
         (x, y)               = playerPosition
65 50
         (Velocity speed dir) = playerVelocity
51
+        PlayerBoost{ .. }      = playerBoost
66 52
         dist                 =
67 53
           timeElapsed * speed * (if boostActive && boostFuel > 0 then gameBoostFactor else 1)
68 54
 
69
-        move' Left  = tail [(x', y) | x' <- [x, x - 1 .. x - dist]]
70
-        move' Right = tail [(x', y) | x' <- [x .. x + dist]]
71
-        move' Up    = tail [(x, y') | y' <- [y, y - 1 .. y - dist]]
72
-        move' Down  = tail [(x, y') | y' <- [y .. y + dist]]
55
+        makeTrail Left  = tail [(x', y) | x' <- [x, x - 1 .. x - dist]]
56
+        makeTrail Right = tail [(x', y) | x' <- [x .. x + dist]]
57
+        makeTrail Up    = tail [(x, y') | y' <- [y, y - 1 .. y - dist]]
58
+        makeTrail Down  = tail [(x, y') | y' <- [y .. y + dist]]
73 59
 
74 60
         checkTrail trail =
75 61
           let trail' = takeWhile (not . flip Set.member gameMapBlockedPoints) trail
@@ -77,9 +63,9 @@ move timeElapsed = do
77 63
              then (trail, PlayerAlive)
78 64
              else (trail', PlayerDead)
79 65
 
80
-        movePlayer = do
66
+        move' = do
81 67
           let
82
-            revTrail                     = move' dir
68
+            revTrail                     = makeTrail dir
83 69
             (checkedTrail, playerState') = checkTrail revTrail
84 70
             trail                        = reverse checkedTrail
85 71
             pos'                         = if null trail then playerPosition else head trail
@@ -97,32 +83,40 @@ move timeElapsed = do
97 83
           put (gameMap', player')
98 84
           tell $ DList.fromList outEvents
99 85
 
86
+leftTurn :: Direction -> Direction
87
+leftTurn Left  = Down
88
+leftTurn Right = Up
89
+leftTurn Up    = Left
90
+leftTurn Down  = Right
91
+
92
+rightTurn :: Direction -> Direction
93
+rightTurn Left  = Up
94
+rightTurn Right = Down
95
+rightTurn Up    = Right
96
+rightTurn Down  = Left
97
+
98
+noTurn :: Direction -> Direction
99
+noTurn = id
100
+
100 101
 turn :: (Direction -> Direction) -> GameEngine ()
101
-turn turnFn = get >>= go
102
-  where
103
-    go (gameMap, player@Player{playerVelocity = Velocity speed dir}) =
104
-      put ( gameMap, player { playerVelocity = Velocity speed $ turnFn dir })
102
+turn turnFn = modify . second $ \player@Player{ playerVelocity = Velocity speed dir } ->
103
+  player { playerVelocity = Velocity speed $ turnFn dir }
105 104
 
106 105
 changeBoost :: Bool -> GameEngine ()
107
-changeBoost boostActive = get >>= go
108
-  where
109
-    go (gameMap, player@Player{..}) =
110
-      put (gameMap, player { playerBoost = playerBoost { boostActive = boostActive } })
106
+changeBoost boostActive = modify . second $ \player@Player{ .. } ->
107
+  player { playerBoost = playerBoost { boostActive = boostActive } }
111 108
 
112 109
 refillBoost :: Int -> GameEngine ()
113 110
 refillBoost timeElapsed = do
114
-  state    <- get
115
-  settings <- ask
116
-  go settings state
117
-  where
118
-    go GameSettings{..} (gameMap, player@Player{..}) = do
119
-      let boostFuel'   = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
120
-          playerBoost' = playerBoost { boostFuel = boostFuel' }
121
-      put (gameMap, player { playerBoost = playerBoost' })
122
-      tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
111
+  (gameMap, player@Player{ .. }) <- get
112
+  GameSettings{ .. }             <- ask
113
+  let boostFuel'   = floor (fromIntegral timeElapsed * gameBoostRefillFactor)
114
+      playerBoost' = playerBoost { boostFuel = boostFuel' }
115
+  put (gameMap, player { playerBoost = playerBoost' })
116
+  tell $ DList.fromList [OutPlayerBoostChange playerId playerBoost' | playerBoost /= playerBoost']
123 117
 
124 118
 stepGame :: Game -> Int -> InEvent -> (Game, [OutEvent])
125
-stepGame game@Game{gameMap = gameMap@GameMap{..}, ..} time = stepGame'
119
+stepGame game@Game{ gameMap = gameMap@GameMap{ .. }, .. } time = stepGame'
126 120
   where
127 121
     stepGame' (InPlayerTurnLeft playerId)                = stepEvent playerId $ turn leftTurn
128 122
     stepGame' (InPlayerTurnRight playerId)               = stepEvent playerId $ turn rightTurn
@@ -130,11 +124,11 @@ stepGame game@Game{gameMap = gameMap@GameMap{..}, ..} time = stepGame'
130 124
     stepGame' (InPlayerBoostChange playerId boostActive) = stepEvent playerId $ changeBoost boostActive
131 125
 
132 126
     stepEvent pId step =
133
-      flip (maybe (game, [])) (Map.lookup pId gamePlayers) $ \player@Player{..} ->
127
+      flip (maybe (game, [])) (Map.lookup pId gamePlayers) $ \player@Player{ .. } ->
134 128
         if playerState /= PlayerAlive
135 129
         then (game, [])
136 130
         else let
137
-            timeElapsed = (time - playerLastEventTime)
131
+            timeElapsed = time - playerLastEventTime
138 132
             fullStep    = move timeElapsed >> step >> refillBoost timeElapsed
139 133
 
140 134
             (gameMap', player'@Player{ playerPosition = pos'

Loading…
Cancel
Save