Commits

jpmoresmau committed b075824 Merge

merge mitar changes

Comments (0)

Files changed (6)

                        mtl >= 1.1 && < 3,
                        bytestring >= 0.9 && < 1,
                        time >= 1.1 && < 2,
-                       serialport >= 0.4 && < 1
+                       serialport >= 0.4.3 && < 1
   Other-modules:       Robotics.NXT.Data,
                        Robotics.NXT.Errors,
                        Robotics.NXT.Protocol,

lib/Robotics/NXT/BluetoothUtils.hs

 
 import Control.Exception
 import Control.Monad.State
+#ifdef linux_HOST_OS
 import Foreign.C.String
 import Foreign.C.Types
+#endif
 
 import Robotics.NXT.Errors
 import Robotics.NXT.Protocol
 
 -- Foreign function call for C function which returns link quality Bluetooth value of a connection to a given Bluetooth address
 foreign import ccall unsafe "lq" lq :: CString -> IO CInt
-#endif
 
 -- As defined in blue.h
 blueError :: Int
 blueError = 1000
 blueNotConnected :: Int
 blueNotConnected = 1001
+#endif
 
 {-|
 Gets received signal strength indicator (RSSI) of the Bluetooth connection to the NXT brick.
   bluetoothRSSIAddr addr
 
 bluetoothRSSIAddr :: BTAddress -> NXT Int
+#ifdef linux_HOST_OS
 bluetoothRSSIAddr addr = do
-#ifdef linux_HOST_OS
   ret <- liftIO $ withCString addr rssi
   let ret' = fromIntegral ret
   case ret' of
       | ret' == blueNotConnected -> liftIO $ throwIO $ NXTException "Connection not established"
       | otherwise                -> return ret'
 #else
+bluetoothRSSIAddr _ = do
     liftIO $ throwIO $ NXTException "Not supported on this system"
 #endif
 
   bluetoothLinkQualityAddr addr
 
 bluetoothLinkQualityAddr :: BTAddress -> NXT Int
+#ifdef linux_HOST_OS
 bluetoothLinkQualityAddr addr = do
-#ifdef linux_HOST_OS
   ret <- liftIO $ withCString addr lq
   let ret' = fromIntegral ret
   case ret' of
       | ret' == blueNotConnected -> liftIO $ throwIO $ NXTException "Connection not established"
       | otherwise                -> return ret'
 #else
+bluetoothLinkQualityAddr _ = do
   liftIO $ throwIO $ NXTException "Not supported on this system"
 #endif
 

lib/Robotics/NXT/Protocol.hs

   execNXT
 ) where
 
+import qualified Data.ByteString as B
 import Control.Exception
 import Control.Monad.State
 import Data.Bits
 import Data.Time.Clock.POSIX
 import Data.Word
 import System.IO
-import System.Hardware.Serialport hiding (One)
+import qualified System.Hardware.Serialport as S
 #if (!defined(mingw32_HOST_OS) && !defined(windows_HOST_OS))
 import System.Posix.Signals
 #endif
   let signals = foldl (flip addSignal) emptySignalSet [virtualTimerExpired]
   blockSignals signals
 #endif
-  h <- openSerial device defaultSerialSettings { commSpeed = CS115200, timeout = 1000 }
+  h <- S.openSerial device S.defaultSerialSettings { S.commSpeed = S.CS115200, S.timeout = 1000 }
 #if (!defined(mingw32_HOST_OS) && !defined(windows_HOST_OS))
   unblockSignals signals
 #endif
 terminate i = do
   i' <- execNXT stopEverything i
   let h = nxthandle i'
