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…
	
	Add table
		Add a link
		
	
		Reference in a new issue