Attributes.hs

-- Copyright 2009-2010 Corey O'Connor
-- Display attributes
--
-- For efficiency this can be, in the future, encoded into a single 32 bit word. The 32 bit word is
-- first divided into 4 groups of 8 bits where:
--  The first group codes what action should be taken with regards to the other groups.
--      XXYYZZ__
--      XX - style action
--          00 => reset to default
--          01 => unchanged
--          10 => set
--      YY - foreground color action
--          00 => reset to default
--          01 => unchanged
--          10 => set
--      ZZ - background color action
--          00 => reset to default
--          01 => unchanged
--          10 => set
--      __ - unused
--
--  Next is the style flags
--      SURBDO__
--      S - standout
--      U - underline
--      R - reverse video
--      B - blink
--      D - dim
--      O - bold
--      __ - unused
--
--  Then the foreground color encoded into 8 bits.
--  Then the background color encoded into 8 bits.
--
module Graphics.Vty.Attributes
    where

import Data.Bits
import Data.Monoid
import Data.Word

-- | A display attribute defines the Color and Style of all the characters rendered after the
-- attribute is applied.
--
--  At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and
--  foreground. The 240 colors and 16 colors are points in different palettes. See Color for more
--  information.
data Attr = Attr 
    { attr_style :: !(MaybeDefault Style)
    , attr_fore_color :: !(MaybeDefault Color)
    , attr_back_color :: !(MaybeDefault Color)
    } deriving ( Eq, Show )

instance Monoid Attr where
    mempty = Attr mempty mempty mempty
    mappend attr_0 attr_1 = 
        Attr ( attr_style attr_0 `mappend` attr_style attr_1 )
             ( attr_fore_color attr_0 `mappend` attr_fore_color attr_1 )
             ( attr_back_color attr_0 `mappend` attr_back_color attr_1 )

-- | Specifies the display attributes such that the final style and color values do not depend on
-- the previously applied display attribute. The display attributes can still depend on the
-- terminal's default colors (unfortunately).
data FixedAttr = FixedAttr
    { fixed_style :: !Style
    , fixed_fore_color :: !(Maybe Color)
    , fixed_back_color :: !(Maybe Color)
    } deriving ( Eq, Show )

-- | The style and color attributes can either be the terminal defaults. Or be equivalent to the
-- previously applied style. Or be a specific value.
data Eq v => MaybeDefault v = Default | KeepCurrent | SetTo !v
    deriving ( Eq, Show )

instance Eq v => Monoid ( MaybeDefault v ) where
    mempty = KeepCurrent
    mappend Default Default = Default
    mappend Default KeepCurrent = Default
    mappend Default ( SetTo v ) = SetTo v
    mappend KeepCurrent Default = Default
    mappend KeepCurrent KeepCurrent = KeepCurrent
    mappend KeepCurrent ( SetTo v ) = SetTo v
    mappend ( SetTo _v ) Default = Default
    mappend ( SetTo v ) KeepCurrent = SetTo v
    mappend ( SetTo _ ) ( SetTo v ) = SetTo v

-- | Abstract data type representing a color.
--  
-- Currently the foreground and background color are specified as points in either a:
--
--  * 16 color palette. Where the first 8 colors are equal to the 8 colors of the ISO 6429 (ANSI) 8
--  color palette and the second 8 colors are bright/vivid versions of the first 8 colors.
--
--  * 240 color palette. This palette is a regular sampling of the full RGB colorspace. 
-- 
-- The 8 ISO 6429 (ANSI) colors are as follows:
--
--      0. black
--
--      1. red
--
--      2. green
--
--      3. yellow
--
--      4. blue
--
--      5. magenta
--
--      6. cyan
--
--      7. white
--
-- The mapping from points in the 240 color palette to colors actually displayable by the terminal
-- depends on the number of colors the terminal claims to support. Which is usually determined by
-- the terminfo "colors" property. If this property is not being accurately reported then the color
-- reproduction will be incorrect.
--
-- If the terminal reports <= 16 colors then the 240 color palette points are only mapped to the 8
-- color pallete. I'm not sure of the RGB points for the "bright" colors which is why they are not
-- addressable via the 240 color palette. 
--
-- If the terminal reports > 16 colors then the 240 color palette points are mapped to the nearest
-- points in a ("color count" - 16) subsampling of the 240 color palette.
--
-- All of this assumes the terminals are behaving similarly to xterm and rxvt when handling colors.
-- And that the individual colors have not been remapped by the user. There may be a way to verify
-- this through terminfo but I don't know it.
--
-- Seriously, terminal color support is INSANE.
data Color = ISOColor !Word8 | Color240 !Word8
    deriving ( Eq, Show )

-- | Standard 8-color ANSI terminal color codes.
black, red, green, yellow, blue, magenta, cyan, white :: Color
black  = ISOColor 0
red    = ISOColor 1
green  = ISOColor 2
yellow = ISOColor 3
blue   = ISOColor 4
magenta= ISOColor 5
cyan   = ISOColor 6
white  = ISOColor 7

-- | Bright/Vivid variants of the standard 8-color ANSI 
bright_black, bright_red, bright_green, bright_yellow :: Color
bright_blue, bright_magenta, bright_cyan, bright_white :: Color
bright_black  = ISOColor 8
bright_red    = ISOColor 9
bright_green  = ISOColor 10
bright_yellow = ISOColor 11
bright_blue   = ISOColor 12
bright_magenta= ISOColor 13
bright_cyan   = ISOColor 14
bright_white  = ISOColor 15

-- | Styles are represented as an 8 bit word. Each bit in the word is 1 if the style attribute
-- assigned to that bit should be applied and 0 if the style attribute should not be applied.
type Style = Word8

-- | The 6 possible style attributes:
--
--      * standout
--
--      * underline
--
--      * reverse_video
--
--      * blink
--
--      * dim
--
--      * bold/bright
--
--  ( The invisible, protect, and altcharset display attributes some terminals support are not
--  supported via VTY.)
standout, underline, reverse_video, blink, dim, bold :: Style
standout        = 0x01
underline       = 0x02
reverse_video   = 0x04
blink           = 0x08
dim             = 0x10
bold            = 0x20

default_style_mask :: Style
default_style_mask = 0x00

style_mask :: Attr -> Word8
style_mask attr 
    = case attr_style attr of
        Default  -> 0
        KeepCurrent -> 0
        SetTo v  -> v

-- | true if the given Style value has the specified Style set.
has_style :: Style -> Style -> Bool
has_style s bit_mask = ( s .&. bit_mask ) /= 0

-- | Set the foreground color of an `Attr'.
with_fore_color :: Attr -> Color -> Attr
with_fore_color attr c = attr { attr_fore_color = SetTo c }

-- | Set the background color of an `Attr'.
with_back_color :: Attr -> Color -> Attr
with_back_color attr c = attr { attr_back_color = SetTo c }

-- | Add the given style attribute
with_style :: Attr -> Style -> Attr
with_style attr style_flag = attr { attr_style = SetTo $ style_mask attr .|. style_flag }

-- | Sets the style, background color and foreground color to the default values for the terminal.
-- There is no easy way to determine what the default background and foreground colors are.
def_attr :: Attr
def_attr = Attr Default Default Default

-- | Keeps the style, background color and foreground color that was previously set. Used to
-- override some part of the previous style.
--
-- EG: current_style `with_fore_color` bright_magenta
--
-- Would be the currently applied style (be it underline, bold, etc) but with the foreground color
-- set to bright_magenta.
current_attr :: Attr
current_attr = Attr KeepCurrent KeepCurrent KeepCurrent