Windows.hs

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