-- | Converters
module CsoundExpr.Opcodes.Midi.Convert
    (cpsmidi,
     cpsmidibI,
     cpsmidibK,
     cpstmid,
     octmidi,
     octmidibI,
     octmidibK,
     pchmidi,
     pchmidibI,
     pchmidibK,
     ampmidi)
where



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



-- | * opcode : cpsmidi
--  
--  
-- * syntax : 
--  
--  >   icps cpsmidi
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event, expressed in
-- cycles-per-second.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpsmidi.html>
 
cpsmidi :: Irate
cpsmidi = opcode "cpsmidi" args
  where args = []


-- | * opcode : cpsmidib
--  
--  
-- * syntax : 
--  
--  >   icps cpsmidib [irange]
--  >   kcps cpsmidib [irange]
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event and modify it by
-- the current pitch-bend value, express it in cycles-per-second.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpsmidib.html>
 
cpsmidibI :: [Irate] -> Irate
cpsmidibI i0init = opcode "cpsmidib" args
  where args = map to i0init


-- | * opcode : cpsmidib
--  
--  
-- * syntax : 
--  
--  >   icps cpsmidib [irange]
--  >   kcps cpsmidib [irange]
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event and modify it by
-- the current pitch-bend value, express it in cycles-per-second.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpsmidib.html>
 
cpsmidibK :: [Irate] -> Krate
cpsmidibK i0init = opcode "cpsmidib" args
  where args = map to i0init


-- | * opcode : cpstmid
--  
--  
-- * syntax : 
--  
--  >   icps cpstmid ifn
--  
--  
-- * description : 
--  
--  This unit is similar to cpsmidi, but allows fully customized
-- micro-tuning scales.
--  
--  
-- * url : <http://www.csounds.com/manual/html/cpstmid.html>
 
cpstmid :: Irate -> Irate
cpstmid i0fn = opcode "cpstmid" args
  where args = [to i0fn]


-- | * opcode : octmidi
--  
--  
-- * syntax : 
--  
--  >   ioct octmidi
--  
--  
-- * description : 
--  
--  Get the note number, in octave-point-decimal units, of the
-- current MIDI event.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octmidi.html>
 
octmidi :: Irate
octmidi = opcode "octmidi" args
  where args = []


-- | * opcode : octmidib
--  
--  
-- * syntax : 
--  
--  >   ioct octmidib [irange]
--  >   koct octmidib [irange]
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event and modify it by
-- the current pitch-bend value, express it in octave-point-decimal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octmidib.html>
 
octmidibI :: [Irate] -> Irate
octmidibI i0init = opcode "octmidib" args
  where args = map to i0init


-- | * opcode : octmidib
--  
--  
-- * syntax : 
--  
--  >   ioct octmidib [irange]
--  >   koct octmidib [irange]
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event and modify it by
-- the current pitch-bend value, express it in octave-point-decimal.
--  
--  
-- * url : <http://www.csounds.com/manual/html/octmidib.html>
 
octmidibK :: [Irate] -> Krate
octmidibK i0init = opcode "octmidib" args
  where args = map to i0init


-- | * opcode : pchmidi
--  
--  
-- * syntax : 
--  
--  >   ipch pchmidi
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event, expressed in
-- pitch-class units.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pchmidi.html>
 
pchmidi :: Irate
pchmidi = opcode "pchmidi" args
  where args = []


-- | * opcode : pchmidib
--  
--  
-- * syntax : 
--  
--  >   ipch pchmidib [irange]
--  >   kpch pchmidib [irange]
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event and modify it by
-- the current pitch-bend value, express it in pitch-class units.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pchmidib.html>
 
pchmidibI :: [Irate] -> Irate
pchmidibI i0init = opcode "pchmidib" args
  where args = map to i0init


-- | * opcode : pchmidib
--  
--  
-- * syntax : 
--  
--  >   ipch pchmidib [irange]
--  >   kpch pchmidib [irange]
--  
--  
-- * description : 
--  
--  Get the note number of the current MIDI event and modify it by
-- the current pitch-bend value, express it in pitch-class units.
--  
--  
-- * url : <http://www.csounds.com/manual/html/pchmidib.html>
 
pchmidibK :: [Irate] -> Krate
pchmidibK i0init = opcode "pchmidib" args
  where args = map to i0init


-- | * opcode : ampmidi
--  
--  
-- * syntax : 
--  
--  >   iamp ampmidi iscal [, ifn]
--  
--  
-- * description : 
--  
--  Get the velocity of the current MIDI event.
--  
--  
-- * url : <http://www.csounds.com/manual/html/ampmidi.html>
 
ampmidi :: [Irate] -> Irate -> Irate
ampmidi i0init i1scal = opcode "ampmidi" args
  where args = [to i1scal] ++ map to i0init