module Haskore.Interface.SuperCollider.Example where import qualified Haskore.Interface.SuperCollider.Play as Play import qualified Haskore.Interface.SuperCollider.Render as Render import qualified Haskore.Interface.SuperCollider.Schedule as Schedule import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap import Haskore.Interface.SuperCollider.SoundMap (InstrumentUGen, DrumUGen) import qualified Sound.SC3.UGen.UGen as SCUGen import qualified Sound.SC3.UGen.Math as SCMath import qualified Sound.SC3.UGen.Rate as SCRate import qualified Sound.SC3.UGen.Oscillator as SCOsci import qualified Sound.SC3.UGen.Filter as SCFilter import qualified Sound.SC3.UGen.Noise.Base as SCNoise import qualified Sound.SC3.UGen.Envelope as SCEnv import qualified Sound.SC3.UGen.Envelope.Construct as SCEnvCons import Sound.SC3.UGen.Enum (DoneAction(DoNothing, PauseSynth), EnvCurve(EnvLin, EnvSin)) import Sound.SC3.UGen.UGen (UGen) import Haskore.Melody.Standard as StdMelody import qualified Haskore.Melody as Melody import Haskore.Music.Rhythmic as RhyMusic import qualified Haskore.Music.GeneralMIDI as MidiMusic import qualified Haskore.Music as Music import qualified Haskore.Example.ChildSong6 as ChildSong6 import qualified Haskore.Example.Kantate147 as Kantate147 import qualified Haskore.Basic.Drum as Drum import qualified Haskore.Basic.Chord as Chord import qualified Haskore.Interface.AutoTrack.Rhythm as Rhythm import qualified Data.ByteString.Lazy as B import Data.List (genericLength) import Data.Ratio(Rational,(%)) import System.Random (randomRs, mkStdGen) latency :: Double latency = 0.1 type Song = (String, Schedule.T) play :: Song -> IO () play = Play.schedule latency . snd render :: Song -> IO () render (fileName, schedule) = do B.writeFile (fileName++".osc") (Render.byteStringFromSchedule schedule) Render.runSCSynth [] 2 Render.AIFF Render.Int16 44100 fileName return () glissandoStrings :: InstrumentUGen glissandoStrings vel freq = (tone0 + tone1) * volume where -- control = SCFilter.hpf freqSig 7 + freqSig control = SCFilter.lag freq 0.2 volume = vel * 0.3 tone0 = SCOsci.saw SCRate.AR (control * SCUGen.MCE [0.998, 1.005]) tone1 = SCOsci.saw SCRate.AR (control * SCUGen.MCE [0.995, 1.002]) reverb :: UGen -> UGen -> UGen reverb dec x = 0.7*x + 0.03 * sum (map (\delfl -> let del = SCUGen.Constant delfl in SCFilter.combN x del del dec) (take 8 (randomRs (0.01,0.03) (mkStdGen 2347)))) filterStrings :: InstrumentUGen filterStrings vel freq = let lfo = SCOsci.sinOsc SCRate.KR 0.1 0 * 1500 + 2000 sweep = SCFilter.rlpf (glissandoStrings vel freq) lfo 0.1 in reverb 3 sweep glissando :: Song glissando = ("Glissando", Schedule.fromMelody filterStrings $ changeTempo 3 $ transpose (-48) $ ChildSong6.mainVoice) -- | normalize a list of numbers, such that they have a specific average normalizeLevel :: Fractional a => a -> [a] -> [a] normalizeLevel newAvrg xs = let avrg = sum xs / genericLength xs in map ((newAvrg-avrg)+) xs strings :: InstrumentUGen strings vel freq = let n = 5 volume = vel * 0.5 / sqrt (fromIntegral n) detunes = normalizeLevel 1 $ take (2*n) $ randomRs (0,0.03) $ mkStdGen 912 phases = randomRs (0,2) $ mkStdGen 54 tones = zipWith (\detune phase -> SCOsci.lfSaw SCRate.AR (freq*detune) phase) detunes phases (tonesLeft,tonesRight) = splitAt n tones in volume * SCUGen.MCE [sum tonesLeft, sum tonesRight] modulatedStrings :: InstrumentUGen modulatedStrings vel freq = let n = 3 volume = vel * 0.3 / sqrt (fromIntegral n) tones = zipWith3 (\depth rate phase -> SCOsci.saw SCRate.AR (freq * (1 + depth * SCOsci.sinOsc SCRate.KR rate phase))) (randomRs (0,0.015) (mkStdGen 912)) (randomRs (2,5) (mkStdGen 105)) (randomRs (0,2*pi) (mkStdGen 234)) (tonesLeft,tonesRight) = splitAt n $ take (2*n) tones in volume * SCUGen.MCE [sum tonesLeft, sum tonesRight] brass :: InstrumentUGen brass vel freq = tone0 + tone1 + tone2 where volume = vel * 0.3 detune = SCEnv.xLine SCRate.KR 10 0.00001 2 PauseSynth tone0 = SCOsci.saw SCRate.AR (freq*(1-0.004*detune)) * volume tone1 = SCOsci.saw SCRate.AR (freq*(1-0.001*detune)) * volume tone2 = SCOsci.saw SCRate.AR (freq*(1+0.005*detune)) * volume sawPerc :: InstrumentUGen sawPerc vel freq = prc * 0.3 where -- env = SCEnv.envGen SCRate.KR 1 2 0 1 PauseSynth SCEnv.envperc' env = SCEnv.xLine SCRate.KR 1.5 0.1 1 PauseSynth saw = vel * SCEnv.xLine SCRate.KR 1 0.05 5 DoNothing * SCOsci.saw SCRate.AR freq prc = SCFilter.rlpf saw (exp env * freq * 1.2) 0.05 dynPerc :: UGen -> InstrumentUGen dynPerc detune vel freq = prc * 0.1 where env = SCEnv.xLine SCRate.KR 1.5 0.1 1 DoNothing saw = SCEnv.xLine SCRate.KR 1 0.05 5 DoNothing * SCOsci.saw SCRate.AR (SCUGen.MCE [freq*(1-detune), freq*(1+detune)]) prc = SCFilter.rlpf saw (exp (2*vel*env) * freq * 1.2) 0.05 fmBass :: UGen -> InstrumentUGen fmBass ratio vel freq = osci * 1 where env = SCEnv.xLine SCRate.KR 1 0.01 1 DoNothing modOsci = SCOsci.sinOsc SCRate.AR (ratio*freq) 0 * env * vel * 10 osci = SCOsci.sinOsc SCRate.AR freq modOsci *env fmGuitar :: UGen -> InstrumentUGen fmGuitar ratio vel freq = let modEnv = SCEnv.xLine SCRate.KR 0.5 2 5 DoNothing modOsci = SCOsci.sinOsc SCRate.AR (ratio*freq) 0 * modEnv * vel * 10 env = SCEnv.xLine SCRate.KR 1 0.01 5 DoNothing lfo = SCOsci.sinOsc SCRate.KR 3 0 * 10 osci = SCOsci.sinOsc SCRate.AR (freq+lfo) modOsci * env in osci xylophone :: InstrumentUGen xylophone vel freq = let env1 = SCEnv.xLine SCRate.KR 1.5 0.03 0.2 PauseSynth sine1 = SCOsci.sinOsc SCRate.AR freq 0 * env1 env2 = SCEnv.xLine SCRate.KR 1.5 0.01 0.2 PauseSynth sine2 = SCOsci.sinOsc SCRate.AR (3*freq) 0 * env2 * vel in sine1 + sine2 harpsichord :: InstrumentUGen harpsichord vel freq = let env = SCEnv.xLine SCRate.KR 1.5 0.03 1 PauseSynth saw = SCOsci.saw SCRate.AR (SCUGen.MCE [freq*0.995, freq*1.005]) * env * vel in saw {- | The 'dust' UGen as provided by SuperCollider has a problem: The higher the sample rate, the more narrow are the impulses, the less volume you obtain. We work-around this by choosing a larger impulse. (We could also use a fixed width for the impulses.) -} colorDust :: Double -> InstrumentUGen colorDust sampleRate _vel freq = 0.0005 * SCFilter.rlpf (SCUGen.Constant sampleRate * SCNoise.dust zeroUId SCRate.AR 10) freq 0.01 flangerSquare :: UGen -> UGen flangerSquare freq = SCOsci.pulse SCRate.AR freq (0.5 + 0.3 * SCOsci.sinOsc SCRate.KR 0.5 0) cubicSine :: UGen -> UGen cubicSine freq = let osci = SCOsci.sinOsc SCRate.AR (SCUGen.MCE [freq*1.003, freq*0.997]) 0 in osci*osci*osci cubicPhaserSaw :: UGen -> UGen cubicPhaserSaw freq = let osci dfreq = sum $ map (SCOsci.saw SCRate.AR) [dfreq*1.003, dfreq*0.997] osciCubic dfreq = osci dfreq * osci dfreq * osci dfreq in SCUGen.MCE [osciCubic (freq*1.002), osciCubic (freq*0.998)] midiInstrMap :: SoundMap.InstrumentTable MidiMusic.Instr midiInstrMap = [(MidiMusic.AcousticGrandPiano, sawPerc), (MidiMusic.SynthBass1, dynPerc (SCUGen.Constant 0.003)), (MidiMusic.SynthBrass1, brass), (MidiMusic.StringEnsemble1, strings)] childSong :: Song childSong = ("ChildSong", Schedule.fromMusic (Schedule.rhythmicMusic [] midiInstrMap) -- (changeTempo 3 (transpose (-48) (MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano ChildSong6.mainVoice))) (loudness 0.5 $ changeTempo 1 $ transpose 0 ChildSong6.song)) bassMusic :: MidiMusic.T bassMusic = MidiMusic.fromStdMelody MidiMusic.SynthBass1 (Music.line (zipWith (\n v -> n tn [Velocity (v%1000)]) (cycle [c 0, d 0, g 0, d 0]) (randomRs (0,1000) (mkStdGen 142)))) bass :: Song bass = ("BassPercs", Schedule.fromMusic (Schedule.rhythmicMusic [] midiInstrMap) bassMusic) bassFinite :: Song bassFinite = ("BassPercs", Schedule.fromMusic (Schedule.rhythmicMusic [] midiInstrMap) $ Music.take 4 bassMusic) {- | Oscillator with the waveform of a parabola. The parabola is created by moving a saw up or down, and squaring it. That is we repeat the function @\x -> (x+s)^2@. The crux is the subsequent normalization to zero DC offset. This boils down to a parabola plus a saw. -} parabolaOsci :: UGen {- ^ Zero means a perfect parabola. The higher the absolute value, the closer is the waveform to a saw. -} -> UGen {- ^ frequency -} -> UGen parabolaOsci straight freq = let x = SCOsci.saw SCRate.AR freq {- integrate parabola, average and subtract offset (1+s)^3-(-1+s)^3)/3 = (3*s^2+1)*2/3 (x+s)^2 - (3*s^2+1)*2/(3*2) = (x+s)^2 - (3*s^2+1)/3 = x^2 + 2*s*x - 1/3 -} in (x+2*straight) * x - 1/3 kantate147 :: Song kantate147 = ("Kantate147", Schedule.fromMusicGlobalEffect (Schedule.rhythmicMusic [] midiInstrMap) (\sig -> flip SCMath.clip2 1 $ 0.5*sig + 0.2*SCFilter.combN sig 0.2 0.2 5, 2) $ MidiMusic.fromMelodyIgnoreAttr MidiMusic.StringEnsemble1 $ loudness 0.5 $ transpose (-12) $ changeTempo 2 Kantate147.song) ------------------------------------------------------------------- pad :: UGen -> InstrumentUGen pad dur vel freq = filtered where filtered = SCFilter.bpf mix filterFreq 0.3 filterFreq = SCEnv.xLine SCRate.KR 100 4000 totalDur DoNothing totalDur = 3 + dur mix = (tone0 + tone1) * env * vel * 0.2 env = SCEnv.envGen SCRate.KR 1 2 0 1 PauseSynth (SCEnvCons.envSine totalDur 1) -- (bridge 1 dur 1) tone0 = SCOsci.saw SCRate.AR (freq * SCUGen.MCE [0.998, 1.005]) tone1 = SCOsci.saw SCRate.AR (freq * SCUGen.MCE [0.995, 1.002]) bridge :: UGen -> UGen -> UGen -> [UGen] bridge fadeDur sustainDur lvl = let segTypes = [EnvSin, EnvLin, EnvSin] clippedFadeDur = min fadeDur sustainDur in SCEnvCons.env [0, lvl, lvl, 0] [clippedFadeDur, max 0 (sustainDur-fadeDur), clippedFadeDur] segTypes (-1) (-1) zeroUId :: SCUGen.UGenId zeroUId = SCUGen.UGenId 0 hihat :: DrumUGen hihat vel = let noise = SCNoise.whiteNoise zeroUId SCRate.AR in SCFilter.hpf noise (SCUGen.MCE [4000, 4001]) * SCEnv.xLine SCRate.KR 1 0.01 0.2 DoNothing * vel * 0.25 bassdrum :: DrumUGen bassdrum vel = let freq = SCEnv.xLine SCRate.KR 100 10 0.5 DoNothing env = SCEnv.xLine SCRate.KR 1 0.1 0.5 DoNothing * vel * 0.8 osci = SCOsci.sinOsc SCRate.AR freq 0 * SCUGen.MCE [env,env] in SCMath.clip2 0.5 osci data Instrument = SynthBass Double | Pad Double deriving (Eq, Ord) data Drum = Hihat | BassDrum deriving (Show, Eq, Ord) instrMap :: SoundMap.InstrumentTableWithParameters Instrument instrMap = SoundMap.instrument1 "synthbass" (\x -> do SynthBass detune <- Just x; Just detune) -- (\x -> case x of SynthBass detune -> Just detune; _ -> Nothing) dynPerc : SoundMap.instrument1 "pad" (\x -> do Pad dur <- Just x; Just dur) pad : [] drumMap :: SoundMap.DrumTableWithParameters Drum drumMap = SoundMap.drumEq "hihat" Hihat hihat : SoundMap.drumEq "bassdrum" BassDrum bassdrum : [] synthBassAttrsToInstr :: (Rational,Double) -> (Rational, Instrument) synthBassAttrsToInstr (vel,detune) = (vel, SynthBass detune) synthBassMelody :: Melody.T (Rational,Double) synthBassMelody = Music.line (zipWith (\n (vel,detune) -> n tn (vel%1000,detune)) (cycle [c 0, d 0, g 0, d 0]) (zip (randomRs (0,1000) (mkStdGen 142)) (randomRs (-0.02,0.02) (mkStdGen 857)))) padAttrsToInstr :: Double -> (Rational, Instrument) padAttrsToInstr dur = (1, Pad dur) padMelody :: Melody.T Double padMelody = Music.legato wn $ Music.line $ cycle $ map (\(dur, chd) -> Chord.harmonicGen (4 * fromRational dur) dur chd) [(hn, [c 1, e 1, a 1]), (hn, [b 0, e 1, g 1]), (hn, [a 0, d 1, f 1]), (hn, [b 0, d 1, g 1])] rhythm :: RhyMusic.T Drum Instrument rhythm = Music.repeat (Drum.toMusic Hihat tn []) =:= Music.repeat (Rhythm.withDrumUnit tn (Rhythm.fromString "x..x..x..x..x...") BassDrum) chillOutMusic :: RhyMusic.T Drum Instrument chillOutMusic = RhyMusic.fromMelody synthBassAttrsToInstr synthBassMelody =:= RhyMusic.fromMelody padAttrsToInstr padMelody =:= rhythm chillOut :: Song chillOut = ("ChillOut", Schedule.fromMusic (Schedule.rhythmicMusicWithParameters drumMap instrMap) chillOutMusic) chillOutFinite :: Song chillOutFinite = ("ChillOut", Schedule.fromMusicGlobalEffect (Schedule.rhythmicMusicWithParameters drumMap instrMap) (flip SCMath.clip2 1, 2) $ Music.take 4 chillOutMusic) data InstrumentTriplet = SawPerc | DynPerc Double deriving (Eq, Ord) sawPercAssign :: SoundMap.InstrumentAssign InstrumentTriplet sawPercAssign = SoundMap.instrument "sawPerc" (\x -> do SawPerc <- Just x; Just ()) sawPerc dynPercAssign :: SoundMap.InstrumentAssign InstrumentTriplet dynPercAssign = SoundMap.instrument1 "dynPerc" (\x -> do DynPerc detune <- Just x; Just detune) dynPerc tripletsMusic :: RhyMusic.T Drum InstrumentTriplet tripletsMusic = let mainMel = RhyMusic.fromMelody (\() -> (1, SawPerc)) $ Music.transpose 12 $ Music.line $ cycle [c 0 qn (), b 0 qn (), c 1 qn ()] bassMel = RhyMusic.fromMelody (\detune -> (1, DynPerc detune)) $ Music.line $ cycle [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01] in Music.changeTempo 2 $ Music.chord [Music.changeTempo 3 mainMel, bassMel] triplets :: Song triplets = ("Triplets", Schedule.fromRhythmicMusicSoundEffects (SoundMap.registerInstrument dynPercAssign $ \dynPercUGen -> SoundMap.registerInstrument sawPercAssign $ \sawPercUGen -> let lfoSine = exp (SCOsci.sinOsc SCRate.KR 0.2 (-pi/2) * 0.5) * 1000 lfoSquare = exp (SCOsci.pulse SCRate.KR 5.1 0.5 * 1) * 1000 mix = SCFilter.rlpf (0.5 * sawPercUGen) lfoSine 0.1 + SCFilter.rlpf (0.5 * dynPercUGen) lfoSquare 0.1 in SoundMap.soundEffect mix) 2 tripletsMusic)