packages feed

ansi-terminal (empty) → 0.1

raw patch · 10 files changed

+954/−0 lines, 10 filesdep +Win32dep +basedep +unixsetup-changed

Dependencies added: Win32, base, unix

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2008, Maximilian Bolingbroke+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted+provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice, this list of+      conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice, this list of+      conditions and the following disclaimer in the documentation and/or other materials+      provided with the distribution.+    * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to+      endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT+OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ System/Console/ANSI.hs view
@@ -0,0 +1,20 @@+#if defined(WINDOWS)+module System.Console.ANSI (+        module System.Console.ANSI.Windows+    ) where++import System.Console.ANSI.Windows++#elif defined(UNIX)++module System.Console.ANSI (+        module System.Console.ANSI.Unix+    ) where++import System.Console.ANSI.Unix++#else++#error Unsupported platform for the ansi-terminal package++#endif
+ System/Console/ANSI/Common.hs view
@@ -0,0 +1,31 @@+module System.Console.ANSI.Common where++data ANSIColor = Black+               | Red+               | Green+               | Yellow+               | Blue+               | Magenta+               | Cyan+               | White+               deriving (Bounded, Enum, Show)++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
+ System/Console/ANSI/Example.hs view
@@ -0,0 +1,250 @@+module Main (+        main+    ) where++import System.Console.ANSI++import System.IO++import Control.Concurrent+import Control.Monad+++examples :: [IO ()]+examples = [ cursorMovementExample+           , lineChangeExample+           , setPositionExample+           , clearExample+           , scrollExample+           , sgrExample+           , cursorVisibilityExample+           ]++main :: IO ()+main = mapM_ (\example -> resetScreen >> example) examples++resetScreen :: IO ()+resetScreen = clearScreen >> setSGR Reset >> setPosition 0 0++pause :: IO ()+pause = do+    hFlush stdout+    -- 1 second pause+    threadDelay 1000000++cursorMovementExample :: IO ()+cursorMovementExample = do+    putStrLn "Line One"+    putStr "Line Two"+    pause+    -- Line One+    -- Line Two+    +    cursorUp 1+    putStr " - Extras"+    pause+    -- Line One - Extras+    -- Line Two+    +    cursorBackward 2+    putStr "zz"+    pause+    -- Line One - Extrzz+    -- Line Two+    +    cursorForward 2+    putStr "- And More"+    pause+    -- Line One - Extrzz  - And More+    -- Line Two+    +    cursorDown 1+    putStr "Disconnected"+    pause+    -- Line One - Extrzz  - And More+    -- Line Two                     Disconnected++lineChangeExample :: IO ()+lineChangeExample = do+    putStrLn "Line One"+    putStr "Line Two"+    pause+    -- Line One+    -- Line Two+    +    previousLine 1+    putStr "New Line One"+    pause+    -- New Line One+    -- Line Two+    +    nextLine 1+    putStr "New Line Two"+    pause+    -- New Line One+    -- New Line Two++setPositionExample :: IO ()+setPositionExample = do+    putStrLn "Line One"+    putStrLn "Line Two"+    pause+    -- Line One+    -- Line Two+    +    setPosition 0 5+    putStr "Foo"+    pause+    -- Line Foo+    -- Line Two+    +    setPosition 1 5+    putStr "Bar"+    pause+    -- Line Foo+    -- Line Bar+    +    setColumn 1+    putStr "oaf"+    pause+    -- Line Foo+    -- Loaf Bar++clearExample :: IO ()+clearExample = do+    putStrLn "Line One"+    putStrLn "Line Two"+    pause+    -- Line One+    -- Line Two+    +    setPosition 0 4+    clearFromCursorToScreenEnd+    pause+    -- Line+    +    +    resetScreen+    putStrLn "Line One"+    putStrLn "Line Two"+    pause+    -- Line One+    -- Line Two+    +    setPosition 1 4+    clearFromCursorToScreenBeginning+    pause+    --+    --     Two+    +    +    resetScreen+    putStrLn "Line One"+    putStrLn "Line Two"+    pause+    -- Line One+    -- Line Two+    +    setPosition 0 4+    clearFromCursorToLineEnd+    pause+    -- Line+    -- Line Two+    +    setPosition 1 4+    clearFromCursorToLineBeginning+    pause+    -- Line+    --      Two+    +    clearLine+    pause+    -- Line+    +    clearScreen+    pause+    --++scrollExample :: IO ()+scrollExample = do+    putStrLn "Line One"+    putStrLn "Line Two"+    putStrLn "Line Three"+    pause+    -- Line One+    -- Line Two+    -- Line Three+    +    scrollPageDown 2+    pause+    --+    --+    -- Line One+    -- Line Two+    -- Line Three+    +    scrollPageUp 3+    pause+    -- Line Two+    -- Line Three++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+    -- 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")+                       ]+    forM_ named_styles $ \(style, name) -> do+              resetScreen+              setSGR style+              putStrLn name+              pause+    -- Text describing a style displayed in that style in sequence+    +    setSGR (ForegroundHighIntensity Red)+    setSGR (BackgroundHighIntensity Blue)+    +    clearScreen >> setPosition 0 0+    setSGR DontSwapForegroundBackground+    putStr "Red-On-Blue"+    pause+    -- Red-On-Blue+    +    clearScreen >> setPosition 0 0+    setSGR SwapForegroundBackground+    putStr "Blue-On-Red"+    pause+    -- Blue-On-Red++cursorVisibilityExample :: IO ()+cursorVisibilityExample = do+    putStr "Cursor Demo"+    pause+    -- Cursor Demo|+    +    hideCursor+    pause+    -- Cursor Demo+    +    showCursor+    pause+    -- Cursor Demo|
+ System/Console/ANSI/Unix.hs view
@@ -0,0 +1,78 @@+module System.Console.ANSI.Unix (+#include "Exports-Include.hs"+    ) where++import System.Console.ANSI.Common++import Data.List+++#include "Common-Include.hs"+++-- | The reference I used for the escape characters in this module was http://en.wikipedia.org/wiki/ANSI_escape_sequences+csi :: [Int] -> String -> IO ()+csi args code = putStr $ "\ESC[" ++ concat (intersperse ";" (map show args)) ++ code+++cursorUp n = csi [n] "A"+cursorDown n = csi [n] "B"+cursorForward n = csi [n] "C"+cursorBackward n = csi [n] "D"++nextLine n = csi [n] "E"+previousLine n = csi [n] "F"++setColumn n = csi [n + 1] "G"++setPosition n m = csi [n + 1, m + 1] "H"++clearFromCursorToScreenEnd = csi [0] "J"+clearFromCursorToScreenBeginning = csi [1] "J"+clearScreen = csi [2] "J"++clearFromCursorToLineEnd = csi [0] "K"+clearFromCursorToLineBeginning = csi [1] "K"+clearLine = csi [2] "K"++scrollPageUp n = csi [n] "S"+scrollPageDown n = csi [n] "T"++setSGR sgr = csi [ansiSGRToCode sgr] "m"++hideCursor = csi [] "?25l"+showCursor = csi [] "?25h"+++ansiColorToCode :: ANSIColor -> Int+ansiColorToCode color = case color of+    Black   -> 0+    Red     -> 1+    Green   -> 2+    Yellow  -> 3+    Blue    -> 4+    Magenta -> 5+    Cyan    -> 6+    White   -> 7++ansiSGRToCode :: ANSISGR -> Int+ansiSGRToCode 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
+ System/Console/ANSI/Windows.hs view
@@ -0,0 +1,6 @@+module System.Console.ANSI.Windows (+#include "Exports-Include.hs"+    ) where++import System.Console.ANSI.Common+import System.Console.ANSI.Windows.Emulator
+ System/Console/ANSI/Windows/Emulator.hs view
@@ -0,0 +1,195 @@+module System.Console.ANSI.Windows.Emulator where++import System.Console.ANSI.Common+import System.Console.ANSI.Windows.Foreign++import Data.Bits+++#include "Common-Include.hs"+++screenRectangle :: IO SMALL_RECT+screenRectangle = do+    handle <- getStdHandle sTD_OUTPUT_HANDLE+    fmap csbi_window $ getConsoleScreenBufferInfo handle+++adjustCursorPosition :: (SHORT -> SHORT -> SHORT) -> (SHORT -> SHORT -> SHORT) -> IO ()+adjustCursorPosition change_x change_y = do+    handle <- getStdHandle sTD_OUTPUT_HANDLE+    screen_buffer_info <- getConsoleScreenBufferInfo handle+    let window = csbi_window screen_buffer_info+        (COORD x y) = csbi_cursor_position screen_buffer_info+        cursor_pos' = COORD (change_x (rect_left window) x) (change_y (rect_top window) y)+    setConsoleCursorPosition handle cursor_pos'++cursorUp n       = adjustCursorPosition (\_ x -> x) (\_ y -> y - fromIntegral n)+cursorDown n     = adjustCursorPosition (\_ x -> x) (\_ y -> y + fromIntegral n)+cursorForward n  = adjustCursorPosition (\_ x -> x + fromIntegral n) (\_ y -> y)+cursorBackward n = adjustCursorPosition (\_ x -> x - fromIntegral n) (\_ y -> y)+++adjustLine :: (SHORT -> SHORT -> SHORT) -> IO ()+adjustLine change_y = do+    adjustCursorPosition (\window_left _ -> window_left) change_y++nextLine n     = adjustLine (\_ y -> y + fromIntegral n)+previousLine n = adjustLine (\_ y -> y - fromIntegral n)+++setColumn x = adjustCursorPosition (\window_left _ -> window_left + fromIntegral x) (\_ y -> y)++setPosition y x = adjustCursorPosition (\window_left _ -> window_left + fromIntegral x) (\window_top _ -> window_top + fromIntegral y)+++clearChar :: WCHAR+clearChar = charToWCHAR ' '++clearAttribute :: WORD+clearAttribute = 0++clearScreenFraction :: (SMALL_RECT -> COORD -> (DWORD, COORD)) -> IO ()+clearScreenFraction fraction_finder = do+    handle <- getStdHandle sTD_OUTPUT_HANDLE+    screen_buffer_info <- getConsoleScreenBufferInfo handle+    +    let window = csbi_window screen_buffer_info+        cursor_pos = csbi_cursor_position screen_buffer_info+        (fill_length, fill_cursor_pos) = fraction_finder window cursor_pos+    +    fillConsoleOutputCharacter handle clearChar fill_length fill_cursor_pos+    fillConsoleOutputAttribute handle clearAttribute fill_length fill_cursor_pos+    return ()++clearFromCursorToScreenEnd = clearScreenFraction go+  where+    go window cursor_pos = (fromIntegral fill_length, cursor_pos)+      where+        size_x = rect_width window+        size_y = rect_bottom window - coord_y cursor_pos+        line_remainder = size_x - coord_x cursor_pos+        fill_length = size_x * size_y + line_remainder++clearFromCursorToScreenBeginning = clearScreenFraction go+  where+    go window cursor_pos = (fromIntegral fill_length, rect_top_left window)+      where+        size_x = rect_width window+        size_y = coord_y cursor_pos - rect_top window+        line_remainder = coord_x cursor_pos+        fill_length = size_x * size_y + line_remainder++clearScreen = clearScreenFraction go+  where+    go window _ = (fromIntegral fill_length, rect_top_left window)+      where+        size_x = rect_width window+        size_y = rect_height window+        fill_length = size_x * size_y++clearFromCursorToLineEnd = clearScreenFraction go+  where+    go window cursor_pos = (fromIntegral (rect_right window - coord_x cursor_pos), cursor_pos)++clearFromCursorToLineBeginning = clearScreenFraction go+  where+    go window cursor_pos = (fromIntegral (coord_x cursor_pos), cursor_pos { coord_x = rect_left window })++clearLine = clearScreenFraction go+  where+    go window cursor_pos = (fromIntegral (rect_width window), cursor_pos { coord_x = rect_left window })+++scrollPage :: Int -> IO ()+scrollPage new_origin_y = do+    handle <- getStdHandle sTD_OUTPUT_HANDLE+    screen_buffer_info <- getConsoleScreenBufferInfo handle+    let fill = CHAR_INFO clearChar clearAttribute+        window = csbi_window screen_buffer_info+        origin = COORD (rect_left window) (rect_top window + fromIntegral new_origin_y)+    scrollConsoleScreenBuffer handle window Nothing origin fill++scrollPageUp n = scrollPage (negate n)+scrollPageDown n = scrollPage n+++{-# INLINE applyANSIColorToAttribute #-}+applyANSIColorToAttribute :: WORD -> WORD -> WORD -> ANSIColor -> WORD -> WORD+applyANSIColorToAttribute rED gREEN bLUE color attribute = case color of+    Black   -> attribute'+    Red     -> attribute' .|. rED+    Green   -> attribute' .|. gREEN+    Yellow  -> attribute' .|. rED .|. gREEN+    Blue    -> attribute' .|. bLUE+    Magenta -> attribute' .|. rED .|. bLUE+    Cyan    -> attribute' .|. gREEN .|. bLUE+    White   -> attribute' .|. wHITE+  where+    wHITE = rED .|. gREEN .|. bLUE+    attribute' = attribute .&. (complement wHITE)++applyForegroundANSIColorToAttribute, applyBackgroundANSIColorToAttribute :: ANSIColor -> WORD -> WORD+applyForegroundANSIColorToAttribute = applyANSIColorToAttribute fOREGROUND_RED fOREGROUND_GREEN fOREGROUND_BLUE+applyBackgroundANSIColorToAttribute = applyANSIColorToAttribute bACKGROUND_RED bACKGROUND_GREEN bACKGROUND_BLUE++swapForegroundBackgroundColors :: WORD -> WORD+swapForegroundBackgroundColors attribute = clean_attribute .|. foreground_attribute' .|. background_attribute'+  where+    foreground_attribute = attribute .&. fOREGROUND_INTENSE_WHITE+    background_attribute = attribute .&. bACKGROUND_INTENSE_WHITE+    clean_attribute = attribute .&. complement (fOREGROUND_INTENSE_WHITE .|. bACKGROUND_INTENSE_WHITE)+    foreground_attribute' = background_attribute `shiftR` 4+    background_attribute' = foreground_attribute `shiftL` 4++applyANSISGRToAttribute :: ANSISGR -> 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+    -- 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     ->+        -- 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 ->+        -- 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)+  where+    iNTENSITY = fOREGROUND_INTENSITY .|. bACKGROUND_INTENSITY++setSGR sgr = do+    handle <- getStdHandle sTD_OUTPUT_HANDLE+    screen_buffer_info <- getConsoleScreenBufferInfo handle+    let attribute = csbi_attributes screen_buffer_info+        attribute' = applyANSISGRToAttribute sgr attribute+    setConsoleTextAttribute handle attribute'+++changeCursorVisibility :: Bool -> IO ()+changeCursorVisibility cursor_visible = do+    handle <- getStdHandle sTD_OUTPUT_HANDLE+    cursor_info <- getConsoleCursorInfo handle+    setConsoleCursorInfo handle (cursor_info { cci_cursor_visible = cursor_visible })++hideCursor = changeCursorVisibility False+showCursor = changeCursorVisibility True+
+ System/Console/ANSI/Windows/Foreign.hs view
@@ -0,0 +1,266 @@+-- | "System.Win32.Console" is really very impoverished, so I have had to do all the FFI myself.+module System.Console.ANSI.Windows.Foreign (+        -- Re-exports from Win32.Types+        BOOL, WORD, DWORD, WCHAR, HANDLE, SHORT,+        +        charToWCHAR,+        +        COORD(..), SMALL_RECT(..), rect_top, rect_bottom, rect_left, rect_right, rect_width, rect_height,+        CONSOLE_CURSOR_INFO(..), CONSOLE_SCREEN_BUFFER_INFO(..), CHAR_INFO(..),+        +        sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE,+        +        fOREGROUND_BLUE, fOREGROUND_GREEN, fOREGROUND_RED, fOREGROUND_INTENSITY, fOREGROUND_WHITE, fOREGROUND_INTENSE_WHITE,+        bACKGROUND_BLUE, bACKGROUND_GREEN, bACKGROUND_RED, bACKGROUND_INTENSITY, bACKGROUND_WHITE, bACKGROUND_INTENSE_WHITE,+        cOMMON_LVB_REVERSE_VIDEO, cOMMON_LVB_UNDERSCORE,+        +        getStdHandle,+        getConsoleScreenBufferInfo,+        getConsoleCursorInfo,+        +        setConsoleTextAttribute,+        setConsoleCursorPosition,+        setConsoleCursorInfo,+        +        fillConsoleOutputAttribute,+        fillConsoleOutputCharacter,+        scrollConsoleScreenBuffer+    ) where++import Foreign.C.Types+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable++import Data.Bits+import Data.Char++import System.Win32.Types+++-- Some Windows types missing from System.Win32+type SHORT = CShort+type WCHAR = CWchar++charToWCHAR :: Char -> WCHAR+charToWCHAR char = fromIntegral (ord char)+++-- This is a FFI hack. Some of the API calls take a Coord, but that isn't a built-in FFI type so I can't+-- use it directly. Instead, I use UNPACKED_COORD and marshal COORDs into this manually. Note that we CAN'T+-- just use two SHORTs directly because they get expanded to 4 bytes each instead of just boing 2 lots of 2+-- bytes by the stdcall convention, so linking fails.+type UNPACKED_COORD = CInt++-- Field packing order determined experimentally: I couldn't immediately find a specification for Windows+-- struct layout anywhere.+unpackCOORD :: COORD -> UNPACKED_COORD+unpackCOORD (COORD x y) = (fromIntegral y) `shiftL` (sizeOf x * 8) .|. (fromIntegral x)+++peekAndOffset :: Storable a => Ptr a -> IO (a, Ptr b)+peekAndOffset ptr = do+    item <- peek ptr+    return (item, ptr `plusPtr` sizeOf item)++pokeAndOffset :: Storable a => Ptr a -> a -> IO (Ptr b)+pokeAndOffset ptr item = do+    poke ptr item+    return (ptr `plusPtr` sizeOf item)+++data COORD = COORD {+        coord_x :: SHORT,+        coord_y :: SHORT+    }++instance Show COORD where+    show (COORD x y) = "(" ++ show x ++ ", " ++ show y ++ ")"++instance Storable COORD where+    sizeOf ~(COORD x y) = sizeOf x + sizeOf y+    alignment ~(COORD x _) = alignment x+    peek ptr = do+        let ptr' = castPtr ptr :: Ptr SHORT+        x <- peekElemOff ptr' 0+        y <- peekElemOff ptr' 1+        return (COORD x y)+    poke ptr (COORD x y) = do+        let ptr' = castPtr ptr :: Ptr SHORT+        pokeElemOff ptr' 0 x+        pokeElemOff ptr' 1 y+++data SMALL_RECT = SMALL_RECT {+        rect_top_left :: COORD,+        rect_bottom_right :: COORD+    }++rect_top, rect_left, rect_bottom, rect_right :: SMALL_RECT -> SHORT+rect_top = coord_y . rect_top_left+rect_left = coord_x . rect_top_left+rect_bottom = coord_y . rect_bottom_right+rect_right = coord_x . rect_bottom_right++rect_width, rect_height :: SMALL_RECT -> SHORT+rect_width rect = rect_right rect - rect_left rect + 1+rect_height rect = rect_bottom rect - rect_top rect + 1++instance Show SMALL_RECT where+    show (SMALL_RECT tl br) = show tl ++ "-" ++ show br++instance Storable SMALL_RECT where+    sizeOf ~(SMALL_RECT tl br) = sizeOf tl + sizeOf br+    alignment ~(SMALL_RECT tl _) = alignment tl+    peek ptr = do+        let ptr' = castPtr ptr :: Ptr COORD+        tl <- peekElemOff ptr' 0+        br <- peekElemOff ptr' 1+        return (SMALL_RECT tl br)+    poke ptr (SMALL_RECT tl br) = do+        let ptr' = castPtr ptr :: Ptr COORD+        pokeElemOff ptr' 0 tl+        pokeElemOff ptr' 1 br+++data CONSOLE_CURSOR_INFO = CONSOLE_CURSOR_INFO {+        cci_cursor_size :: DWORD,+        cci_cursor_visible :: BOOL+    }+    deriving (Show)++instance Storable CONSOLE_CURSOR_INFO where+    sizeOf ~(CONSOLE_CURSOR_INFO size visible) = sizeOf size + sizeOf visible+    alignment ~(CONSOLE_CURSOR_INFO size _) = alignment size+    peek ptr = do+        (size, ptr') <- peekAndOffset (castPtr ptr)+        visible <- peek ptr'+        return (CONSOLE_CURSOR_INFO size visible)+    poke ptr (CONSOLE_CURSOR_INFO size visible) = do+        ptr' <- pokeAndOffset (castPtr ptr) size+        poke ptr' visible+++data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO {+        csbi_size :: COORD,+        csbi_cursor_position :: COORD,+        csbi_attributes :: WORD,+        csbi_window :: SMALL_RECT,+        csbi_maximum_window_size :: COORD+    }+    deriving (Show)++instance Storable CONSOLE_SCREEN_BUFFER_INFO where+    sizeOf ~(CONSOLE_SCREEN_BUFFER_INFO size cursor_position attributes window maximum_window_size)+      = sizeOf size + sizeOf cursor_position + sizeOf attributes + sizeOf window + sizeOf maximum_window_size+    alignment ~(CONSOLE_SCREEN_BUFFER_INFO size _ _ _ _) = alignment size+    peek ptr = do+        (size, ptr1) <- peekAndOffset (castPtr ptr)+        (cursor_position, ptr2) <- peekAndOffset ptr1+        (attributes, ptr3) <- peekAndOffset ptr2+        (window, ptr4) <- peekAndOffset ptr3+        maximum_window_size <- peek ptr4+        return (CONSOLE_SCREEN_BUFFER_INFO size cursor_position attributes window maximum_window_size)+    poke ptr (CONSOLE_SCREEN_BUFFER_INFO size cursor_position attributes window maximum_window_size) = do+        ptr1 <- pokeAndOffset (castPtr ptr) size+        ptr2 <- pokeAndOffset ptr1 cursor_position+        ptr3 <- pokeAndOffset ptr2 attributes+        ptr4 <- pokeAndOffset ptr3 window+        poke ptr4 maximum_window_size+++data CHAR_INFO = CHAR_INFO {+        ci_char :: WCHAR,+        ci_attributes :: WORD+    }+    deriving (Show)++instance Storable CHAR_INFO where+    sizeOf ~(CHAR_INFO char attributes) = sizeOf char + sizeOf attributes+    alignment ~(CHAR_INFO char _) = alignment char+    peek ptr = do+        (char, ptr') <- peekAndOffset (castPtr ptr)+        attributes <- peek ptr'+        return (CHAR_INFO char attributes)+    poke ptr (CHAR_INFO char attributes) = do+        ptr' <- pokeAndOffset (castPtr ptr) char+        poke ptr' attributes+++sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE :: DWORD+sTD_INPUT_HANDLE = -10+sTD_OUTPUT_HANDLE = -11+sTD_ERROR_HANDLE = -12++fOREGROUND_BLUE, fOREGROUND_GREEN, fOREGROUND_RED, fOREGROUND_INTENSITY,+  bACKGROUND_BLUE, bACKGROUND_GREEN, bACKGROUND_RED, bACKGROUND_INTENSITY,+  cOMMON_LVB_REVERSE_VIDEO, cOMMON_LVB_UNDERSCORE :: WORD+fOREGROUND_BLUE = 0x1+fOREGROUND_GREEN = 0x2+fOREGROUND_RED = 0x4+fOREGROUND_INTENSITY = 0x8+bACKGROUND_BLUE = 0x10+bACKGROUND_GREEN = 0x20+bACKGROUND_RED= 0x40+bACKGROUND_INTENSITY = 0x80+cOMMON_LVB_REVERSE_VIDEO = 0x4000+cOMMON_LVB_UNDERSCORE = 0x8000++fOREGROUND_WHITE, bACKGROUND_WHITE, fOREGROUND_INTENSE_WHITE, bACKGROUND_INTENSE_WHITE :: WORD+fOREGROUND_WHITE = fOREGROUND_RED .|. fOREGROUND_GREEN .|. fOREGROUND_BLUE+bACKGROUND_WHITE = bACKGROUND_RED .|. bACKGROUND_GREEN .|. bACKGROUND_BLUE+fOREGROUND_INTENSE_WHITE = fOREGROUND_WHITE .|. fOREGROUND_INTENSITY+bACKGROUND_INTENSE_WHITE = bACKGROUND_WHITE .|. bACKGROUND_INTENSITY+++foreign import stdcall unsafe "windows.h GetStdHandle" getStdHandle :: DWORD -> IO HANDLE+foreign import stdcall unsafe "windows.h GetConsoleScreenBufferInfo" cGetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL+foreign import stdcall unsafe "windows.h GetConsoleCursorInfo" cGetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL++foreign import stdcall unsafe "windows.h SetConsoleTextAttribute" cSetConsoleTextAttribute :: HANDLE -> WORD -> IO BOOL+foreign import stdcall unsafe "windows.h SetConsoleCursorPosition" cSetConsoleCursorPosition :: HANDLE -> UNPACKED_COORD -> IO BOOL+foreign import stdcall unsafe "windows.h SetConsoleCursorInfo" cSetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL++foreign import stdcall unsafe "windows.h FillConsoleOutputAttribute" cFillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL+foreign import stdcall unsafe "windows.h FillConsoleOutputCharacterW" cFillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL+foreign import stdcall unsafe "windows.h ScrollConsoleScreenBufferW" cScrollConsoleScreenBuffer :: HANDLE -> Ptr SMALL_RECT -> Ptr SMALL_RECT -> UNPACKED_COORD -> Ptr CHAR_INFO -> IO BOOL+++getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO+getConsoleScreenBufferInfo handle = alloca $ \ptr_console_screen_buffer_info -> do+    failIfFalse_ "getConsoleScreenBufferInfo" $ cGetConsoleScreenBufferInfo handle ptr_console_screen_buffer_info+    peek ptr_console_screen_buffer_info++getConsoleCursorInfo :: HANDLE -> IO CONSOLE_CURSOR_INFO+getConsoleCursorInfo handle = alloca $ \ptr_console_cursor_info -> do+    failIfFalse_ "getConsoleCursorInfo" $ cGetConsoleCursorInfo handle ptr_console_cursor_info+    peek ptr_console_cursor_info+++setConsoleTextAttribute :: HANDLE -> WORD -> IO ()+setConsoleTextAttribute handle attributes = failIfFalse_ "setConsoleTextAttribute" $ cSetConsoleTextAttribute handle attributes++setConsoleCursorPosition :: HANDLE -> COORD -> IO ()+setConsoleCursorPosition handle cursor_position = failIfFalse_ "setConsoleCursorPosition" $ cSetConsoleCursorPosition handle (unpackCOORD cursor_position)++setConsoleCursorInfo :: HANDLE -> CONSOLE_CURSOR_INFO -> IO ()+setConsoleCursorInfo handle console_cursor_info = with console_cursor_info $ \ptr_console_cursor_info -> do+    failIfFalse_ "setConsoleCursorInfo" $ cSetConsoleCursorInfo handle ptr_console_cursor_info+++fillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> COORD -> IO DWORD+fillConsoleOutputAttribute handle attribute fill_length write_origin = alloca $ \ptr_chars_written -> do+    failIfFalse_ "fillConsoleOutputAttribute" $ cFillConsoleOutputAttribute handle attribute fill_length (unpackCOORD write_origin) ptr_chars_written+    peek ptr_chars_written++fillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> COORD -> IO DWORD+fillConsoleOutputCharacter handle char fill_length write_origin = alloca $ \ptr_chars_written -> do+    failIfFalse_ "fillConsoleOutputCharacter" $ cFillConsoleOutputCharacter handle char fill_length (unpackCOORD write_origin) ptr_chars_written+    peek ptr_chars_written++scrollConsoleScreenBuffer :: HANDLE -> SMALL_RECT -> Maybe SMALL_RECT -> COORD -> CHAR_INFO -> IO ()+scrollConsoleScreenBuffer handle scroll_rectangle mb_clip_rectangle destination_origin fill +  = with scroll_rectangle $ \ptr_scroll_rectangle ->+    maybeWith with mb_clip_rectangle $ \ptr_clip_rectangle ->+    with fill $ \ptr_fill ->+    failIfFalse_ "scrollConsoleScreenBuffer" $ cScrollConsoleScreenBuffer handle ptr_scroll_rectangle ptr_clip_rectangle (unpackCOORD destination_origin) ptr_fill
+ ansi-terminal.cabal view
@@ -0,0 +1,82 @@+Name:           ansi-terminal+Version:        0.1+Cabal-Version:  >= 1.2+Category:       User Interfaces+Synopsis:       Simple ANSI terminal support, with Windows compatibility+Description:    ANSI terminal support for Haskell: allows cursor movement, screen clearing, color output and showing or hiding the cursor+License:        BSD3+License-File:   LICENSE+Author:         Max Bolingbroke+Maintainer:     batterseapower@hotmail.com+Homepage:       http://bsp.lighthouseapp.com/projects/16235-ansi-terminal/overview+Build-Type:     Simple++Flag SplitBase+        Description:    Choose the new smaller, split-up base package+        Default:        True++Flag Example+        Description:    Build the example application+        Default:        False+++Library+        Exposed-Modules:        System.Console.ANSI+        +        Other-Modules:          System.Console.ANSI.Common+        +        Cpp-Options:            -Iincludes+        +        if os(windows)+                Build-Depends:          Win32 >= 2.0+                Cpp-Options:            -DWINDOWS+                Extra-Libraries:        "kernel32"+                Other-Modules:          System.Console.ANSI.Windows+                                        System.Console.ANSI.Windows.Foreign+                                        System.Console.ANSI.Windows.Emulator+        else+                -- We assume any non-Windows platform is Unix+                Build-Depends:          unix >= 2.3.0.0+                Cpp-Options:            -DUNIX+                Other-Modules:          System.Console.ANSI.Unix+        +        if flag(splitBase)+                Build-Depends:          base >= 3+        else+                Build-Depends:          base < 3+        +        Extensions:             CPP+                                ForeignFunctionInterface+        +        Ghc-Options:                    -Wall++Executable ansi-terminal-example+        Main-Is:                System/Console/ANSI/Example.hs+        +        Cpp-Options:            -Iincludes+        +        if os(windows)+                Build-Depends:          Win32 >= 2.0+                Cpp-Options:            -DWINDOWS+                Extra-Libraries:        "kernel32"+                Other-Modules:          System.Console.ANSI.Windows+                                        System.Console.ANSI.Windows.Foreign+                                        System.Console.ANSI.Windows.Emulator+        else+                -- We assume any non-Windows platform is Unix+                Build-Depends:          unix >= 2.3.0.0+                Cpp-Options:            -DUNIX+                Other-Modules:          System.Console.ANSI.Unix+        +        if flag(splitBase)+                Build-Depends:          base >= 3+        else+                Build-Depends:          base < 3+        +        Extensions:             CPP+                                ForeignFunctionInterface+        +        Ghc-Options:            -Wall+        +        if !flag(example)+                Buildable:              False