Add entities, and allow walking around

Add support for entities via a port of the EntityMap type, and implement
command support starting at basic hjkl.
This commit is contained in:
Griffin Smith 2019-08-31 13:17:27 -04:00
parent 6eba471e24
commit 4ef19aa35a
21 changed files with 719 additions and 32 deletions

View file

@ -0,0 +1,21 @@
module Xanthous.Entities.Character
( Character(..)
, mkCharacter
) where
import Xanthous.Prelude
import Test.QuickCheck
import Xanthous.Entities
data Character where
Character :: Character
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (CoArbitrary, Function)
deriving Draw via (DrawCharacter "@" Character)
instance Arbitrary Character where
arbitrary = pure Character
mkCharacter :: Character
mkCharacter = Character

View file

@ -0,0 +1,34 @@
{-# LANGUAGE GADTs #-}
module Xanthous.Entities.SomeEntity
( SomeEntity(..)
, downcastEntity
) where
import Xanthous.Prelude
import Test.QuickCheck (Arbitrary(..))
import qualified Test.QuickCheck.Gen as Gen
import Xanthous.Entities (Draw(..), Entity)
import Data.Typeable
import Xanthous.Entities.Character
data SomeEntity where
SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity
instance Show SomeEntity where
show (SomeEntity x) = "SomeEntity (" <> show x <> ")"
instance Eq SomeEntity where
(SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of
Just Refl -> a == b
_ -> False
instance Arbitrary SomeEntity where
arbitrary = Gen.oneof
[pure $ SomeEntity Character]
instance Draw SomeEntity where
draw (SomeEntity ent) = draw ent
downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a
downcastEntity (SomeEntity e) = cast e