import Wave
constant :: Double -> Signal
constant d = Signal (repeat d)
silence :: Signal
silence = constant 0
sine :: Double -> Signal
sine freq = Signal (map sin [0,f..])
where f = 2 * pi * freq / sampleRate
trim :: Signal -> Double -> Signal
trim (Signal x) t = Signal (take (double2Int (44100 * t)) x)
double2Int :: Double -> Int
double2Int = fromInteger . floor
instance Num Signal where
(Signal x) + (Signal y) = Signal (zipWith (+) x y)
(Signal x) - (Signal y) = Signal (zipWith (-) x y)
(Signal x) * (Signal y) = Signal (zipWith (*) x y)
--negate (Signal x) = (Signal x) * constant (-1)
--negate (Signal x) = Signal (map negate x)
abs (Signal x) = Signal (map abs x)
signum (Signal x) = Signal (map signum x)
fromInteger i = constant (fromInteger i)
instance Fractional Signal where
(Signal x) / (Signal y) = Signal (zipWith (/) x y)
fromRational r = constant (fromRational r)
integrate :: Signal -> Signal
integrate (Signal x) = Signal (0 : integrate' x 0)
integrate' :: [Double] -> Double -> [Double]
integrate' [] _ = []
integrate' (x:y:xs) a = trapez : integrate' (y:xs) trapez
where trapez = a + (x + y) / (2 * sampleRate)
modulatedSine :: Double -> Signal -> Signal
modulatedSine c m = Signal (map sin fs)
where f t = 2 * pi * c * t
fs = zipWith (+) (map f [0,1/sampleRate..]) (map (c *) i)
Signal i = integrate m
append (Signal x) (Signal y) = Signal (x ++ y)
rampUp :: Double -> Signal
rampUp time = Signal [0,f..1]
where f = 1 / (sampleRate * time)
hullCurve :: Double -> Double -> Double -> Double -> Signal
hullCurve attack decay decayLevel release =
(rampUp attack) `append` decayDown `append` releaseDown
where decayDown = 1 - (rampUp decay) * (1 - constant decayLevel)
releaseDown = (1 - (rampUp release)) * (constant decayLevel)
synthLead :: Double -> Signal
synthLead freq = base * hull
where base = modulatedSine freq (sine freq)
hull = hullCurve 0.004 0.2 0.625 2.0
type Instrument = Double -> Signal
play :: Instrument -> [(Double, Double)] -> Signal
play _ [] = Signal []
play instrument ((freq,len):xs) = go `append` (play instrument xs)
where go = (insSignal `append` silence) `trim` len
insSignal = instrument freq
lenSignal = (\(Signal s) -> length s) insSignal
samples = double2Int $ time2Samples len