hsc3-auditor-0.15: Haskell SuperCollider Auditor

Safe HaskellNone
LanguageHaskell98

Sound.SC3.Auditor.Smplr

Contents

Description

Auditor sampler synthdef.

Synopsis

Documentation

fold_midi :: (Ord n, Num n, Num r, Fractional r) => (n, n) -> (r, n) -> (r, n) Source

If a note is not in range, shift until it is in range and set playback rate.

map (fold_midi (59,87)) [(1,50.5),(1,60.5),(1,90.5)] == [(0.5,62.5),(1.0,60.5),(2.0,78.5)]

param_merge :: Param -> Param -> Param Source

Right biased

smplr :: (Bool, Bool) -> Synthdef Source

Trivial file playback instrument. The rdelay parameter sets the maximum pre-delay time (in seconds), each instance is randomly pre-delayed betwee zero and the indicated time. The ramplitude parameter sets the maximum amplitude offset of the amp parameter, each instance is randomly amplified between zero and the indicated value.

If use_gate is True the synth ends either when the sound file ends or the gate closes, else there is a sustain parameter and a linear envelope with a decay time of decay is applied.

If pan is True the sampler pans according to the pan parameter, else it writes directly to bus.

let {u = [False,True]; opt = [(a,b) | a <- u, b <- u]}
in withSC3 (mapM_ async (map (d_recv . smplr) opt))
import Sound.SC3.Lang.Control.Event
import Sound.SC3.Lang.Pattern.ID
audition (pbind [(K_instr,psynth (smplr (True,True)))
                ,(K_param "bufnum",pseries 0 1 (29 * 3))
                ,(K_param "attack",0.25)
                ,(K_param "decay",0.15)
                ,(K_dur,0.35)])
audition (pbind [(K_instr,psynth (smplr (True,True)))
                ,(K_param "bufnum",pwhitei 'a' 0 (6 * 6) inf)
                ,(K_param "startpos",0.15 * 48000)
                ,(K_param "attack",0.15)
                ,(K_amp,pwhite 'b' 0.15 0.65 inf)
                ,(K_param "pan",pwhite 'c' (-1) 1 inf)
                ,(K_dur,pwhite 'd' 0.15 1.65 inf)])

mcons :: Maybe a -> [a] -> [a] Source

type SMPLR_OPT = ((Int, Int), String, Int, Int, (Double, Double), Int, Int, Param) Source

Sampler options, (rng,ch,nid,b0,(aT,rT),bus,grp,p2)

ch = channel assignment mode, nid = node id, b0 = buffer zero, aT = attack time, rT = release time, bus = output bus, grp = group to allocate node at, p2 = further synthesis parameters

smplr_msg :: SMPLR_OPT -> (Int, Double) -> Maybe Double -> Double -> Message Source

Make smplr control Message.

m = midi note number, dt = detune (cents), du = duration, g = gain,

smplr_recv_all_msg :: [Message] Source

d_recv messages for all smplr variants.

smplr_load_all :: IO () Source

Load all smplr variants.

NC