diff --git a/System/Hardware/Serialport.hs b/System/Hardware/Serialport.hs --- a/System/Hardware/Serialport.hs +++ b/System/Hardware/Serialport.hs @@ -17,6 +17,7 @@ ,sendChar ,recvChar ,closeSerial + ,setDTR ) where #if defined(mingw32_HOST_OS) diff --git a/System/Hardware/Serialport/Posix.hs b/System/Hardware/Serialport/Posix.hs deleted file mode 100644 --- a/System/Hardware/Serialport/Posix.hs +++ /dev/null @@ -1,93 +0,0 @@ -module System.Hardware.Serialport.Posix where - -import System.IO -import System.IO.Error -import System.Posix.IO -import System.Posix.Types -import System.Posix.Terminal -import System.Hardware.Serialport.Types - - --- |Open and configure a serial port -openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ - -> SerialPortSettings - -> IO SerialPort -openSerial dev settings = - do fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True } - setSerialSettings fd' settings - return $ SerialPort fd' settings - - --- |Possibly receive a character unless the timeout given in openSerial is exceeded. -recvChar :: SerialPort -> IO (Maybe Char) -recvChar (SerialPort fd' _) = - do result <- try $ fdRead fd' 1 - case result of - Right (str, _) -> return $ Just $ head str - Left _ -> return Nothing - - --- |Send a character -sendChar :: SerialPort -> Char -> IO () -sendChar (SerialPort fd' _ ) c = - fdWrite fd' [c] >> return () - - --- |Close the serial port -closeSerial :: SerialPort -> IO () -closeSerial (SerialPort fd' _ ) = - closeFd fd' - - -setSerialSettings :: Fd -> SerialPortSettings -> IO () -setSerialSettings fd' settings = - do termOpts <- getTerminalAttributes fd' - let termOpts' = configureSettings termOpts settings - setTerminalAttributes fd' termOpts' Immediately - - -withParity :: TerminalAttributes -> Parity -> TerminalAttributes -withParity termOpts Even = termOpts `withMode` EnableParity - `withoutMode` OddParity -withParity termOpts Odd = termOpts `withMode` EnableParity - `withMode` OddParity -withParity termOpts NoParity = termOpts `withoutMode` EnableParity - - -withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes -withFlowControl termOpts NoFlowControl = termOpts - `withoutMode` StartStopInput - `withoutMode` StartStopOutput -withFlowControl termOpts Software = termOpts - `withMode` StartStopInput - `withMode` StartStopOutput - - -withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes -withStopBits termOpts One = termOpts `withoutMode` TwoStopBits -withStopBits termOpts Two = termOpts `withMode` TwoStopBits - - -configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes -configureSettings termOpts settings = - termOpts `withInputSpeed` (baudRate settings) - `withOutputSpeed` (baudRate settings) - `withBits` (fromIntegral (bitsPerWord settings)) - `withStopBits` (stopb settings) - `withParity` (parity settings) - `withFlowControl` (flowControl settings) - `withoutMode` EnableEcho - `withoutMode` EchoErase - `withoutMode` EchoKill - `withoutMode` ProcessInput - `withoutMode` ProcessOutput - `withoutMode` MapCRtoLF - `withoutMode` EchoLF - `withoutMode` HangupOnClose - `withoutMode` KeyboardInterrupts - `withoutMode` ExtendedFunctions - `withMode` LocalMode - `withMode` ReadEnable - `withTime` (timeout settings) - `withMinInput` 0 - diff --git a/System/Hardware/Serialport/Posix.hsc b/System/Hardware/Serialport/Posix.hsc new file mode 100644 --- /dev/null +++ b/System/Hardware/Serialport/Posix.hsc @@ -0,0 +1,126 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module System.Hardware.Serialport.Posix where + +import System.IO +import System.IO.Error +import System.Posix.IO +import System.Posix.Types +import System.Posix.Terminal +import System.Hardware.Serialport.Types +import Foreign +import Foreign.C +import Data.Bits + + +-- |Open and configure a serial port +openSerial :: FilePath -- ^ The filename of the serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@ + -> SerialPortSettings + -> IO SerialPort +openSerial dev settings = + do fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True } + setSerialSettings fd' settings + return $ SerialPort fd' settings + + +-- |Possibly receive a character unless the timeout given in openSerial is exceeded. +recvChar :: SerialPort -> IO (Maybe Char) +recvChar (SerialPort fd' _) = + do result <- try $ fdRead fd' 1 + case result of + Right (str, _) -> return $ Just $ head str + Left _ -> return Nothing + + +-- |Send a character +sendChar :: SerialPort -> Char -> IO () +sendChar (SerialPort fd' _ ) c = + fdWrite fd' [c] >> return () + + +-- |Close the serial port +closeSerial :: SerialPort -> IO () +closeSerial (SerialPort fd' _ ) = + closeFd fd' + + +#include + +foreign import ccall "ioctl" c_ioctl :: CInt -> CInt -> Ptr () -> IO CInt + +c_ioctl' :: Fd -> Int -> Ptr d -> IO () +c_ioctl' f req = + throwErrnoIfMinus1_ "ioctl" . + c_ioctl (fromIntegral f) (fromIntegral req) . castPtr + + +getTIOCM :: Fd -> IO Int +getTIOCM fd' = + alloca $ \p -> c_ioctl' fd' (#const TIOCMGET) p >> peek p + + +setTIOCM :: Fd -> Int -> IO () +setTIOCM fd' val = + with val $ c_ioctl' fd' (#const TIOCMSET) + + +-- |Set the Data Terminal Ready level +setDTR :: SerialPort -> Bool -> IO () +setDTR (SerialPort fd' _) set = + do current <- getTIOCM fd' + setTIOCM fd' $ if set + then current .|. (#const TIOCM_DTR) + else current .&. (complement (#const TIOCM_DTR)) + + +setSerialSettings :: Fd -> SerialPortSettings -> IO () +setSerialSettings fd' settings = + do termOpts <- getTerminalAttributes fd' + let termOpts' = configureSettings termOpts settings + setTerminalAttributes fd' termOpts' Immediately + + +withParity :: TerminalAttributes -> Parity -> TerminalAttributes +withParity termOpts Even = termOpts `withMode` EnableParity + `withoutMode` OddParity +withParity termOpts Odd = termOpts `withMode` EnableParity + `withMode` OddParity +withParity termOpts NoParity = termOpts `withoutMode` EnableParity + + +withFlowControl :: TerminalAttributes -> FlowControl -> TerminalAttributes +withFlowControl termOpts NoFlowControl = termOpts + `withoutMode` StartStopInput + `withoutMode` StartStopOutput +withFlowControl termOpts Software = termOpts + `withMode` StartStopInput + `withMode` StartStopOutput + + +withStopBits :: TerminalAttributes -> StopBits -> TerminalAttributes +withStopBits termOpts One = termOpts `withoutMode` TwoStopBits +withStopBits termOpts Two = termOpts `withMode` TwoStopBits + + +configureSettings :: TerminalAttributes -> SerialPortSettings -> TerminalAttributes +configureSettings termOpts settings = + termOpts `withInputSpeed` (baudRate settings) + `withOutputSpeed` (baudRate settings) + `withBits` (fromIntegral (bitsPerWord settings)) + `withStopBits` (stopb settings) + `withParity` (parity settings) + `withFlowControl` (flowControl settings) + `withoutMode` EnableEcho + `withoutMode` EchoErase + `withoutMode` EchoKill + `withoutMode` ProcessInput + `withoutMode` ProcessOutput + `withoutMode` MapCRtoLF + `withoutMode` EchoLF + `withoutMode` HangupOnClose + `withoutMode` KeyboardInterrupts + `withoutMode` ExtendedFunctions + `withMode` LocalMode + `withMode` ReadEnable + `withTime` (timeout settings) + `withMinInput` 0 + diff --git a/System/Hardware/Serialport/Windows.hs b/System/Hardware/Serialport/Windows.hs --- a/System/Hardware/Serialport/Windows.hs +++ b/System/Hardware/Serialport/Windows.hs @@ -59,6 +59,14 @@ 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 { diff --git a/System/Win32/Comm.hsc b/System/Win32/Comm.hsc --- a/System/Win32/Comm.hsc +++ b/System/Win32/Comm.hsc @@ -184,3 +184,20 @@ 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 ) + diff --git a/serialport.cabal b/serialport.cabal --- a/serialport.cabal +++ b/serialport.cabal @@ -1,5 +1,5 @@ Name: serialport -Version: 0.3.1 +Version: 0.3.2 Cabal-Version: >= 1.2 Build-Type: Simple license: BSD3