diff --git a/System/Win32/Console.hsc b/System/Win32/Console.hsc --- a/System/Win32/Console.hsc +++ b/System/Win32/Console.hsc @@ -27,17 +27,26 @@ CtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT, generateConsoleCtrlEvent, -- * Command line - commandLineToArgv + commandLineToArgv, + -- * Screen buffer + CONSOLE_SCREEN_BUFFER_INFO(..), + COORD(..), + SMALL_RECT(..), + getConsoleScreenBufferInfo, + getCurrentConsoleScreenBufferInfo ) where +#include +#include "alignment.h" ##include "windows_cconv.h" import System.Win32.Types +import Graphics.Win32.Misc import Foreign.C.Types (CInt(..)) import Foreign.C.String (withCWString, CWString) import Foreign.Ptr (Ptr) -import Foreign.Storable (peek) +import Foreign.Storable (Storable(..)) import Foreign.Marshal.Array (peekArray) import Foreign.Marshal.Alloc (alloca) @@ -82,4 +91,80 @@ size <- peek c_size args <- peekArray (fromIntegral size) res _ <- localFree res - mapM peekTString args + mapM peekTString args + +data CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO + { dwSize :: COORD + , dwCursorPosition :: COORD + , wAttributes :: WORD + , srWindow :: SMALL_RECT + , dwMaximumWindowSize :: COORD + } deriving (Show, Eq) + +instance Storable CONSOLE_SCREEN_BUFFER_INFO where + sizeOf = const #{size CONSOLE_SCREEN_BUFFER_INFO} + alignment _ = #alignment CONSOLE_SCREEN_BUFFER_INFO + peek buf = do + dwSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwSize) buf + dwCursorPosition' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) buf + wAttributes' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes) buf + srWindow' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf + dwMaximumWindowSize' <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf + return $ CONSOLE_SCREEN_BUFFER_INFO dwSize' dwCursorPosition' wAttributes' srWindow' dwMaximumWindowSize' + poke buf info = do + (#poke CONSOLE_SCREEN_BUFFER_INFO, dwSize) buf (dwSize info) + (#poke CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) buf (dwCursorPosition info) + (#poke CONSOLE_SCREEN_BUFFER_INFO, wAttributes) buf (wAttributes info) + (#poke CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf (srWindow info) + (#poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf (dwMaximumWindowSize info) + +data COORD = COORD + { x :: SHORT + , y :: SHORT + } deriving (Show, Eq) + +instance Storable COORD where + sizeOf = const #{size COORD} + alignment _ = #alignment COORD + peek buf = do + x' <- (#peek COORD, X) buf + y' <- (#peek COORD, Y) buf + return $ COORD x' y' + poke buf coord = do + (#poke COORD, X) buf (x coord) + (#poke COORD, Y) buf (y coord) + +data SMALL_RECT = SMALL_RECT + { left :: SHORT + , top :: SHORT + , right :: SHORT + , bottom :: SHORT + } deriving (Show, Eq) + +instance Storable SMALL_RECT where + sizeOf _ = #{size SMALL_RECT} + alignment _ = #alignment SMALL_RECT + peek buf = do + left' <- (#peek SMALL_RECT, Left) buf + top' <- (#peek SMALL_RECT, Top) buf + right' <- (#peek SMALL_RECT, Right) buf + bottom' <- (#peek SMALL_RECT, Bottom) buf + return $ SMALL_RECT left' top' right' bottom' + poke buf small_rect = do + (#poke SMALL_RECT, Left) buf (left small_rect) + (#poke SMALL_RECT, Top) buf (top small_rect) + (#poke SMALL_RECT, Right) buf (right small_rect) + (#poke SMALL_RECT, Bottom) buf (bottom small_rect) + +foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo" + c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL + +getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO +getConsoleScreenBufferInfo h = alloca $ \ptr -> do + failIfFalse_ "GetConsoleScreenBufferInfo" $ c_GetConsoleScreenBufferInfo h ptr + peek ptr + +getCurrentConsoleScreenBufferInfo :: IO CONSOLE_SCREEN_BUFFER_INFO +getCurrentConsoleScreenBufferInfo = do + h <- failIf (== nullHANDLE) "getStdHandle" $ getStdHandle sTD_OUTPUT_HANDLE + getConsoleScreenBufferInfo h diff --git a/System/Win32/File.hsc b/System/Win32/File.hsc --- a/System/Win32/File.hsc +++ b/System/Win32/File.hsc @@ -531,9 +531,13 @@ foreign import WINDOWS_CCONV unsafe "windows.h WriteFile" c_WriteFile :: HANDLE -> Ptr a -> DWORD -> Ptr DWORD -> LPOVERLAPPED -> IO Bool --- missing Seek functioinality; GSL ??? --- Dont have Word64; ADR --- %fun SetFilePointer :: HANDLE -> Word64 -> FilePtrDirection -> IO Word64 +setFilePointerEx :: HANDLE -> LARGE_INTEGER -> FilePtrDirection -> IO LARGE_INTEGER +setFilePointerEx h dist dir = + alloca $ \p_pos -> do + failIfFalse_ "SetFilePointerEx" $ c_SetFilePointerEx h dist p_pos dir + peek p_pos +foreign import WINDOWS_CCONV unsafe "windows.h SetFilePointerEx" + c_SetFilePointerEx :: HANDLE -> LARGE_INTEGER -> Ptr LARGE_INTEGER -> FilePtrDirection -> IO Bool ---------------------------------------------------------------- -- File Notifications diff --git a/Win32.cabal b/Win32.cabal --- a/Win32.cabal +++ b/Win32.cabal @@ -1,15 +1,15 @@ name: Win32 -version: 2.6.1.0 +version: 2.6.2.0 license: BSD3 license-file: LICENSE author: Alastair Reid, shelarcy, Tamar Christina -copyright: Alastair Reid, 1999-2003; shelarcy, 2012-2013; Tamar Christina, 2016-2017 +copyright: Alastair Reid, 1999-2003; shelarcy, 2012-2013; Tamar Christina, 2016-2018 maintainer: Haskell Libraries bug-reports: https://github.com/haskell/win32/issues homepage: https://github.com/haskell/win32 category: System, Graphics -synopsis: A binding to part of the Win32 library -description: A binding to part of the Win32 library. +synopsis: A binding to Windows Win32 API. +description: This library contains direct bindings to the Windows Win32 APIs for Haskell. build-type: Simple cabal-version: >=1.10 extra-source-files: diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ # Changelog for [`Win32` package](http://hackage.haskell.org/package/Win32) +## 2.6.2.0 *December 2017* + +* Add `setFilePointerEx` (See #94) +* Add `getConsoleScreenBufferInfo` and `getCurrentConsoleScreenBufferInfo` (See #95) + ## 2.6.1.0 *November 2017* * Add `terminateProcessById` (See #91) @@ -7,7 +12,7 @@ ## 2.6.0.0 *September 2017* * Make cabal error out on compilation on non-Windows OSes. (See #80) -* Update cabal format to 1.10 and set language +* Update cabal format to 1.10 and set language default to Haskell2010. (See #81) * Use `Maybe` in wrappers for functions with nullable pointer parameters (See #83) * Improve cross compilation support. (See #87)