Commits

mitar committed 1411f8f

Cleaning new code for serial port communication.

  • Participants
  • Parent commits 5fe8752

Comments (0)

Files changed (11)

 Name:                NXT
-Version:             0.1.9
+Version:             0.2.0
 Synopsis:            A Haskell interface to Lego Mindstorms NXT
 Description:         A Haskell interface to Lego Mindstorms NXT over Bluetoooth. It supports direct commands, messages and
                      many sensors (also unofficial). It has also support for a simple message-based control of a NXT brick
                      It contains two simple programs: @nxt-upload@ for uploading files to a NXT brick and @nxt-shutdown@ for
                      remote shutdown of a NXT brick.
                      .
-                     It should work on Linux, MacOs and Windows.
+                     It works on Linux, Mac OS X and Windows.
                      .
                      Feel free to contribute additional features, interfaces for more sensors and propose or write other
                      (example) programs.
 License-file:        LICENSE
 Author:              Mitar Milutinovic
 Maintainer:          mitar.haskell@tnode.com
-Copyright:           (c) 2010 Mitar Milutinovic
+Copyright:           (c) 2011 Mitar Milutinovic
 Category:            Robotics
 Build-type:          Simple
-Cabal-version:       >= 1.8
+Cabal-version:       >= 1.10
 Stability:           experimental
 Homepage:            http://mitar.tnode.com
 Extra-source-files:  remote/remote.rxe,
                      remote/remote.nxc,
-                     ffi/blue.h,
-                     ffi/initserial.h
+                     ffi/blue.h
 
 Library
   Exposed-modules:     Robotics.NXT,
                        mtl >= 1.1 && < 3,
                        bytestring >= 0.9 && < 1,
                        time >= 1.1 && < 2,
-                       serialport,
-                       transformers
+                       serialport >= 0.4 && < 1
   Other-modules:       Robotics.NXT.Data,
                        Robotics.NXT.Errors,
                        Robotics.NXT.Protocol,
   GHC-options:         -Wall
   GHC-prof-options:    -Wall
   GHC-shared-options:  -Wall
+  Default-language:    Haskell2010
+  C-sources:           ffi/blue.c
+  Includes:            ffi/blue.h
 
   if !os(windows)
-    Build-depends:  unix >= 2.4 && < 3
+    Build-depends:     unix >= 2.4 && < 3
 
-  if !os(windows)
-    C-sources:        ffi/blue.c,
-                         ffi/initserial.c
-    Includes:         ffi/blue.h,
-                         ffi/initserial.h
-    Extra-libraries:  bluetooth
+  if os(linux)
+    Extra-libraries:   bluetooth
 
 Source-repository head
-  type:      mercurial
-  location:  https://bitbucket.org/mitar/nxt
+  type:                mercurial
+  location:            https://bitbucket.org/mitar/nxt
 
 Executable nxt-shutdown
-  Main-is:         Shutdown.hs
-  HS-source-dirs:  src
-  Build-depends:   base >= 4.3 && < 5,
+  Main-is:             Shutdown.hs
+  HS-source-dirs:      src
+  Build-depends:       base >= 4.3 && < 5,
                        mtl >= 1.1 && < 3,
-                       NXT,
-                       transformers,
-                       serialport
-  GHC-options:     -Wall
+                       NXT == 0.2.0
+  GHC-options:         -Wall
+  Default-language:    Haskell2010
 
 Executable nxt-upload
-  Main-is:         UploadFiles.hs
-  HS-source-dirs:  src
-  Build-depends:   base >= 4.3 && < 5,
+  Main-is:             UploadFiles.hs
+  HS-source-dirs:      src
+  Build-depends:       base >= 4.3 && < 5,
                        mtl >= 1.1 && < 3,
                        bytestring >= 0.9 && < 1,
                        filepath >= 1.1 && < 2,
-                       NXT,
-                       transformers,
-                       serialport
-  GHC-options:     -Wall
+                       NXT == 0.2.0
+  GHC-options:         -Wall
+  Default-language:    Haskell2010
 
