ansi-terminal 0.3.1 → 0.4.0

raw patch · 7 files changed

+198/−172 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• System/Console/ANSI/Common.hs +44/−29
• System/Console/ANSI/Example.hs +42/−40
• System/Console/ANSI/Unix.hs +36/−32
• System/Console/ANSI/Windows/Emulator.hs +29/−30
• ansi-terminal.cabal +1/−1
• includes/Common-Include.hs +37/−31
• includes/Exports-Include.hs +9/−9

@@ -1,33 +1,48 @@ module System.Console.ANSI.Common where --- | ANSI colors: come in various intensities, which are controlled by 'ANSISGR'-data ANSIColor = Black-               | Red-               | Green-               | Yellow-               | Blue-               | Magenta-               | Cyan-               | White-               deriving (Bounded, Enum, Show) +-- | ANSI colors: come in various intensities, which are controlled by 'ColorIntensity'+data Color = Black+           | Red+           | Green+           | Yellow+           | Blue+           | Magenta+           | Cyan+           | White+           deriving (Bounded, Enum, Show)++-- | ANSI colors come in two intensities+data ColorIntensity = Dull+                    | Vivid+                    deriving (Enum, Show)++-- | ANSI colors can be set on two different layers+data ConsoleLayer = Foreground+                  | Background+                  deriving (Enum, Show)++-- | ANSI blink speeds: values other than 'NoBlink' are not widely supported+data BlinkSpeed = SlowBlink -- ^ Less than 150 blinks per minute+                | RapidBlink -- ^ More than 150 blinks per minute+                | NoBlink++-- | ANSI text underlining+data Underlining = SingleUnderline+                 | DoubleUnderline -- ^ Not widely supported+                 | NoUnderline++-- | ANSI general console intensity: usually treated as setting the font style (e.g. 'BoldIntensity' causes text to be bold)+data ConsoleIntensity = BoldIntensity+                      | FaintIntensity -- ^ Not widely supported: sometimes treated as concealing text+                      | NormalIntensity+ -- | ANSI Select Graphic Rendition command-data ANSISGR = Reset-             | BoldIntensity-             | FaintIntensity -- ^ Not widely supported: sometimes treated as conceal-             | NormalIntensity-             | Italic -- ^ Not widely supported: sometimes treated as swapping foreground and background-             | SingleUnderline-             | DoubleUnderline -- ^ Not widely supported-             | NoUnderline-             | SlowBlink-             | RapidBlink-             | NoBlink-             | Conceal -- ^ Not widely supported-             | Reveal-             | SwapForegroundBackground-             | DontSwapForegroundBackground-             | ForegroundNormalIntensity ANSIColor-             | ForegroundHighIntensity ANSIColor-             | BackgroundNormalIntensity ANSIColor-             | BackgroundHighIntensity ANSIColor+data SGR = Reset+         | SetConsoleIntensity ConsoleIntensity+         | SetItalicized Bool -- ^ Not widely supported: sometimes treated as swapping foreground and background+         | SetUnderlining Underlining+         | SetBlinkSpeed BlinkSpeed+         | SetVisible Bool -- ^ Not widely supported+         | SetSwapForegroundBackground Bool+         | SetColor ConsoleLayer ColorIntensity Color

