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

-- | Im-specific controls.  Generally they are per-instrument, but like
-- "Derive.Controls", it's useful to have a standard vocabulary.
module Synth.Shared.Control where
import qualified Data.Map as Map
import qualified Data.String as String

import qualified Util.Num as Num
import qualified Util.Serialize as Serialize

import           Global


-- | Unlike 'Derive.ScoreTypes.Control', pitch is just another control.
newtype Control = Control Text
    deriving (Control -> Control -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control -> Control -> Bool
$c/= :: Control -> Control -> Bool
== :: Control -> Control -> Bool
$c== :: Control -> Control -> Bool
Eq, Eq Control
Control -> Control -> Bool
Control -> Control -> Ordering
Control -> Control -> Control
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Control -> Control -> Control
$cmin :: Control -> Control -> Control
max :: Control -> Control -> Control
$cmax :: Control -> Control -> Control
>= :: Control -> Control -> Bool
$c>= :: Control -> Control -> Bool
> :: Control -> Control -> Bool
$c> :: Control -> Control -> Bool
<= :: Control -> Control -> Bool
$c<= :: Control -> Control -> Bool
< :: Control -> Control -> Bool
$c< :: Control -> Control -> Bool
compare :: Control -> Control -> Ordering
$ccompare :: Control -> Control -> Ordering
Ord, Int -> Control -> ShowS
[Control] -> ShowS
Control -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control] -> ShowS
$cshowList :: [Control] -> ShowS
show :: Control -> String
$cshow :: Control -> String
showsPrec :: Int -> Control -> ShowS
$cshowsPrec :: Int -> Control -> ShowS
Show, String -> Control
forall a. (String -> a) -> IsString a
fromString :: String -> Control
$cfromString :: String -> Control
String.IsString, Get Control
Putter Control
forall a. Putter a -> Get a -> Serialize a
get :: Get Control
$cget :: Get Control
put :: Putter Control
$cput :: Putter Control
Serialize.Serialize)

instance Pretty Control where pretty :: Control -> Text
pretty (Control Text
c) = Text
c

-- | This should come from 'Derive.Controls.dynamic'.  Unlike score-level dyn,
-- whose meaning is abstract, this should be more or less on a dB scale, where
-- 0 corresponds to 'minimumDb'.
--
-- It can be more closely defined here because im instruments have direct
-- control over the sound they produce, while other backends, like MIDI, are up
-- to the whims of the synthesizer's interpretation.
dynamic :: Control
dynamic :: Control
dynamic = Control
"dyn" -- TODO unify with Controls.dynamic

-- | This is similar to 'dynamic', but this always maps to physical volume,
-- for the case where an instrument distinguishes between dynamic level and
-- volume level.  The score-level equivalent is 'Derive.Controls.vol' which
-- corresponds to MIDI cc7 in the MIDI backend.
volume :: Control
volume :: Control
volume = Control
"vol"

-- | A 'dynamic' of 1 maps to 0dB of attenuation, and 0 maps to this level.
-- Humans maybe have a limit around 120dB, but 96 is a theoretical maximum for
-- 16 bit audio, which is likely what this turns into anyway.
--
-- My manual experiment shows that -96 on a normalized sample is just about
-- inaudible.
minimumDb :: Double
minimumDb :: Double
minimumDb = -Double
96

-- | Get 'volume' value for the given dB.
dbToVolume :: Double -> Double
dbToVolume :: Double -> Double
dbToVolume = forall a. (Eq a, Fractional a) => a -> a -> a -> a
Num.normalize Double
minimumDb Double
0

-- | -1 means pan left, 1 means pan right.  Unlike other controls, the range is
-- -1 to 1 instead of 0 to 1.  This is so adding signals is the same as adding
-- pan, and a 0 signal has no effect.
pan :: Control
pan :: Control
pan = Control
"pan"

-- | Pitch in NoteNumbers.
pitch :: Control
pitch :: Control
pitch = Control
"pitch"

-- | Used by some synths to mark note start and end times.  This should be used
-- internally, not exposed.
gate :: Control
gate :: Control
gate = Control
"gate"

-- | An integral variation, for "random" variant samples.
variation :: Control
variation :: Control
variation = Control
"variation"

-- | Amount of mutedness, for instruments that support variable amount of mute.
mute :: Control
mute :: Control
mute = Control
"mute"

sampleStartOffset :: Control
sampleStartOffset :: Control
sampleStartOffset = Control
"sample-start-offset"

supportSampleStartOffset :: Supported
supportSampleStartOffset :: Supported
supportSampleStartOffset = Control -> Text -> Supported
support
    Control
sampleStartOffset Text
"Sample start offset, in frames."

-- | Inflict time stretch on the sample.
sampleTimeStretch :: Control
sampleTimeStretch :: Control
sampleTimeStretch = Control
"sample-time-stretch"

supportSampleTimeStretch :: Supported
supportSampleTimeStretch :: Supported
supportSampleTimeStretch = Control -> Text -> Supported
support
    Control
sampleTimeStretch Text
"Time stretch ratio."

-- | Inflict pitch shift on the sample.  Units are Pitch.NoteNumbers.
samplePitchShift :: Control
samplePitchShift :: Control
samplePitchShift = Control
"sample-pitch-shift"

supportSamplePitchShift :: Supported
supportSamplePitchShift :: Supported
supportSamplePitchShift = Control -> Text -> Supported
support
    Control
samplePitchShift Text
"Pitch shift, in nn."

-- * Supported

type Supported = Map Control Text

support :: Control -> Text -> Supported
support :: Control -> Text -> Supported
support = forall k a. k -> a -> Map k a
Map.singleton

supportPitch :: Supported
supportPitch :: Supported
supportPitch = Control -> Text -> Supported
support Control
pitch Text
"Pitch signal."

supportDyn :: Supported
supportDyn :: Supported
supportDyn = Control -> Text -> Supported
support Control
dynamic forall a b. (a -> b) -> a -> b
$
    Text
"Dynamic signal.  dB scale, where 0 is " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Double
minimumDb forall a. Semigroup a => a -> a -> a
<> Text
" dB."

supportVariation :: Supported
supportVariation :: Supported
supportVariation = Control -> Text -> Supported
support
    Control
variation Text
"Random integer, to choose between variant samples."