packages feed

serialport-0.1.0.1: System/Hardware/Serialport/Windows.hs

module System.Hardware.Serialport.Windows where 

import System.IO
import System.Win32.File
import System.Win32.Types
import Data.Bits
import Data.Word
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
           -> Word8
           -> 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     
           -> Word8          
           -> 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