-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.Button
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Reads the value of a push-button and displays it's status continuously
-- on the computer screen and by lighting a led on the Arduino as long as
-- the button is pressed.
-------------------------------------------------------------------------------

module System.Hardware.Arduino.SamplePrograms.Button where

import Control.Monad.Trans (liftIO)

import System.Hardware.Arduino

-- | Read the value of a push-button (NO - normally open)
-- connected to input pin 2 on the Arduino. We will continuously
-- monitor and print the value as it changes. Also, we'll turn
-- the led on pin 13 on when the switch is pressed.
--
-- The wiring is straightforward: Simply put a push-button between
-- digital input 2 and +5V, guarded by a 10K resistor:
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Button.png>>
button :: IO ()
button :: IO ()
button = Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
            Pin -> PinMode -> Arduino ()
setPinMode Pin
led PinMode
OUTPUT
            Pin -> PinMode -> Arduino ()
setPinMode Pin
pb  PinMode
INPUT
            forall {b}. Bool -> Arduino b
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pin -> Arduino Bool
digitalRead Pin
pb
 where pb :: Pin
pb   = Word8 -> Pin
digital Word8
2
       led :: Pin
led  = Word8 -> Pin
digital Word8
13
       go :: Bool -> Arduino b
go Bool
s = do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"Button is currently " forall a. [a] -> [a] -> [a]
++ if Bool
s then FilePath
"ON" else FilePath
"OFF"
                 Pin -> Bool -> Arduino ()
digitalWrite Pin
led Bool
s
                 Bool -> Arduino b
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pin -> Arduino Bool
waitFor Pin
pb