--------------------------------------------------------------------------------- |-- Module : System.Hardware.Arduino.SamplePrograms.Servo-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental---- Demonstrates basic Servo motor control-------------------------------------------------------------------------------moduleSystem.Hardware.Arduino.SamplePrograms.ServowhereimportControl.Monad(forever)importControl.Monad.Trans(liftIO)importData.Char(toLower)importSystem.Hardware.Arduino importSystem.Hardware.Arduino.Parts.Servo -- | Control a servo, by executing user requests of blade movement. We allow 3 user commands:---- * @l@ to swipe from angle-0 to 180;---- * @r@ to swipe from angle-180 to 0;---- * Or any number between @0@ to @180@, which puts the servo to the desired position.---- Almost any servo motor would work with this example, though you should make sure to adjust min/max pulse durations-- in the 'attach' command to match the datasheet of the servo you have. In this example, we have used the HS-55 feather-- servo (<http://www.servocity.com/html/hs-55_sub-micro.html>), which has the values 600 to 2400 micro-seconds.---- To connect the servo to the Arduino, simply connect the VCC (red) and the GND (black) appropriately, and the signal line (white)-- to any SERVO capable pin, in this example we're using pin number 9:---- <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Servo.png>>servo ::IO()servo :: IO ()
servo =Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
FalseFilePath
"/dev/cu.usbmodemFD131"forall a b. (a -> b) -> a -> b
$doServo
s <-Pin -> Maybe Int -> Maybe Int -> Arduino Servo
attach (Word8 -> Pin
digital Word8
9)(forall a. a -> Maybe a
JustInt
600)(forall a. a -> Maybe a
JustInt
2400)forall (f :: * -> *) a b. Applicative f => f a -> f b
forever(Servo -> Arduino ()
demo Servo
s )wheredemo :: Servo -> Arduino ()
demo Servo
s =doforall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$FilePath -> IO ()
putStrFilePath
"Enter l, r or the desired servo angle: "FilePath
a <-forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOIO FilePath
getLinecase(forall a b. (a -> b) -> [a] -> [b]
mapChar -> Char
toLowerFilePath
a ,forall a. Read a => ReadS a
readsFilePath
a )of(FilePath
"l",[(Int, FilePath)]
_)->forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_Int -> Arduino ()
move [Int
0..Int
180](FilePath
"r",[(Int, FilePath)]
_)->forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_Int -> Arduino ()
move [Int
180,Int
179..Int
0](FilePath
_,[(Int
v ,FilePath
"")])|Int
0forall a. Ord a => a -> a -> Bool
<=Int
v Bool -> Bool -> Bool
&&Int
v forall a. Ord a => a -> a -> Bool
<=Int
180->Servo -> Int -> Arduino ()
setAngle Servo
s Int
v (FilePath, [(Int, FilePath)])
_->forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$FilePath -> IO ()
putStrLnFilePath
"Invalid entry."wheremove :: Int -> Arduino ()
move Int
a =Servo -> Int -> Arduino ()
setAngle Servo
s Int
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>Int -> Arduino ()
delay Int
100-- | Control a servo, as guided by the input read from a potentiometer. The set-up is similar to the 'servo' example-- above, except instead of querying the user for the angle, we use the readings from a potentiometer connected to-- analog input number 2. We used a 10 KOhm potentiometer, but other pots would work just as well too:---- <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/ServoAnalog.png>>servoAnalog ::IO()servoAnalog :: IO ()
servoAnalog =Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
FalseFilePath
"/dev/cu.usbmodemFD131"forall a b. (a -> b) -> a -> b
$doServo
s <-Pin -> Maybe Int -> Maybe Int -> Arduino Servo
attach (Word8 -> Pin
digital Word8
9)(forall a. a -> Maybe a
JustInt
600)(forall a. a -> Maybe a
JustInt
2400)Pin -> PinMode -> Arduino ()
setPinMode Pin
pot PinMode
ANALOG forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$FilePath -> IO ()
putStrLnFilePath
"Adjust the potentiometer to control the servo!"forall (f :: * -> *) a b. Applicative f => f a -> f b
forever(Servo -> Arduino ()
demo Servo
s )wherepot :: Pin
pot =Word8 -> Pin
analog Word8
2demo :: Servo -> Arduino ()
demo Servo
s =doInt
v <-Pin -> Arduino Int
analogRead Pin
pot Servo -> Int -> Arduino ()
setAngle Servo
s (forall {a}. Integral a => a -> a
cvt Int
v )Int -> Arduino ()
delay Int
100-- Analog input will be from 0 to 1023; convert it to-- angles, mapping 1023 to 0-degrees, and 0 to 180cvt :: a -> a
cvt a
i =((a
1023forall a. Num a => a -> a -> a
-a
i )forall a. Num a => a -> a -> a
*a
180)forall a. Integral a => a -> a -> a
`div`a
1023

AltStyle によって変換されたページ (->オリジナル) /