serialport-0.3.2: System/Win32/Comm.hsc
{-# LANGUAGE ForeignFunctionInterface #-}
module System.Win32.Comm where
import System.IO
import System.Win32.Types
import Data.Word
import Data.Bits
import Foreign.Storable
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import qualified System.Hardware.Serialport.Types as STypes
#include <windows.h>
type LPDCB = Ptr DCB
data DCB = DCB
{ baudRate :: STypes.BaudRate,
parity :: STypes.Parity,
stopBits :: STypes.StopBits,
byteSize :: Word8,
flowControl :: STypes.FlowControl
}
-- | If this member is TRUE, binary mode is enabled. Windows does not support nonbinary mode transfers, so this member must be TRUE.
fBinary :: DWORD
fBinary = 0x0000000000000001
-- | If this member is TRUE, parity checking is performed and errors are reported.
fParity :: DWORD
fParity = 0x0000000000000010
instance Storable DCB where
sizeOf = const #size DCB
alignment = sizeOf
poke buf dcb = do
(#poke DCB, DCBlength) buf (sizeOf dcb)
(#poke DCB, BaudRate) buf (fromIntegral (STypes.fromBaudToInt (baudRate dcb)) :: DWORD)
pokeByteOff buf 8 (fBinary .|. fParity :: DWORD)
(#poke DCB, wReserved) buf (0 :: WORD)
(#poke DCB, XonLim) buf (2048 :: WORD)
(#poke DCB, XoffLim) buf (512 :: WORD)
(#poke DCB, ByteSize) buf (byteSize dcb :: BYTE)
(#poke DCB, Parity) buf (case (parity dcb) of
STypes.NoParity -> 0
STypes.Odd -> 1
STypes.Even -> 2 :: BYTE)
(#poke DCB, StopBits) buf (case (stopBits dcb) of
STypes.One -> 0
STypes.Two -> 2
:: BYTE)
(#poke DCB, wReserved1) buf (0 :: WORD)
peek buf = do
_dCBlength <- (#peek DCB, DCBlength) buf :: IO DWORD
_baudRate <- do _baud <- (#peek DCB, BaudRate) buf :: IO DWORD
return $ STypes.fromIntToBaud (fromIntegral _baud :: Int)
_fsettings <- peekByteOff buf 8 :: IO DWORD
_byteSize <- (#peek DCB, ByteSize) buf :: IO BYTE
_parity <- do _par <- (#peek DCB, Parity) buf :: IO BYTE
case _par of
0 -> return STypes.NoParity
1 -> return STypes.Odd
2 -> return STypes.Even
3 -> fail $ "unsupported markparity"
4 -> fail $ "unsupported spaceparity"
_ -> fail $ "unsupported parity" ++ (show _par)
_stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE
case _stopb of
0 -> return STypes.One
1 -> fail $ "unsupported one5stopbits"
2 -> return STypes.Two
_ -> fail "unexpected stop bit count"
_XonLim <- (#peek DCB, XonLim) buf :: IO WORD
_XoffLim <- (#peek DCB, XoffLim) buf :: IO WORD
return DCB { baudRate = _baudRate,
parity = _parity,
stopBits = _stopBits,
flowControl = STypes.NoFlowControl,
byteSize = _byteSize
}
getCommState :: HANDLE -> IO DCB
getCommState h =
alloca (\dcbp ->
do c_GetCommState h dcbp
peek dcbp )
--BOOL WINAPI GetCommState(
-- __in HANDLE hFile,
-- __inout LPDCB lpDCB
--);
foreign import stdcall unsafe "winbase.h GetCommState"
c_GetCommState :: HANDLE -> LPDCB -> IO BOOL
setCommState :: HANDLE -> DCB -> IO ()
setCommState h dcb =
failIfFalse_ "setCommState" ( with dcb (c_SetCommState h))
--BOOL WINAPI SetCommState(
-- __in HANDLE hFile,
-- __in LPDCB lpDCB
--);
foreign import stdcall unsafe "winbase.h SetCommState"
c_SetCommState :: HANDLE -> LPDCB -> IO BOOL
-- |
-- If an application sets ReadIntervalTimeout and ReadTotalTimeoutMultiplier to MAXDWORD and sets ReadTotalTimeoutConstant to a value greater than zero and less than MAXDWORD, one of the following occurs when the ReadFile function is called:
--
-- * If there are any bytes in the input buffer, ReadFile returns immediately with the bytes in the buffer.
--
-- * If there are no bytes in the input buffer, ReadFile waits until a byte arrives and then returns immediately.
--
-- * If no bytes arrive within the time specified by ReadTotalTimeoutConstant, ReadFile times out.
--
type LPCOMMTIMEOUTS = Ptr COMMTIMEOUTS
data COMMTIMEOUTS = COMMTIMEOUTS
{ readIntervalTimeout :: DWORD, -- in milliseconds
readTotalTimeoutMultiplier :: DWORD, -- in milliseconds
readTotalTimeoutConstant :: DWORD, -- in milliseconds
writeTotalTimeoutMultiplier :: DWORD, -- in milliseconds
writeTotalTimeoutConstant :: DWORD } -- in milliseconds
deriving Show
instance Storable COMMTIMEOUTS where
sizeOf = const #size COMMTIMEOUTS
alignment = sizeOf
poke buf ct = do
(#poke COMMTIMEOUTS, ReadIntervalTimeout) buf (readIntervalTimeout ct)
(#poke COMMTIMEOUTS, ReadTotalTimeoutMultiplier) buf ( readTotalTimeoutMultiplier ct)
(#poke COMMTIMEOUTS, ReadTotalTimeoutConstant) buf ( readTotalTimeoutConstant ct)
(#poke COMMTIMEOUTS, WriteTotalTimeoutMultiplier) buf ( writeTotalTimeoutMultiplier ct)
(#poke COMMTIMEOUTS, WriteTotalTimeoutConstant) buf ( writeTotalTimeoutConstant ct)
peek buf = do
_readIntervalTimeout <- (#peek COMMTIMEOUTS, ReadIntervalTimeout) buf
_readTotalTimeoutMultiplier <- (#peek COMMTIMEOUTS, ReadTotalTimeoutMultiplier ) buf
_readTotalTimeoutConstant <- (#peek COMMTIMEOUTS, ReadTotalTimeoutConstant ) buf
_writeTotalTimeoutMultiplier <- (#peek COMMTIMEOUTS, WriteTotalTimeoutMultiplier ) buf
_writeTotalTimeoutConstant <- (#peek COMMTIMEOUTS, WriteTotalTimeoutConstant ) buf
return COMMTIMEOUTS { readIntervalTimeout = _readIntervalTimeout,
readTotalTimeoutMultiplier = _readTotalTimeoutMultiplier,
readTotalTimeoutConstant = _readTotalTimeoutConstant,
writeTotalTimeoutMultiplier = _writeTotalTimeoutMultiplier,
writeTotalTimeoutConstant = _writeTotalTimeoutConstant }
getCommTimeouts :: HANDLE -> IO COMMTIMEOUTS
getCommTimeouts h =
alloca (\c ->
do c_GetCommTimeouts h c
peek c )
-- getcommtimeouts
-- winbase.h -> BOOL WINAPI GetCommTimeouts(HANDLE, LPCOMMTIMEOUTS);
foreign import stdcall unsafe "winbase.h GetCommTimeouts"
c_GetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL
-- |
--
-- On success it returns nonzero. On failure, the return value is zero and the GetLastError should be called.
--
setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO ()
setCommTimeouts h ct =
failIfFalse_ "setCommTimeouts" ( with ct (c_SetCommTimeouts h) )
-- setcommtimeouts
-- winbase.h -> BOOL WINAPI SetCommTimeouts(HANDLE, LPCOMMTIMEOUTS);
foreign import stdcall unsafe "winbase.h SetCommTimeouts"
c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL
clrDTR :: DWORD
clrDTR = #const CLRDTR
setDTR :: DWORD
setDTR = #const SETDTR
--
--
foreign import stdcall unsafe "winbase.h EscapeCommFunction"
c_EscapeCommFunction :: HANDLE -> DWORD -> IO BOOL
escapeCommFunction :: HANDLE -> DWORD -> IO ()
escapeCommFunction h t =
failIfFalse_ "excapeCommFunction" ( c_EscapeCommFunction h t )