-- | Functions
module CsoundExpr.Opcodes.Pitch.Funcs
    (cent,
     cpsmidinn,
     cpsoct,
     cpspch,
     octave,
     octcps,
     octmidinn,
     octpch,
     pchmidinn,
     pchoct,
     semitone)
where



import CsoundExpr.Base.Types
import CsoundExpr.Base.MultiOut
import CsoundExpr.Base.SideEffect
import CsoundExpr.Base.UserDefined



-- | * opcode : cent
--  
--  
-- * syntax : 
--  
--  >   cent(x)
--  
--  
-- * description : 
--  
--  Calculates a factor to raise/lower a frequency by a given amount
-- of cents.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cent.html>
 
cent :: (X x0) => x0 -> x0
cent x0sig = prefixOperation "cent" args
  where args = [to x0sig]


-- | * opcode : cpsmidinn
--  
--  
-- * syntax : 
--  
--  >   cpsmidinn (MidiNoteNumber) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts a Midi note number value to cycles-per-second.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpsmidinn.html>
 
cpsmidinn :: (K k0) => k0 -> k0
cpsmidinn k0sig = prefixOperation "cpsmidinn" args
  where args = [to k0sig]


-- | * opcode : cpsoct
--  
--  
-- * syntax : 
--  
--  >   cpsoct (oct) (no rate restriction)
--  
--  
-- * description : 
--  
--  Converts an octave-point-decimal value to cycles-per-second.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpsoct.html>
 
cpsoct :: (X x0) => x0 -> x0
cpsoct x0sig = prefixOperation "cpsoct" args
  where args = [to x0sig]


-- | * opcode : cpspch
--  
--  
-- * syntax : 
--  
--  >   cpspch (pch) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts a pitch-class value to cycles-per-second.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpspch.html>
 
cpspch :: (K k0) => k0 -> k0
cpspch k0sig = prefixOperation "cpspch" args
  where args = [to k0sig]


-- | * opcode : octave
--  
--  
-- * syntax : 
--  
--  >   octave(x)
--  
--  
-- * description : 
--  
--  Calculates a factor to raise/lower a frequency by a given amount
-- of octaves.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octave.html>
 
octave :: (X x0) => x0 -> x0
octave x0sig = prefixOperation "octave" args
  where args = [to x0sig]


-- | * opcode : octcps
--  
--  
-- * syntax : 
--  
--  >   octcps (cps) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts a cycles-per-second value to octave-point-decimal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octcps.html>
 
octcps :: (K k0) => k0 -> k0
octcps k0sig = prefixOperation "octcps" args
  where args = [to k0sig]


-- | * opcode : octmidinn
--  
--  
-- * syntax : 
--  
--  >   octmidinn (MidiNoteNumber) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts a Midi note number value to octave-point-decimal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octmidinn.html>
 
octmidinn :: (K k0) => k0 -> k0
octmidinn k0sig = prefixOperation "octmidinn" args
  where args = [to k0sig]


-- | * opcode : octpch
--  
--  
-- * syntax : 
--  
--  >   octpch (pch) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts a pitch-class value to octave-point-decimal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octpch.html>
 
octpch :: (K k0) => k0 -> k0
octpch k0sig = prefixOperation "octpch" args
  where args = [to k0sig]


-- | * opcode : pchmidinn
--  
--  
-- * syntax : 
--  
--  >   pchmidinn (MidiNoteNumber) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts a Midi note number value to octave point pitch-class
-- units.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pchmidinn.html>
 
pchmidinn :: (K k0) => k0 -> k0
pchmidinn k0sig = prefixOperation "pchmidinn" args
  where args = [to k0sig]


-- | * opcode : pchoct
--  
--  
-- * syntax : 
--  
--  >   pchoct (oct) (init- or control-rate args only)
--  
--  
-- * description : 
--  
--  Converts an octave-point-decimal value to pitch-class.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pchoct.html>
 
pchoct :: (K k0) => k0 -> k0
pchoct k0sig = prefixOperation "pchoct" args
  where args = [to k0sig]


-- | * opcode : semitone
--  
--  
-- * syntax : 
--  
--  >   semitone(x)
--  
--  
-- * description : 
--  
--  Calculates a factor to raise/lower a frequency by a given amount
-- of semitones.
--  
--  
-- * url : <http://www.csounds.com/manual/html/semitone.html>
 
semitone :: (X x0) => x0 -> x0
semitone x0sig = prefixOperation "semitone" args
  where args = [to x0sig]