-  closeSerial h
+  S.closeSerial h
   when debug $ hPutStrLn stderr "terminated"
 
 {-|
   h <- getsNXT nxthandle
   let len = toUWord . length $ message
       packet = len ++ message
-  liftIO $ sendString h $ map (toEnum . fromEnum) packet
+  n <- liftIO . S.send h . B.pack $ packet
+  when (n /= length packet) $ liftIO $ failNXT' "not all data has been send"
   when debug $ liftIO . hPutStrLn stderr $ "sent: " ++ show packet
 
 -- Main function for receiving data from NXT
 receiveData :: NXT [Word8]
 receiveData = do
   h <- getsNXT nxthandle
-  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
+  len <- liftIO $ S.recv h 2
+  let len' = fromUWord . B.unpack $ len
+  packet <- liftIO $ S.recv h len'
+  let unpacket = B.unpack packet
+  when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show unpacket
+  return unpacket
 
 {-|
 Gets firmware and protocol versions of the NXT brick.
   when debug $ liftIO . hPutStrLn stderr $ "keepalive"
   current <- liftIO getPOSIXTime
   modifyNXT (\s -> s { lastkeepalive = Just current })
-  let send = [0x00, 0x0D]
+  let send = [request confirm, 0x0D]
   sendData send
   if confirm
     then do

src/UploadFiles.hs

             h' <- openWrite filename (fromIntegral size)
             mapM_ (write h') $ chunk 61 content
             close h'
+            liftIO $ putStrLn "Done."
           chunk _ [] = [[]]
           chunk n xs = y1 : chunk n y2
             where (y1, y2) = splitAt n xs
 
   let Device device = fromMaybe (Device defaultDevice) . find isDevice $ opts
 
-  putStrLn "Please connect a motor to port A, a swich sensor to port 1, an ultrasonic sensor to port 2, and press enter key to continue."
+  putStrLn "Please connect a motor to port A, a switch sensor to port 1, an ultrasonic sensor to port 2, and press enter key to continue."
 
   _ <- try getLine :: IO (Either IOException String)
 

tests/Robotics/NXT/Basic.hs

 testDeviceInfo :: IORef NXTInternals -> Test
 testDeviceInfo ref = TestLabel "testDeviceInfo" $ TestCase $ do
   (DeviceInfo name address _ _) <- testNXT ref getDeviceInfo
-  assertBool "empty name" (not $ null name)
+  assertBool "name" (not . null $ name)
   putStrLn $ "NXT Name: " ++ name
-  assertBool "empty address" (not $ null address)
+  assertBool "address" (not . null $ address)
   putStrLn $ "NXT Address: " ++ address
 
 remoteProgramFilename :: String
     liftIO $ assertBool "not successful waitfor" successful
     OutputState outputPort outputPower outputMode regulationMode turnRatio runState tachoLimit tachoCount _ _ <- getOutputState A
     liftIO $ do
-      assertEqual "not A outputPort" A outputPort
-      assertEqual "not 0 outputPower" 0 outputPower
-      assertEqual "not outputMode" [MotorOn, Brake] outputMode
-      assertEqual "not regulationMode" RegulationModeIdle regulationMode
-      assertEqual "not 0 turnRatio" 0 turnRatio
-      assertEqual "not runState" MotorRunStateRunning runState
-      assertEqual "not 0 tachoLimit" 0 tachoLimit
-      assertBool "not tachoCount ~ 1000" (tachoCount > 900 && tachoCount < 1100)
+      assertEqual "outputPort" A outputPort
+      assertEqual "outputPower" 0 outputPower
+      assertEqual "outputMode" [MotorOn, Brake] outputMode
+      assertEqual "regulationMode" RegulationModeIdle regulationMode
+      assertEqual "turnRatio" 0 turnRatio
+      assertEqual "runState" MotorRunStateRunning runState
+      assertEqual "tachoLimit" 0 tachoLimit
+      assertBool ("tachoCount !~ 1000: " ++ show tachoCount) (tachoCount > 700 && tachoCount < 1300)
 
 testInputMode :: IORef NXTInternals -> Test
 testInputMode ref = TestLabel "testInputMode" $ TestCase $ do
   InputValue inputPort valid _ sensorType sensorMode _ normalizedADValue scaledValue _ <- testNXT ref $ do
     setInputModeConfirm One Switch BooleanMode
     getInputValues One
-  assertEqual "not 1 inputPort" One inputPort
+  assertEqual "inputPort" One inputPort
   assertBool "not valid" valid
-  assertEqual "not sensorType" Switch sensorType
-  assertEqual "not sensorMode" BooleanMode sensorMode
-  assertBool "not in range normalizedADValue" (normalizedADValue >= 0 && normalizedADValue <= 1023)
-  assertEqual "not 0 scaledValue" 0 scaledValue
+  assertEqual "sensorType" Switch sensorType
+  assertEqual "sensorMode" BooleanMode sensorMode
+  assertBool ("normalizedADValue not in range [0, 1023]: " ++ show normalizedADValue) (normalizedADValue >= 0 && normalizedADValue <= 1023)
+  assertEqual "scaledValue" 0 scaledValue
 
 testUltrasonicSensor :: IORef NXTInternals -> Test
 testUltrasonicSensor ref = TestLabel "testUltrasonicSensor" $ TestCase $ do
   measurement <- testNXT ref $ do
     usInit Two
     version <- usGetVersion Two
-    liftIO $ assertEqual "not V1.0 version" "V1.0" version
+    liftIO $ assertEqual "version" "V1.0" version
     vendor <- usGetVendorID Two
-    liftIO $ assertEqual "not LEGO vendor" "LEGO" vendor
+    liftIO $ assertEqual "vendor" "LEGO" vendor
     device <- usGetDeviceID Two
-    liftIO $ assertEqual "not Sonar device" "Sonar" device
+    liftIO $ assertEqual "device" "Sonar" device
     units <- usGetMeasurementUnits Two
-    liftIO $ assertEqual "not 10E-2m units" "10E-2m" units
+    liftIO $ assertEqual "units" "10E-2m" units
+    usSetMode Two ContinuousMeasurement
+    mode <- usGetMode Two
+    liftIO $ assertEqual "mode" ContinuousMeasurement mode
     usSetMode Two SingleShot
-    mode <- usGetMode Two
-    liftIO $ assertEqual "not mode" SingleShot mode
-    usGetMeasurement Two 0
+    measurement <- usGetMeasurement Two 0
+    usSetMode Two Off
+    mode' <- usGetMode Two
+    liftIO $ assertEqual "mode" Off mode'
+    return measurement
   putStrLn $ "Ultrasonic sensor measurement: " ++ (show measurement)
-