Skip to content

Commit 482d5f5

Browse files
chhackettMistuke
chhackett
authored and
Mistuke
committed
Adding ReadConsoleInput to the API.
1 parent 027cbcf commit 482d5f5

File tree

2 files changed

+167
-3
lines changed

2 files changed

+167
-3
lines changed

‎System/Win32/Console.hsc

Lines changed: 20 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,15 @@ module System.Win32.Console (
6060

6161
-- * Env
6262
getEnv,
63-
getEnvironment
63+
getEnvironment,
64+
-- * Console I/O
65+
KEY_EVENT_RECORD(..),
66+
MOUSE_EVENT_RECORD(..),
67+
WINDOW_BUFFER_SIZE_RECORD(..),
68+
MENU_EVENT_RECORD(..),
69+
FOCUS_EVENT_RECORD(..),
70+
INPUT_RECORD(..),
71+
readConsoleInput
6472
) where
6573

6674
#include <windows.h>
@@ -77,7 +85,7 @@ import Graphics.Win32.GDI.Types (COLORREF)
7785

7886
import GHC.IO (bracket)
7987
import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
80-
import Foreign.Ptr (plusPtr)
88+
import Foreign.Ptr (plusPtr, Ptr)
8189
import Foreign.C.Types (CWchar)
8290
import Foreign.C.String (withCWString, CWString)
8391
import Foreign.Storable (Storable(..))
@@ -232,3 +240,13 @@ cWcharsToChars = map chr . fromUTF16 . map fromIntegral
232240
fromUTF16 (c:wcs) = c : fromUTF16 wcs
233241
fromUTF16 [] = []
234242

243+
-- | Reads all available input records up to the amount specified by the
244+
-- len parameter.
245+
readConsoleInput :: HANDLE -> Int -> Ptr INPUT_RECORD -> IO Int
246+
readConsoleInput handle len inputRecordPtr =
247+
alloca $ \numEventsReadPtr -> do
248+
poke numEventsReadPtr 0
249+
failIfFalse_ "ReadConsoleInput" $
250+
c_ReadConsoleInput handle inputRecordPtr (fromIntegral len) numEventsReadPtr
251+
numEvents <- peek numEventsReadPtr
252+
return $ fromIntegral numEvents

‎System/Win32/Console/Internal.hsc

Lines changed: 147 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ module System.Win32.Console.Internal where
2727
import System.Win32.Types
2828
import Graphics.Win32.GDI.Types (COLORREF)
2929

30-
import Foreign.C.Types (CInt(..))
30+
import Foreign.C.Types (CInt(..), CWchar)
3131
import Foreign.C.String (CWString)
3232
import Foreign.Ptr (Ptr, plusPtr)
3333
import Foreign.Storable (Storable(..))
@@ -188,3 +188,149 @@ foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfo"
188188
foreign import WINDOWS_CCONV safe "windows.h GetConsoleScreenBufferInfoEx"
189189
c_GetConsoleScreenBufferInfoEx :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX -> IO BOOL
190190

