diff options
author | Griffin Smith <root@gws.fyi> | 2019-08-31T17·17-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-08-31T17·18-0400 |
commit | 4ef19aa35a6d63a8d9f7b6a7a11ac82c2a525783 (patch) | |
tree | 00a0109cca42bbdda93fa117142d381501c1bf00 /src/Xanthous/Entities.hs | |
parent | 6eba471e2426e7e4e7d5c935e3ce973e13fd6b24 (diff) |
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.
Diffstat (limited to 'src/Xanthous/Entities.hs')
-rw-r--r-- | src/Xanthous/Entities.hs | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs new file mode 100644 index 000000000000..6851a7a5d506 --- /dev/null +++ b/src/Xanthous/Entities.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE UndecidableInstances #-} + +module Xanthous.Entities + ( Draw(..) + , DrawCharacter(..) + , DrawStyledCharacter(..) + , Entity + + , Color(..) + , KnownColor(..) + ) where + +import Xanthous.Prelude +import Brick +import Data.Typeable +import qualified Graphics.Vty.Attributes as Vty +import qualified Graphics.Vty.Image as Vty + +class Draw a where + draw :: a -> Widget n + +newtype DrawCharacter (char :: Symbol) (a :: Type) where + DrawCharacter :: a -> DrawCharacter char a + +instance KnownSymbol char => Draw (DrawCharacter char a) where + draw _ = str $ symbolVal @char Proxy + +-------------------------------------------------------------------------------- + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White + +class KnownColor (color :: Color) where + colorVal :: forall proxy. proxy color -> Vty.Color + +instance KnownColor 'Black where colorVal _ = Vty.black +instance KnownColor 'Red where colorVal _ = Vty.red +instance KnownColor 'Green where colorVal _ = Vty.green +instance KnownColor 'Yellow where colorVal _ = Vty.yellow +instance KnownColor 'Blue where colorVal _ = Vty.blue +instance KnownColor 'Magenta where colorVal _ = Vty.magenta +instance KnownColor 'Cyan where colorVal _ = Vty.cyan +instance KnownColor 'White where colorVal _ = Vty.white + +newtype DrawStyledCharacter (fg :: Color) (bg :: Color) (char :: Symbol) (a :: Type) where + DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a + +instance + ( KnownColor fg + , KnownColor bg + , KnownSymbol char + ) + => Draw (DrawStyledCharacter fg bg char a) where + draw _ = raw $ Vty.string attr $ symbolVal @char Proxy + where attr = Vty.Attr + { Vty.attrStyle = Vty.Default + , Vty.attrForeColor = Vty.SetTo $ colorVal @fg Proxy + , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy + , Vty.attrURL = Vty.Default + } + +-------------------------------------------------------------------------------- + +class (Show a, Eq a, Draw a) => Entity a +instance (Show a, Eq a, Draw a) => Entity a |