1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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
|