@@ -13,7 +13,7 @@ examples :: [IO ()] examples = [ cursorMovementExample            , lineChangeExample-           , setPositionExample+           , setCursorPositionExample            , clearExample            , scrollExample            , sgrExample@@ -24,7 +24,7 @@ main = mapM_ (\example -> resetScreen >> example) examples  resetScreen :: IO ()-resetScreen = clearScreen >> setSGR Reset >> setPosition 0 0+resetScreen = clearScreen >> setSGR [Reset] >> setCursorPosition 0 0  pause :: IO () pause = do@@ -72,39 +72,39 @@     -- Line One     -- Line Two     -    previousLine 1+    cursorUpLine 1     putStr "New Line One"     pause     -- New Line One     -- Line Two     -    nextLine 1+    cursorDownLine 1     putStr "New Line Two"     pause     -- New Line One     -- New Line Two -setPositionExample :: IO ()-setPositionExample = do+setCursorPositionExample :: IO ()+setCursorPositionExample = do     putStrLn "Line One"     putStrLn "Line Two"     pause     -- Line One     -- Line Two     -    setPosition 0 5+    setCursorPosition 0 5     putStr "Foo"     pause     -- Line Foo     -- Line Two     -    setPosition 1 5+    setCursorPosition 1 5     putStr "Bar"     pause     -- Line Foo     -- Line Bar     -    setColumn 1+    setCursorColumn 1     putStr "oaf"     pause     -- Line Foo@@ -118,7 +118,7 @@     -- Line One     -- Line Two     -    setPosition 0 4+    setCursorPosition 0 4     clearFromCursorToScreenEnd     pause     -- Line@@ -131,7 +131,7 @@     -- Line One     -- Line Two     -    setPosition 1 4+    setCursorPosition 1 4     clearFromCursorToScreenBeginning     pause     --@@ -145,13 +145,13 @@     -- Line One     -- Line Two     -    setPosition 0 4+    setCursorPosition 0 4     clearFromCursorToLineEnd     pause     -- Line     -- Line Two     -    setPosition 1 4+    setCursorPosition 1 4     clearFromCursorToLineBeginning     pause     -- Line@@ -190,47 +190,49 @@  sgrExample :: IO () sgrExample = do-    let colors = enumFromTo minBound maxBound :: [ANSIColor]-    forM_ [ForegroundNormalIntensity, ForegroundHighIntensity, BackgroundNormalIntensity, BackgroundHighIntensity] $ \color_way -> do-        resetScreen-        forM_ colors $ \color -> do-            setSGR Reset-            setSGR (color_way color)-            putStrLn (show color)-        pause+    let colors = enumFromTo minBound maxBound :: [Color]+    forM_ [Foreground, Background] $ \layer ->  do+        forM_ [Dull, Vivid] $ \intensity -> do+            resetScreen+            forM_ colors $ \color -> do+                setSGR [Reset]+                setSGR [SetColor layer intensity color]+                putStrLn (show color)+            pause     -- All the colors, 4 times in sequence     -    let named_styles = [ (BoldIntensity, "Bold")-                       , (FaintIntensity, "Faint")-                       , (NormalIntensity, "Normal")-                       , (Italic, "Italic")-                       , (SingleUnderline, "Single Underline")-                       , (DoubleUnderline, "Double Underline")-                       , (NoUnderline, "No Underline")-                       , (SlowBlink, "Slow Blink")-                       , (RapidBlink, "Rapid Blink")-                       , (NoBlink, "No Blink")-                       , (Conceal, "Conceal")-                       , (Reveal, "Reveal")+    let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold")+                       , (SetConsoleIntensity FaintIntensity, "Faint")+                       , (SetConsoleIntensity NormalIntensity, "Normal")+                       , (SetItalicized True, "Italic")+                       , (SetItalicized False, "No Italics")+                       , (SetUnderlining SingleUnderline, "Single Underline")+                       , (SetUnderlining DoubleUnderline, "Double Underline")+                       , (SetUnderlining NoUnderline, "No Underline")+                       , (SetBlinkSpeed SlowBlink, "Slow Blink")+                       , (SetBlinkSpeed RapidBlink, "Rapid Blink")+                       , (SetBlinkSpeed NoBlink, "No Blink")+                       , (SetVisible False, "Conceal")+                       , (SetVisible True, "Reveal")                        ]     forM_ named_styles $ \(style, name) -> do               resetScreen-              setSGR style+              setSGR [style]               putStrLn name               pause     -- Text describing a style displayed in that style in sequence     -    setSGR (ForegroundHighIntensity Red)-    setSGR (BackgroundHighIntensity Blue)+    setSGR [SetColor Foreground Vivid Red]+    setSGR [SetColor Background Vivid Blue]     -    clearScreen >> setPosition 0 0-    setSGR DontSwapForegroundBackground+    clearScreen >> setCursorPosition 0 0+    setSGR [SetSwapForegroundBackground False]     putStr "Red-On-Blue"     pause     -- Red-On-Blue     -    clearScreen >> setPosition 0 0-    setSGR SwapForegroundBackground+    clearScreen >> setCursorPosition 0 0+    setSGR [SetSwapForegroundBackground True]     putStr "Blue-On-Red"     pause     -- Blue-On-Red

@@ -17,8 +17,8 @@ csi :: [Int] -> String -> String csi args code = "\ESC[" ++ concat (intersperse ";" (map show args)) ++ code -ansiColorToCode :: ANSIColor -> Int-ansiColorToCode color = case color of+colorToCode :: Color -> Int+colorToCode color = case color of     Black   -> 0     Red     -> 1     Green   -> 2@@ -28,27 +28,31 @@     Cyan    -> 6     White   -> 7 -ansiSGRToCode :: ANSISGR -> Int-ansiSGRToCode sgr = case sgr of+sgrToCode :: SGR -> Int+sgrToCode sgr = case sgr of     Reset -> 0-    BoldIntensity   -> 1-    FaintIntensity  -> 2-    NormalIntensity -> 22-    Italic -> 3-    SingleUnderline -> 4-    DoubleUnderline -> 21-    NoUnderline     -> 24-    SlowBlink   -> 5-    RapidBlink  -> 6-    NoBlink     -> 25-    Conceal -> 8-    Reveal  -> 28-    SwapForegroundBackground        -> 7-    DontSwapForegroundBackground    -> 27-    ForegroundNormalIntensity color -> 30 + ansiColorToCode color-    ForegroundHighIntensity color   -> 90 + ansiColorToCode color-    BackgroundNormalIntensity color -> 40 + ansiColorToCode color-    BackgroundHighIntensity color   -> 100 + ansiColorToCode color+    SetConsoleIntensity intensity -> case intensity of+        BoldIntensity   -> 1+        FaintIntensity  -> 2+        NormalIntensity -> 22+    SetItalicized True  -> 3+    SetItalicized False -> 23+    SetUnderlining underlining -> case underlining of+        SingleUnderline -> 4+        DoubleUnderline -> 21+        NoUnderline     -> 24+    SetBlinkSpeed blink_speed -> case blink_speed of+        SlowBlink   -> 5+        RapidBlink  -> 6+        NoBlink     -> 25+    SetVisible False -> 8+    SetVisible True  -> 28+    SetSwapForegroundBackground True  -> 7+    SetSwapForegroundBackground False -> 27+    SetColor Foreground Dull color  -> 30 + colorToCode color+    SetColor Foreground Vivid color -> 90 + colorToCode color+    SetColor Background Dull color  -> 40 + colorToCode color+    SetColor Background Vivid color -> 100 + colorToCode color   cursorUpCode n = csi [n] "A"@@ -62,18 +66,18 @@ hCursorBackward h n = hPutStr h $ cursorBackwardCode n  -nextLineCode n = csi [n] "E"-previousLineCode n = csi [n] "F"+cursorDownLineCode n = csi [n] "E"+cursorUpLineCode n = csi [n] "F" -hNextLine h n = hPutStr h $ nextLineCode n-hPreviousLine h n = hPutStr h $ previousLineCode n+hCursorDownLine h n = hPutStr h $ cursorDownLineCode n+hCursorUpLine h n = hPutStr h $ cursorUpLineCode n  -setColumnCode n = csi [n + 1] "G"-setPositionCode n m = csi [n + 1, m + 1] "H"+setCursorColumnCode n = csi [n + 1] "G"+setCursorPositionCode n m = csi [n + 1, m + 1] "H" -hSetColumn h n = hPutStr h $ setColumnCode n-hSetPosition h n m = hPutStr h $ setPositionCode n m+hSetCursorColumn h n = hPutStr h $ setCursorColumnCode n+hSetCursorPosition h n m = hPutStr h $ setCursorPositionCode n m   clearFromCursorToScreenEndCode = csi [0] "J"@@ -101,9 +105,9 @@ hScrollPageDown h n = hPutStr h $ scrollPageDownCode n  -setSGRCode sgr = csi [ansiSGRToCode sgr] "m"+setSGRCode sgrs = csi (map sgrToCode sgrs) "m" -hSetSGR h sgr = hPutStr h $ setSGRCode sgr+hSetSGR h sgrs = hPutStr h $ setSGRCode sgrs   hideCursorCode = csi [] "?25l"

@@ -8,6 +8,7 @@ import System.IO  import Data.Bits+import Data.List   #include "Common-Include.hs"@@ -44,21 +45,21 @@ adjustLine :: HANDLE -> (SHORT -> SHORT -> SHORT) -> IO () adjustLine handle change_y = adjustCursorPosition handle (\window_left _ -> window_left) change_y -hNextLine h n     = withHandle h $ \handle -> adjustLine handle (\_ y -> y + fromIntegral n)-hPreviousLine h n = withHandle h $ \handle -> adjustLine handle (\_ y -> y - fromIntegral n)+hCursorDownLine h n = withHandle h $ \handle -> adjustLine handle (\_ y -> y + fromIntegral n)+hCursorUpLine h n   = withHandle h $ \handle -> adjustLine handle (\_ y -> y - fromIntegral n) -nextLineCode _     = ""-previousLineCode _ = ""+cursorDownLineCode _   = ""+cursorUpLineCode _ = ""  -hSetColumn h x = withHandle h $ \handle -> adjustCursorPosition handle (\window_left _ -> window_left + fromIntegral x) (\_ y -> y)+hSetCursorColumn h x = withHandle h $ \handle -> adjustCursorPosition handle (\window_left _ -> window_left + fromIntegral x) (\_ y -> y) -setColumnCode _ = ""+setCursorColumnCode _ = ""  -hSetPosition h y x = withHandle h $ \handle -> adjustCursorPosition handle (\window_left _ -> window_left + fromIntegral x) (\window_top _ -> window_top + fromIntegral y)+hSetCursorPosition h y x = withHandle h $ \handle -> adjustCursorPosition handle (\window_left _ -> window_left + fromIntegral x) (\window_top _ -> window_top + fromIntegral y) -setPositionCode _ _ = ""+setCursorPositionCode _ _ = ""   clearChar :: WCHAR@@ -141,7 +142,7 @@   {-# INLINE applyANSIColorToAttribute #-}-applyANSIColorToAttribute :: WORD -> WORD -> WORD -> ANSIColor -> WORD -> WORD+applyANSIColorToAttribute :: WORD -> WORD -> WORD -> Color -> WORD -> WORD applyANSIColorToAttribute rED gREEN bLUE color attribute = case color of     Black   -> attribute'     Red     -> attribute' .|. rED@@ -155,7 +156,7 @@     wHITE = rED .|. gREEN .|. bLUE     attribute' = attribute .&. (complement wHITE) -applyForegroundANSIColorToAttribute, applyBackgroundANSIColorToAttribute :: ANSIColor -> WORD -> WORD+applyForegroundANSIColorToAttribute, applyBackgroundANSIColorToAttribute :: Color -> WORD -> WORD applyForegroundANSIColorToAttribute = applyANSIColorToAttribute fOREGROUND_RED fOREGROUND_GREEN fOREGROUND_BLUE applyBackgroundANSIColorToAttribute = applyANSIColorToAttribute bACKGROUND_RED bACKGROUND_GREEN bACKGROUND_BLUE @@ -168,44 +169,42 @@     foreground_attribute' = background_attribute `shiftR` 4     background_attribute' = foreground_attribute `shiftL` 4 -applyANSISGRToAttribute :: ANSISGR -> WORD -> WORD+applyANSISGRToAttribute :: SGR -> WORD -> WORD applyANSISGRToAttribute sgr attribute = case sgr of     Reset -> fOREGROUND_WHITE-    BoldIntensity   -> attribute .|. iNTENSITY-    FaintIntensity  -> attribute .&. (complement iNTENSITY) -- Not supported-    NormalIntensity -> attribute .&. (complement iNTENSITY)-    Italic -> attribute -- Not supported-    SingleUnderline -> attribute .|. cOMMON_LVB_UNDERSCORE -- Not supported, since cOMMON_LVB_UNDERSCORE seems to have no effect-    DoubleUnderline -> attribute .|. cOMMON_LVB_UNDERSCORE -- Not supported, since cOMMON_LVB_UNDERSCORE seems to have no effect-    NoUnderline     -> attribute .&. (complement cOMMON_LVB_UNDERSCORE)-    SlowBlink  -> attribute -- Not supported-    RapidBlink -> attribute -- Not supported-    NoBlink    -> attribute-    Conceal -> attribute -- Not supported-    Reveal  -> attribute+    SetConsoleIntensity intensity -> case intensity of+        BoldIntensity   -> attribute .|. iNTENSITY+        FaintIntensity  -> attribute .&. (complement iNTENSITY) -- Not supported+        NormalIntensity -> attribute .&. (complement iNTENSITY)+    SetItalicized _ -> attribute -- Not supported+    SetUnderlining underlining -> case underlining of+        NoUnderline -> attribute .&. (complement cOMMON_LVB_UNDERSCORE)+        _           -> attribute .|. cOMMON_LVB_UNDERSCORE -- Not supported, since cOMMON_LVB_UNDERSCORE seems to have no effect+    SetBlinkSpeed _ -> attribute -- Not supported+    SetVisible _    -> attribute -- Not supported     -- The cOMMON_LVB_REVERSE_VIDEO doesn't actually appear to have any affect on the colors being displayed, so the emulator     -- just uses it to carry information and implements the color-swapping behaviour itself. Bit of a hack, I guess :-)-    SwapForegroundBackground     ->+    SetSwapForegroundBackground True ->         -- Check if the color-swapping flag is already set         if attribute .&. cOMMON_LVB_REVERSE_VIDEO /= 0          then attribute          else swapForegroundBackgroundColors attribute .|. cOMMON_LVB_REVERSE_VIDEO-    DontSwapForegroundBackground ->+    SetSwapForegroundBackground False ->         -- Check if the color-swapping flag is already not set         if attribute .&. cOMMON_LVB_REVERSE_VIDEO == 0          then attribute          else swapForegroundBackgroundColors attribute .&. (complement cOMMON_LVB_REVERSE_VIDEO)-    ForegroundNormalIntensity color -> applyForegroundANSIColorToAttribute color (attribute .&. (complement fOREGROUND_INTENSITY))-    ForegroundHighIntensity color   -> applyForegroundANSIColorToAttribute color (attribute .|. fOREGROUND_INTENSITY)-    BackgroundNormalIntensity color -> applyBackgroundANSIColorToAttribute color (attribute .&. (complement bACKGROUND_INTENSITY))-    BackgroundHighIntensity color   -> applyBackgroundANSIColorToAttribute color (attribute .|. bACKGROUND_INTENSITY)+    SetColor Foreground Dull color  -> applyForegroundANSIColorToAttribute color (attribute .&. (complement fOREGROUND_INTENSITY))+    SetColor Foreground Vivid color -> applyForegroundANSIColorToAttribute color (attribute .|. fOREGROUND_INTENSITY)+    SetColor Background Dull color  -> applyBackgroundANSIColorToAttribute color (attribute .&. (complement bACKGROUND_INTENSITY))+    SetColor Background Vivid color -> applyBackgroundANSIColorToAttribute color (attribute .|. bACKGROUND_INTENSITY)   where     iNTENSITY = fOREGROUND_INTENSITY .|. bACKGROUND_INTENSITY  hSetSGR h sgr = withHandle h $ \handle -> do     screen_buffer_info <- getConsoleScreenBufferInfo handle     let attribute = csbi_attributes screen_buffer_info-        attribute' = applyANSISGRToAttribute sgr attribute+        attribute' = foldl' (flip applyANSISGRToAttribute) attribute sgr     setConsoleTextAttribute handle attribute'  setSGRCode _ = ""

@@ -1,5 +1,5 @@ Name:                ansi-terminal-Version:             0.3.1+Version:             0.4.0 Cabal-Version:       >= 1.2 Category:            User Interfaces Synopsis:            Simple ANSI terminal support, with Windows compatibility

@@ -12,41 +12,41 @@ cursorBackward = hCursorBackward stdout  -hNextLine, hPreviousLine :: Handle-                         -> Int -- ^ Number of lines to move-                         -> IO ()-nextLine, previousLine :: Int -- ^ Number of lines to move-                       -> IO ()-nextLineCode, previousLineCode :: Int -- ^ Number of lines to move-                               -> String+hCursorDownLine, hCursorUpLine :: Handle+                               -> Int -- ^ Number of lines to move+                               -> IO ()+cursorDownLine, cursorUpLine :: Int -- ^ Number of lines to move+                             -> IO ()+cursorDownLineCode, cursorUpLineCode :: Int -- ^ Number of lines to move+                                     -> String -nextLine = hNextLine stdout-previousLine = hPreviousLine stdout+cursorDownLine = hCursorDownLine stdout+cursorUpLine = hCursorUpLine stdout  -hSetColumn :: Handle-           -> Int -- ^ 0-based column to move to-           -> IO ()-setColumn :: Int -- ^ 0-based column to move to-          -> IO ()-setColumnCode :: Int -- ^ 0-based column to move to-              -> String+hSetCursorColumn :: Handle+                 -> Int -- ^ 0-based column to move to+                 -> IO ()+setCursorColumn :: Int -- ^ 0-based column to move to+                -> IO ()+setCursorColumnCode :: Int -- ^ 0-based column to move to+                    -> String -setColumn = hSetColumn stdout+setCursorColumn = hSetCursorColumn stdout  -hSetPosition :: Handle-             -> Int -- ^ 0-based row to move to-             -> Int -- ^ 0-based column to move to-             -> IO ()-setPosition :: Int -- ^ 0-based row to move to-            -> Int -- ^ 0-based column to move to-            -> IO ()-setPositionCode :: Int -- ^ 0-based row to move to-                -> Int -- ^ 0-based column to move to-                -> String+hSetCursorPosition :: Handle+                   -> Int -- ^ 0-based row to move to+                   -> Int -- ^ 0-based column to move to+                   -> IO ()+setCursorPosition :: Int -- ^ 0-based row to move to+                  -> Int -- ^ 0-based column to move to+                  -> IO ()+setCursorPositionCode :: Int -- ^ 0-based row to move to+                      -> Int -- ^ 0-based column to move to+                      -> String -setPosition = hSetPosition stdout+setCursorPosition = hSetCursorPosition stdout   hClearFromCursorToScreenEnd, hClearFromCursorToScreenBeginning, hClearScreen :: Handle@@ -86,13 +86,19 @@  -- | Set the Select Graphic Rendition mode hSetSGR :: Handle-        -> ANSISGR -- ^ Mode: this is applied to the current console SGR mode+        -> [SGR] -- ^ Commands: these will typically be applied on top of the current console SGR mode.+                 -- An empty list of commands is equivalent to the list @[Reset]@. Commands are applied+                 -- left to right.         -> IO () -- | Set the Select Graphic Rendition mode-setSGR :: ANSISGR -- ^ Mode: this is applied to the current console SGR mode+setSGR :: [SGR] -- ^ Commands: these will typically be applied on top of the current console SGR mode.+                -- An empty list of commands is equivalent to the list @[Reset]@. Commands are applied+                -- left to right.        -> IO () -- | Set the Select Graphic Rendition mode-setSGRCode :: ANSISGR -- ^ Mode: this is applied to the current console SGR mode+setSGRCode :: [SGR] -- ^ Commands: these will typically be applied on top of the current console SGR mode.+                    -- An empty list of commands is equivalent to the list @[Reset]@. Commands are applied+                    -- left to right.            -> String  setSGR = hSetSGR stdout

@@ -7,18 +7,18 @@ cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode,  -- * Cursor movement by line-nextLine, previousLine,-hNextLine, hPreviousLine,-nextLineCode, previousLineCode,+cursorUpLine, cursorDownLine,+hCursorUpLine, hCursorDownLine,+cursorUpLineCode, cursorDownLineCode,  -- * Directly changing cursor position-setColumn,-hSetColumn,-setColumnCode,+setCursorColumn,+hSetCursorColumn,+setCursorColumnCode, -setPosition,-hSetPosition,-setPositionCode,+setCursorPosition,+hSetCursorPosition,+setCursorPositionCode,  -- * Clearing parts of the screen clearFromCursorToScreenEnd, clearFromCursorToScreenBeginning, clearScreen,