1module Language.Haskell.HsColour.ColourHighlight
2  ( Colour(..)
3  , Highlight(..)
4  , base256, unbase
5  , rgb24bit_to_xterm256
6  ,   projectToBasicColour8
7  , hlProjectToBasicColour8
8  ) where
9
10import Data.Word
11
12-- | Colours supported by ANSI codes.
13data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Rgb Word8 Word8 Word8
14  deriving (Eq,Show,Read)
15
16-- | Convert an integer in the range [0,2^24-1] to its base 256-triplet, passing the result to the given continuation (avoid unnecessary tupleism).
17base256 :: Integral int => (Word8 -> Word8 -> Word8 -> r) -> int -> r
18base256 kont x =
19    let
20        (r,gb) = divMod x 256
21        (g,b)  = divMod gb 256
22        fi = fromIntegral
23    in
24        kont (fi r) (fi g) (fi b)
25
26-- | Convert a three-digit numeral in the given (as arg 1) base to its integer value.
27unbase :: Integral int => int -> Word8 -> Word8 -> Word8 -> int
28unbase base r g b = (fi r*base+fi g)*base+fi b
29    where fi = fromIntegral
30
31-- | Approximate a 24-bit Rgb colour with a colour in the xterm256 6x6x6 colour cube, returning its index.
32rgb24bit_to_xterm256 :: (Integral t) => Word8 -> Word8 -> Word8 -> t
33rgb24bit_to_xterm256 r g b = let f = (`div` 43)
34                          in 16 + unbase 6 (f r) (f g) (f b)
35
36
37-- | Ap\"proxi\"mate a 24-bit Rgb colour with an ANSI8 colour. Will leave other colours unchanged and will never return an 'Rgb' constructor value.
38projectToBasicColour8 ::  Colour -> Colour
39projectToBasicColour8 (Rgb r g b) = let f = (`div` 128)
40                          in  toEnum ( unbase 2 (f r) (f g) (f b) )
41projectToBasicColour8 x = x
42
43
44-- | Lift 'projectToBasicColour8' to 'Highlight's
45hlProjectToBasicColour8 ::  Highlight -> Highlight
46hlProjectToBasicColour8 (Foreground c) = Foreground (projectToBasicColour8 c)
47hlProjectToBasicColour8 (Background c) = Background (projectToBasicColour8 c)
48hlProjectToBasicColour8 h = h
49
50
51
52instance Enum Colour where
53    toEnum 0 = Black
54    toEnum 1 = Red
55    toEnum 2 = Green
56    toEnum 3 = Yellow
57    toEnum 4 = Blue
58    toEnum 5 = Magenta
59    toEnum 6 = Cyan
60    toEnum 7 = White
61    -- Arbitrary extension; maybe just 'error' out instead
62    toEnum x = base256 Rgb (x-8)
63
64    fromEnum Black   = 0
65    fromEnum Red     = 1
66    fromEnum Green   = 2
67    fromEnum Yellow  = 3
68    fromEnum Blue    = 4
69    fromEnum Magenta = 5
70    fromEnum Cyan    = 6
71    fromEnum White   = 7
72    -- Arbitrary extension; maybe just 'error' out instead
73    fromEnum (Rgb r g b) = 8 + unbase 256 r g b
74
75
76-- | Types of highlighting supported by ANSI codes (and some extra styles).
77data Highlight =
78    Normal
79  | Bold
80  | Dim
81  | Underscore
82  | Blink
83  | ReverseVideo
84  | Concealed
85  | Foreground Colour
86  | Background Colour
87  -- The above styles are ANSI-supported, with the exception of the 'Rgb' constructor for 'Colour's.  Below are extra styles (e.g. for Html rendering).
88  | Italic
89  deriving (Eq,Show,Read)
90
91
92
93
94