module Haskore.Interface.Signal.Example.WinterAde where
import qualified Synthesizer.Plain.Filter.Recursive.Comb as Comb
import qualified Synthesizer.Plain.Signal as Sig
import qualified Haskore.Interface.Signal.InstrumentMap as InstrMap
import qualified Haskore.Interface.Signal.Write as MusicSignal
import Haskore.Interface.Signal.Write(NonNegTime, Time, Volume)
import Haskore.Melody.Standard as StdMelody
import qualified Haskore.Music as Music
import Haskore.Music.Rhythmic as RhyMusic
import qualified Haskore.Performance.Fancy as FancyPf
import qualified Haskore.Performance.Context as Context
import qualified Haskore.Basic.Duration as Dur
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import Synthesizer.Plain.Displacement (mix)
import Synthesizer.Plain.Filter.NonRecursive (fadeInOut)
import Synthesizer.Plain.Instrument (bell, squareBell, fatSaw, filterSweep, )
import qualified Sox.File
import System.Exit(ExitCode)
import PreludeBase
import NumericPrelude
melody0, melody1,
partA, partB, partC0, partC1,
partD0, partD1, partE0, partE1,
bassLine0, bassLine1, chordPad
:: StdMelody.T
melody0 = Music.transpose 12 (line [partA, partA, partB, partC0, partD0, partE0])
melody1 = Music.transpose 12 (line [partA, partA, partB, partC1, partD1, partE1])
chordDur :: t -> [t -> NoteAttributes -> StdMelody.T] -> StdMelody.T
chordDur dr chd = chord (map (\n -> n dr na) chd)
partA = line [chordDur qn [g 0, c 1, e 1],
chordDur qn [g 0, c 1, e 1],
chordDur qn [g 0, b 0, d 1],
chordDur dhn [e 0, g 0, c 1] ]
partB = line [chordDur qn [g 0, c 1, e 1],
chordDur qn [g 0, d 1, f 1],
chordDur qn [g 0, e 1, g 1],
chordDur qn [a 0, d 1, g 1],
chordDur en [a 0, d 1, f 1],
chordDur en [a 0, d 1, e 1],
chordDur qn [a 0, c 1, f 1] ]
partC0 = line [chordDur qn [g 0, b 0, d 1],
chordDur qn [g 0, c 1, e 1],
chordDur qn [g 0, d 1, f 1],
chordDur qn [g 0, c 1, f 1],
chordDur en [g 0, c 1, e 1],
chordDur en [g 0, c 1, d 1],
chordDur qn [g 0, b 0, e 1] ]
partC1 = line [chordDur qn [g 0, b 0, d 1],
chordDur qn [g 0, c 1, e 1],
chordDur qn [g 0, d 1, f 1],
chordDur qn [gs 0, d 1, f 1],
chordDur en [gs 0, c 1, e 1],
chordDur en [gs 0, c 1, d 1],
chordDur qn [a 0, c 1, e 1] ]
partD0 = line [chordDur qn [a 0, c 1, e 1],
chordDur qn [a 0, c 1, e 1],
chordDur qn [g 0, d 1, f 1],
chordDur dhn [g 0, c 1, g 1] ]
partD1 = line [chordDur qn [g 0, c 1, e 1],
chordDur qn [g 0, c 1, e 1],
chordDur qn [a 0, c 1, f 1],
chordDur dhn [c 1, e 1, g 1] ]
partE0 = line [chordDur qn [f 0, a 0, e 1],
chordDur qn [f 0, a 0, e 1],
chordDur qn [g 0, b 0, d 1],
chordDur dhn [e 0, g 0, c 1] ]
partE1 = line [chordDur qn [fs 0, a 0, e 1],
chordDur qn [fs 0, a 0, e 1],
chordDur qn [g 0, b 0, d 1],
chordDur dwn [e 0, g 0, c 1] ]
bassLine :: [Dur -> NoteAttributes -> StdMelody.T] -> StdMelody.T
bassLine x =
Music.transpose (12) (line (map (\n -> n en na) x))
bassLine0 = bassLine (bassA ++ bassA ++ bassB ++ bassC0 ++ bassD0 ++ bassE0)
bassLine1 = bassLine (bassA ++ bassA ++ bassB ++ bassC1 ++ bassD1 ++ bassE1)
bassA, bassB, bassC0, bassD0, bassE0,
bassC1, bassD1, bassE1 :: [Dur -> NoteAttributes -> StdMelody.T]
bassA = [c 0, g 0, c 1, g 0, d 1, g 0,
c 0, g 0, e 1, g 0, d 1, g 0 ]
bassB = [c 0, g 0, c 1, g 0, e 1, g 0,
d 0, a 0, d 1, a 0, f 1, a 0 ]
bassC0 = [d 0, g 0, d 1, g 0, f 1, g 0,
c 0, g 0, c 1, g 0, b 0, g 0 ]
bassD0 = [e 0, a 0, e 1, a 0, g 0, d 1,
c 0, g 0, c 1, g 0, g 1, c 1 ]
bassE0 = [c 0, f 0, c 1, f 0, d 0, d 1,
c 0, g 0, c 1, g 0, d 1, g 0 ]
bassC1 = [d 0, g 0, d 1, g 0, f 1, g 0,
e 0, gs 0, e 1, gs 0, e 1, a 0 ]
bassD1 = [c 0, g 0, c 1, g 0, d 1, g 0,
c 0, g 0, e 1, g 0, d 1, g 0 ]
bassE1 = [d 0, fs 0, d 1, fs 0, d 1, g 0,
c 0, g 0, c 1, g 0, d 1, g 0 ]
chordPad = Music.transpose (12) (
line [chordDur (15*qn) [g 0, c 1, e 1],
chordDur ( 2*qn) [a 0, d 1, f 1],
chordDur ( qn) [a 0, c 1, f 1],
chordDur ( 3*qn) [b 0, d 1, g 1],
chordDur ( 2*qn) [b 0, e 1, gs 1],
chordDur ( qn) [c 1, e 1, a 1],
chordDur ( 2*qn) [g 0, c 1, e 1],
chordDur ( qn) [a 0, c 1, f 1],
chordDur ( 3*qn) [c 1, e 1, g 1],
chordDur ( 2*qn) [fs 0, a 0, e 1],
chordDur ( qn) [g 0, b 0, d 1],
chordDur ( 6*qn) [e 0, g 0, c 1] ] )
data Instrument =
Bell
| Bass
| Pad
deriving (Eq, Ord)
type Music = RhyMusic.T () Instrument
context :: Context.T NonNegTime Volume (RhyMusic.Note () Instrument)
context = MusicSignal.contextMetro 120 qn
instrMap :: InstrMap.InstrumentTable Time Volume Instrument
instrMap =
[(Bell, MusicSignal.amplify (0.2::Volume) bell ),
(Bass, MusicSignal.amplify (0.2::Volume) squareBell),
(Pad, MusicSignal.amplify (0.2::Volume) fatSaw )]
defltSampleRate :: Ring.C a => a
defltSampleRate = 11025
songToSignalMono :: Time -> Music -> Sig.T Volume
songToSignalMono dif song =
MusicSignal.fromRhythmicMusic defltSampleRate
(MusicSignal.detuneInstrs dif instrMap)
FancyPf.map
context
song
songToSignalStereo :: Time -> Music -> Sig.T (Volume,Volume)
songToSignalStereo det song =
zip (songToSignalMono (1det) song)
(songToSignalMono (1+det) song)
melodySignal :: StdMelody.T -> Sig.T (Volume,Volume)
melodySignal mel =
let (musr, musl) = unzip (songToSignalStereo 0.001
(RhyMusic.fromStdMelody Bell mel))
in zip (Comb.run (round (0.19*defltSampleRate :: Time)) (0.4::Volume) musl)
(Comb.run (round (0.23*defltSampleRate :: Time)) (0.5::Volume) musr)
melodySignal0, melodySignal1 :: Sig.T (Volume,Volume)
melodySignal0 = melodySignal melody0
melodySignal1 = melodySignal melody1
durToSampleNum :: Music.Dur -> Int
durToSampleNum dr =
round (defltSampleRate * Context.getDur context * Dur.toNumber dr)
fadeChord :: Field.C a => [a] -> [a]
fadeChord =
fadeInOut
(durToSampleNum (2 * dhn))
(durToSampleNum (Music.dur chordPad 4 * dhn))
(durToSampleNum (2 * dhn))
chordSignal :: Sig.T (Volume,Volume)
chordSignal =
let (musr, musl) = unzip (songToSignalStereo 0.005
(RhyMusic.fromStdMelody Pad chordPad))
filt phase mus = filterSweep defltSampleRate phase (fadeChord mus)
in zip (filt (0.7::Volume) musl)
(filt (0.8::Volume) musr)
bassSignal :: StdMelody.T -> Sig.T (Volume,Volume)
bassSignal mel =
songToSignalStereo 0.005 (RhyMusic.fromStdMelody Bass mel)
bassSignal0, bassSignal1 :: Sig.T (Volume,Volume)
bassSignal0 = bassSignal bassLine0
bassSignal1 = bassSignal bassLine1
songSignal :: Sig.T (Volume,Volume)
songSignal =
foldl1 mix [melodySignal0, bassSignal0] ++
foldl1 mix [melodySignal1, bassSignal1, chordSignal]
main :: IO ExitCode
main = Sox.File.writeStereo "WinterAde" defltSampleRate songSignal