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