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:
parent
6eba471e24
commit
4ef19aa35a
21 changed files with 719 additions and 32 deletions
21
src/Xanthous/Entities/Character.hs
Normal file
21
src/Xanthous/Entities/Character.hs
Normal 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
|
||||
34
src/Xanthous/Entities/SomeEntity.hs
Normal file
34
src/Xanthous/Entities/SomeEntity.hs
Normal 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue