{-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_HADDOCK hide #-} module System.Win32.Comm where import System.Win32.Types import Data.Bits import Foreign.Storable import Foreign.Ptr import Foreign.Marshal.Alloc import Foreign.Marshal.Utils import System.Hardware.Serialport.Types #include -- | 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 = 0x00000001 -- | If this member is TRUE, parity checking is performed and errors are reported. fParity :: DWORD fParity = 0x00000002 -- Preceding bits: (fBinary)1 + (fParity)1 + (fOutxCtrFlow)1 + (fOutxDsrFlow)1 fDtrEnable :: DWORD fDtrEnable = (#const DTR_CONTROL_ENABLE) `shift` 4 -- Preciding bits:(fBinary)1 + (fParity)1 + (fOutxCtrFlow)1 + (fOutxDsrFlow)1 + (fDtrControl)2 + (fDsrSensitivity)1 + -- (fTXContinueOnXoff)1 + (fOutX)1 + (fInx)1 + (fErrorChar)1 + (fNull)1 fRtsEnable :: DWORD fRtsEnable = (#const RTS_CONTROL_ENABLE) `shift` 12 instance Storable SerialPortSettings where sizeOf _ = #{size DCB} alignment = sizeOf poke buf settings = do #{poke DCB, DCBlength} buf (sizeOf settings) #{poke DCB, BaudRate} buf (fromIntegral (commSpeedToBaudRate (commSpeed settings)) :: DWORD) pokeByteOff buf 8 (fBinary .|. fDtrEnable .|. fRtsEnable ) #{poke DCB, wReserved} buf (0 :: WORD) #{poke DCB, XonLim} buf (2048 :: WORD) #{poke DCB, XoffLim} buf (512 :: WORD) #{poke DCB, ByteSize} buf (bitsPerWord settings :: BYTE) #{poke DCB, Parity} buf (case parity settings of NoParity -> #const NOPARITY Odd -> #const ODDPARITY Even -> #const EVENPARITY :: BYTE) #{poke DCB, StopBits} buf (case stopb settings of One -> #const ONESTOPBIT Two -> #const TWOSTOPBITS :: BYTE) #{poke DCB, wReserved1} buf (0 :: WORD) peek buf = do _dCBlength <- #{peek DCB, DCBlength} buf :: IO DWORD _commSpeed <- do _baud <- #{peek DCB, BaudRate} buf :: IO DWORD return $ baudRateToCommSpeed (fromIntegral _baud) _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 #{const NOPARITY} -> return NoParity #{const ODDPARITY} -> return Odd #{const EVENPARITY} -> return Even #{const MARKPARITY} -> fail "unsupported markparity" #{const SPACEPARITY} -> fail "unsupported spaceparity" _ -> fail $ "unsupported parity" ++ show _par _stopBits <- do _stopb <- #{peek DCB, StopBits} buf :: IO BYTE case _stopb of #{const ONESTOPBIT} -> return One #{const ONE5STOPBITS} -> fail "unsupported one5stopbits" #{const TWOSTOPBITS} -> return Two _ -> fail "unexpected stop bit count" _XonLim <- #{peek DCB, XonLim} buf :: IO WORD _XoffLim <- #{peek DCB, XoffLim} buf :: IO WORD return SerialPortSettings { commSpeed = _commSpeed, bitsPerWord = _byteSize, stopb = _stopBits, parity = _parity, flowControl = NoFlowControl, timeout = 0 } getCommState :: HANDLE -> IO SerialPortSettings 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 -> Ptr SerialPortSettings -> IO BOOL setCommState :: HANDLE -> SerialPortSettings -> IO () setCommState h settings = failIfFalse_ "setCommState" ( with settings (c_SetCommState h)) --BOOL WINAPI SetCommState( -- __in HANDLE hFile, -- __in LPDCB lpDCB --); foreign import stdcall unsafe "winbase.h SetCommState" c_SetCommState :: HANDLE -> Ptr SerialPortSettings -> 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 _ = #{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 clrRTS :: DWORD clrRTS = #const CLRRTS setRTS :: DWORD setRTS = #const SETRTS -- -- 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 ) baudRateToCommSpeed :: Int -> CommSpeed baudRateToCommSpeed baud = case baud of (#const CBR_110) -> CS110 _ -> CS9600 commSpeedToBaudRate :: CommSpeed -> Int commSpeedToBaudRate cs = case cs of CS110 -> (#const CBR_110) CS300 -> (#const CBR_300) CS600 -> (#const CBR_600) CS1200 -> (#const CBR_1200) CS2400 -> (#const CBR_2400) CS4800 -> (#const CBR_4800) CS9600 -> (#const CBR_9600) CS19200 -> (#const CBR_19200) CS38400 -> (#const CBR_38400) CS57600 -> (#const CBR_57600) CS115200 -> (#const CBR_115200)