-- 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

-- | This \"scale\" generates pitches which are ratios of the pitches in
-- another pitch signal, @#ratio-source@.  The intent is to tune one instrument
-- relative another.
--
-- It's not a usual scale because there is no notion of scale degrees or
-- transposition or anything like that.  The degrees are ratios, e.g. @3/2@ or
-- @-9/8@.  A positive ratio will multiply with the source pitch, a negative
-- one will divide.  The source pitch is only sampled at the beginning of the
-- relative pitch, so if the source is moving the relative one won't move with
-- it.
module Derive.Scale.Ratio where
import qualified Data.Attoparsec.Text as A

import qualified Util.ParseText as ParseText
import qualified Derive.Args as Args
import qualified Derive.Call.Module as Module
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.PSignal as PSignal
import qualified Derive.Pitches as Pitches
import qualified Derive.Scale as Scale
import qualified Derive.Scale.Scales as Scales
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Sig as Sig
import           Derive.Sig (defaulted)

import qualified Perform.Pitch as Pitch


scales :: [Scale.Definition]
scales :: [Definition]
scales = forall a b. (a -> b) -> [a] -> [b]
map Scale -> Definition
Scale.Simple [Scale
scale]

scale :: Scale.Scale
scale :: Scale
scale = Scale.Scale
    { scale_id :: ScaleId
scale_id = ScaleId
"ratio"
    , scale_pattern :: Text
scale_pattern = Text
"[+-]?\\d+/\\d+ e.g. 2/5 or -4/3"
    , scale_symbols :: [Symbol]
scale_symbols = []
    , scale_transposers :: Set Control
scale_transposers = forall a. Monoid a => a
mempty
    , scale_read :: Environ -> Note -> Either PitchError Pitch
scale_read = \Environ
_ Note
_ -> forall a b. a -> Either a b
Left PitchError
DeriveT.NotImplemented
    , scale_show :: Environ -> Pitch -> Either PitchError Note
scale_show = \Environ
_ Pitch
_ -> forall a b. a -> Either a b
Left PitchError
DeriveT.NotImplemented
    , scale_bottom :: Pitch
scale_bottom = forall pc. Enum pc => Int -> pc -> Pitch
Pitch.pitch Int
0 Integer
0
    , scale_layout :: Layout
scale_layout = Layout
Scale.no_octaves
    , scale_transpose :: Transpose
scale_transpose = Transpose
Scales.non_transposing
    , scale_enharmonics :: Enharmonics
scale_enharmonics = Enharmonics
Scales.no_enharmonics
    , scale_note_to_call :: Note -> Maybe ValCall
scale_note_to_call = Note -> Maybe ValCall
note_to_call
    -- Since this isn't a proper scale, I can't think of any sensible way to
    -- input this with a music keyboard, so we'll have to use the computer
    -- keyboard.
    , scale_input_to_note :: Environ -> Input -> Either PitchError Note
scale_input_to_note = \Environ
_ Input
_ -> forall a b. a -> Either a b
Left PitchError
DeriveT.InvalidInput
    , scale_input_to_nn :: ScoreTime -> Input -> Deriver (Either PitchError NoteNumber)
scale_input_to_nn = ScoreTime -> Input -> Deriver (Either PitchError NoteNumber)
Scales.direct_input_to_nn
    , scale_call_doc :: DocumentedCall
scale_call_doc = ValCall -> DocumentedCall
Derive.extract_val_doc forall a b. (a -> b) -> a -> b
$ Note -> (Double -> Double) -> ValCall
note_call (Text -> Note
Pitch.Note Text
"1/1") forall a. a -> a
id
    }

note_to_call :: Pitch.Note -> Maybe Derive.ValCall
note_to_call :: Note -> Maybe ValCall
note_to_call Note
note = Note -> (Double -> Double) -> ValCall
note_call Note
note forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall a. Parser a -> Text -> Maybe a
ParseText.maybe_parse Parser (Double -> Double)
p_note (Note -> Text
Pitch.note_text Note
note)

note_call :: Pitch.Note -> (Double -> Double) -> Derive.ValCall
note_call :: Note -> (Double -> Double) -> ValCall
note_call Note
note Double -> Double
ratio = forall a.
ToVal a =>
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (PassedArgs Tagged -> Deriver a)
-> ValCall
Derive.val_call Module
Module.scale CallName
"ratio" forall a. Monoid a => a
mempty
    ( Doc
"Generate a frequency that is the ratio of the frequency of the "
    forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Doc
ShowVal.doc PControlRef
pcontrol_ref
    forall a. Semigroup a => a -> a -> a
<> Doc
" signal. A negative ratio divides, a positive one multiplies."
    ) forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call
    (forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
defaulted ArgName
"hz" (Double
0 :: Double) Doc
"Add an absolute hz value to the output.") forall a b. (a -> b) -> a -> b
$
    \Double
hz PassedArgs Tagged
args -> do
        RealTime
start <- forall a. PassedArgs a -> Deriver RealTime
Args.real_start PassedArgs Tagged
args
        Environ
env <- Deriver Environ
Derive.get_environ
        NoteNumber
nn <- forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require
            (Text
"ratio scale requires " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Text
ShowVal.show_val PControlRef
pcontrol_ref)
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PControl -> RealTime -> Deriver (Maybe NoteNumber)
Derive.named_nn_at PControl
pcontrol RealTime
start
        let out_nn :: NoteNumber
out_nn = Double -> NoteNumber
Pitch.hz_to_nn forall a b. (a -> b) -> a -> b
$ Double -> Double
ratio (NoteNumber -> Double
Pitch.nn_to_hz NoteNumber
nn) forall a. Num a => a -> a -> a
+ Double
hz
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scale
-> (PitchConfig -> Either PitchError NoteNumber)
-> (PitchConfig -> Either PitchError Note)
-> PitchConfig
-> Pitch
PSignal.pitch
            Scale
pscale (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return NoteNumber
out_nn) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Note
note)
            (Environ -> ControlValMap -> PitchConfig
PSignal.PitchConfig Environ
env forall a. Monoid a => a
mempty)
    where
    pcontrol_ref :: PControlRef
pcontrol_ref = forall control val. control -> Maybe val -> Ref control val
DeriveT.Ref PControl
control forall a. Maybe a
Nothing :: DeriveT.PControlRef
    control :: PControl
control = PControl
"ratio-source"
    pcontrol :: PControl
pcontrol = PControl
"ratio-source" -- TODO remove
    pscale :: Scale
pscale = Scale -> Scale
Pitches.scale Scale
scale

-- | Ratios look like @2/5@, @-4/3@.  A negative ratio divides, a positive one
-- multiplies.
p_note :: ParseText.Parser (Double -> Double)
p_note :: Parser (Double -> Double)
p_note = do
    Int
num <- Parser Int
ParseText.p_int
    Char -> Parser Char
A.char Char
'/'
    Int
denom <- Parser Int
ParseText.p_nat
    let ratio :: Double
ratio = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
abs Int
num) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
denom
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
num forall a. Ord a => a -> a -> Bool
< Int
0 then (forall a. Fractional a => a -> a -> a
/ Double
ratio) else (forall a. Num a => a -> a -> a
* Double
ratio)