-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.Servo
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Demonstrates basic Servo motor control
-------------------------------------------------------------------------------

module System.Hardware.Arduino.SamplePrograms.Servo where

import Control.Monad       (forever)
import Control.Monad.Trans (liftIO)
import Data.Char           (toLower)

import System.Hardware.Arduino
import System.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
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
            Servo
s <- Pin -> Maybe Int -> Maybe Int -> Arduino Servo
attach (Word8 -> Pin
digital Word8
9) (forall a. a -> Maybe a
Just Int
600) (forall a. a -> Maybe a
Just Int
2400)
            forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Servo -> Arduino ()
demo Servo
s)
 where demo :: Servo -> Arduino ()
demo Servo
s = do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr FilePath
"Enter l, r or the desired servo angle: "
                   FilePath
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getLine
                   case (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
a, forall a. Read a => ReadS a
reads FilePath
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
0 forall 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
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"Invalid entry."
         where move :: 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
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
                 Servo
s <- Pin -> Maybe Int -> Maybe Int -> Arduino Servo
attach (Word8 -> Pin
digital Word8
9) (forall a. a -> Maybe a
Just Int
600) (forall a. a -> Maybe a
Just Int
2400)
                 Pin -> PinMode -> Arduino ()
setPinMode Pin
pot PinMode
ANALOG
                 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"Adjust the potentiometer to control the servo!"
                 forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Servo -> Arduino ()
demo Servo
s)
 where pot :: Pin
pot = Word8 -> Pin
analog Word8
2
       demo :: Servo -> Arduino ()
demo Servo
s = do Int
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 180
       cvt :: 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