serialport-0.2.0: System/Win32/Comm.hsc
{-# LANGUAGE ForeignFunctionInterface #-}
module System.Win32.Comm where
import System.IO
import System.Win32.Types
import Data.Word
import Foreign.Storable
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
#include <windows.h>
data BaudRate
= B0
| B50
| B75
| B110
| B134
| B150
| B200
| B300
| B600
| B1200
| B1800
| B2400
| B4800
| B9600
| B19200
| B38400
| B57600
| B115200
deriving Show
data StopBits = One | Two deriving Show
data Parity = Even | Odd | NoParity deriving Show
data FlowControl = Software | NoFlowControl deriving Show
type LPDCB = Ptr DCB
data DCB = DCB
{ baudRate :: BaudRate,
parity :: Parity,
stopBits :: StopBits,
flowControl :: FlowControl,
byteSize :: Word8
} deriving Show
-- 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
instance Storable DCB where
sizeOf = const #size DCB
alignment = sizeOf
poke buf dcb = do
(#poke DCB, DCBlength) buf (sizeOf dcb)
(#poke DCB, BaudRate) buf (case (baudRate dcb) of
B0 -> 0
B50 -> 50
B75 -> 75
B110 -> 110
B134 -> 134
B150 -> 150
B200 -> 200
B300 -> 300
B600 -> 600
B1200 -> 1200
B1800 -> 1800
B2400 -> 2400
B4800 -> 4800
B9600 -> 9600
B19200 -> 19200
B38400 -> 38400
B57600 -> 57600
B115200 -> 115200 :: DWORD)
pokeByteOff buf 8 (fBinary :: 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
NoParity -> 0
Odd -> 1
Even -> 2 :: BYTE)
(#poke DCB, StopBits) buf (case (stopBits dcb) of
One -> 0
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
case _baud of
0 -> return B0
50 -> return B50
75 -> return B75
110 -> return B110
134 -> return B134
150 -> return B150
200 -> return B200
300 -> return B300
600 -> return B600
1200 -> return B1200
1800 -> return B1800
2400 -> return B2400
4800 -> return B4800
9600 -> return B9600
19200 -> return B19200
38400 -> return B38400
57600 -> return B57600
115200 -> return B115200
_ -> fail "incorrect baudrate"
_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 NoParity
1 -> return Odd
2 -> return Even
--3 -> markparity
--4 -> spaceparity
_ -> fail $ "incorrect parity" ++ (show _par)
_stopBits <- do _stopb <- (#peek DCB, StopBits) buf :: IO BYTE
case _stopb of
0 -> return One
-- 1 -> one5stopbits
2 -> return 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 = 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 =
do with dcb (c_SetCommState h)
return ()
--BOOL WINAPI SetCommState(
-- __in HANDLE hFile,
-- __in LPDCB lpDCB
--);
foreign import stdcall unsafe "winbase.h SetCommState"
c_SetCommState :: HANDLE -> LPDCB -> IO BOOL
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
setCommTimeouts :: HANDLE -> COMMTIMEOUTS -> IO ()
setCommTimeouts h ct =
do with ct (c_SetCommTimeouts h)
return ()
-- setcommtimeouts
-- winbase.h -> BOOL WINAPI SetCommTimeouts(HANDLE, LPCOMMTIMEOUTS);
foreign import stdcall unsafe "winbase.h SetCommTimeouts"
c_SetCommTimeouts :: HANDLE -> LPCOMMTIMEOUTS -> IO BOOL