191+
-- | This type represents a keyboard input event. The structure is documented here:
192+
-- https://learn.microsoft.com/en-us/windows/console/key-event-record-str
193+
data KEY_EVENT_RECORD = KEY_EVENT_RECORD
194+
{ keyDown :: BOOL
195+
, repeatCount :: WORD
196+
, virtualKeyCode :: WORD
197+
, virtualScanCode :: WORD
198+
, uChar :: CWchar
199+
, controlKeyStateK :: DWORD
200+
} deriving (Eq, Show)
201+
202+
-- | This type represents a mouse event. The structure is documented here:
203+
-- https://learn.microsoft.com/en-us/windows/console/mouse-event-record-str
204+
data MOUSE_EVENT_RECORD = MOUSE_EVENT_RECORD
205+
{ mousePosition :: COORD
206+
, buttonState :: DWORD
207+
, controlKeyStateM :: DWORD
208+
, eventFlags :: DWORD
209+
} deriving (Eq, Show)
210+
211+
-- | This type represents a window size change event. The structure is documented here:
212+
-- https://learn.microsoft.com/en-us/windows/console/window-buffer-size-record-str
213+
newtype WINDOW_BUFFER_SIZE_RECORD = WINDOW_BUFFER_SIZE_RECORD
214+
{ windowSize :: COORD
215+
} deriving (Eq, Show)
216+
217+
-- | This type represents a window menu event. (Current ignored by VTY). The structure
218+
-- is documented here: https://learn.microsoft.com/en-us/windows/console/menu-event-record-str
219+
newtype MENU_EVENT_RECORD = MENU_EVENT_RECORD
220+
{ commandId :: UINT
221+
} deriving (Eq, Show)
222+
223+
-- | This type represents a window focus change event. The structure is documented here:
224+
-- https://learn.microsoft.com/en-us/windows/console/focus-event-record-str
225+
newtype FOCUS_EVENT_RECORD = FOCUS_EVENT_RECORD
226+
{ setFocus :: BOOL
227+
} deriving (Eq, Show)
228+
229+
-- | Description of a Windows console input event. Documented here:
230+
-- https://learn.microsoft.com/en-us/windows/console/input-record-str
231+
data INPUT_RECORD =
232+
KeyEvent KEY_EVENT_RECORD
233+
| MouseEvent MOUSE_EVENT_RECORD
234+
| WindowBufferSizeEvent WINDOW_BUFFER_SIZE_RECORD
235+
| MenuEvent MENU_EVENT_RECORD
236+
| FocusEvent FOCUS_EVENT_RECORD
237+
deriving (Eq, Show)
238+
239+
instance Storable KEY_EVENT_RECORD where
240+
sizeOf = const #{size KEY_EVENT_RECORD}
241+
alignment _ = #alignment KEY_EVENT_RECORD
242+
poke buf input = do
243+
(#poke KEY_EVENT_RECORD, bKeyDown) buf (keyDown input)
244+
(#poke KEY_EVENT_RECORD, wRepeatCount) buf (repeatCount input)
245+
(#poke KEY_EVENT_RECORD, wVirtualKeyCode) buf (virtualKeyCode input)
246+
(#poke KEY_EVENT_RECORD, wVirtualScanCode) buf (virtualScanCode input)
247+
(#poke KEY_EVENT_RECORD, uChar) buf (uChar input)
248+
(#poke KEY_EVENT_RECORD, dwControlKeyState) buf (controlKeyStateK input)
249+
peek buf = do
250+
keyDown' <- (#peek KEY_EVENT_RECORD, bKeyDown) buf
251+
repeatCount' <- (#peek KEY_EVENT_RECORD, wRepeatCount) buf
252+
virtualKeyCode' <- (#peek KEY_EVENT_RECORD, wVirtualKeyCode) buf
253+
virtualScanCode' <- (#peek KEY_EVENT_RECORD, wVirtualScanCode) buf
254+
uChar' <- (#peek KEY_EVENT_RECORD, uChar) buf
255+
controlKeyStateK' <- (#peek KEY_EVENT_RECORD, dwControlKeyState) buf
256+
return $ KEY_EVENT_RECORD keyDown' repeatCount' virtualKeyCode' virtualScanCode' uChar' controlKeyStateK'
257+
258+
instance Storable MOUSE_EVENT_RECORD where
259+
sizeOf = const #{size MOUSE_EVENT_RECORD}
260+
alignment _ = #alignment MOUSE_EVENT_RECORD
261+
poke buf input = do
262+
(#poke MOUSE_EVENT_RECORD, dwMousePosition) buf (mousePosition input)
263+
(#poke MOUSE_EVENT_RECORD, dwButtonState) buf (buttonState input)
264+
(#poke MOUSE_EVENT_RECORD, dwControlKeyState) buf (controlKeyStateM input)
265+
(#poke MOUSE_EVENT_RECORD, dwEventFlags) buf (eventFlags input)
266+
peek buf = do
267+
mousePosition' <- (#peek MOUSE_EVENT_RECORD, dwMousePosition) buf
268+
buttonState' <- (#peek MOUSE_EVENT_RECORD, dwButtonState) buf
269+
controlKeyStateM' <- (#peek MOUSE_EVENT_RECORD, dwControlKeyState) buf
270+
eventFlags' <- (#peek MOUSE_EVENT_RECORD, dwEventFlags) buf
271+
return $ MOUSE_EVENT_RECORD mousePosition' buttonState' controlKeyStateM' eventFlags'
272+
273+
instance Storable WINDOW_BUFFER_SIZE_RECORD where
274+
sizeOf = const #{size WINDOW_BUFFER_SIZE_RECORD}
275+
alignment _ = #alignment WINDOW_BUFFER_SIZE_RECORD
276+
poke buf input = do
277+
(#poke WINDOW_BUFFER_SIZE_RECORD, dwSize) buf (windowSize input)
278+
peek buf = do
279+
size' <- (#peek WINDOW_BUFFER_SIZE_RECORD, dwSize) buf
280+
return $ WINDOW_BUFFER_SIZE_RECORD size'
281+
282+
instance Storable MENU_EVENT_RECORD where
283+
sizeOf = const #{size MENU_EVENT_RECORD}
284+
alignment _ = #alignment MENU_EVENT_RECORD
285+
poke buf input = do
286+
(#poke MENU_EVENT_RECORD, dwCommandId) buf (commandId input)
287+
peek buf = do
288+
commandId' <- (#peek MENU_EVENT_RECORD, dwCommandId) buf
289+
return $ MENU_EVENT_RECORD commandId'
290+
291+
instance Storable FOCUS_EVENT_RECORD where
292+
sizeOf = const #{size FOCUS_EVENT_RECORD}
293+
alignment _ = #alignment FOCUS_EVENT_RECORD
294+
poke buf input = do
295+
(#poke FOCUS_EVENT_RECORD, bSetFocus) buf (setFocus input)
296+
peek buf = do
297+
setFocus' <- (#peek FOCUS_EVENT_RECORD, bSetFocus) buf
298+
return $ FOCUS_EVENT_RECORD setFocus'
299+
300+
instance Storable INPUT_RECORD where
301+
sizeOf = const #{size INPUT_RECORD}
302+
alignment _ = #alignment INPUT_RECORD
303+
304+
poke buf (KeyEvent key) = do
305+
(#poke INPUT_RECORD, EventType) buf (#{const KEY_EVENT} :: WORD)
306+
(#poke INPUT_RECORD, Event) buf key
307+
poke buf (MouseEvent mouse) = do
308+
(#poke INPUT_RECORD, EventType) buf (#{const MOUSE_EVENT} :: WORD)
309+
(#poke INPUT_RECORD, Event) buf mouse
310+
poke buf (WindowBufferSizeEvent window) = do
311+
(#poke INPUT_RECORD, EventType) buf (#{const WINDOW_BUFFER_SIZE_EVENT} :: WORD)
312+
(#poke INPUT_RECORD, Event) buf window
313+
poke buf (MenuEvent menu) = do
314+
(#poke INPUT_RECORD, EventType) buf (#{const MENU_EVENT} :: WORD)
315+
(#poke INPUT_RECORD, Event) buf menu
316+
poke buf (FocusEvent focus) = do
317+
(#poke INPUT_RECORD, EventType) buf (#{const FOCUS_EVENT} :: WORD)
318+
(#poke INPUT_RECORD, Event) buf focus
319+
320+
peek buf = do
321+
event <- (#peek INPUT_RECORD, EventType) buf :: IO WORD
322+
case event of
323+
#{const KEY_EVENT} ->
324+
KeyEvent `fmap` (#peek INPUT_RECORD, Event) buf
325+
#{const MOUSE_EVENT} ->
326+
MouseEvent `fmap` (#peek INPUT_RECORD, Event) buf
327+
#{const WINDOW_BUFFER_SIZE_EVENT} ->
328+
WindowBufferSizeEvent `fmap` (#peek INPUT_RECORD, Event) buf
329+
#{const MENU_EVENT} ->
330+
MenuEvent `fmap` (#peek INPUT_RECORD, Event) buf
331+
#{const FOCUS_EVENT} ->
332+
FocusEvent `fmap` (#peek INPUT_RECORD, Event) buf
333+
_ -> error $ "Unknown input event type " ++ show event
334+
335+
foreign import ccall unsafe "windows.h ReadConsoleInputW"
336+
c_ReadConsoleInput :: HANDLE -> Ptr INPUT_RECORD -> DWORD -> LPDWORD -> IO BOOL

0 commit comments

Comments
 (0)