-- | Loris Opcodes
module CsoundExpr.Opcodes.Spectral.Loris
    (lorisread,
     lorismorph,
     lorisplay)
where



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



-- | * opcode : lorisread
--  
--  
-- * syntax : 
--  
--  >   lorisread ktimpnt, ifilcod, istoreidx, kfreqenv, kampenv, kbwenv[, ifadetime]
--  
--  
-- * description : 
--  
--  lorisread imports a set of bandwidth-enhanced partials from a
-- SDIF-format data file, applying control-rate frequency,
-- amplitude, and bandwidth scaling envelopes, and stores the
-- modified partials in memory.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lorisread.html>
 
lorisread ::
            (K k0, K k1, K k2, K k3) =>
            [Irate] -> k0 -> String -> Irate -> k1 -> k2 -> k3 -> SignalOut
lorisread i0init k1timpnt s2file i3storeidx k4freqenv k5ampenv
  k6bwenv = outOpcode "lorisread" args
  where args
          = [to k1timpnt, to s2file, to i3storeidx, to k4freqenv,
             to k5ampenv, to k6bwenv]
              ++ map to i0init


-- | * opcode : lorismorph
--  
--  
-- * syntax : 
--  
--  >   lorismorph isrcidx, itgtidx, istoreidx, kfreqmorphenv, kampmorphenv, kbwmorphenv
--  
--  
-- * description : 
--  
--  lorismorph morphs two stored sets of bandwidth-enhanced partials
-- and stores a new set of partials representing the morphed sound.
-- The morph is performed by linearly interpolating the parameter
-- envelopes (frequency, amplitude, and bandwidth, or noisiness) of
-- the bandwidth-enhanced partials according to control-rate
-- frequency, amplitude, and bandwidth morphing functions.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lorismorph.html>
 
lorismorph ::
             (K k0, K k1, K k2) =>
             Irate -> Irate -> Irate -> k0 -> k1 -> k2 -> SignalOut
lorismorph i0srcidx i1tgtidx i2storeidx k3freqmorphenv
  k4ampmorphenv k5bwmorphenv = outOpcode "lorismorph" args
  where args
          = [to i0srcidx, to i1tgtidx, to i2storeidx, to k3freqmorphenv,
             to k4ampmorphenv, to k5bwmorphenv]


-- | * opcode : lorisplay
--  
--  
-- * syntax : 
--  
--  >   ar lorisplay ireadidx, kfreqenv, kampenv, kbwenv
--  
--  
-- * description : 
--  
--  lorisplay renders a stored set of bandwidth-enhanced partials
-- using the method of Bandwidth-Enhanced Additive Synthesis
-- implemented in the Loris software, applying control-rate
-- frequency, amplitude, and bandwidth scaling envelopes.
--  
--  
-- * url : <http://www.csounds.com/manual/html/lorisplay.html>
 
lorisplay :: (K k0, K k1, K k2) => Irate -> k0 -> k1 -> k2 -> Arate
lorisplay i0readidx k1freqenv k2ampenv k3bwenv
  = opcode "lorisplay" args
  where args = [to i0readidx, to k1freqenv, to k2ampenv, to k3bwenv]