-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.Firmata
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Implementation of the firmata protocol
-------------------------------------------------------------------------------

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module System.Hardware.Arduino.Firmata where

import Control.Concurrent  (newEmptyMVar, readMVar, withMVar, modifyMVar_, threadDelay)
import Control.Monad       (when, unless, void)
import Control.Monad.State (StateT(..), gets)
import Control.Monad.Trans (liftIO)
import Data.Bits           ((.&.), shiftR, setBit)
import Data.Maybe          (fromMaybe)
import Data.Time           (getCurrentTime, utctDayTime)
import System.Timeout      (timeout)
import Data.Word           (Word8)

import qualified Data.Map as M

import System.Hardware.Arduino.Data
import System.Hardware.Arduino.Comm

import qualified System.Hardware.Arduino.Utils as U

-- | Retrieve the Firmata firmware version running on the Arduino. The first
-- component is the major, second is the minor. The final value is a human
-- readable identifier for the particular board.
queryFirmware :: Arduino (Word8, Word8, String)
queryFirmware :: Arduino (Word8, Word8, String)
queryFirmware = do
        Request -> Arduino ()
send Request
QueryFirmware
        Response
r <- Arduino Response
recv
        case Response
r of
          Firmware Word8
v1 Word8
v2 String
m -> forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
v1, Word8
v2, String
m)
          Response
_                -> forall a. String -> [String] -> Arduino a
die String
"queryFirmware: Got unexpected response for query firmware call: " [forall a. Show a => a -> String
show Response
r]

-- | Delay the computaton for a given number of milli-seconds
delay :: Int -> Arduino ()
delay :: Int -> Arduino ()
delay = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
U.delay

-- | Time a given action, result is measured in micro-seconds.
time :: Arduino a -> Arduino (Int, a)
time :: forall a. Arduino a -> Arduino (Int, a)
time Arduino a
a = do Integer
start <- Arduino Integer
tick
            a
r     <- Arduino a
a
            Integer
end   <- a
r seq :: forall a b. a -> b -> b
`seq` Arduino Integer
tick
            forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int
toMicroSeconds (Integer
end forall a. Num a => a -> a -> a
- Integer
start), a
r)
 where -- tick gets the current time in picoseconds
       tick :: Arduino Integer
tick = do DiffTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
utctDayTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO UTCTime
getCurrentTime
                 let precision :: Integer
precision = Integer
1000000000000 :: Integer
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
precision forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ DiffTime
t
       toMicroSeconds :: Integer -> Int
       toMicroSeconds :: Integer -> Int
toMicroSeconds Integer
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
t forall a. Integral a => a -> a -> a
`quot` Integer
1000000

