module System.Hardware.Serialport.Windows where import System.IO import System.Win32.File import System.Win32.Types import Data.Bits import Control.Concurrent import System.Win32.Comm import Foreign.Marshal.Alloc import Foreign.Marshal.Utils import Foreign.Storable import Foreign.Ptr import Foreign.C.Types import Foreign.C.String data SerialPort = SerialPort HANDLE openSerial :: String -- ^ The filename of the serial port, such as @COM5@ or @//./CNCA0@ -> BaudRate -> Int -> StopBits -> Parity -> FlowControl -> IO SerialPort openSerial dev baud bPerB stopBits parity flow = do h <- createFile dev access_mode share_mode security_attr create_mode file_attr template_file setSerial h baud bPerB stopBits parity flow return $ SerialPort h 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 setSerial :: HANDLE -> BaudRate -> Int -> StopBits -> Parity -> FlowControl -> IO () setSerial h baud bPerB stopb parit flow = do -- set timeouts let ct = COMMTIMEOUTS { readIntervalTimeout = 0, readTotalTimeoutMultiplier = 100, readTotalTimeoutConstant = 0, writeTotalTimeoutMultiplier = 0, writeTotalTimeoutConstant = 0 } setCommTimeouts h ct --print $ show ct -- configure DCB structure dcb <- getCommState h --print $ show dcb let dcb' = DCB { baudRate = baud, parity = parit, stopBits = stopb, flowControl = flow, byteSize = bPerB } --print $ show dcb' setCommState h dcb' dcb_check <- getCommState h --print $ show dcb_check return () sendChar :: SerialPort -> Char -> IO () sendChar (SerialPort h) s = do with s (\ p_s -> do win32_WriteFile h p_s count overlapped return () ) where count = 1 overlapped = Nothing recvChar :: SerialPort -> IO (Maybe Char) recvChar (SerialPort h) = do 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 closeSerial :: SerialPort -> IO () closeSerial (SerialPort h) = closeHandle h