{-# 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
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 :: 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 :: 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 :: 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
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')))
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
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 ()
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
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
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
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]
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
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
[(Bool, Bool)]
vs <- [Pin] -> Arduino [(Bool, Bool)]
waitGeneric [Pin]
ps
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
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
[(Bool, Bool)]
vs <- [Pin] -> Arduino [(Bool, Bool)]
waitGeneric [Pin]
ps
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
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
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
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]
pulseOut_hostTiming :: Pin
-> Bool
-> Int
-> Int
-> 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
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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
dBefore
(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
(Word8, Word8) -> Arduino ()
writeThrough (Word8, Word8)
resetMask
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" #-}
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)
(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)
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" #-}
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
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
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