summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHaraldWolfsgruber <>2010-01-24 23:44:07 (GMT)
committerLuite Stegeman <luite@luite.com>2010-01-24 23:44:07 (GMT)
commit74c802f6a6bf06b9981f0f985951efd213ee2d76 (patch)
tree7749977496bae40f06ce4df681184249834f0e5a
version 1.1HEAD1.1master
-rw-r--r--AWin32Console.cabal19
-rw-r--r--LICENSE24
-rw-r--r--README61
-rw-r--r--Setup.lhs4
-rw-r--r--System/Win32/AWin32Console.hsc261
-rw-r--r--c/BWin32Console.c97
-rw-r--r--include/BWin32Console.h25
7 files changed, 491 insertions, 0 deletions
diff --git a/AWin32Console.cabal b/AWin32Console.cabal
new file mode 100644
index 0000000..0bd3413
--- /dev/null
+++ b/AWin32Console.cabal
@@ -0,0 +1,19 @@
+Name: AWin32Console
+Version: 1.1
+Synopsis: A binding to a part of the ANSI escape code for the console
+Description: ANSI escape code
+Author: Harald Wolfsgruber
+Maintainer: Harald Wolfsgruber
+License: BSD3
+License-File: LICENSE
+Category: System
+C-Sources: c/BWin32Console.c
+Include-Dirs: include
+Includes: "BWin32Console.h"
+Install-Includes: "BWin32Console.h"
+Extensions: ForeignFunctionInterface
+Extra-Source-Files: README
+Build-Type: Simple
+Cabal-Version: >=1.6
+Build-Depends: base >= 4 && < 5, regex-compat, Win32
+Exposed-modules: System.Win32.AWin32Console
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..3c3dc20
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,24 @@
+* Copyright (c) 2010, Harald Wolfsgruber
+* 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 Harald Wolfsgruber nor the
+* names of its contributors may be used to endorse or promote products
+* derived from this software without specific prior written permission.
+*
+* THIS SOFTWARE IS PROVIDED BY HARALD WOLFSGRUBER "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 HARALD WOLFSGRUBER 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.
diff --git a/README b/README
new file mode 100644
index 0000000..64986b2
--- /dev/null
+++ b/README
@@ -0,0 +1,61 @@
+Name: AWin32Console
+Version: 1.1
+Description: ANSI escape code
+License: BSD3
+License-file: LICENSE
+Author: Harald Wolfsgruber
+
+
+-- Library Files -------------
+
+ AWin32Console.hs
+ BWin32Console.c
+ BWin32Console.h
+ LICENSE
+ README
+
+
+-- Functions -----------------
+
+ aPutStr :: String -> IO ()
+ aPutStrLn :: String -> IO ()
+
+
+-- Usage ---------------------
+
+ aPutStrLn "\ESC[1;32mTest\ESC[0m"
+
+
+-- Documentation -------------
+
+ Implemented:
+
+ ESC[#;...;#m set display attributes
+ ESC[0m reset display attributes
+
+ ESC[0J erase from cursor to end of display
+ ESC[1J erase from start to cursor
+ ESC[2J cls and cursor to (1,1)
+
+ ESC[0K delete to end of line
+ ESC[1K delete from start of line to cursor
+ ESC[2K delete whole line
+
+ ESC[#L insert # blank lines
+ ESC[#@ insert # blank characters
+ ESC[#M delete # lines
+ ESC[#P delete # characters
+
+ ESC[#A moves cursor up # lines
+ ESC[#B moves cursor down # lines
+ ESC[#C moves cursor forward # lines
+ ESC[#D moves cursor back # lines
+ ESC[#E moves cursor down # lines column 1
+ ESC[#F moves cursor up # lines column 1
+ ESC[#G moves cursor to column #
+
+ ESC[#;#H moves cursor to line #, column #
+ ESC[#;#f moves cursor to line #, column #
+
+ ESC[s saves the cursor position
+ ESC[u restores the cursor position
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
index 0000000..6ad1835
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
diff --git a/System/Win32/AWin32Console.hsc b/System/Win32/AWin32Console.hsc
new file mode 100644
index 0000000..bed1501
--- /dev/null
+++ b/System/Win32/AWin32Console.hsc
@@ -0,0 +1,261 @@
+{-# OPTIONS_GHC -fglasgow-exts -O2 -optc-O3 -optc-ffast-math -fvia-C #-}
+
+{-
+ Copyright (c) 2010 - Harald Wolfsgruber
+ All rights reserved.
+
+ Name: AWin32Console
+ Version: 1.1
+ Description: ANSI escape code
+ License: BSD3
+ License-file: LICENSE
+ Author: Harald Wolfsgruber
+-}
+
+module System.Win32.AWin32Console (aPutStr, aPutStrLn) where
+import Data.Bits
+import Data.IORef
+import Text.Regex
+import System.IO
+import System.IO.Unsafe
+import System.Win32.Types
+
+#include <windows.h>
+
+type SHORT = USHORT
+data A = AForm {bold :: Bool, underline :: Bool,
+ revideo :: Bool, concealed :: Bool,
+ foreground :: WORD, background :: WORD}
+
+foreign import ccall unsafe "BWin32Console.h SetAttr"
+ setAttr :: WORD -> IO ()
+foreign import ccall unsafe "BWin32Console.h SetPos"
+ setPos :: SHORT -> SHORT -> IO ()
+foreign import ccall unsafe "BWin32Console.h SetCls"
+ setCls :: IO ()
+foreign import ccall unsafe "BWin32Console.h SetScroll"
+ setScroll :: SHORT -> SHORT ->
+ SHORT -> SHORT -> SHORT -> SHORT ->
+ IO ()
+foreign import ccall unsafe "BWin32Console.h GetPosX"
+ getPosX :: IO SHORT
+foreign import ccall unsafe "BWin32Console.h GetPosY"
+ getPosY :: IO SHORT
+foreign import ccall unsafe "BWin32Console.h GetSizeX"
+ getSizeX :: IO SHORT
+foreign import ccall unsafe "BWin32Console.h GetSizeY"
+ getSizeY :: IO SHORT
+foreign import ccall unsafe "BWin32Console.h GetAttr"
+ getAttr :: IO WORD
+
+aPutStrLn :: String -> IO ()
+aPutStrLn str = puts str >> putChar '\n' >> hFlush stdout
+aPutStr :: String -> IO ()
+aPutStr str = puts str >> hFlush stdout
+
+globalAttrSt :: IORef A
+{-# NOINLINE globalAttrSt #-}
+globalAttrSt = unsafePerformIO (newIORef aFn)
+
+globalPosSt :: IORef (SHORT,SHORT)
+{-# NOINLINE globalPosSt #-}
+globalPosSt = unsafePerformIO (newIORef (0,0))
+
+splitC :: String -> Char -> [String]
+splitC [] _ = [""]
+splitC (c:cs) d | c == d = "" : r
+ | otherwise = (c : head r) : tail r
+ where
+ r = splitC cs d
+
+aFn = AForm {bold=False, underline=False,
+ revideo=False, concealed=False,
+ foreground=7, background=0}
+
+puts :: String -> IO ()
+puts x = f x
+ where
+ a = mkRegex "\ESC\\[([0-9\\;\\=]*)([a-zA-Z@])"
+ fB = 0x01
+ fG = 0x02
+ fR = 0x04
+ fi = 0x08
+ bB = 0x10
+ bG = 0x20
+ bR = 0x40
+ bi = 0x80
+ color :: WORD -> WORD
+ color 30 = 0
+ color 31 = fR
+ color 32 = fG
+ color 33 = fR .|. fG
+ color 34 = fB
+ color 35 = fB .|. fR
+ color 36 = fB .|. fG
+ color 37 = fR .|. fG .|. fB
+ color 40 = 0
+ color 41 = bR
+ color 42 = bG
+ color 43 = bR .|. bG
+ color 44 = bB
+ color 45 = bB .|. bR
+ color 46 = bB .|. bG
+ color 47 = bR .|. bG .|. bB
+ z x = map (\xx -> if xx == "" then 0 else read xx) $ splitC x ';'
+ z1 x = map (\xx -> if xx == "" then 1 else read xx) $ splitC x ';'
+ zZ x = if x == "" then 1 else read x
+ g' x = let xs = z1 x in case length xs of
+ 0 -> setPos 0 0
+ 1 -> setPos 0 (xs!!0-1)
+ _ -> setPos (xs!!1-1) (xs!!0-1)
+ f [] = return ()
+ f x = maybe (putStr x) (\(k,_,n,m) -> putStr k >>
+ hFlush stdout >> g m >> f n) aa
+ where aa = matchRegexAll a x
+ g [x,"m"] = readIORef globalAttrSt >>=
+ \aFxx -> return (foldr h aFxx (reverse $ z x)) >>=
+ \aFyy -> writeIORef globalAttrSt aFyy >>
+ (setAttr $ k $ aFyy)
+ where
+ h x a = i
+ where
+ i | x == 1 = a {bold=True}
+ | x == 21 = a {bold=False}
+ | x == 4 = a {underline=True}
+ | x == 24 = a {underline=False}
+ | x == 7 = a {revideo=True}
+ | x == 27 = a {revideo=False}
+ | x == 8 = a {concealed=True}
+ | x == 28 = a {concealed=False}
+ | x >= 30 && x <= 37 = a {foreground=x-30}
+ | x >= 40 && x <= 47 = a {background=x-40}
+ | otherwise = aFn
+ k x = attr'' $ attr' attr
+ where
+ attr | revideo x = color (40+foreground x) .|.
+ color (30+background x)
+ | otherwise = color (30+foreground x) .|.
+ color (40+background x)
+ attr' a | bold x = a .|. fi
+ | otherwise = a
+ attr'' a | underline x = a .|. bi
+ | otherwise = a
+ g [x,"J"] = hFlush stdout >> case x of
+ "1" -> do
+ i0 <- getSizeX
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos 0 0
+ putStr (replicate (fromEnum (i3*i0+i2+1)) ' ')
+ hFlush stdout
+ "2" -> do
+ setCls
+ setPos 0 0
+ hFlush stdout
+ _ -> do
+ i0 <- getSizeX
+ i1 <- getSizeY
+ i2 <- getPosX
+ i3 <- getPosY
+ putStr (replicate (fromEnum ((i1-i3)*i0-i2-1)) ' ')
+ hFlush stdout
+ setPos i2 i3
+ g [x,"K"] = hFlush stdout >> case x of
+ "1" -> do
+ i0 <- getSizeX
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos 0 i3
+ putStr (replicate (fromEnum (i2+1)) ' ')
+ hFlush stdout
+ setPos i2 i3
+ "2" -> do
+ i0 <- getSizeX
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos 0 i3
+ putStr (replicate (fromEnum (i0+1)) ' ')
+ hFlush stdout
+ setPos i2 i3
+ _ -> do
+ i0 <- getSizeX
+ i2 <- getPosX
+ i3 <- getPosY
+ putStr (replicate (fromEnum (i0-i2+1)) ' ')
+ hFlush stdout
+ setPos i2 i3
+ g [x,"L"] = do
+ i0 <- getSizeX
+ i1 <- getSizeY
+ i2 <- getPosX
+ i3 <- getPosY
+ setScroll 0 (i3+zZ x)
+ 0 i3 (i0-1) (i1-1)
+ setPos i2 i3
+ g [x,"M"] = do
+ i0 <- getSizeX
+ i1 <- getSizeY
+ i2 <- getPosX
+ i3 <- getPosY
+ setScroll 0 i3
+ 0 (i3+zZ x) (i0-1) (i1-1)
+ setPos i2 i3
+ g [x,"P"] = do
+ i0 <- getSizeX
+ i1 <- getSizeY
+ i2 <- getPosX
+ i3 <- getPosY
+ setScroll i2 i3
+ (i2+xx i0 i2) i3 (i0-1) i3
+ setPos i2 i3
+ where
+ xx i0 i2 | i2+z>i0-1 = i0-i2
+ | otherwise = z
+ where z = zZ x
+ g [x,"@"] = do
+ i0 <- getSizeX
+ i1 <- getSizeY
+ i2 <- getPosX
+ i3 <- getPosY
+ setScroll (i2+xx i0 i2) i3
+ i2 i3 (i0-1) i3
+ setPos i2 i3
+ where
+ xx i0 i2 | i2+z>i0-1 = i0-i2
+ | otherwise = z
+ where z = zZ x
+ g [x,"f"] = g' x
+ g [x,"H"] = g' x
+ g [x,"A"] = do
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos i2 (i3-zZ x)
+ g [x,"B"] = do
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos i2 (i3+zZ x)
+ g [x,"C"] = do
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos (i2+zZ x) i3
+ g [x,"D"] = do
+ i2 <- getPosX
+ i3 <- getPosY
+ setPos (i2-zZ x) i3
+ g [x,"E"] = do
+ i3 <- getPosY
+ setPos 0 (i3+zZ x)
+ g [x,"F"] = do
+ i3 <- getPosY
+ setPos 0 (i3-zZ x)
+ g [x,"G"] = do
+ i3 <- getPosY
+ setPos (zZ x-1) i3
+ g [x,"s"] = do
+ i2 <- getPosX
+ i3 <- getPosY
+ writeIORef globalPosSt (i2,i3)
+ g [x,"u"] = do
+ (i2,i3) <- readIORef globalPosSt
+ setPos i2 i3
+ g xs = putStr $ "\ESC[" ++ concat xs
diff --git a/c/BWin32Console.c b/c/BWin32Console.c
new file mode 100644
index 0000000..94b005a
--- /dev/null
+++ b/c/BWin32Console.c
@@ -0,0 +1,97 @@
+// Copyright (c) 2010 - Harald Wolfsgruber
+// All rights reserved.
+//
+// Name: AWin32Console
+// Version: 1.1
+// Description: ANSI escape code
+// License: BSD3
+// License-file: LICENSE
+// Author: Harald Wolfsgruber
+
+#include <windows.h>
+
+void SetAttr(WORD a)
+{
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ SetConsoleTextAttribute(hStdOut,a);
+ return;
+}
+
+void SetPos(SHORT x, SHORT y)
+{
+ COORD a;
+ a.X = x;
+ a.Y = y;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ SetConsoleCursorPosition(hStdOut,a);
+ return;
+}
+
+void SetCls()
+{
+ COORD a = {0, 0};
+ DWORD c;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ CONSOLE_SCREEN_BUFFER_INFO b;
+ GetConsoleScreenBufferInfo(hStdOut, &b);
+ DWORD hSize = b.dwSize.X*b.dwSize.Y;
+ FillConsoleOutputCharacter(hStdOut, (TCHAR) ' ', hSize, a, &c);
+ FillConsoleOutputAttribute(hStdOut, b.wAttributes, hSize, a, &c);
+ return;
+}
+
+void SetScroll(SHORT xTO, SHORT yTO, SHORT lR, SHORT tR, SHORT rR, SHORT bR)
+{
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ CONSOLE_SCREEN_BUFFER_INFO e;
+ GetConsoleScreenBufferInfo(hStdOut,&e);
+ COORD a;
+ a.X = xTO;
+ a.Y = yTO;
+ SMALL_RECT b = {lR,tR,rR,bR};
+ SMALL_RECT *bP = &b;
+ CHAR_INFO d = {(CHAR) ' ', e.wAttributes};
+ CHAR_INFO *dP = &d;
+ ScrollConsoleScreenBuffer(hStdOut, bP, NULL, a, dP);
+ return;
+}
+
+SHORT GetPosX()
+{
+ CONSOLE_SCREEN_BUFFER_INFO a;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ GetConsoleScreenBufferInfo(hStdOut,&a);
+ return a.dwCursorPosition.X;
+}
+
+SHORT GetPosY()
+{
+ CONSOLE_SCREEN_BUFFER_INFO a;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ GetConsoleScreenBufferInfo(hStdOut,&a);
+ return a.dwCursorPosition.Y;
+}
+
+SHORT GetSizeX()
+{
+ CONSOLE_SCREEN_BUFFER_INFO a;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ GetConsoleScreenBufferInfo(hStdOut,&a);
+ return a.dwSize.X;
+}
+
+SHORT GetSizeY()
+{
+ CONSOLE_SCREEN_BUFFER_INFO a;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ GetConsoleScreenBufferInfo(hStdOut,&a);
+ return a.dwSize.Y;
+}
+
+WORD GetAttr()
+{
+ CONSOLE_SCREEN_BUFFER_INFO a;
+ HANDLE hStdOut = GetStdHandle(STD_OUTPUT_HANDLE);
+ GetConsoleScreenBufferInfo(hStdOut,&a);
+ return a.wAttributes;
+}
diff --git a/include/BWin32Console.h b/include/BWin32Console.h
new file mode 100644
index 0000000..28051d9
--- /dev/null
+++ b/include/BWin32Console.h
@@ -0,0 +1,25 @@
+// Copyright (c) 2010 - Harald Wolfsgruber
+// All rights reserved.
+//
+// Name: AWin32Console
+// Version: 1.1
+// Description: ANSI escape code
+// License: BSD3
+// License-file: LICENSE
+// Author: Harald Wolfsgruber
+
+#ifndef H_HAS_CON_SET
+#define H_HAS_CON_SET
+#include <windows.h>
+
+void SetAttr(WORD a);
+void SetPos(SHORT x, SHORT y);
+void SetCls();
+void SetScroll(SHORT xTO, SHORT yTO, SHORT lR, SHORT tR, SHORT rR, SHORT bR);
+SHORT GetPosX();
+SHORT GetPosY();
+SHORT GetSizeX();
+SHORT GetSizeY();
+WORD GetAttr();
+
+#endif