module Exercise06 where import Data.List import Effects import Types sinPeriod :: Signal sinPeriod x = sin (x * 2* pi) sqwPeriod :: Signal sqwPeriod x | x <= 0.5 = -1 | x > 0.5 = 1 sawPeriod :: Signal sawPeriod x = 2 * x -1 triPeriod :: Signal triPeriod x | x <= 0.5 = 4 * x - 1 | x > 0.5 = -4 * x + 3 constPeriod :: Signal constPeriod _ = 1.0 silence :: Signal silence _ = 0.0 -- NOTE: the formula is taken from https://pages.mtu.edu/~suits/NoteFreqCalcs.html f :: Semitone -> Hz f n = 440.0 * (2 ** (fromInteger n / 12.0)) scale :: RealFrac a => a -> a scale x = x - fromIntegral (floor x) --type Oscillator = Semitone-> Seconds -> Signal osc :: Signal -> ADSR -> Oscillator osc sig adsrparam tone len = adsr adsrparam len (\x -> sig (scale (x*f tone))) adsr :: ADSR -> Seconds -> Signal -> Signal adsr param len sig x | x <= fst4 param = slopeA * x * sig scaledX | x <= fst4 param + snd4 param = (slopeB * x + fst4 param * (-slopeB) + 1) * sig scaledX | x <= (len - fth param) = thd param * sig scaledX | otherwise = (slopeD * x + (len - fth param) * (-slopeD) + thd param) * sig scaledX where slopeA = 1.0/fst4 param slopeB = (thd param - 1.0) / snd4 param slopeD = -thd param/fth param scaledX = scale x adsrUnscaled :: ADSR -> Seconds -> Signal -> Signal adsrUnscaled param len sig x | x <= fst4 param = slopeA * x * sig x | x <= fst4 param + snd4 param = (slopeB * x + fst4 param * (-slopeB) + 1) * sig x | x <= (len - fth param) = thd param * sig x | otherwise = (slopeD * x + (len - fth param) * (-slopeD) + thd param) * sig x where slopeA = 1.0/fst4 param slopeB = (thd param - 1.0) / snd4 param slopeD = -thd param/fth param fst4 :: (Double, b, c, d) -> Double fst4 (x,_,_,_) = x snd4 :: (a, Double, c, d) -> Double snd4 (_,x,_,_) = x thd :: (a, b, Double, d) -> Double thd (_,_,x,_) = x fth :: (a, b, c, Double) -> Double fth (_,_,_,x) = x mix :: [SampledSignal] -> SampledSignal mix as = map (/ fromIntegral (length as)) (mixHelper as) mixHelper :: [SampledSignal] -> SampledSignal mixHelper [] = [] mixHelper [a] = a mixHelper (a:b:as) = mixHelper (addLists a b : as) addLists :: Num a => [a] -> [a] -> [a] addLists [] [] = [] addLists [] (b:bs) = b : addLists bs [] addLists (a:as) [] = a : addLists as [] addLists (a:as) (b:bs) = (a+b) : addLists as bs {-WETT-} pianoFourier :: Seconds -> [Seconds] -> [Sample] -> Sample pianoFourier _ [] [] = 0 pianoFourier x (f:fs) (a:as) = a * sinPeriod (x*f) + pianoFourier x fs as fc :: [Double] fc = [1.02014401, 2.00673065, 1.01343254, 1.9933077 , 0.98658664, 3.00674024, 0.99329811, 1.00672106, 1.00000959, 2.00001918] fa :: [Double] fa = [0.04755034, 0.05506318, 0.06735161, 0.07993557, 0.08309806, 0.09062592, 0.10479318, 0.12221876, 0.15071729, 0.19864611] fcViolin :: [Double] fcViolin = [7.01492537, 6.00995025, 1.99502488, 5.99502488, 5.0199005 , 3.99502488, 8.00497512, 8.00995025, 4.00995025, 2.00497512, 7.00995025, 5.00995025, 3.0 , 8.0 , 6.0 , 7.0 , 1.0 , 5.0 , 4.0 , 2.0 ] faViolin :: [Double] faViolin = [0.01545987, 0.01553978, 0.01804062, 0.01814017, 0.01859291, 0.01942809, 0.02085049, 0.02158895, 0.024062 , 0.02429568, 0.02828831, 0.03088582, 0.04657574, 0.04927102, 0.0711144 , 0.08072446, 0.08644351, 0.11484647, 0.14501456, 0.15083716] fcVoice :: [Double] fcVoice = [3.01879699, 3.02255639, 1.4962406 , 1.0112782 , 3.05639098, 2.9887218 , 2.9924812 , 1.51503759, 3.02631579, 1.0 , 1.01503759, 1.53007519, 1.4887218 , 1.4924812 , 1.5075188 , 1.53383459, 1.51879699, 1.5037594 , 1.5 , 1.52255639] faVoice :: [Double] faVoice = [0.02730307, 0.02822291, 0.02965473, 0.03117929, 0.03224508, 0.03245047, 0.03307578, 0.03518499, 0.03577438, 0.03730591, 0.04007458, 0.04056361, 0.05474667, 0.0588984 , 0.05966779, 0.0624193 , 0.0678395 , 0.08217582, 0.086773 , 0.12444475] piano2 :: Oscillator piano2 tone len = adsrUnscaled (0.01, 0.1, 0.7, 0.2) len (\x -> pianoFourier x (map (*f tone) fc) fa) violin :: Oscillator violin tone len = adsrUnscaled (0.01, 0.1, 0.7, 0.2) len (\x -> pianoFourier x (map (*f tone) fcViolin) faViolin) voice tone len = adsrUnscaled (0.01, 0.1, 0.7, 0.2) len (\x -> pianoFourier x (map (*f tone) fcVoice) faVoice) -- piano :: Oscillator piano = osc sawPeriod (0.01, 0.1, 0.7, 0.2) lead :: Oscillator lead = osc sqwPeriod (0.01, 0.2, 0.3, 0.1) bass :: Oscillator bass = osc sinPeriod (0.001, 0.2, 0.9, 0.1) -- you can add more effects here -- mix the signals with some volume mixTracks :: [SampledSignal] -> [Double] -> SampledSignal mixTracks trks vols = mix $ zipWith (\trk vol -> map (* vol) trk) trks vols -- here we mix it all together and apply the effects notesToSignal :: (Oscillator -> [Note] -> SampledSignal) -> [[Note]] -> SampledSignal notesToSignal playNotes tracks = audio where -- specify the instruments of each track -- try the following instruments with the mario.mid file --instrs = cycle [piano, bass] instrs = cycle [voice,voice,piano2,piano2,piano2,piano2,violin] audioTracks = zipWith playNotes instrs tracks --audioNoEffects = mixTracks audioTracks [0.8, 0.7] audioNoEffects = mixTracks audioTracks [0.8, 1.0,0.9, 0.8,0.8, 0.8,0.8] --audio = audioNoEffects -- To add effects, replace the line above by the line at the end of this comment and change the list off effects to your own effects. -- Note that the effects are applied from right to left, ie. the rightmost effect is applied first. audio = addEffects [clip 0.9, addGain 4] audioNoEffects -- If you want to apply an effect only to parts of the signal, you can use the function applyEffectToInterval, as shown below. -- Thereby the first argument specifies the interval to which the effect should be applied in seconds. -- audio = applyEffectToInterval (2, 6) audioNoEffects distortion {-TTEW-}