-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.Distance
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Measuring distance using a HC-SR04 sensor. (Data sheet: <http://www.micropik.com/PDF/HCSR04.pdf>.)
--
-- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the high
-- accuracy pulse-in command, which is needed for this sketch.  However, there is a patch to add this
-- command; see: <http://github.com/rwldrn/johnny-five/issues/18> for details on how to install it. You /should/
-- have this patched version of Firmata running on your board for this sketch to function properly.
--
-- Accuracy: Keep in mind that measurements on a platform like Arduino is always subject to
-- various errors. Relying on this program for precise distance measurements would be a mistake.
-- The results here should be accurate to within about half-a-centimeter, provided you stay
-- within the range of HC-SR04, which is between 2 to 400 cm. For anything more precise than
-- this, you'll need to use a much more sensitive sensor.
-------------------------------------------------------------------------------

module System.Hardware.Arduino.SamplePrograms.Distance where

import Control.Monad       (forever)
import Control.Monad.Trans (liftIO)
import Numeric             (showGFloat)

import System.Hardware.Arduino

-- | Sound travels 343.2 meters per second (<http://en.wikipedia.org/wiki/Speed_of_sound>).
-- The echo time is round-trip, from the sensor to the object and back. Thus, if echo is high
-- for @d@ microseconds, then the distance in centimeters is:
--
--    @
--        d * 10^-6 * 343.2 * 10^2 / 2
--      = 1.716e-2 * d
--    @
microSecondsToCentimeters :: Int -> Float
microSecondsToCentimeters :: Int -> Float
microSecondsToCentimeters Int
d = Float
1.716e-2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d

-- | Measure and display the distance continuously, as reported by an HC-SR04 sensor.
--
-- Wiring: Simply connect VCC and GND of HC-SR04 to Arduino as usual. The @Echo@ line on the sensor is connected
-- to Arduino pin 2. The @Trig@ line is connected on the board to the @Echo@ line, i.e., they both connect to the
-- same pin on the Arduino. We also have a led on pin 13 that we will light-up
-- if the distance detected is less than 5 centimeters, indicating an impending crash!
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Distance.png>>
distance :: IO ()
distance :: IO ()
distance = Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
             Pin -> PinMode -> Arduino ()
setPinMode Pin
sensor PinMode
INPUT
             Pin -> PinMode -> Arduino ()
setPinMode Pin
led    PinMode
OUTPUT
             forall {b}. Arduino b
update
 where sensor :: Pin
sensor = Word8 -> Pin
digital Word8
2
       led :: Pin
led    = Word8 -> Pin
digital Word8
13
       measure :: Arduino ()
measure = do Maybe Int
mbd <- Pin -> Bool -> Int -> Maybe Int -> Arduino (Maybe Int)
pulse Pin
sensor Bool
True Int
10 forall a. Maybe a
Nothing
                    case Maybe Int
mbd of
                      Maybe Int
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"Distance: No measurement received."
                      Just Int
d  -> do let c :: Float
c = Int -> Float
microSecondsToCentimeters Int
d
                                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Distance: " forall a. [a] -> [a] -> [a]
++ forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat (forall a. a -> Maybe a
Just Int
2) Float
c FilePath
" centimeters."
                                    Pin -> Bool -> Arduino ()
digitalWrite Pin
led (Float
c forall a. Ord a => a -> a -> Bool
< Float
5)
       update :: Arduino b
update = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do Arduino ()
measure
                             Int -> Arduino ()
delay Int
1000