-- | Time-out a given action. Time-out amount is in micro-seconds.
timeOut :: Int -> Arduino a -> Arduino (Maybe a)
timeOut :: forall a. Int -> Arduino a -> Arduino (Maybe a)
timeOut Int
to (Arduino (StateT ArduinoState -> IO (a, ArduinoState)
f)) = forall a. StateT ArduinoState IO a -> Arduino a
Arduino (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\ArduinoState
st -> do
        Maybe (a, ArduinoState)
mbRes <- forall a. Int -> IO a -> IO (Maybe a)
timeout Int
to (ArduinoState -> IO (a, ArduinoState)
f ArduinoState
st)
        case Maybe (a, ArduinoState)
mbRes of
          Maybe (a, ArduinoState)
Nothing       -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, ArduinoState
st)
          Just (a
a, ArduinoState
st') -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a,  ArduinoState
st')))

-- | Set the mode on a particular pin on the board
setPinMode :: Pin -> PinMode -> Arduino ()
setPinMode :: Pin -> PinMode -> Arduino ()
setPinMode Pin
p' PinMode
m = do
   IPin
p <- Pin -> Arduino IPin
getInternalPin Pin
p'
   [Request]
extras <- IPin -> PinMode -> Arduino [Request]
registerPinMode IPin
p PinMode
m
   Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ IPin -> PinMode -> Request
SetPinMode IPin
p PinMode
m
   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Request -> Arduino ()
send [Request]
extras

-- | Set or clear a digital pin on the board
digitalWrite :: Pin -> Bool -> Arduino ()
digitalWrite :: Pin -> Bool -> Arduino ()
digitalWrite Pin
p' Bool
v = do
   (IPin
p, PinData
pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"digitalWrite" Pin
p' PinMode
OUTPUT
   case PinData -> Maybe (Either Bool Int)
pinValue PinData
pd of
     Just (Left Bool
b) | Bool
b forall a. Eq a => a -> a -> Bool
== Bool
v -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- no change, nothing to do
     Maybe (Either Bool Int)
_                      -> do (Word8
lsb, Word8
msb) <- IPin -> Bool -> Arduino (Word8, Word8)
computePortData IPin
p Bool
v
                                  Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ Port -> Word8 -> Word8 -> Request
DigitalPortWrite (IPin -> Port
pinPort IPin
p) Word8
lsb Word8
msb

-- | Turn on/off internal pull-up resistor on an input pin
pullUpResistor :: Pin -> Bool -> Arduino ()
pullUpResistor :: Pin -> Bool -> Arduino ()
pullUpResistor Pin
p' Bool
v = do
   (IPin
p, PinData
_) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"pullUpResistor" Pin
p' PinMode
INPUT
   (Word8
lsb, Word8
msb) <- IPin -> Bool -> Arduino (Word8, Word8)
computePortData IPin
p Bool
v
   Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ Port -> Word8 -> Word8 -> Request
DigitalPortWrite (IPin -> Port
pinPort IPin
p) Word8
lsb Word8
msb

-- | Read the value of a pin in digital mode; this is a non-blocking call, returning
-- the current value immediately. See 'waitFor' for a version that waits for a change
-- in the pin first.
digitalRead :: Pin -> Arduino Bool
digitalRead :: Pin -> Arduino Bool
digitalRead Pin
p' = do
   (IPin
_, PinData
pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"digitalRead" Pin
p' PinMode
INPUT
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case PinData -> Maybe (Either Bool Int)
pinValue PinData
pd of
              Just (Left Bool
v) -> Bool
v
              Maybe (Either Bool Int)
_             -> Bool
False -- no (correctly-typed) value reported yet, default to False

-- | Wait for a change in the value of the digital input pin. Returns the new value.
-- Note that this is a blocking call. For a non-blocking version, see 'digitalRead', which returns the current
-- value of a pin immediately.
waitFor :: Pin -> Arduino Bool
waitFor :: Pin -> Arduino Bool
waitFor Pin
p = forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Pin] -> Arduino [Bool]
waitAny [Pin
p]

-- | Wait for a change in any of the given pins. Once a change is detected, all the new values are
-- returned. Similar to 'waitFor', but is useful when we are watching multiple digital inputs.
waitAny :: [Pin] -> Arduino [Bool]
waitAny :: [Pin] -> Arduino [Bool]
waitAny [Pin]
ps = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Pin] -> Arduino [(Bool, Bool)]
waitGeneric [Pin]
ps

-- | Wait for any of the given pins to go from low to high. If all of the pins are high to start
-- with, then we first wait for one of them to go low, and then wait for one of them to go back high.
-- Returns the new values.
waitAnyHigh :: [Pin] -> Arduino [Bool]
waitAnyHigh :: [Pin] -> Arduino [Bool]
waitAnyHigh [Pin]
ps = do
   [Bool]
curVals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
curVals) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Pin] -> Arduino [Bool]
waitAnyLow [Pin]
ps   -- all are H to start with, wait for at least one to go low
   [(Bool, Bool)]
vs <- [Pin] -> Arduino [(Bool, Bool)]
waitGeneric [Pin]
ps  -- wait for some change
   if (Bool
False, Bool
True) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Bool, Bool)]
vs
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, Bool)]
vs
      else [Pin] -> Arduino [Bool]
