diff options
author | Griffin Smith <root@gws.fyi> | 2019-09-15T17·00-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-09-15T21·30-0400 |
commit | 58fce2ec1976b957c7e24a282964c62f7ddf7b02 (patch) | |
tree | d7746cd93bcdda4faac465574ae66ea6b481d106 /src/Xanthous/Entities.hs | |
parent | 6678ac986c0ccdc2a809da4fc99de7bcc0eb21f4 (diff) |
Progressively reveal the map to the player
As the character walks around the map, progressively reveal the entities on the map to them, using an algorithm based on well known circle-rasterizing and line-rasterizing algorithms to calculate lines of sight that are potentially obscured by walls.
Diffstat (limited to 'src/Xanthous/Entities.hs')
-rw-r--r-- | src/Xanthous/Entities.hs | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs index bd52ae62b29f..223c8d769ba4 100644 --- a/src/Xanthous/Entities.hs +++ b/src/Xanthous/Entities.hs @@ -7,7 +7,7 @@ module Xanthous.Entities ( Draw(..) , DrawCharacter(..) , DrawStyledCharacter(..) - , Entity + , Entity(..) , SomeEntity(..) , downcastEntity , entityIs @@ -29,8 +29,11 @@ import Data.Aeson import Xanthous.Data -------------------------------------------------------------------------------- -class (Show a, Eq a, Draw a) => Entity a -instance (Show a, Eq a, Draw a) => Entity a +class (Show a, Eq a, Draw a) => Entity a where + blocksVision :: a -> Bool + +instance Entity a => Entity (Positioned a) where + blocksVision (Positioned _ ent) = blocksVision ent -------------------------------------------------------------------------------- data SomeEntity where @@ -47,6 +50,9 @@ instance Eq SomeEntity where instance Draw SomeEntity where drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent +instance Entity SomeEntity where + blocksVision (SomeEntity ent) = blocksVision ent + downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e @@ -61,6 +67,10 @@ class Draw a where draw :: a -> Widget n draw = drawWithNeighbors $ pure mempty +instance Draw a => Draw (Positioned a) where + drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a + draw (Positioned _ a) = draw a + newtype DrawCharacter (char :: Symbol) (a :: Type) where DrawCharacter :: a -> DrawCharacter char a |