-
-Test-suite NXTTests
-  Type:            exitcode-stdio-1.0
-  x-uses-tf:       true
-  Build-depends:   base >= 4,
-                   HUnit >= 1.2 && < 2,
-                   QuickCheck >= 2.4,
-                   test-framework >= 0.4.1,
-                   test-framework-quickcheck2,
-                   test-framework-hunit,
-                   NXT,
-                   transformers,
-                   serialport,
-                   mtl
-  GHC-options:     -Wall -rtsopts
-  HS-source-dirs:  test
-  Main-is:         Main.hs
-  Other-modules:   Robotics.NXT.Basic
-
+Test-suite nxt-tests
+  Type:                exitcode-stdio-1.0
+  X-uses-tf:           true
+  Build-depends:       base >= 4,
+                       HUnit >= 1.2 && < 2,
+                       QuickCheck >= 2.4 && < 3,
+                       test-framework >= 0.4 && < 1,
+                       test-framework-quickcheck2 >= 0.2 && < 1,
+                       test-framework-hunit >= 0.2 && < 1,
+                       mtl >= 1.1 && < 3,
+                       NXT == 0.2.0
+  GHC-options:         -Wall -rtsopts
+  Default-language:    Haskell2010
+  HS-source-dirs:      tests
+  Main-is:             Main.hs
+  Other-modules:       Robotics.NXT.Basic

File ffi/initserial.c

-#include <termios.h>
-#include <unistd.h>
-
-#include "initserial.h"
-
-// A simple function which initializes serial port device: 8 bit data, one stop bit, RTS/CTS flow control
-
-int initSerialPort(int fd) {
-	struct termios params;
-	
-	tcflush(fd, TCIOFLUSH);
-	
-	if (tcgetattr(fd, &params) == -1) return -1;
-	
-	cfmakeraw(&params);
-#ifdef __MAX_BAUD
-	cfsetspeed(&params, __MAX_BAUD);
-#elif defined B230400
-	cfsetspeed(&params, B230400);
-#endif
-	params.c_cflag = CLOCAL | CREAD | CS8 | HUPCL | CRTSCTS;
-	
-	//params.c_cc[VTIME] = (5000 + 50) / 100;
-    //params.c_cc[VMIN] = 0;
-	
-	if (tcsetattr(fd, TCSANOW, &params) == -1) return -1;
-	
-	return 0;
-}

File ffi/initserial.h

-#ifndef INITSERIAL_H_
-#define INITSERIAL_H_
-
-int initSerialPort(int fd);
-
-#endif /* INITSERIAL_H_ */

File lib/Robotics/NXT/BluetoothUtils.hs

