module Csound.Typed.Opcode.PitchConverters (
    
    
    -- * Functions.
    cent, cpsmidinn, cpsoct, cpspch, octave, octcps, octmidinn, octpch, pchmidinn, pchoct, semitone,
    
    -- * Tuning Opcodes.
    cps2pch, cpstun, cpstuni, cpsxpch) where

import Control.Applicative
import Control.Monad.Trans.Class
import Csound.Dynamic
import Csound.Typed

-- Functions.

-- | 
-- Calculates a factor to raise/lower a frequency by a given amount of cents.
--
-- >  cent (x) 
--
-- csound doc: <http://www.csounds.com/manual/html/cent.html>
cent :: SigOrD a => a -> a
cent b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1 "cent" a1

-- | 
-- Converts a Midi note number value to cycles-per-second.
--
-- >  cpsmidinn  (MidiNoteNumber)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/cpsmidinn.html>
cpsmidinn :: SigOrD a => a -> a
cpsmidinn b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "cpsmidinn" a1

-- | 
-- Converts an octave-point-decimal value to cycles-per-second.
--
-- >  cpsoct  (oct)  (no rate restriction)
--
-- csound doc: <http://www.csounds.com/manual/html/cpsoct.html>
cpsoct :: SigOrD a => a -> a
cpsoct b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1 "cpsoct" a1

-- | 
-- Converts a pitch-class value to cycles-per-second.
--
-- >  cpspch  (pch)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/cpspch.html>
cpspch :: SigOrD a => a -> a
cpspch b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "cpspch" a1

-- | 
-- Calculates a factor to raise/lower a frequency by a given amount of octaves.
--
-- >  octave (x)
--
-- csound doc: <http://www.csounds.com/manual/html/octave.html>
octave :: SigOrD a => a -> a
octave b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1 "octave" a1

-- | 
-- Converts a cycles-per-second value to octave-point-decimal.
--
-- >  octcps  (cps)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/octcps.html>
octcps :: SigOrD a => a -> a
octcps b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "octcps" a1

-- | 
-- Converts a Midi note number value to octave-point-decimal.
--
-- >  octmidinn  (MidiNoteNumber)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/octmidinn.html>
octmidinn :: SigOrD a => a -> a
octmidinn b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "octmidinn" a1

-- | 
-- Converts a pitch-class value to octave-point-decimal.
--
-- >  octpch  (pch)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/octpch.html>
octpch :: SigOrD a => a -> a
octpch b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "octpch" a1

-- | 
-- Converts a Midi note number value to octave point pitch-class units.
--
-- >  pchmidinn  (MidiNoteNumber)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/pchmidinn.html>
pchmidinn :: SigOrD a => a -> a
pchmidinn b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "pchmidinn" a1

-- | 
-- Converts an octave-point-decimal value to pitch-class.
--
-- >  pchoct  (oct)  (init- or control-rate args only)
--
-- csound doc: <http://www.csounds.com/manual/html/pchoct.html>
pchoct :: SigOrD a => a -> a
pchoct b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1k "pchoct" a1

-- | 
-- Calculates a factor to raise/lower a frequency by a given amount of semitones.
--
-- >  semitone (x)
--
-- csound doc: <http://www.csounds.com/manual/html/semitone.html>
semitone :: SigOrD a => a -> a
semitone b1 = fromGE $ f <$> toGE b1
    where f a1 = opr1 "semitone" a1

-- Tuning Opcodes.

-- | 
-- Converts a pitch-class value into cycles-per-second (Hz) for equal divisions of the octave.
--
-- > icps  cps2pch  ipch, iequal
--
-- csound doc: <http://www.csounds.com/manual/html/cps2pch.html>
cps2pch ::  D -> D -> D
cps2pch b1 b2 = D $ f <$> unD b1 <*> unD b2
    where f a1 a2 = opcs "cps2pch" [(Ir,[Ir,Ir])] [a1,a2]

-- | 
-- Returns micro-tuning values at k-rate.
--
-- > kcps  cpstun  ktrig, kindex, kfn
--
-- csound doc: <http://www.csounds.com/manual/html/cpstun.html>
cpstun ::  Sig -> Sig -> Tab -> Sig
cpstun b1 b2 b3 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unTab b3
    where f a1 a2 a3 = opcs "cpstun" [(Kr,[Kr,Kr,Kr])] [a1,a2,a3]

-- | 
-- Returns micro-tuning values at init-rate.
--
-- > icps  cpstuni  index, ifn
--
-- csound doc: <http://www.csounds.com/manual/html/cpstuni.html>
cpstuni ::  D -> Tab -> D
cpstuni b1 b2 = D $ f <$> unD b1 <*> unTab b2
    where f a1 a2 = opcs "cpstuni" [(Ir,[Ir,Ir])] [a1,a2]

-- | 
-- Converts a pitch-class value into cycles-per-second (Hz) for equal divisions of any interval.
--
-- Converts a pitch-class value into cycles-per-second (Hz) for equal divisions of any interval. There is a restriction of no more than 100 equal divisions.
--
-- > icps  cpsxpch  ipch, iequal, irepeat, ibase
--
-- csound doc: <http://www.csounds.com/manual/html/cpsxpch.html>
cpsxpch ::  D -> D -> D -> D -> D
cpsxpch b1 b2 b3 b4 = D $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4
    where f a1 a2 a3 a4 = opcs "cpsxpch" [(Ir,[Ir,Ir,Ir,Ir])] [a1,a2,a3,a4]