waitAnyHigh [Pin]
ps

-- | Wait for any of the given pins to go from high to low. If all of the pins are low to start
-- with, then we first wait for one of them to go high, and then wait for one of them to go back low.
-- Returns the new values.
waitAnyLow :: [Pin] -> Arduino [Bool]
waitAnyLow :: [Pin] -> Arduino [Bool]
waitAnyLow [Pin]
ps = do
   [Bool]
curVals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
curVals) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Pin] -> Arduino [Bool]
waitAnyHigh [Pin]
ps   -- all are L to start with, wait for at least one to go high
   [(Bool, Bool)]
vs <- [Pin] -> Arduino [(Bool, Bool)]
waitGeneric [Pin]
ps  -- wait for some change
   if (Bool
True, Bool
False) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Bool, Bool)]
vs
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, Bool)]
vs
      else [Pin] -> Arduino [Bool]
waitAnyLow [Pin]
ps

-- | A utility function, waits for any change on any given pin
-- and returns both old and new values. It's guaranteed that
-- at least one returned pair have differing values.
waitGeneric :: [Pin] -> Arduino [(Bool, Bool)]
waitGeneric :: [Pin] -> Arduino [(Bool, Bool)]
waitGeneric [Pin]
ps = do
   [Bool]
curVals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
   MVar ()
semaphore <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
   let wait :: Arduino [(Bool, Bool)]
wait = do MVar () -> Arduino ()
digitalWakeUp MVar ()
semaphore
                 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar ()
semaphore
                 [Bool]
newVals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
                 if [Bool]
curVals forall a. Eq a => a -> a -> Bool
== [Bool]
newVals
                    then Arduino [(Bool, Bool)]
wait
                    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
curVals [Bool]
newVals
   Arduino [(Bool, Bool)]
wait

-- | Send down a pulse, and measure how long the pin reports a corresponding pulse, with a potential time-out. The call @pulse p v duration mbTimeOut@
-- does the following:
--
--   * Set the pin to value @v@ for @duration@ microseconds.
--
--   * Waits 2 microseconds
--
--   * Waits until pin @p@ has value @not v@.
--
--   * Returns, in micro-seconds, the duration the pin stayed @v@, counting from the 2 microsecond wait.
--
-- Time-out parameter is used as follows:
--
--    * If @mbTimeOut@ is @Nothing@, then 'pulse' will wait until the pin attains the value required and so long as it holds it.
--    Note that very-long time-out values are unlikely to be accurate.
-- 
--    * If @mbTimeOut@ is @Just t@ then, 'pulse' will stop if the above procedure does not complete within the given micro-seconds.
--    In this case, the overall return value is @Nothing@.
--
-- NB. Both the time-out value and the return value are given in micro-seconds.
--
-- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the Pulse-In command.
-- However, there is a patch to add this command; see: <http://github.com/rwldrn/johnny-five/issues/18> for details.
-- If you want to use hArduino's @pulseIn@ command, then you /have/ to install the above patch. Also see the function
-- @pulseIn_hostOnly@, which works with the distributed StandardFirmata: It implements a version that is not as
-- accurate in its timing, but might be sufficient if high precision is not required.
pulse :: Pin -> Bool -> Int -> Maybe Int -> Arduino (Maybe Int)
pulse :: Pin -> Bool -> Int -> Maybe Int -> Arduino (Maybe Int)
pulse Pin
p' Bool
v Int
duration Maybe Int
mbTo = do
        (IPin
p, PinData
_) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"pulse" Pin
p' PinMode
INPUT
        let to :: Int
to = forall a. a -> Maybe a -> a
fromMaybe Int
maxAllowed Maybe Int
mbTo
            maxAllowed :: Int
maxAllowed = Int
2147483647  -- works out to about 36 minutes; which is way beyond the accuracy provided by Arduino
            bad :: Int -> Bool
bad Int
x = Int
x forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x forall a. Ord a => a -> a -> Bool
> Int
maxAllowed
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Int -> Bool
bad [Int
duration, Int
to]) forall a b. (a -> b) -> a -> b
$ forall a. String -> [String] -> Arduino a
die (String
"Invalid duration/time-out values for pulse on pin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p)
                                            [ String
"Values should be between 0 and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
maxAllowed
                                            , String
"Received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
duration, Int
to)
                                            ]
        Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ IPin -> Bool -> Word32 -> Word32 -> Request
Pulse IPin
p Bool
v (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
duration) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
to)
        Response
r <- Arduino Response
recv
        case Response
r of
          PulseResponse IPin
pOut Word32
d | IPin
p forall a. Eq a => a -> a -> Bool
== IPin
pOut -> case Word32
d of
                                                Word32
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return  forall a. Maybe a
Nothing
                                                Word32
i -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i))
          Response
_                                -> forall a. String -> [String] -> Arduino a
die (String
"pulseIn: Got unexpected response for Pulse call on pin: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Pin
p') [forall a. Show a => a -> String
show Response
r]

-- | A /hostOnly/ version of pulse-out on a digital-pin. Use this function only for cases where the
-- precision required only matters for the host, not for the board. That is, due to the inherent
-- delays involved in Firmata communication, the timing will /not/ be accurate, and should not
-- be expected to work uniformly over different boards. Similar comments apply for 'pulseIn_hostTiming'
-- as well. See the function 'pulse' for a more accurate version.
pulseOut_hostTiming :: Pin  -- ^ Pin to send the pulse on
                  -> Bool -- ^ Pulse value
                  -> Int  -- ^ Time, in microseconds, to signal beginning of pulse; will send the opposite value for this amount
                  -> Int  -- ^ Pulse duration, measured in microseconds
                  -> Arduino ()
pulseOut_hostTiming :: Pin -> Bool -> Int -> Int -> Arduino ()
pulseOut_hostTiming Pin
p' Bool
pulseValue Int
dBefore Int
dAfter
  | Int
dBefore forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dAfter forall a. Ord a => a -> a -> Bool
< Int
0
  = forall a. String -> [String] -> Arduino a
die (String
"pulseOut: Invalid delay amounts: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
dBefore, Int
dAfter)) 
        [ String
"Pre-delay and pulse-amounts must be non-negative."]
  | Bool
True
  = do (IPin
p, PinData
pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"pulseOut_hostTiming" Pin
p' PinMode
OUTPUT
       let curPort :: Port
curPort  = IPin -> Port
pinPort IPin
p
           curIndex :: Word8
curIndex = IPin -> Word8
pinPortIndex IPin
p
       MVar BoardState
bs  <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
       ((Word8, Word8)
setMask, (Word8, Word8)
resetMask) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
           let values :: [(Word8, Maybe (Either Bool Int))]
values = [(IPin -> Word8
pinPortIndex IPin
sp, PinData -> Maybe (Either Bool Int)
pinValue PinData
spd) | (IPin
sp, PinData
spd) <- forall k a. Map k a -> [(k, a)]
M.assocs (BoardState -> Map IPin PinData
pinStates BoardState
bst), Port
curPort forall a. Eq a => a -> a -> Bool
== IPin -> Port
pinPort IPin
sp, PinData -> PinMode
pinMode PinData
pd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PinMode
INPUT, PinMode
OUTPUT]]
               getVal :: Bool -> Word8 -> Bool
getVal Bool
nv Word8
i
                | Word8
i forall a. Eq a => a -> a -> Bool
== Word8
curIndex                              = Bool
nv
                | Just (Just (Left Bool
ov)) <- Word8
i forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Word8, Maybe (Either Bool Int))]
values = Bool
ov
                | Bool
True                                       = Bool
False
               mkMask :: Bool -> (a, b)
mkMask Bool
val = let [Bool
b0, Bool
b1, Bool
b2, Bool
b3, Bool
b4, Bool
b5, Bool
b6, Bool
b7] = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Word8 -> Bool
getVal Bool
val) [Word8
0 .. Word8
7]
                                lsb :: a
lsb = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, Bool
b) a
m -> if Bool
b then a
m forall a. Bits a => a -> Int -> a
`setBit` Int
i     else a
m) a
0 (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Bool
b0, Bool
b1, Bool
b2, Bool
b3, Bool
b4, Bool
b5, Bool
b6])
                                msb :: b
msb = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, Bool
b) b
m -> if Bool
b then b
m forall a. Bits a => a -> Int -> a
`setBit` (Int
iforall a. Num a => a -> a -> a
-Int
7) else b
m) b
0 (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
7..] [Bool
b7])
                            in (a
lsb, b
msb)
           forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a} {b}. (Bits a, Num a, Bits b, Num b) => Bool -> (a, b)
mkMask Bool
pulseValue, forall {a} {b}. (Bits a, Num a, Bits b, Num b) => Bool -> (a, b)
mkMask (Bool -> Bool
not Bool
pulseValue))
       let writeThrough :: (Word8, Word8) -> Arduino ()
writeThrough (Word8
lsb, Word8
msb) = Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ Port -> Word8 -> Word8 -> Request
DigitalPortWrite Port
curPort Word8
lsb Word8
msb
       -- make sure masks are pre computed, and clear the line
       forall a b. (a, b) -> a
fst (Word8, Word8)
setMask seq :: forall a b. a -> b -> b
`seq` forall a b. (a, b) -> b
snd (Word8, Word8)
setMask seq :: forall a b. a -> b -> b
`seq` forall a b. (a, b) -> a
fst (Word8, Word8)
resetMask seq :: forall a b. a -> b -> b
`seq` forall a b. (a, b) -> b
snd (Word8, Word8)
resetMask seq :: forall a b. a -> b -> b
`seq` (Word8, Word8) -> Arduino ()
writeThrough (Word8, Word8)
resetMask
       -- Wait before starting the pulse
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
dBefore
       -- Send the pulse
       (Word8, Word8) -> Arduino ()
writeThrough (Word8, Word8)
setMask
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
dAfter
       -- Finish the pulse
       (Word8, Word8) -> Arduino ()
writeThrough (Word8, Word8)
resetMask
       -- Do a final internal update to reflect the final value of the line
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> forall (m :: * -> *) a. Monad m => a -> m a
return BoardState
bst{pinStates :: Map IPin PinData
pinStates = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert IPin
p PinData{pinMode :: PinMode
pinMode = PinMode
OUTPUT, pinValue :: Maybe (Either Bool Int)
pinValue = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (Bool -> Bool
not Bool
pulseValue))}(BoardState -> Map IPin PinData
pinStates BoardState
bst)}
{-# ANN pulseOut_hostTiming "HLint: ignore Use camelCase" #-}

-- | A /hostOnly/ version of pulse-in on a digital-pin. Use this function only for cases where the
-- precision required only matters for the host, not for the board. That is, due to the inherent
-- delays involved in Firmata communication, the timing will /not/ be accurate, and should not
-- be expected to work uniformly over different boards. Similar comments apply for 'pulseOut_hostTiming'
-- as well. See the function 'pulse' for a more accurate version.
pulseIn_hostTiming :: Pin -> Bool -> Maybe Int -> Arduino (Maybe Int)
pulseIn_hostTiming :: Pin -> Bool -> Maybe Int -> Arduino (Maybe Int)
pulseIn_hostTiming Pin
p Bool
v Maybe Int
mbTo = case Maybe Int
mbTo of
                    Maybe Int
Nothing -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Arduino Int
measure
                    Just Int
to -> forall a. Int -> Arduino a -> Arduino (Maybe a)
timeOut Int
to Arduino Int
measure
  where waitTill :: (Bool -> Bool) -> Arduino ()
waitTill Bool -> Bool
f = do Bool
curVal <- Pin -> Arduino Bool
digitalRead Pin
p
                        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
f Bool
curVal) forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Arduino ()
waitTill Bool -> Bool
f
        measure :: Arduino Int
