-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Utilities for 'PSignal.PSignal's and 'PSignal.Pitch's.
--
-- Functions here can't go into "Derive.PSignal" itself due to circular
-- imports---PSignal is a low level module imported by other low level
-- modules like "Derive.Score".
module Derive.Pitches where
import qualified Util.Segment as Segment
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.PSignal as PSignal
import qualified Derive.Scale as Scale

import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime

import           Global


scale :: Scale.Scale -> PSignal.Scale
scale :: Scale -> Scale
scale Scale
scale =
    ScaleId -> Set Control -> Scale
PSignal.Scale (Scale -> ScaleId
Scale.scale_id Scale
scale) (Scale -> Set Control
Scale.scale_transposers Scale
scale)

-- | A pitch interpolated a certain distance between two other pitches.
interpolated :: PSignal.Pitch -> PSignal.Pitch -> Double -> PSignal.Pitch
interpolated :: Pitch -> Pitch -> Double -> Pitch
interpolated Pitch
p1 Pitch
p2 =
    Interpolate Pitch
PSignal.interpolate (X -> Pitch -> Sample Pitch
forall y. X -> y -> Sample y
Segment.Sample X
0 Pitch
p1) (X -> Pitch -> Sample Pitch
forall y. X -> y -> Sample y
Segment.Sample X
1 Pitch
p2)
    (X -> Pitch) -> (Double -> X) -> Double -> Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> X
RealTime.seconds

-- | Transpose a pitch.
transpose :: Pitch.Transpose -> PSignal.RawPitch a -> PSignal.RawPitch a
transpose :: forall a. Transpose -> RawPitch a -> RawPitch a
transpose Transpose
t = Control -> Double -> RawPitch a -> RawPitch a
forall a. Control -> Double -> RawPitch a -> RawPitch a
PSignal.add_control Control
control Double
val
    where (Double
val, Control
control) = Transpose -> (Double, Control)
Controls.transpose_control Transpose
t

transpose_nn :: Pitch.NoteNumber -> PSignal.RawPitch a -> PSignal.RawPitch a
transpose_nn :: forall a. NoteNumber -> RawPitch a -> RawPitch a
transpose_nn = Transpose -> RawPitch a -> RawPitch a
forall a. Transpose -> RawPitch a -> RawPitch a
transpose (Transpose -> RawPitch a -> RawPitch a)
-> (NoteNumber -> Transpose)
-> NoteNumber
-> RawPitch a
-> RawPitch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Transpose
Pitch.Nn (Double -> Transpose)
-> (NoteNumber -> Double) -> NoteNumber -> Transpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteNumber -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

transpose_d :: Pitch.Step -> PSignal.RawPitch a -> PSignal.RawPitch a
transpose_d :: forall a. Step -> RawPitch a -> RawPitch a
transpose_d = Transpose -> RawPitch a -> RawPitch a
forall a. Transpose -> RawPitch a -> RawPitch a
transpose (Transpose -> RawPitch a -> RawPitch a)
-> (Step -> Transpose) -> Step -> RawPitch a -> RawPitch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Transpose
Pitch.Diatonic (Double -> Transpose) -> (Step -> Double) -> Step -> Transpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Step -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

transpose_c :: Pitch.Step -> PSignal.RawPitch a -> PSignal.RawPitch a
transpose_c :: forall a. Step -> RawPitch a -> RawPitch a
transpose_c = Transpose -> RawPitch a -> RawPitch a
forall a. Transpose -> RawPitch a -> RawPitch a
transpose (Transpose -> RawPitch a -> RawPitch a)
-> (Step -> Transpose) -> Step -> RawPitch a -> RawPitch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Transpose
Pitch.Chromatic (Double -> Transpose) -> (Step -> Double) -> Step -> Transpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Step -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Convert a Pitch to a NoteNumber, throwing an exception if the pitch
-- failed.
pitch_nn :: PSignal.Transposed -> Derive.Deriver Pitch.NoteNumber
pitch_nn :: Transposed -> Deriver NoteNumber
pitch_nn = (PitchError -> Deriver NoteNumber)
-> (NoteNumber -> Deriver NoteNumber)
-> Either PitchError NoteNumber
-> Deriver NoteNumber
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Deriver NoteNumber
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver NoteNumber)
-> (PitchError -> Text) -> PitchError -> Deriver NoteNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"evaluating pitch nn: " <>) (Text -> Text) -> (PitchError -> Text) -> PitchError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PitchError -> Text
forall a. Pretty a => a -> Text
pretty)
    NoteNumber -> Deriver NoteNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PitchError NoteNumber -> Deriver NoteNumber)
