packages feed

AWin32Console (empty) → 1.1

raw patch · 7 files changed

+491/−0 lines, 7 filesdep +Win32dep +basedep +regex-compatsetup-changed

Dependencies added: Win32, base, regex-compat

Files

+ AWin32Console.cabal view
@@ -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
+ LICENSE view
@@ -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.
+ README view
@@ -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
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
+ System/Win32/AWin32Console.hsc view
@@ -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
+ c/BWin32Console.c view
@@ -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;
+}
+ include/BWin32Console.h view
@@ -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