Add GetConsoleScreenBufferInfoEx

The function retrieves extended information about the specified console screen buffer. See https://docs.microsoft.com/en-us/windows/console/getconsolescreenbufferinfoex.

Also adds `getCurrentConsoleScreenBufferInfoEx`, corresponding to `getCurrentConsoleScreenBufferInfo`.

For convenience, re-exports `Graphics.Win32.GDI.Types.COLORREF` from module `System.Win32.Console`.

Introduces `wincon_compat.h` to patch the incomplete version of `wincon.h` provided with x86 versions of GHC before GHC 7.10.

Author: mpilgrem

System/Win32/Console.hsc

@@ -47,24 +47,30 @@ module System.Win32.Console (
         commandLineToArgv,
         -- * Screen buffer
         CONSOLE_SCREEN_BUFFER_INFO(..),
+        CONSOLE_SCREEN_BUFFER_INFOEX(..),
         COORD(..),
         SMALL_RECT(..),
+        COLORREF,
         getConsoleScreenBufferInfo,
-        getCurrentConsoleScreenBufferInfo
+        getCurrentConsoleScreenBufferInfo,
+        getConsoleScreenBufferInfoEx,
+        getCurrentConsoleScreenBufferInfoEx
   ) where
 
 #include <windows.h>
 #include "alignment.h"
 ##include "windows_cconv.h"
+#include "wincon_compat.h"
 
 import System.Win32.Types
 import Graphics.Win32.Misc
+import Graphics.Win32.GDI.Types (COLORREF)
 
 import Foreign.C.Types (CInt(..))
 import Foreign.C.String (withCWString, CWString)
-import Foreign.Ptr (Ptr)
+import Foreign.Ptr (Ptr, plusPtr)
 import Foreign.Storable (Storable(..))
-import Foreign.Marshal.Array (peekArray)
+import Foreign.Marshal.Array (peekArray, pokeArray)
 import Foreign.Marshal.Alloc (alloca)
 
 foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode"
