-- BasicCharModes -- -- Author : Hermann O. Rodrigues -- Created: April 2001 -- -- $Id$ -- -- Copyright (c) 2000 Hermann O. Rodrigues -- -- This file is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published -- by the Free Software Foundation; either version 2 of the License, -- or (at your option) any later version. -- -- This file is distributed in the hope that it will be useful, but -- WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- General Public License for more details. -- --- DESCRIPTION --------------------------------------------------------------- -- -- This module provides the basic functionalities to allow color and -- font formating during text printing as described in the ISO 6429 -- report and in the ANSI standard. -- -- The use of the higher level `CharModes' module is preferred. -- --- DOCU ---------------------------------------------------------------------- -- -- language: Haskell 98 -- -- A case example to teach the using of the `BasicCharModes' module -- is provided: -- To print the text "Jedi Rules!" using a yellow background and -- using a bold blue font to "Jedi" and an italic font to " Rules!" -- in an ANSI terminal, use the following code sequence: -- putStrLn $ ( default' -- . bgColor Yellow -- . bold -- . fgColor Blue -- ) "Jedi" -- ++ -- ( default' -- . bgColor Yellow -- . italic -- ) " Rules!" -- module BasicCharModes (-- -- The character formating mode. -- CharMode, -- -- The character attributes. -- CharAttribute (..), attribTag, CharAttributeGroup, attribGroup, attribCxt, -- -- The character colors. -- CharColor (..), colorTag, -- -- Escape sequence translation. -- CharModeEsc, transMode, appMode, rstMode, -- -- Attribute and color application. -- attrib, fgColor, bgColor, -- -- Predefined attribute application. -- default', bold, nonBold, italic, underline, blink, rapidBlink, reverseVideo, invisible) where -- Haskell module imports. -- ----------------------- import List (intersect) -- The character formating mode. -- ----------------------------- -- The character formating mode datatype (EXPORTED) -- type CharMode = ( [ CharAttribute ] , Maybe CharColor -- Foreground. , Maybe CharColor -- Background. ) -- The character attributes. -- ------------------------- -- The character attribute datatype (EXPORTED). -- data CharAttribute = Default -- All off (Except for -- foreground and background color). | HighIntensity -- Bold. | LowIntensity -- Normal. | Italic -- (Works only on some systems). | Underline -- Underlined font. | Blink -- Blinking font. | RapidBlink -- (Works only on some systems). | ReverseVideo -- Swaps the foreground and the -- background color. | Invisible -- Do not display characters. deriving (Eq) -- Returns the internal tag of the given attribute (EXPORTED). -- attribTag :: CharAttribute -> Int attribTag Default = 0 attribTag HighIntensity = 1 attribTag LowIntensity = 2 attribTag Italic = 3 attribTag Underline = 4 attribTag Blink = 5 attribTag RapidBlink = 6 attribTag ReverseVideo = 7 attribTag Invisible = 8 -- The attribute group type (EXPORTED). -- type CharAttributeGroup = Int -- Returns the groups of the given attribute (EXPORTED). -- -- * Attributes of the same group set/unset the behaviour to the same -- functionality. -- attribGroup :: CharAttribute -> [CharAttributeGroup] attribGroup Default = [1, 2, 3, 4, 5] attribGroup HighIntensity = [1] attribGroup LowIntensity = [1] attribGroup Italic = [2] attribGroup Underline = [3] attribGroup Blink = [4] attribGroup RapidBlink = [4] attribGroup ReverseVideo = [5] attribGroup Invisible = [1, 2, 3, 4, 5] -- Analizes which attributes in the first attribute list can be used -- in the context of the second one (EXPORTED). -- -- * Returns the attribute context including the selected attributes -- in the given attribute list. -- attribCxt :: [CharAttribute] -> [CharAttribute] -> [CharAttribute] attribCxt [] attribl' = attribl' attribCxt (attrib0:attribl) attribl' = let agl = attribGroup attrib0 agl' = (concat . map attribGroup) attribl' sec = agl `intersect` agl' in if sec == [] then attribCxt attribl (attrib0:attribl') else attribCxt attribl attribl' -- The character colors. -- --------------------- -- The character color datatype (EXPORTED). -- data CharColor = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White -- Returns the internal tag of the given color (EXPORTED). -- colorTag :: Bool {- Is it a foreground color? -} -> CharColor -> Int colorTag True color = colorTag' color colorTag False color = colorTag' color + 10 colorTag' Black = 30 colorTag' Red = 31 colorTag' Green = 32 colorTag' Yellow = 33 colorTag' Blue = 34 colorTag' Magenta = 35 colorTag' Cyan = 36 colorTag' White = 37 -- Escape sequence translation. -- ---------------------------- -- The character escape sequence type (EXPORTED). -- type CharModeEsc = String -- The (E)scape (S)equence (S)tart/(E)nd string and the (A)ttribute -- (S)eparator string. -- ess, ese, as :: String ess = "\o33[" ese = "m" as = ";" -- Translate the given character mode in the equivalent escape -- sequence (EXPORTED). -- transMode :: CharMode -> CharModeEsc transMode ([] , Nothing , Nothing ) = "" transMode ([] , Nothing , Just col2) = ess ++ transBgColor col2 ++ ese transMode ([] , Just col1, Nothing ) = ess ++ transFgColor col1 ++ ese transMode ([] , Just col1, Just col2) = ess ++ transFgColor col1 ++ as ++ transBgColor col2 ++ ese transMode (attribl, Nothing , Nothing ) = ess ++ transAttribl attribl ++ ese transMode (attribl, Nothing , Just col2) = ess ++ transAttribl attribl ++ as ++ transBgColor col2 ++ ese transMode (attribl, Just col1, Nothing ) = ess ++ transAttribl attribl ++ as ++ transFgColor col1 ++ ese transMode (attribl, Just col1, Just col2) = ess ++ transAttribl attribl ++ as ++ transFgColor col1 ++ as ++ transBgColor col2 ++ ese transAttribl :: [ CharAttribute ] -> CharModeEsc {- bad signature? -} transAttribl [] = "" transAttribl [attrib] = show (attribTag attrib) transAttribl (attrib:l) = show (attribTag attrib) ++ as ++ transAttribl l transFgColor, transBgColor :: CharColor -> CharModeEsc {- bad signature? -} transFgColor = show . colorTag True transBgColor = show . colorTag False -- Applies the given character formating mode to the given string -- (EXPORTED). -- appMode :: CharMode -> String -> String appMode = (++) . transMode -- Attribute and color application. -- -------------------------------- -- Applies the given character attribute list to the given string -- (EXPORTED). -- attrib :: [CharAttribute] -> String -> String attrib attribl = appMode (attribCxt attribl [], Nothing, Nothing) -- Colours the given string using the given foreground color -- (EXPORTED). -- fgColor :: CharColor -> String -> String fgColor col = appMode ([], Just col, Nothing) -- Colours the given string using the given background color -- (EXPORTED). bgColor :: CharColor -> String -> String bgColor col = appMode ([], Nothing, Just col) -- Predefined attribute application. -- --------------------------------- -- Reset the character formating modes. -- rstMode :: String rstMode = transMode ([Default], Nothing, Nothing) -- Applies the given predefined attribute to the given string -- (EXPORTED). -- default', bold, nonBold, italic, underline, blink, rapidBlink, reverseVideo, invisible :: String -> String bold = attrib [HighIntensity] nonBold = attrib [LowIntensity ] italic = attrib [Italic ] underline = attrib [Underline ] blink = attrib [Blink ] rapidBlink = attrib [RapidBlink ] reverseVideo = attrib [ReverseVideo ] invisible = attrib [Invisible ] -- -- `default'' behaves a little different from the others predefined -- attribute appliers: Only the subsequent strings are affected by -- the attribute changes. -- default' = (++ rstMode)