-------------------------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.Parts.Piezo
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Abstractions for piezo speakers. 
-------------------------------------------------------------------------------------------------

module System.Hardware.Arduino.Parts.Piezo(
   -- * Declaring a piezo speaker
     Piezo, speaker
   -- * Notes you can play, and durations
   , Note(..), Duration(..)
   -- * Playing a note, rest, or silencing
   , playNote, rest, silence
   -- * Play a sequence of notes:
   , playNotes
   ) where

import Data.Bits  (shiftR, (.&.))
import Data.Maybe (fromMaybe)

import System.Hardware.Arduino
import System.Hardware.Arduino.Comm
import System.Hardware.Arduino.Data

-- | A piezo speaker. Note that this type is abstract, use 'speaker' to
-- create an instance.
data Piezo = Piezo { Piezo -> IPin
piezoPin :: IPin  -- ^ The internal-pin that controls the speaker
                   , Piezo -> Int
tempo    :: Int   -- ^ Tempo for the melody
                   }

-- | Create a piezo speaker instance.
speaker :: Int            -- ^ Tempo. Higher numbers mean faster melodies; in general.
        -> Pin            -- ^ Pin controlling the piezo. Should be a pin that supports PWM mode.
        -> Arduino Piezo
speaker :: Int -> Pin -> Arduino Piezo
speaker Int
t Pin
p = do String -> Arduino ()
debug forall a b. (a -> b) -> a -> b
$ String
"Attaching speaker on pin: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Pin
p
                 Pin -> PinMode -> Arduino ()
setPinMode Pin
p PinMode
PWM
                 (IPin
ip, PinData
_) <- String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
"Piezo.speaker" Pin
p PinMode
PWM
                 forall (m :: * -> *) a. Monad m => a -> m a
return Piezo { piezoPin :: IPin
piezoPin = IPin
ip, tempo :: Int
tempo = Int
t }

-- | Musical notes, notes around middle-C
data Note     = A | B | C | D | E | F | G | R  deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)  -- R is for rest

-- | Beat counts
data Duration = Whole | Half | Quarter | Eight deriving (Duration -> Duration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show)

-- | Convert a note to its frequency appropriate for Piezo
frequency :: Note -> Int
frequency :: Note -> Int
frequency Note
n = forall a. a -> Maybe a -> a
fromMaybe Int
0 (Note
n forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Note, Int)]
fs)
 where fs :: [(Note, Int)]
fs = [(Note
A, Int
440), (Note
B, Int
493), (Note
C, Int
261), (Note
D, Int
294), (Note
E, Int
329), (Note
F, Int
349), (Note
G, Int
392), (Note
R, Int
0)]

-- | Convert a duration to a delay amount
interval :: Piezo -> Duration -> Int
interval :: Piezo -> Duration -> Int
interval Piezo
p Duration
Whole   = Int
8 forall a. Num a => a -> a -> a
* Piezo -> Duration -> Int
interval Piezo
p Duration
Eight
interval Piezo
p Duration
Half    = Int
4 forall a. Num a => a -> a -> a
* Piezo -> Duration -> Int
interval Piezo
p Duration
Eight
interval Piezo
p Duration
Quarter = Int
2 forall a. Num a => a -> a -> a
* Piezo -> Duration -> Int
interval Piezo
p Duration
Eight
interval Piezo
p Duration
Eight   = Piezo -> Int
tempo Piezo
p

-- | Turn the speaker off
silence :: Piezo -> Arduino ()
silence :: Piezo -> Arduino ()
silence (Piezo IPin
p Int
_) = Request -> Arduino ()
send forall a b. (a -> b) -> a -> b
$ IPin -> Word8 -> Word8 -> Request
AnalogPinWrite IPin
p Word8
0 Word8
0

-- | Keep playing a given note on the piezo:
setNote :: Piezo -> Note -> Arduino ()
setNote :: Piezo -> Note -> Arduino ()
setNote (Piezo IPin
p Int
_) Note
n = 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 f :: Int
f   = Note -> Int
frequency Note
n
         lsb :: Int
lsb = Int
f forall a. Bits a => a -> a -> a
.&. Int
0x7f
         msb :: Int
msb = (Int
f forall a. Bits a => a -> Int -> a
`shiftR` Int
7) forall a. Bits a => a -> a -> a
.&. Int
0x7f

-- | Play the given note for the duration
playNote :: Piezo -> (Note, Duration) -> Arduino ()
playNote :: Piezo -> (Note, Duration) -> Arduino ()
playNote Piezo
pz (Note
n, Duration
d) = do Piezo -> Note -> Arduino ()
setNote Piezo
pz Note
n
                        Int -> Arduino ()
delay (Piezo -> Duration -> Int
interval Piezo
pz Duration
d)
                        Piezo -> Arduino ()
silence Piezo
pz

-- | Play a sequence of notes with given durations:
playNotes :: Piezo -> [(Note, Duration)] -> Arduino ()
playNotes :: Piezo -> [(Note, Duration)] -> Arduino ()
playNotes Piezo
pz = [(Note, Duration)] -> Arduino ()
go
  where go :: [(Note, Duration)] -> Arduino ()
go []            = Piezo -> Arduino ()
silence Piezo
pz
        go (nd :: (Note, Duration)
nd@(Note
_, Duration
d):[(Note, Duration)]
r) = do Piezo -> (Note, Duration) -> Arduino ()
playNote Piezo
pz (Note, Duration)
nd
                              Int -> Arduino ()
delay (Piezo -> Duration -> Int
interval Piezo
pz Duration
d forall a. Integral a => a -> a -> a
`div` Int
3) -- heuristically found.. :-)
                              [(Note, Duration)] -> Arduino ()
go [(Note, Duration)]
r

-- | Rest for a given duration:
rest :: Piezo -> Duration -> Arduino ()
rest :: Piezo -> Duration -> Arduino ()
rest Piezo
pz Duration
d = Int -> Arduino ()
delay (Piezo -> Duration -> Int
interval Piezo
pz Duration
d)