Update the vision every time we step the game
Recalculate the character's lines of sight every time we step the game, rather than just every time the character *moves*. I had originally thought this was a non-contiguous lines-of-sight bug - which there's a test disproving - but it actually turned out to be that actions like eating or attacking would step the game forward (thus moving gormlaks) without re-calculating the positions visible to the character.
This commit is contained in:
		
							parent
							
								
									a58966d43f
								
							
						
					
					
						commit
						32421916e0
					
				
					 4 changed files with 53 additions and 2 deletions
				
			
		|  | @ -102,6 +102,8 @@ stepGameBy ticks = do | |||
|     pEntity' <- step ticks pEntity | ||||
|     entities . ix eid .= pEntity' | ||||
| 
 | ||||
|   modify updateCharacterVision | ||||
| 
 | ||||
|   whenM (uses character isDead) | ||||
|     . prompt_ @'Continue ["dead"] Uncancellable | ||||
|     . const . lift . liftIO | ||||
|  | @ -137,7 +139,6 @@ handleCommand (Move dir) = do | |||
|       characterPosition .= newPos | ||||
|       stepGameBy =<< uses (character . speed) (|*| 1) | ||||
|       describeEntitiesAt newPos | ||||
|       modify updateCharacterVision | ||||
|     Just Combat -> attackAt newPos | ||||
|     Just Stop -> pure () | ||||
|   continue | ||||
|  |  | |||
|  | @ -1,6 +1,7 @@ | |||
| import Test.Prelude | ||||
| import qualified Xanthous.Data.EntityCharSpec | ||||
| import qualified Xanthous.Data.EntityMapSpec | ||||
| import qualified Xanthous.Data.EntityMap.GraphicsSpec | ||||
| import qualified Xanthous.DataSpec | ||||
| import qualified Xanthous.Entities.RawsSpec | ||||
| import qualified Xanthous.GameSpec | ||||
|  | @ -18,6 +19,7 @@ test :: TestTree | |||
| test = testGroup "Xanthous" | ||||
|   [ Xanthous.Data.EntityCharSpec.test | ||||
|   , Xanthous.Data.EntityMapSpec.test | ||||
|   , Xanthous.Data.EntityMap.GraphicsSpec.test | ||||
|   , Xanthous.Entities.RawsSpec.test | ||||
|   , Xanthous.GameSpec.test | ||||
|   , Xanthous.Generators.UtilSpec.test | ||||
|  |  | |||
							
								
								
									
										47
									
								
								test/Xanthous/Data/EntityMap/GraphicsSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										47
									
								
								test/Xanthous/Data/EntityMap/GraphicsSpec.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,47 @@ | |||
| -------------------------------------------------------------------------------- | ||||
| module Xanthous.Data.EntityMap.GraphicsSpec (main, test) where | ||||
| -------------------------------------------------------------------------------- | ||||
| import Test.Prelude | ||||
| import Data.Aeson | ||||
| -------------------------------------------------------------------------------- | ||||
| import Xanthous.Game.State | ||||
| import Xanthous.Data | ||||
| import Xanthous.Data.EntityMap | ||||
| import Xanthous.Data.EntityMap.Graphics | ||||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| main :: IO () | ||||
| main = defaultMain test | ||||
| 
 | ||||
| test :: TestTree | ||||
| test = testGroup "Xanthous.Data.EntityMap.Graphics" | ||||
|   [ testGroup "visiblePositions" | ||||
|     [ testCase "non-contiguous bug 1" $ | ||||
|         let charPos = Position 20 20 | ||||
|             gormlakPos = Position 17 19 | ||||
|             em = insertAt gormlakPos TestEntity | ||||
|                . insertAt charPos TestEntity | ||||
|                $ mempty | ||||
|             visPositions = visiblePositions charPos 12 em | ||||
|         in (gormlakPos `member` visPositions) @? | ||||
|           ( "not (" | ||||
|           <> show gormlakPos <> " `member` " | ||||
|           <> show visPositions | ||||
|           <> ")" | ||||
|           ) | ||||
|     ] | ||||
|   ] | ||||
| 
 | ||||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| data TestEntity = TestEntity | ||||
|   deriving stock (Show, Eq, Ord, Generic) | ||||
|   deriving anyclass (ToJSON, FromJSON, NFData) | ||||
| 
 | ||||
| instance Brain TestEntity where | ||||
|   step _ = pure | ||||
| instance Draw TestEntity | ||||
| instance Entity TestEntity where | ||||
|   blocksVision _ = False | ||||
|   description _ = "" | ||||
|   entityChar _ = "e" | ||||
|  | @ -4,7 +4,7 @@ cabal-version: 1.12 | |||
| -- | ||||
| -- see: https://github.com/sol/hpack | ||||
| -- | ||||
| -- hash: ae5b84ec168dd61b715e874bcb49579697873b164c43027a776dda725dfdffbf | ||||
| -- hash: 2d93180ab419496ded42f750d00a5b3f6c6994a9af86a8694bb585a1f52919d4 | ||||
| 
 | ||||
| name:           xanthous | ||||
| version:        0.1.0.0 | ||||
|  | @ -208,6 +208,7 @@ test-suite test | |||
|   other-modules: | ||||
|       Test.Prelude | ||||
|       Xanthous.Data.EntityCharSpec | ||||
|       Xanthous.Data.EntityMap.GraphicsSpec | ||||
|       Xanthous.Data.EntityMapSpec | ||||
|       Xanthous.DataSpec | ||||
|       Xanthous.Entities.RawsSpec | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue