-------------------------------------------------------------------------------
-- |
-- 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
        r <- Arduino Response
recv
        case r of
          Firmware Word8
v1 Word8
v2 String
m -> (Word8, Word8, String) -> Arduino (Word8, Word8, String)
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
v1, Word8
v2, String
m)
          Response
_                -> String -> [String] -> Arduino (Word8, Word8, String)
forall a. String -> [String] -> Arduino a
die String
"queryFirmware: Got unexpected response for query firmware call: " [Response -> String
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 = IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Arduino ()) -> (Int -> IO ()) -> Int -> Arduino ()
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 start <- Arduino Integer
tick
            r     <- a
            end   <- r `seq` tick
            return (toMicroSeconds (end - start), r)
 where -- tick gets the current time in picoseconds
       tick :: Arduino Integer
tick = do t <- IO DiffTime -> Arduino DiffTime
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DiffTime -> Arduino DiffTime)
-> IO DiffTime -> Arduino DiffTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
utctDayTime (UTCTime -> DiffTime) -> IO UTCTime -> IO DiffTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO UTCTime
getCurrentTime
                 let precision = Integer
1000000000000 :: Integer
                 return . round . (fromIntegral precision *) . toRational $ t
       toMicroSeconds :: Integer -> Int
       toMicroSeconds :: Integer -> Int
toMicroSeconds Integer
t = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
t Integer -> Integer -> Integer
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)) = StateT ArduinoState IO (Maybe a) -> Arduino (Maybe a)
forall a. StateT ArduinoState IO a -> Arduino a
Arduino ((ArduinoState -> IO (Maybe a, ArduinoState))
-> StateT ArduinoState IO (Maybe a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\ArduinoState
st -> do
        mbRes <- Int -> IO (a, ArduinoState) -> IO (Maybe (a, ArduinoState))
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
to (ArduinoState -> IO (a, ArduinoState)
f ArduinoState
st)
        case mbRes of
          Maybe (a, ArduinoState)
Nothing       -> (Maybe a, ArduinoState) -> IO (Maybe a, ArduinoState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, ArduinoState
st)
          Just (a
a, ArduinoState
st') -> (Maybe a, ArduinoState) -> IO (Maybe a, ArduinoState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
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
   p <- Pin -> Arduino IPin
getInternalPin Pin
p'
   extras <- registerPinMode p m
   send $ SetPinMode p m
   mapM_ send extras

-- | Set or clear a digital pin on the board
digitalWrite :: Pin -> Bool -> Arduino ()
digitalWrite :: Pin -> Bool -> Arduino ()
digitalWrite Pin
p' Bool
v = do
   (p, pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"digitalWrite" Pin
p' PinMode
OUTPUT
   case pinValue pd of
     Just (Left Bool
b) | Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
v -> () -> Arduino ()
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no change, nothing to do
     Maybe (Either Bool Int)
_                      -> do (lsb, msb) <- IPin -> Bool -> Arduino (Word8, Word8)
computePortData IPin
p Bool
v
                                  send $ DigitalPortWrite (pinPort p) lsb 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
   (p, _) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"pullUpResistor" Pin
p' PinMode
INPUT
   (lsb, msb) <- computePortData p v
   send $ DigitalPortWrite (pinPort p) lsb 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
   (_, pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"digitalRead" Pin
p' PinMode
INPUT
   return $ case pinValue 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 = [Bool] -> Bool
forall a. HasCallStack => [a] -> a
head ([Bool] -> Bool) -> Arduino [Bool] -> Arduino Bool
forall a b. (a -> b) -> Arduino a -> Arduino b
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 = ((Bool, Bool) -> Bool) -> [(Bool, Bool)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(Bool, Bool)] -> [Bool])
-> Arduino [(Bool, Bool)] -> Arduino [Bool]
forall a b. (a -> b) -> Arduino a -> Arduino b
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
   curVals <- (Pin -> Arduino Bool) -> [Pin] -> Arduino [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
   when (and curVals) $ void $ waitAnyLow ps   -- all are H to start with, wait for at least one to go low
   vs <- waitGeneric ps  -- wait for some change
   if (False, True) `elem` vs
      then return $ map snd vs
      else waitAnyHigh 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
   curVals <- (Pin -> Arduino Bool) -> [Pin] -> Arduino [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
   unless (or curVals) $ void $ waitAnyHigh ps   -- all are L to start with, wait for at least one to go high
   vs <- waitGeneric ps  -- wait for some change
   if (True, False) `elem` vs
      then return $ map snd vs
      else waitAnyLow 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
   curVals <- (Pin -> Arduino Bool) -> [Pin] -> Arduino [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
   semaphore <- liftIO newEmptyMVar
   let wait = do MVar () -> Arduino ()
digitalWakeUp MVar ()
semaphore
                 IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Arduino ()) -> IO () -> Arduino ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
readMVar MVar ()
semaphore
                 newVals <- (Pin -> Arduino Bool) -> [Pin] -> Arduino [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pin -> Arduino Bool
digitalRead [Pin]
ps
                 if curVals == newVals
                    then wait
                    else return $ zip curVals newVals
   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
        (p, _) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"pulse" Pin
p' PinMode
INPUT
        let to = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
maxAllowed Maybe Int
mbTo
            maxAllowed = Int
2147483647  -- works out to about 36 minutes; which is way beyond the accuracy provided by Arduino
            bad Int
x = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxAllowed
        when (any bad [duration, to]) $ die ("Invalid duration/time-out values for pulse on pin " ++ show p)
                                            [ "Values should be between 0 and " ++ show maxAllowed
                                            , "Received: " ++ show (duration, to)
                                            ]
        send $ Pulse p v (fromIntegral duration) (fromIntegral to)
        r <- recv
        case r of
          PulseResponse IPin
pOut Word32
d | IPin
p IPin -> IPin -> Bool
forall a. Eq a => a -> a -> Bool
== IPin
pOut -> case Word32
d of
                                                Word32
0 -> Maybe Int -> Arduino (Maybe Int)
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return  Maybe Int
forall a. Maybe a
Nothing
                                                Word32
i -> Maybe Int -> Arduino (Maybe Int)
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i))
          Response
_                                -> String -> [String] -> Arduino (Maybe Int)
forall a. String -> [String] -> Arduino a
die (String
"pulseIn: Got unexpected response for Pulse call on pin: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pin -> String
forall a. Show a => a -> String
show Pin
p') [Response -> String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
dAfter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
  = String -> [String] -> Arduino ()
forall a. String -> [String] -> Arduino a
die (String
"pulseOut: Invalid delay amounts: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
dBefore, Int
dAfter)) 
        [ String
"Pre-delay and pulse-amounts must be non-negative."]
  | Bool
True
  = do (p, pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"pulseOut_hostTiming" Pin
p' PinMode
OUTPUT
       let curPort  = IPin -> Port
pinPort IPin
p
           curIndex = IPin -> Word8
pinPortIndex IPin
p
       bs  <- gets boardState
       (setMask, resetMask) <- liftIO $ withMVar bs $ \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) <- Map IPin PinData -> [(IPin, PinData)]
forall k a. Map k a -> [(k, a)]
M.assocs (BoardState -> Map IPin PinData
pinStates BoardState
bst), Port
curPort Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== IPin -> Port
pinPort IPin
sp, PinData -> PinMode
pinMode PinData
pd PinMode -> [PinMode] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
curIndex                              = Bool
nv
                | Just (Just (Left Bool
ov)) <- Word8
i Word8
-> [(Word8, Maybe (Either Bool Int))]
-> Maybe (Maybe (Either Bool Int))
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] = (Word8 -> Bool) -> [Word8] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Word8 -> Bool
getVal Bool
val) [Word8
0 .. Word8
7]
                                lsb :: a
lsb = ((Int, Bool) -> a -> a) -> a -> [(Int, Bool)] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
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 a -> Int -> a
forall a. Bits a => a -> Int -> a
`setBit` Int
i     else a
m) a
0 ([Int] -> [Bool] -> [(Int, Bool)]
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 = ((Int, Bool) -> b -> b) -> b -> [(Int, Bool)] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
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 b -> Int -> b
forall a. Bits a => a -> Int -> a
`setBit` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
7) else b
m) b
0 ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
7..] [Bool
b7])
                            in (a
lsb, b
msb)
           ((Word8, Word8), (Word8, Word8))
-> IO ((Word8, Word8), (Word8, Word8))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> (Word8, Word8)
forall {a} {b}. (Bits a, Bits b, Num a, Num b) => Bool -> (a, b)
mkMask Bool
pulseValue, Bool -> (Word8, Word8)
forall {a} {b}. (Bits a, Bits b, Num a, Num b) => Bool -> (a, b)
mkMask (Bool -> Bool
not Bool
pulseValue))
       let writeThrough (Word8
lsb, Word8
msb) = Request -> Arduino ()
send (Request -> Arduino ()) -> Request -> Arduino ()
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
       fst setMask `seq` snd setMask `seq` fst resetMask `seq` snd resetMask `seq` writeThrough resetMask
       -- Wait before starting the pulse
       liftIO $ threadDelay dBefore
       -- Send the pulse
       writeThrough setMask
       liftIO $ threadDelay dAfter
       -- Finish the pulse
       writeThrough resetMask
       -- Do a final internal update to reflect the final value of the line
       liftIO $ modifyMVar_ bs $ \BoardState
bst -> BoardState -> IO BoardState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BoardState
bst{pinStates = M.insert p PinData{pinMode = OUTPUT, pinValue = Just (Left (not pulseValue))}(pinStates 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 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Arduino Int -> Arduino (Maybe Int)
forall a b. (a -> b) -> Arduino a -> Arduino b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Arduino Int
measure
                    Just Int
to -> Int -> Arduino Int -> Arduino (Maybe Int)
forall a. Int -> Arduino a -> Arduino (Maybe a)
timeOut Int
to Arduino Int
measure
  where waitTill :: (Bool -> Bool) -> Arduino ()
waitTill Bool -> Bool
f = do curVal <- Pin -> Arduino Bool
digitalRead Pin
p
                        unless (f curVal) $ waitTill f
        measure :: Arduino Int
measure = do (Bool -> Bool) -> Arduino ()
waitTill (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
v)                  -- wait until pulse starts
                     (t, _) <- Arduino () -> Arduino (Int, ())
forall a. Arduino a -> Arduino (Int, a)
time (Arduino () -> Arduino (Int, ()))
-> Arduino () -> Arduino (Int, ())
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Arduino ()
waitTill (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
v) -- wait till pulse ends, measuring the time
                     return $ fromIntegral 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
   (_, pd) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"analogRead" Pin
p' PinMode
ANALOG
   return $ case pinValue 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
   (p, _) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"analogWrite" Pin
p' PinMode
PWM
   when (dc < 0 || dc > 255) $ die ("Invalid duty-cycle value for PWM write on pin " ++ show p)
                                   [ "Values should be between 0 and 255"
                                   , "Received: " ++ show dc
                                   ]
   send $ AnalogPinWrite p (fromIntegral lsb) (fromIntegral msb)
  where lsb :: Int
lsb = Int
dc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f
        msb :: Int
msb = (Int
dc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
7) Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
16383
  = String -> [String] -> Arduino ()
forall a. String -> [String] -> Arduino a
die (String
"hArduino: setAnalogSamplingInterval: Allowed interval is [10, 16383] ms, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) []
  | Bool
True
  = Request -> Arduino ()
send (Request -> Arduino ()) -> Request -> Arduino ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Request
SamplingInterval (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lsb) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msb)
  where lsb :: Int
lsb = Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f
        msb :: Int
msb = (Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
7) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f