Put new levels at the right position in the list
New levels need to go at the *end* of the list of levels, not the beginning - otherwise we jump to the proper position on the new level but the current level stays the same (oops).
This commit is contained in:
parent
d62aba218d
commit
72edcff323
3 changed files with 8 additions and 3 deletions
|
@ -300,8 +300,7 @@ handleCommand GoDown = do
|
|||
let newLevelNum = Levels.pos levs + 1
|
||||
levs' <- nextLevel (levelToEntityMap <$> genLevel newLevelNum) levs
|
||||
cEID <- use characterEntityID
|
||||
pCharacter <- use $ entities . at cEID
|
||||
entities . at cEID .= Nothing
|
||||
pCharacter <- entities . at cEID <<.= Nothing
|
||||
levels .= levs'
|
||||
entities . at cEID .= pCharacter
|
||||
else say_ ["cant", "goDown"]
|
||||
|
|
|
@ -102,7 +102,7 @@ nextLevel genLevel levs
|
|||
= pure $ seeks succ levs
|
||||
| otherwise
|
||||
= genLevel <&> \level ->
|
||||
seek (pos levs + 1) . partialMkLevels $ level <| allLevels levs
|
||||
seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level
|
||||
|
||||
-- | Go to the previous level. Returns Nothing if 'pos' is 0
|
||||
prevLevel :: Levels level -> Maybe (Levels level)
|
||||
|
|
|
@ -37,6 +37,12 @@ test = testGroup "Xanthous.Data.Levels"
|
|||
, testProperty "extract is total" $ \(levels :: Levels Int) genned ->
|
||||
let levels' = runIdentity . nextLevel (Identity genned) $ levels
|
||||
in total $ extract levels'
|
||||
, testProperty "uses the generated level as the next level"
|
||||
$ \(levels :: Levels Int) genned ->
|
||||
let levels' = seek (length levels - 1) levels
|
||||
levels'' = runIdentity . nextLevel (Identity genned) $ levels'
|
||||
in counterexample (show levels'')
|
||||
$ extract levels'' === genned
|
||||
]
|
||||
, testGroup "prevLevel"
|
||||
[ testProperty "seeks backwards" $ \(levels :: Levels Int) ->
|
||||
|
|
Loading…
Reference in a new issue