module System.Hardware.Serialport.Windows where import Data.Bits import qualified System.Win32.Comm as Comm import System.Win32.Types import System.Win32.File import Foreign.C.Types import Foreign.C.String import Foreign.Marshal.Utils import Foreign.Marshal.Alloc import Foreign.Storable import System.Hardware.Serialport.Types -- | Open and configure a serial port openSerial :: String -- ^ The filename of the serial port, such as @COM5@ or @\/\/.\/CNCA0@ -> SerialPortSettings -> IO SerialPort openSerial dev settings = do h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file setSerialSettings h settings return $ SerialPort h settings where access_mode = gENERIC_READ .|. gENERIC_WRITE share_mode = fILE_SHARE_NONE security_attr = Nothing create_mode = oPEN_EXISTING file_attr = fILE_ATTRIBUTE_NORMAL -- .|. fILE_FLAG_OVERLAPPED template_file = Nothing -- |Possibly receive a character unless the timeout given in openSerial is exceeded. recvChar :: SerialPort -> IO (Maybe Char) recvChar (SerialPort h _) = allocaBytes 1 $ \ p_n -> do received <- win32_ReadFile h p_n count overlapped if received == 0 then return Nothing else do c <- peek p_n :: IO CChar return $ Just $ castCCharToChar c where count = 1 overlapped = Nothing -- |Send a character sendChar :: SerialPort -> Char -> IO () sendChar (SerialPort h _) s = with s (\ p_s -> do win32_WriteFile h p_s count overlapped return () ) where count = 1 overlapped = Nothing -- |Close the serial port closeSerial :: SerialPort -> IO () closeSerial (SerialPort h _) = closeHandle h -- |Set the Data Terminal Ready level setDTR :: SerialPort -> Bool -> IO () setDTR (SerialPort h _ ) set = Comm.escapeCommFunction h $ if set then Comm.setDTR else Comm.clrDTR setSerialSettings :: HANDLE -> SerialPortSettings -> IO () setSerialSettings h settings = do let ct = Comm.COMMTIMEOUTS { Comm.readIntervalTimeout = maxBound :: DWORD, Comm.readTotalTimeoutMultiplier = maxBound :: DWORD, Comm.readTotalTimeoutConstant = fromIntegral (timeout settings) * 100, Comm.writeTotalTimeoutMultiplier = 0, Comm.writeTotalTimeoutConstant = 0 } Comm.setCommTimeouts h ct let dcb = Comm.DCB { Comm.baudRate = (baudRate settings), Comm.parity = (parity settings), Comm.stopBits = (stopb settings), Comm.flowControl = (flowControl settings), Comm.byteSize = (bitsPerWord settings) } Comm.setCommState h dcb return ()