measure = do (Bool -> Bool) -> Arduino ()
waitTill (forall a. Eq a => a -> a -> Bool
== Bool
v)                  -- wait until pulse starts
                     (Int
t, ()
_) <- forall a. Arduino a -> Arduino (Int, a)
time forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Arduino ()
waitTill (forall a. Eq a => a -> a -> Bool
/= Bool
v) -- wait till pulse ends, measuring the time
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t
{-# ANN pulseIn_hostTiming "HLint: ignore Use camelCase" #-}

-- | Read the value of a pin in analog mode; this is a non-blocking call, immediately
-- returning the last sampled value. It returns @0@ if the voltage on the pin
-- is 0V, and @1023@ if it is 5V, properly scaled. (See `setAnalogSamplingInterval` for
-- sampling frequency.)
analogRead :: Pin -> Arduino Int
analogRead :: Pin -> Arduino Int
analogRead Pin
p' = do
   (IPin
_, PinData
pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"analogRead" Pin
p' PinMode
ANALOG
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case PinData -> Maybe (Either Bool Int)
pinValue PinData
pd of
              Just (Right Int
v) -> Int
v
              Maybe (Either Bool Int)
_              -> Int
0 -- no (correctly-typed) value reported yet, default to 0

-- | Write a PWM analog value to a pin. The argument is an 'Int', indicating the duty cycle.
-- @0@ means off; @255@ means always on. Intermediate values will create a square wave
-- on that pin with the given duty-cycle
analogWrite :: Pin -> Int -> Arduino ()
analogWrite :: Pin -> Int -> Arduino ()
analogWrite Pin
p' Int
dc = do
   (IPin
p, PinData
_) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"analogWrite" Pin
p' PinMode
PWM
   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
dc forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dc forall a. Ord a => a -> a -> Bool
> Int
255) forall a b. (a -> b) -> a -> b
$ forall a. String -> [String] -> Arduino a
die (String
"Invalid duty-cycle value for PWM write on pin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p)
                                   [ String
"Values should be between 0 and 255"
                                   , String
"Received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
dc
                                   ]
   Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ IPin -> Word8 -> Word8 -> Request
AnalogPinWrite IPin
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lsb) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msb)
  where lsb :: Int
lsb = Int
dc forall a. Bits a => a -> a -> a
.&. Int
0x7f
        msb :: Int
msb = (Int
dc forall a. Bits a => a -> Int -> a
`shiftR` Int
7) forall a. Bits a => a -> a -> a
.&. Int
0x7f

-- | Set the analog sampling interval, in milliseconds. Arduino uses a default of 19ms to sample analog and I2C
-- signals, which is fine for many applications, but can be modified if needed. The argument
-- should be a number between @10@ and @16384@; @10@ being the minumum sampling interval supported by Arduino
-- and @16383@ being the largest value we can represent in 14 bits that this message can handle. (Note that
-- the largest value is just about @16@ seconds, which is plenty infrequent for all practical needs.)
setAnalogSamplingInterval :: Int -> Arduino ()
setAnalogSamplingInterval :: Int -> Arduino ()
setAnalogSamplingInterval Int
i
  | Int
i forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
|| Int
i forall a. Ord a => a -> a -> Bool
> Int
16383
  = forall a. String -> [String] -> Arduino a
die (String
"hArduino: setAnalogSamplingInterval: Allowed interval is [10, 16383] ms, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i) []
  | Bool
True
  = Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Request
SamplingInterval (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lsb) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msb)
  where lsb :: Int
lsb = Int
i forall a. Bits a => a -> a -> a
.&. Int
0x7f
        msb :: Int
msb = (Int
i forall a. Bits a => a -> Int -> a
`shiftR` Int
7) forall a. Bits a => a -> a -> a
.&. Int
0x7f