@@ -169,6 +175,50 @@ instance Storable CONSOLE_SCREEN_BUFFER_INFO where
         (#poke CONSOLE_SCREEN_BUFFER_INFO, srWindow) buf (srWindow info)
         (#poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize) buf (dwMaximumWindowSize info)
 
+data CONSOLE_SCREEN_BUFFER_INFOEX = CONSOLE_SCREEN_BUFFER_INFOEX
+    { dwSizeEx              :: COORD
+    , dwCursorPositionEx    :: COORD
+    , wAttributesEx         :: WORD
+    , srWindowEx            :: SMALL_RECT
+    , dwMaximumWindowSizeEx :: COORD
+    , wPopupAttributes      :: WORD
+    , bFullscreenSupported  :: BOOL
+    , colorTable            :: [COLORREF]
+      -- ^ Only the first 16 'COLORREF' values passed to the Windows Console
+      -- API. If fewer than 16 values, the remainder are padded with @0@ when
+      -- passed to the API.
+    } deriving (Show, Eq)
+
+instance Storable CONSOLE_SCREEN_BUFFER_INFOEX where
+    sizeOf = const #{size CONSOLE_SCREEN_BUFFER_INFOEX}
+    alignment = const #{alignment CONSOLE_SCREEN_BUFFER_INFOEX}
+    peek buf = do
+        dwSize'               <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwSize) buf
+        dwCursorPosition'     <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwCursorPosition) buf
+        wAttributes'          <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, wAttributes) buf
+        srWindow'             <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, srWindow) buf
+        dwMaximumWindowSize'  <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, dwMaximumWindowSize) buf
+        wPopupAttributes'     <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, wPopupAttributes) buf
+        bFullscreenSupported' <- (#peek CONSOLE_SCREEN_BUFFER_INFOEX, bFullscreenSupported) buf
+        colorTable'           <- peekArray 16 ((#ptr CONSOLE_SCREEN_BUFFER_INFOEX, ColorTable) buf)
+        return $ CONSOLE_SCREEN_BUFFER_INFOEX dwSize' dwCursorPosition'
+          wAttributes' srWindow' dwMaximumWindowSize' wPopupAttributes'
+          bFullscreenSupported' colorTable'
+    poke buf info = do
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, cbSize) buf cbSize
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwSize) buf (dwSizeEx info)
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwCursorPosition) buf (dwCursorPositionEx info)
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, wAttributes) buf (wAttributesEx info)
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, srWindow) buf (srWindowEx info)
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, dwMaximumWindowSize) buf (dwMaximumWindowSizeEx info)
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, wPopupAttributes) buf (wPopupAttributes info)
+        (#poke CONSOLE_SCREEN_BUFFER_INFOEX, bFullscreenSupported) buf (bFullscreenSupported info)
+        pokeArray ((#ptr CONSOLE_SCREEN_BUFFER_INFOEX, ColorTable) buf) colorTable'
+      where
+        cbSize :: ULONG
+        cbSize = #{size CONSOLE_SCREEN_BUFFER_INFOEX}
+        colorTable' = take 16 $ colorTable info ++ repeat 0
+
 data COORD = COORD
     { xPos :: SHORT
     , yPos :: SHORT
@@ -210,6 +260,9 @@ instance Storable SMALL_RECT where
 foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo"
     c_GetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL
 
+foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfoEx"
+    c_GetConsoleScreenBufferInfoEx :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX -> IO BOOL
+
 getConsoleScreenBufferInfo :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFO
 getConsoleScreenBufferInfo h = alloca $ \ptr -> do
     failIfFalse_ "GetConsoleScreenBufferInfo" $ c_GetConsoleScreenBufferInfo h ptr
@@ -219,3 +272,19 @@ getCurrentConsoleScreenBufferInfo :: IO CONSOLE_SCREEN_BUFFER_INFO
 getCurrentConsoleScreenBufferInfo = do
     h <- failIf (== nullHANDLE) "getStdHandle" $ getStdHandle sTD_OUTPUT_HANDLE
     getConsoleScreenBufferInfo h
+
+getConsoleScreenBufferInfoEx :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFOEX
+getConsoleScreenBufferInfoEx h = alloca $ \ptr -> do
+    -- The cbSize member must be set or GetConsoleScreenBufferInfoEx fails with
+    -- ERROR_INVALID_PARAMETER (87).
+    (#poke CONSOLE_SCREEN_BUFFER_INFOEX, cbSize) ptr cbSize
+    failIfFalse_ "GetConsoleScreenBufferInfoEx" $ c_GetConsoleScreenBufferInfoEx h ptr
+    peek ptr
+  where
+    cbSize :: ULONG
+    cbSize = #{size CONSOLE_SCREEN_BUFFER_INFOEX}
+
+getCurrentConsoleScreenBufferInfoEx :: IO CONSOLE_SCREEN_BUFFER_INFOEX
+getCurrentConsoleScreenBufferInfoEx = do
+    h <- failIf (== nullHANDLE) "getStdHandle" $ getStdHandle sTD_OUTPUT_HANDLE
+    getConsoleScreenBufferInfoEx h

Win32.cabal

@@ -108,7 +108,7 @@ Library
     ghc-options:      -Wall
     include-dirs:     include
     includes:         "alphablend.h", "diatemp.h", "dumpBMP.h", "ellipse.h", "errors.h", "HsGDI.h", "HsWin32.h", "Win32Aux.h", "win32debug.h", "windows_cconv.h", "WndProc.h", "alignment.h"
-    install-includes: "HsWin32.h", "HsGDI.h", "WndProc.h", "windows_cconv.h", "alphablend.h", "winternl_compat.h", "winuser_compat.h", "winreg_compat.h", "tlhelp32_compat.h", "winnls_compat.h", "winnt_compat.h"
+    install-includes: "HsWin32.h", "HsGDI.h", "WndProc.h", "windows_cconv.h", "alphablend.h", "wincon_compat.h", "winternl_compat.h", "winuser_compat.h", "winreg_compat.h", "tlhelp32_compat.h", "winnls_compat.h", "winnt_compat.h"
     c-sources:
         cbits/HsGDI.c
         cbits/HsWin32.c

changelog.md

@@ -5,6 +5,8 @@
 * Add function `createIcon` (see #194)
 * Add `WindowMessage` value `wM_SETICON` (see #194)
 * Add `WPARAM` values `iCON_SMALL`, `iCON_BIG` (see #194)
+* Add functions `getConsoleScreenBufferInfoEx` and
+  `getCurrentConsoleScreenBufferInfoEx`
 
 ## 2.13.2.0 November 2021
 

include/wincon_compat.h

@@ -0,0 +1,26 @@
+/* The version of wincon.h provided by the version of MSYS2 included with x86
+ * versions of GHC before GHC 7.10 excludes certain components introduced with
+ * Windows Vista.
+ */
+
+#ifndef WINCON_COMPAT_H
+#define WINCON_COMPAT_H
+
+#if defined(x86_64_HOST_ARCH) || __GLASGOW_HASKELL__ > 708
+#
+#else
+
+typedef struct _CONSOLE_SCREEN_BUFFER_INFOEX {
+  ULONG      cbSize;
+  COORD      dwSize;
+  COORD      dwCursorPosition;
+  WORD       wAttributes;
+  SMALL_RECT srWindow;
+  COORD      dwMaximumWindowSize;
+  WORD       wPopupAttributes;
+  WINBOOL    bFullscreenSupported;
+  COLORREF   ColorTable[16];
+} CONSOLE_SCREEN_BUFFER_INFOEX, *PCONSOLE_SCREEN_BUFFER_INFOEX;
+
+#endif /* GHC version check */
+#endif /* WINCON_COMPAT_H */