-> (Transposed -> Either PitchError NoteNumber)
-> Transposed
-> Deriver NoteNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transposed -> Either PitchError NoteNumber
PSignal.pitch_nn

-- | Like 'pitch_nn', but return the Note.
pitch_note :: PSignal.Transposed -> Derive.Deriver Pitch.Note
pitch_note :: Transposed -> Deriver Note
pitch_note = (PitchError -> Deriver Note)
-> (Note -> Deriver Note) -> Either PitchError Note -> Deriver Note
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Deriver Note
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver Note)
-> (PitchError -> Text) -> PitchError -> Deriver Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"evaluating symbolic pitch: " <>) (Text -> Text) -> (PitchError -> Text) -> PitchError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PitchError -> Text
forall a. Pretty a => a -> Text
pretty)
    Note -> Deriver Note
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PitchError Note -> Deriver Note)
-> (Transposed -> Either PitchError Note)
-> Transposed
-> Deriver Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transposed -> Either PitchError Note
PSignal.pitch_note

-- | Modify a pitch by hz.  Its symbolic pitch will remain the same.
modify_hz :: PSignal.Scale -> (Pitch.Hz -> Pitch.Hz) -> PSignal.Pitch
    -> PSignal.Pitch
modify_hz :: Scale -> (Double -> Double) -> Pitch -> Pitch
modify_hz Scale
scale Double -> Double
modify Pitch
pitch =
    Scale
-> (PitchConfig -> Either PitchError NoteNumber)
-> (PitchConfig -> Either PitchError Note)
-> PitchConfig
-> Pitch
PSignal.pitch Scale
scale ((Double -> Double)
-> Pitch -> PitchConfig -> Either PitchError NoteNumber
forall {a}.
(Double -> Double)
-> RawPitch a -> PitchConfig -> Either PitchError NoteNumber
pitch_nn Double -> Double
modify Pitch
pitch)
        (Pitch -> PitchConfig -> Either PitchError Note
forall a. RawPitch a -> PitchConfig -> Either PitchError Note
PSignal.pitch_eval_note Pitch
pitch) (Pitch -> PitchConfig
forall a. RawPitch a -> PitchConfig
PSignal.pitch_config Pitch
pitch)
    where
    pitch_nn :: (Double -> Double)
-> RawPitch a -> PitchConfig -> Either PitchError NoteNumber
pitch_nn Double -> Double
modify RawPitch a
pitch = \PitchConfig
config -> do
        NoteNumber
nn <- Transposed -> Either PitchError NoteNumber
PSignal.pitch_nn (Transposed -> Either PitchError NoteNumber)
-> Transposed -> Either PitchError NoteNumber
forall a b. (a -> b) -> a -> b
$ RawPitch Any -> Transposed
forall a b. RawPitch a -> RawPitch b
PSignal.coerce (RawPitch Any -> Transposed) -> RawPitch Any -> Transposed
forall a b. (a -> b) -> a -> b
$
            PitchConfig -> RawPitch a -> RawPitch Any
forall a b. PitchConfig -> RawPitch a -> RawPitch b
PSignal.apply_config PitchConfig
config RawPitch a
pitch
        NoteNumber -> Either PitchError NoteNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteNumber -> Either PitchError NoteNumber)
-> NoteNumber -> Either PitchError NoteNumber
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> NoteNumber -> NoteNumber
Pitch.modify_hz Double -> Double
modify NoteNumber
nn

equal :: DeriveT.RawPitch a -> DeriveT.RawPitch a -> Bool
equal :: forall a. RawPitch a -> RawPitch a -> Bool
equal = RawPitch a -> RawPitch a -> Bool
forall a. RawPitch a -> RawPitch a -> Bool
DeriveT.pitches_equal