-- 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 Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime

import           Global


scale :: Derive.Scale -> PSignal.Scale
scale :: Scale -> Scale
scale Scale
scale =
    ScaleId -> Set Control -> Scale
PSignal.Scale (Scale -> ScaleId
Derive.scale_id Scale
scale) (Scale -> Set Control
Derive.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 (forall y. X -> y -> Sample y
Segment.Sample X
0 Pitch
p1) (forall y. X -> y -> Sample y
Segment.Sample X
1 Pitch
p2)
    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 = 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 = forall a. Transpose -> RawPitch a -> RawPitch a
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Transpose
Pitch.Nn forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Transpose -> RawPitch a -> RawPitch a
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Transpose
Pitch.Diatonic forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Transpose -> RawPitch a -> RawPitch a
transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Transpose
Pitch.Chromatic forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => Text -> Deriver a
Derive.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"evaluating pitch nn: " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty)
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => Text -> Deriver a
Derive.throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"evaluating symbolic pitch: " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty)
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 (forall {a}.
(Double -> Double)
-> RawPitch a -> PitchConfig -> Either PitchError NoteNumber
pitch_nn Double -> Double
modify Pitch
pitch)
        (forall a. RawPitch a -> PitchConfig -> Either PitchError Note
PSignal.pitch_eval_note Pitch
pitch) (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 forall a b. (a -> b) -> a -> b
$ forall a b. RawPitch a -> RawPitch b
PSignal.coerce forall a b. (a -> b) -> a -> b
$
            forall a b. PitchConfig -> RawPitch a -> RawPitch b
PSignal.apply_config PitchConfig
config RawPitch a
pitch
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. RawPitch a -> RawPitch a -> Bool
DeriveT.pitches_equal