-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.Pulse
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Demonstrates 'pulseIn_hostTiming' and 'pulseOut_hostTiming' functions, sending
-- and receiving pulses to/from the board.
-------------------------------------------------------------------------------

module System.Hardware.Arduino.SamplePrograms.Pulse where

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

import System.Hardware.Arduino

-------------------------------------------------------------------------------
-- * Detecting pulses
-------------------------------------------------------------------------------

-- | Computes the amount of time a push-button is connected to
-- input pin 2 on the Arduino. We will wait for at most 5 seconds,
-- as a further demonstration of the time-out facility. Note that the
-- timing is done on the host side, so this measurement is inherently
-- inaccurate.
--
-- The wiring is straightforward: Simply put a push-button between
-- digital input 2 and +5V, guarded by a 10K resistor:
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/PulseIn.png>>
pulseInDemo :: IO ()
pulseInDemo :: IO ()
pulseInDemo = Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
               Pin -> PinMode -> Arduino ()
setPinMode Pin
pb PinMode
INPUT
               forall {b}. Arduino b
go
 where pb :: Pin
pb = Word8 -> Pin
digital Word8
2
       go :: Arduino b
go = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr FilePath
"Ready, push-and-hold for less than 5 seconds: "
              Maybe Int
mbDur <- Pin -> Bool -> Maybe Int -> Arduino (Maybe Int)
pulseIn_hostTiming Pin
pb Bool
True (forall a. a -> Maybe a
Just Int
5000000)
              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
$ case Maybe Int
mbDur of
                Maybe Int
Nothing -> FilePath
"Time out!"
                Just Int
d  -> FilePath
"Button stayed high for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
d forall a. [a] -> [a] -> [a]
++ FilePath
" micro-seconds"

-------------------------------------------------------------------------------
-- * Sending pulses
-------------------------------------------------------------------------------

-- | Send pulses on a led as requested by the user. Note that the timing is computed
-- on the host side, thus the duration of the pulse is subject to some error due to
-- the Firmata communication overhead.
--
-- Wiring: Simply a led on pin 13:
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Blink.png>>
pulseOutDemo :: IO ()
pulseOutDemo :: IO ()
pulseOutDemo = Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
              Pin -> PinMode -> Arduino ()
setPinMode Pin
led  PinMode
OUTPUT
              Pin -> Bool -> Arduino ()
digitalWrite Pin
led Bool
False
              forall (f :: * -> *) a b. Applicative f => f a -> f b
forever Arduino ()
trigger
 where led :: Pin
led  = Word8 -> Pin
digital Word8
13
       trigger :: Arduino ()
trigger = do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr FilePath
"Pulse duration? (microseconds) "
                    FilePath
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getLine
                    case forall a. Read a => ReadS a
reads FilePath
d of
                     [(Int
v, FilePath
"")] -> Pin -> Bool -> Int -> Int -> Arduino ()
pulseOut_hostTiming Pin
led Bool
True Int
0 Int
v
                     [(Int, FilePath)]
_         -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"Please enter a number."