-- | Comparators and Accumulators
module CsoundExpr.Opcodes.Math.SigmodCompaccum
    (maxA,
     maxK,
     max_k,
     maxabsA,
     maxabsK,
     maxabsaccum,
     maxaccum,
     minA,
     minK,
     minabsA,
     minabsK,
     minabsaccum,
     minaccum)
where



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



-- | * opcode : max
--  
--  
-- * syntax : 
--  
--  >   amax max ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmax max kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The max opcode takes any number of a-rate or k-rate signals as
-- input (all of the same rate), and outputs a signal at the same
-- rate that is the maximum of all of the inputs. For a-rate
-- signals, the inputs are compared one sample at a time (i.e. max
-- does not scan an entire ksmps period of a signal for its local
-- maximum as the max_k opcode does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/max.html>
 
maxA :: [Arate] -> Arate
maxA a0inN = opcode "max" args
  where args = map to a0inN


-- | * opcode : max
--  
--  
-- * syntax : 
--  
--  >   amax max ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmax max kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The max opcode takes any number of a-rate or k-rate signals as
-- input (all of the same rate), and outputs a signal at the same
-- rate that is the maximum of all of the inputs. For a-rate
-- signals, the inputs are compared one sample at a time (i.e. max
-- does not scan an entire ksmps period of a signal for its local
-- maximum as the max_k opcode does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/max.html>
 
maxK :: (K k0) => [k0] -> Krate
maxK k0inN = opcode "max" args
  where args = map to k0inN


-- | * opcode : max_k
--  
--  
-- * syntax : 
--  
--  >   knumkout max_k asig, ktrig, itype
--  
--  
-- * description : 
--  
--  max_k outputs the local maximum (or minimum) value of the
-- incoming asig signal, checked in the time interval between ktrig
-- has become true twice.
--  
--  
-- * url : <http://www.csounds.com/manual/html/max_k.html>
 
max_k :: (K k0) => Arate -> k0 -> Irate -> Krate
max_k a0sig k1trig i2type = opcode "max_k" args
  where args = [to a0sig, to k1trig, to i2type]


-- | * opcode : maxabs
--  
--  
-- * syntax : 
--  
--  >   amax maxabs ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmax maxabs kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The maxabs opcode takes any number of a-rate or k-rate signals
-- as input (all of the same rate), and outputs a signal at the same
-- rate that is the maximum of all of the inputs. It is identical to
-- the max opcode except that it takes the absolute value of each
-- input before comparing them. Therefore, the output is always
-- non-negative. For a-rate signals, the inputs are compared one
-- sample at a time (i.e. maxabs does not scan an entire ksmps
-- period of a signal for its local maximum as the max_k opcode
-- does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/maxabs.html>
 
maxabsA :: [Arate] -> Arate
maxabsA a0inN = opcode "maxabs" args
  where args = map to a0inN


-- | * opcode : maxabs
--  
--  
-- * syntax : 
--  
--  >   amax maxabs ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmax maxabs kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The maxabs opcode takes any number of a-rate or k-rate signals
-- as input (all of the same rate), and outputs a signal at the same
-- rate that is the maximum of all of the inputs. It is identical to
-- the max opcode except that it takes the absolute value of each
-- input before comparing them. Therefore, the output is always
-- non-negative. For a-rate signals, the inputs are compared one
-- sample at a time (i.e. maxabs does not scan an entire ksmps
-- period of a signal for its local maximum as the max_k opcode
-- does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/maxabs.html>
 
maxabsK :: (K k0) => [k0] -> Krate
maxabsK k0inN = opcode "maxabs" args
  where args = map to k0inN


-- | * opcode : maxabsaccum
--  
--  
-- * syntax : 
--  
--  >   maxabsaccum aAccumulator, aInput
--  
--  
-- * description : 
--  
--  maxabsaccum compares two audio-rate variables and stores the
-- maximum of their absolute values into the first.
--  
--  
-- * url : <http://www.csounds.com/manual/html/maxabsaccum.html>
 
maxabsaccum :: Arate -> Arate -> SignalOut
maxabsaccum a0Accumulator a1Input = outOpcode "maxabsaccum" args
  where args = [to a0Accumulator, to a1Input]


-- | * opcode : maxaccum
--  
--  
-- * syntax : 
--  
--  >   maxaccum aAccumulator, aInput
--  
--  
-- * description : 
--  
--  maxaccum compares two audio-rate variables and stores the
-- maximum value between them into the first.
--  
--  
-- * url : <http://www.csounds.com/manual/html/maxaccum.html>
 
maxaccum :: Arate -> Arate -> SignalOut
maxaccum a0Accumulator a1Input = outOpcode "maxaccum" args
  where args = [to a0Accumulator, to a1Input]


-- | * opcode : min
--  
--  
-- * syntax : 
--  
--  >   amin min ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmin min kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The min opcode takes any number of a-rate or k-rate signals as
-- input (all of the same rate), and outputs a signal at the same
-- rate that is the minimum of all of the inputs. For a-rate
-- signals, the inputs are compared one sample at a time (i.e. min
-- does not scan an entire ksmps period of a signal for its local
-- minimum as the max_k opcode does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/min.html>
 
minA :: [Arate] -> Arate
minA a0inN = opcode "min" args
  where args = map to a0inN


-- | * opcode : min
--  
--  
-- * syntax : 
--  
--  >   amin min ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmin min kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The min opcode takes any number of a-rate or k-rate signals as
-- input (all of the same rate), and outputs a signal at the same
-- rate that is the minimum of all of the inputs. For a-rate
-- signals, the inputs are compared one sample at a time (i.e. min
-- does not scan an entire ksmps period of a signal for its local
-- minimum as the max_k opcode does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/min.html>
 
minK :: (K k0) => [k0] -> Krate
minK k0inN = opcode "min" args
  where args = map to k0inN


-- | * opcode : minabs
--  
--  
-- * syntax : 
--  
--  >   amin minabs ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmin minabs kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The minabs opcode takes any number of a-rate or k-rate signals
-- as input (all of the same rate), and outputs a signal at the same
-- rate that is the minimum of all of the inputs. It is identical to
-- the min opcode except that it takes the absolute value of each
-- input before comparing them. Therefore, the output is always
-- non-negative. For a-rate signals, the inputs are compared one
-- sample at a time (i.e. minabs does not scan an entire ksmps
-- period of a signal for its local minimum as the max_k opcode
-- does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/minabs.html>
 
minabsA :: [Arate] -> Arate
minabsA a0inN = opcode "minabs" args
  where args = map to a0inN


-- | * opcode : minabs
--  
--  
-- * syntax : 
--  
--  >   amin minabs ain1 [, ain2] [, ain3] [, ain4] [...]
--  >   kmin minabs kin1 [, kin2] [, kin3] [, kin4] [...]
--  
--  
-- * description : 
--  
--  The minabs opcode takes any number of a-rate or k-rate signals
-- as input (all of the same rate), and outputs a signal at the same
-- rate that is the minimum of all of the inputs. It is identical to
-- the min opcode except that it takes the absolute value of each
-- input before comparing them. Therefore, the output is always
-- non-negative. For a-rate signals, the inputs are compared one
-- sample at a time (i.e. minabs does not scan an entire ksmps
-- period of a signal for its local minimum as the max_k opcode
-- does).
--  
--  
-- * url : <http://www.csounds.com/manual/html/minabs.html>
 
minabsK :: (K k0) => [k0] -> Krate
minabsK k0inN = opcode "minabs" args
  where args = map to k0inN


-- | * opcode : minabsaccum
--  
--  
-- * syntax : 
--  
--  >   minabsaccum aAccumulator, aInput
--  
--  
-- * description : 
--  
--  minabsaccum compares two audio-rate variables and stores the
-- minimum of their absolute values into the first.
--  
--  
-- * url : <http://www.csounds.com/manual/html/minabsaccum.html>
 
minabsaccum :: Arate -> Arate -> SignalOut
minabsaccum a0Accumulator a1Input = outOpcode "minabsaccum" args
  where args = [to a0Accumulator, to a1Input]


-- | * opcode : minaccum
--  
--  
-- * syntax : 
--  
--  >   minaccum aAccumulator, aInput
--  
--  
-- * description : 
--  
--  minaccum compares two audio-rate variables and stores the
-- minimum value between them into the first.
--  
--  
-- * url : <http://www.csounds.com/manual/html/minaccum.html>
 
minaccum :: Arate -> Arate -> SignalOut
minaccum a0Accumulator a1Input = outOpcode "minaccum" args
  where args = [to a0Accumulator, to a1Input]