-{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# CFILES ffi/blue.c #-}
 
 module Robotics.NXT.BluetoothUtils (
   -- * Bluetooth utils
   -- | `getDeviceInfo` returns zero for Bluetooth signal strength as this is not implemented in current NXT firmware versions. 
   -- Here are functions which retrieve that from a host (computer) Bluetooth stack.
-#ifdef linux_HOST_OS  
   bluetoothRSSI,
   bluetoothLinkQuality
-#endif
 ) where
 
 import Control.Exception
 import Robotics.NXT.Types
 import Robotics.NXT.Internals
 
-#ifdef linux_HOST_OS
 -- Foreign function call for C function which returns RSSI Bluetooth value of a connection to a given Bluetooth address
 foreign import ccall unsafe "rssi" rssi :: CString -> IO CInt
 
       | ret' == blueNotConnected -> liftIO $ throwIO $ NXTException "Connection not established"
       | ret' == blueNotSupported -> liftIO $ throwIO $ NXTException "Not supported on this system"
       | otherwise                -> return ret'
-#endif
 
 bluetoothAddress :: NXT BTAddress
 bluetoothAddress = do

File lib/Robotics/NXT/Externals.hs

+{-# LANGUAGE DeriveDataTypeable #-}
+
 module Robotics.NXT.Externals where
 
+import Control.Exception
 import Data.Int
 import Data.Ratio
 import Data.Time.Clock
+import Data.Typeable
 import Data.Word
 
 -- Described in Lego Mindstorms NXT Bluetooth Developer Kit:
 type IOMapOffset = Int -- unsigned word
 type IOMapLength = Int -- unsigned word
 type IOMapData = [Word8]
+
+-- | Timeout exception for NXT IO operations.
+data TimeoutException = TimoutException deriving (Show, Typeable)
+instance Exception TimeoutException

File lib/Robotics/NXT/Internals.hs

 import Control.Monad.State
 import Data.Time.Clock.POSIX
 import Data.Typeable
-import System.Hardware.Serialport (SerialPort)
+import System.Hardware.Serialport
 
 import Robotics.NXT.Externals
 

File lib/Robotics/NXT/Protocol.hs

+{-# LANGUAGE CPP #-}
+
 module Robotics.NXT.Protocol (
   -- * Initialization
   withNXT,
   execNXT
 ) where
 
---import qualified Data.ByteString as B
 import Control.Exception
 import Control.Monad.State
-import Control.Monad.Trans.Maybe
 import Data.Bits
 import Data.Char
 import Data.List hiding (delete)
 import Data.Ratio
 import Data.Time.Clock.POSIX
 import Data.Word
---import Foreign.C.Error
---import Foreign.C.Types
 import System.IO
-import System.Hardware.Serialport (openSerial,defaultSerialSettings,sendString ,recvChar,closeSerial,commSpeed ,timeout, CommSpeed(CS19200) , flush)
---import System.Posix.Types
+import System.Hardware.Serialport hiding (One)
+#ifndef windows_HOST_OS
+import System.Posix.Signals
+#endif
 import Text.Printf
 
 import Robotics.NXT.Data
 -- TODO: Add an optional warning if direction of communication changes
 -- TODO: Implement all missing "confirm" versions of functions
 
--- Foreign function call for C function which initialize serial port device on POSIX systems
---foreign import ccall unsafe "initSerialPort" initSerialPort' :: Fd -> IO CInt
---
---initSerialPort :: Fd -> IO ()
---initSerialPort fd = throwErrnoIfMinus1_ "initSerialPort" $ initSerialPort' fd
-
 {-|
 Default Bluetooth serial device filename for current operating system. Currently always @\/dev\/rfcomm0@.
 -}
 -}
 initialize :: FilePath -> IO NXTInternals
 initialize device = do
-  s <- openSerial device defaultSerialSettings { commSpeed  = CS19200,timeout=1000 }
-
---  -- we have to block signals from interrupting openFd system call (fixed in GHC versions after 6.12.1)
---  let signals = foldl (flip addSignal) emptySignalSet [virtualTimerExpired]
---  blockSignals signals
---  fd <- openFd device ReadWrite Nothing OpenFileFlags { append = False, noctty = True, exclusive = False, nonBlock = True, trunc = False }
---  unblockSignals signals
---  initSerialPort fd
---  h <- fdToHandle fd
---  hSetBuffering h NoBuffering
+#ifndef windows_HOST_OS
+  -- we have to block signals from interrupting openFd system call (fixed in GHC versions after 6.12.1)
+  let signals = foldl (flip addSignal) emptySignalSet [virtualTimerExpired]
+  blockSignals signals
+#endif
+  h <- openSerial device defaultSerialSettings { commSpeed = CS115200, timeout = 1000 }
+#ifndef windows_HOST_OS
+  unblockSignals signals
+#endif
   when debug $ hPutStrLn stderr "initialized"
-  return $ NXTInternals s Nothing [] Nothing Nothing
+  return $ NXTInternals h Nothing [] Nothing Nothing
 
 {-|
 Stops all NXT activities (by calling 'stopEverything') and closes the Bluetooth serial device communication. 'NXTInternals' token must not
   h <- getsNXT nxthandle
   let len = toUWord . length $ message
       packet = len ++ message
-  --liftIO . B.hPut h . B.pack $ packet
   liftIO $ sendString h $ map (toEnum . fromEnum) packet
   when debug $ liftIO . hPutStrLn stderr $ "sent: " ++ show packet
 
 receiveData :: NXT [Word8]
 receiveData = do
   h <- getsNXT nxthandle
-  --len <- liftIO $ B.hGet h 2
-  --let len' = fromUWord . B.unpack $ len
-  --packet <- liftIO $ B.hGet h len'
-  --let unpacket = B.unpack packet
---  unpacket<-liftIO (do
---        mc1<-recvChar h
---        case mc1 of
---                Just c1-> do
---                        mc2<-recvChar h
---                        case mc2 of
---                                Just c2-> do
---                                       let len' = fromUWord $ map (toEnum . fromEnum) [c1, c2]
---                                       when debug $ liftIO . hPutStrLn stderr $ "received length: " ++ show len'
---                                       fs<-mapM (\_->recvChar h) [1..len']
---                                       return $ map fromJust fs
---                                Nothing->return ""
---                Nothing-> return ""        
---        )
-  unpacket<-runMaybeT $ do
-        c1<-MaybeT $ liftIO $ recvChar h
-        c2<-MaybeT $ liftIO $ recvChar h
-        let len' = fromUWord $ map (toEnum . fromEnum) [c1, c2]
-        when debug $ liftIO . hPutStrLn stderr $ "received length: " ++ show len'
-        fs<-mapM (\_->liftIO $ recvChar h) [1..len']
-        return $ map fromJust fs
-  let ws=map (toEnum . fromEnum) (fromMaybe "" unpacket)
-  when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show ws
-  return ws
+  let hChar :: IO Word8
+      hChar = do
+        c <- recvChar h
+        case c of
+          Just c' -> return $ toEnum . fromEnum $ c'
+          Nothing -> throwIO TimoutException
+      hGet :: Int -> IO [Word8]
+      hGet l = replicateM l hChar
+  len <- liftIO $ hGet 2
+  let len' = fromUWord len
+  packet <- liftIO $ hGet len'
+  when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show packet
+  return packet
 
 {-|
 Gets firmware and protocol versions of the NXT brick.

File test/Main.hs

-
-module Main where
-
-import Robotics.NXT
-import Robotics.NXT.Basic
-
-import Control.Exception
-import Control.Monad.State.Class
-
-import Test.Framework (defaultMainWithArgs, testGroup,Test)
-import Test.Framework.Providers.HUnit
-
-
-import System.Environment ( getArgs)
-import Data.IORef
-import Control.Monad.IO.Class (liftIO)
-
-main :: IO()
-main = do
-  (device:args) <- getArgs
-  bracket (do
-                i<-initialize device
-                newIORef i)
-        (\ref->do
-                i'<-readIORef ref
-                terminate i')
-        (\ref->defaultMainWithArgs (tests ref) args)
- 
---  withNXT device (do
---        i<-get
---        ref<-liftIO $ newIORef i
---        liftIO $ defaultMainWithArgs (tests ref) args
---        i'<-liftIO $ readIORef ref
---        return ()
---        )
-
-tests :: IORef (NXTInternals) -> [Test]
-tests ref= [testGroup "Basic Tests" (concatMap hUnitTestToTests (basicTests ref))
-         ]
-         

File test/Robotics/NXT/Basic.hs

-
-module Robotics.NXT.Basic where
-
-import Robotics.NXT
-import Test.HUnit
-
-import Control.Concurrent (threadDelay)
-import Data.IORef
-
-basicTests :: IORef NXTInternals -> [Test]
-basicTests d= map (\x->x d) [testDeviceInfo,testOutputState,testInputMode]
---
-
-delay :: IO()
-delay =threadDelay $ 1000000 * 30
-
-testNXT :: IORef NXTInternals ->  NXT a -> IO a
-testNXT ref f=do
-        i<-readIORef ref
-        (a,i')<-runNXT f i
-        writeIORef ref i'
-        return a
-
-
-testDeviceInfo :: IORef NXTInternals -> Test
-testDeviceInfo ref= TestLabel "testDeviceInfo" (TestCase (do
-        (DeviceInfo name address _ _)<-testNXT ref getDeviceInfo
-        assertBool "empty name" (not $ null name)
-        putStrLn ("NXT Name: "++name)
-        assertBool "empty address" (not $ null address)
-        putStrLn ("NXT Address: "++address)
-        ))
-        
-testOutputState :: IORef NXTInternals -> Test
-testOutputState ref= TestLabel "testOutputState" (TestCase (do
-       (OutputState port power modes reg ratio _ limit count _ _) <- testNXT ref (do
-                setOutputStateConfirm A 75 [MotorOn,Brake] RegulationModeMotorSpeed 0 MotorRunStateRunning 360
-                getOutputState A
-                )
-       assertEqual "not A port" A port
-       assertEqual "not 75 power" 75 power
-       assertEqual "not modes" [MotorOn,Brake] modes
-       assertEqual "not regulation" RegulationModeMotorSpeed reg
-       assertEqual "not 0 ratio" 0 ratio
-       assertEqual "not 360 limit" 360 limit
-       assertBool "count>0" (count>0)
-       ))
-       
-testInputMode :: IORef NXTInternals -> Test
-testInputMode ref= TestLabel "testInputMode" (TestCase (do
-        InputValue port valid calibrated stype smode _ normV scalV _<-testNXT ref (do
-                setInputModeConfirm One Switch BooleanMode
-                getInputValues One
-                )
-        assertEqual "not port 1" One port
-        assertBool "not valid" valid
-        assertBool "calibrated" (not calibrated)
-        assertEqual "not switch" Switch stype
-        assertEqual "not boolean" BooleanMode smode
-        assertBool "normalized not in range" (normV>=0 && normV<1024)
-        assertEqual "scaled not 0" 0 scalV
-        ))

File tests/Main.hs

+module Main where
+
+import Robotics.NXT
+import Robotics.NXT.Basic
+
+import Control.Exception
+import Control.Monad.State.Class
+
+import Test.Framework (defaultMainWithArgs, testGroup,Test)
+import Test.Framework.Providers.HUnit
+
+
+import System.Environment ( getArgs)
+import Data.IORef
+import Control.Monad.IO.Class (liftIO)
+
+main :: IO()
+main = do
+  (device:args) <- getArgs
+  bracket (do
+                i<-initialize device
+                newIORef i)
+        (\ref->do
+                i'<-readIORef ref
+                terminate i')
+        (\ref->defaultMainWithArgs (tests ref) args)
+ 
+--  withNXT device (do
+--        i<-get
+--        ref<-liftIO $ newIORef i
+--        liftIO $ defaultMainWithArgs (tests ref) args
+--        i'<-liftIO $ readIORef ref
+--        return ()
+--        )
+
+tests :: IORef (NXTInternals) -> [Test]
+tests ref= [testGroup "Basic Tests" (concatMap hUnitTestToTests (basicTests ref))
+         ]

File tests/Robotics/NXT/Basic.hs

+module Robotics.NXT.Basic where
+
+import Robotics.NXT
+import Test.HUnit
+
+import Control.Concurrent (threadDelay)
+import Data.IORef
+
+basicTests :: IORef NXTInternals -> [Test]
+basicTests d= map (\x->x d) [testDeviceInfo,testOutputState,testInputMode]
+--
+
+delay :: IO()
+delay =threadDelay $ 1000000 * 30
+
+testNXT :: IORef NXTInternals ->  NXT a -> IO a
+testNXT ref f=do
+        i<-readIORef ref
+        (a,i')<-runNXT f i
+        writeIORef ref i'
+        return a
+
+
+testDeviceInfo :: IORef NXTInternals -> Test
+testDeviceInfo ref= TestLabel "testDeviceInfo" (TestCase (do
+        (DeviceInfo name address _ _)<-testNXT ref getDeviceInfo
+        assertBool "empty name" (not $ null name)
+        putStrLn ("NXT Name: "++name)
+        assertBool "empty address" (not $ null address)
+        putStrLn ("NXT Address: "++address)
+        ))
+        
+testOutputState :: IORef NXTInternals -> Test
+testOutputState ref= TestLabel "testOutputState" (TestCase (do
+       (OutputState port power modes reg ratio _ limit count _ _) <- testNXT ref (do
+                setOutputStateConfirm A 75 [MotorOn,Brake] RegulationModeMotorSpeed 0 MotorRunStateRunning 360
+                getOutputState A
+                )
+       assertEqual "not A port" A port
+       assertEqual "not 75 power" 75 power
+       assertEqual "not modes" [MotorOn,Brake] modes
+       assertEqual "not regulation" RegulationModeMotorSpeed reg
+       assertEqual "not 0 ratio" 0 ratio
+       assertEqual "not 360 limit" 360 limit
+       assertBool "count>0" (count>0)
+       ))
+       
+testInputMode :: IORef NXTInternals -> Test
+testInputMode ref= TestLabel "testInputMode" (TestCase (do
+        InputValue port valid calibrated stype smode _ normV scalV _<-testNXT ref (do
+                setInputModeConfirm One Switch BooleanMode
+                getInputValues One
+                )
+        assertEqual "not port 1" One port
+        assertBool "not valid" valid
+        assertBool "calibrated" (not calibrated)
+        assertEqual "not switch" Switch stype
+        assertEqual "not boolean" BooleanMode smode
+        assertBool "normalized not in range" (normV>=0 && normV<1024)
+        assertEqual "scaled not 0" 0 scalV
+        ))