Implement collision
Check if there's a wall or other entity where the character is going, and stop the character from going there
This commit is contained in:
		
							parent
							
								
									c06edf3cc6
								
							
						
					
					
						commit
						33c831d23d
					
				
					 2 changed files with 29 additions and 3 deletions
				
			
		|  | @ -16,7 +16,6 @@ import           Xanthous.Data | ||||||
|                  , Dimensions |                  , Dimensions | ||||||
|                  , positionFromPair |                  , positionFromPair | ||||||
|                  ) |                  ) | ||||||
| import qualified Xanthous.Data.EntityMap as EntityMap |  | ||||||
| import           Xanthous.Data.EntityMap (EntityMap) | import           Xanthous.Data.EntityMap (EntityMap) | ||||||
| import           Xanthous.Game | import           Xanthous.Game | ||||||
| import           Xanthous.Game.Draw (drawGame) | import           Xanthous.Game.Draw (drawGame) | ||||||
|  | @ -74,7 +73,11 @@ handleEvent _ = continue | ||||||
| handleCommand :: Command -> AppM (Next GameState) | handleCommand :: Command -> AppM (Next GameState) | ||||||
| handleCommand Quit = halt | handleCommand Quit = halt | ||||||
| handleCommand (Move dir) = do | handleCommand (Move dir) = do | ||||||
|   characterPosition %= move dir |   newPos <- uses characterPosition $ move dir | ||||||
|  |   collisionAt newPos >>= \case | ||||||
|  |     Nothing -> characterPosition .= newPos | ||||||
|  |     Just Combat -> undefined | ||||||
|  |     Just Stop -> pure () | ||||||
|   continue |   continue | ||||||
| 
 | 
 | ||||||
| handleCommand PreviousMessage = do | handleCommand PreviousMessage = do | ||||||
|  |  | ||||||
|  | @ -1,3 +1,4 @@ | ||||||
|  | {-# LANGUAGE MultiWayIf #-} | ||||||
| {-# LANGUAGE TemplateHaskell #-} | {-# LANGUAGE TemplateHaskell #-} | ||||||
| {-# LANGUAGE RecordWildCards #-} | {-# LANGUAGE RecordWildCards #-} | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  | @ -17,6 +18,10 @@ module Xanthous.Game | ||||||
|   , pushMessage |   , pushMessage | ||||||
|   , popMessage |   , popMessage | ||||||
|   , hideMessage |   , hideMessage | ||||||
|  | 
 | ||||||
|  |     -- * collisions | ||||||
|  |   , Collision(..) | ||||||
|  |   , collisionAt | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude | import           Xanthous.Prelude | ||||||
|  | @ -26,12 +31,14 @@ import qualified Data.List.NonEmpty as NonEmpty | ||||||
| import           System.Random | import           System.Random | ||||||
| import           Test.QuickCheck | import           Test.QuickCheck | ||||||
| import           Test.QuickCheck.Arbitrary.Generic | import           Test.QuickCheck.Arbitrary.Generic | ||||||
|  | import           Control.Monad.State.Class | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Data.EntityMap (EntityMap, EntityID) | import           Xanthous.Data.EntityMap (EntityMap, EntityID) | ||||||
| import qualified Xanthous.Data.EntityMap as EntityMap | import qualified Xanthous.Data.EntityMap as EntityMap | ||||||
| import           Xanthous.Data (Positioned, Position(..), positioned, position) | import           Xanthous.Data (Positioned, Position(..), positioned, position) | ||||||
| import           Xanthous.Entities (SomeEntity(..), downcastEntity) | import           Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs) | ||||||
| import           Xanthous.Entities.Character | import           Xanthous.Entities.Character | ||||||
|  | import           Xanthous.Entities.Creature | ||||||
| import           Xanthous.Entities.Arbitrary () | import           Xanthous.Entities.Arbitrary () | ||||||
| import           Xanthous.Orphans () | import           Xanthous.Orphans () | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  | @ -122,3 +129,19 @@ character = positionedCharacter . positioned | ||||||
| 
 | 
 | ||||||
| characterPosition :: Lens' GameState Position | characterPosition :: Lens' GameState Position | ||||||
| characterPosition = positionedCharacter . position | characterPosition = positionedCharacter . position | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | data Collision | ||||||
|  |   = Stop | ||||||
|  |   | Combat | ||||||
|  |   deriving stock (Show, Eq, Ord, Generic) | ||||||
|  |   deriving anyclass (NFData) | ||||||
|  | 
 | ||||||
|  | collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) | ||||||
|  | collisionAt pos = do | ||||||
|  |   ents <- use $ entities . EntityMap.atPosition pos | ||||||
|  |   pure $ | ||||||
|  |     if | null ents -> Nothing | ||||||
|  |        | any (entityIs @Creature) ents -> pure Combat | ||||||
|  |        | otherwise -> pure Stop | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue