module Haskore.Interface.Signal.Example.FMBassLine where
import qualified Synthesizer.Plain.Filter.NonRecursive as FiltNR
import qualified Synthesizer.Plain.Oscillator as Osci
import qualified Synthesizer.Plain.Signal as Sig
import Synthesizer.Plain.Instrument (fmBell)
import qualified Sox.File
import qualified Haskore.Basic.Pitch as Pitch
import qualified Haskore.Melody as Melody
import Haskore.Melody.Standard as StdMelody
import qualified Haskore.Music as Music
import Haskore.Music.Standard as StdMusic
import qualified Haskore.Performance.Fancy as FancyPf
import qualified Haskore.Interface.Signal.Note as Note
import qualified Haskore.Interface.Signal.Write as MusicSignal
import Haskore.Interface.Signal.Write(Time, Volume)
import qualified Number.NonNegative as NonNeg
import System.Random
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import System.Exit(ExitCode)
import PreludeBase
import NumericPrelude
data MyNote =
Bass ModIndex ModDepth Pitch.T
| Saw Volume Vibrato Pitch.T
deriving (Show, Eq, Ord)
type ModIndex = Int
type ModDepth = Time
type ModParam = (ModIndex, ModDepth)
type Vibrato = Time
type NoteIon = Music.Dur -> () -> Melody.T ()
makeBassLine :: [NoteIon] -> [ModIndex] -> [ModDepth] -> Music.T MyNote
makeBassLine mel indexes depths = line
(zipWith3 (\n index depth ->
Music.mapNote
(\(Melody.Note _ p) -> (Bass index depth p))
(n en ()))
mel indexes depths)
bassPattern :: [NoteIon]
bassPattern =
cycle [a 0, a 0, a 0, e 1, a 0, a 0, f 1, a 0, a 0, d 1, a 0, a 0]
bassLine :: Music.T MyNote
bassLine =
transpose (12)
(makeBassLine bassPattern
(randomRs (1,4) (mkStdGen 12354))
(randomRs (0,2) (mkStdGen 35902)))
makeSawLine :: [([NoteIon], [(Dur, Dur, Vibrato)])] -> Music.T MyNote
makeSawLine = line . concatMap
(\(chrd, params) ->
map (\(durTone,durRest,vib) ->
let mkNote dur vel =
chord (map (\n ->
Music.mapNote
(\(Melody.Note _ p) ->
(Saw vel vib p))
(n dur ()))
chrd)
in mkNote durTone 1 +:+ mkNote durRest 0.3)
params)
zn :: Dur
zn = NonNeg.fromNumber zero
sawPattern :: [([NoteIon], [(Dur, Dur, Vibrato)])]
sawPattern =
let v0 = (sn,sn,0.01)
v1 = (en,zn,0.02)
v2 = (qn,zn,0.05)
v3 = (qn,zn,0.00)
in cycle [([a 0, c 1, e 1], replicate 8 v0 ++ [v0,v0,v0,v1]),
([g 0, b 0, d 1], [v2]),
([a 0, c 1, e 1], [v3]),
([a 0, d 1, f 1], replicate 8 v0 ++ [v0,v0,v0,v1]),
([a 0, e 1, g 1], [v2]),
([a 0, d 1, f 1], [v3])]
sawLine :: Music.T MyNote
sawLine = makeSawLine sawPattern
song :: Music.T MyNote
song = bassLine =:= sawLine
noteToSignal ::
Time -> Volume -> Pitch.Relative -> MyNote -> Note.T Volume Volume
noteToSignal detune dyn trans note =
let freq p = detune * Note.pitchFromStd trans p
in Note.Cons (\sampleRate ->
case note of
Bass index depth p ->
FiltNR.amplifyVector (dyn * 0.3)
(fmBell sampleRate depth (fromIntegral index) (freq p))
Saw vel vib p ->
FiltNR.amplifyVector (dyn * vel*0.4)
(saw sampleRate vib 10 (freq p)))
saw :: (Module.C a a, Trans.C a, RealField.C a) =>
a -> a -> a -> a -> Sig.T a
saw sampleRate modDepth modFreq freq =
Osci.freqModSaw 0
(map (\y -> freq/sampleRate * (1+modDepth*y))
(Osci.staticSine 0.25 (modFreq/sampleRate)))
songToSignalMono :: Time -> Time -> Music.T MyNote -> Sig.T Volume
songToSignalMono sampleRate dif music =
MusicSignal.fromMusic
sampleRate (noteToSignal dif)
FancyPf.map
(MusicSignal.contextMetro 240 qn)
music
stereoSignal :: Time -> Sig.T (Volume,Volume)
stereoSignal sampleRate =
zip (songToSignalMono sampleRate 1.003 song)
(songToSignalMono sampleRate 0.997 song)
main :: IO ExitCode
main =
Sox.File.renderStereo "FMBassLine" 44100
(\sampleRate -> take (round (16*sampleRate)) (stereoSignal sampleRate))