186 lines
3.5 KiB
Haskell
186 lines
3.5 KiB
Haskell
import qualified Data.ByteString.Lazy as BSL
|
|
import qualified Data.ByteString.Builder as BSB
|
|
import qualified Data.Foldable
|
|
import qualified System.Process
|
|
import qualified Text.Printf
|
|
|
|
|
|
-- Frequency in Hertz
|
|
type Hz = Float
|
|
|
|
-- Time in seconds
|
|
type Sec = Float
|
|
|
|
type Wave = [Float]
|
|
|
|
type Semitone = Int
|
|
type Beat = Float
|
|
|
|
outFile :: FilePath
|
|
outFile = "out.bin"
|
|
|
|
save :: Wave -> FilePath -> IO ()
|
|
save wav outfile
|
|
-- Write to outfile
|
|
= BSL.writeFile outfile
|
|
|
|
-- Build lazy byte string
|
|
$ BSB.toLazyByteString
|
|
|
|
-- Combine all data points into single bytestring
|
|
$ Data.Foldable.fold
|
|
|
|
-- build float little endian byte string for each data point
|
|
$ map BSB.floatLE wav
|
|
|
|
play :: Wave -> IO ()
|
|
play wav = do
|
|
save (map (*volume) wav) outFile
|
|
-- save wav outFile
|
|
_ <- System.Process.runCommand $ Text.Printf.printf
|
|
"ffplay -showmode 1 -f f32le -ar %f %s"
|
|
sr outFile
|
|
return ()
|
|
|
|
-----
|
|
|
|
-- Sample rate: Number of data points per second
|
|
sr :: Hz
|
|
sr = 48000
|
|
|
|
bpm :: Beat
|
|
bpm = 120.0
|
|
|
|
volume :: Float
|
|
volume = 0.4
|
|
--volume = 10
|
|
|
|
|
|
-- Generate a 'base wave' of given frequency and duration.
|
|
-- For use in `wave' function.
|
|
genBaseWave :: Hz -> Sec -> Wave
|
|
genBaseWave freq duration = map (sin . (*(step freq))) [0.0 .. (sr*duration - 1)]
|
|
where
|
|
-- Get step size for use in `genBaseWave'
|
|
step :: Hz -> Float
|
|
step freq = (2 * pi * freq) / sr
|
|
|
|
note :: Semitone -> Beat -> Wave
|
|
note n beatN = genWave (stFreq n) (beatN * beat1Duration )
|
|
where
|
|
beat1Duration = 60/bpm
|
|
|
|
-- |Generate a wave of given frequency and duration
|
|
genWave :: Hz -> Sec -> Wave
|
|
genWave freq duration
|
|
= zipWith3 (\a w d -> a * w * d) asc wav dsc
|
|
where
|
|
wav = genBaseWave freq duration
|
|
-- len = fromIntegral $ length wav
|
|
asc = map (min 1.0) [0.00, 0.001 .. ]
|
|
dsc = reverse $ take (length wav) asc
|
|
|
|
-- |Get frequency of a semitone
|
|
-- http://web.archive.org/web/20220524232706/https://pages.mtu.edu/~suits/NoteFreqCalcs.html
|
|
stFreq :: Semitone -> Hz
|
|
stFreq n = f0 + a ** (fromIntegral n)
|
|
where
|
|
a = 2 ** (1/12)
|
|
f0 = 440 -- standard pitch (A440)
|
|
|
|
mix :: Wave -> Wave -> Wave
|
|
mix = zipWith (\x y -> x + y)
|
|
|
|
freqDur :: [(Hz, Sec)]
|
|
freqDur =
|
|
[(220, 1),
|
|
(320, 1),
|
|
(440, 1)]
|
|
o1 = concat [genWave f d | (f, d) <- freqDur]
|
|
|
|
|
|
stBeats2 :: [(Semitone, Beat)]
|
|
stBeats2 =
|
|
[ (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.5)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.5)
|
|
, (5, 0.25)
|
|
, (5, 0.25)
|
|
, (5, 0.25)
|
|
, (5, 0.25)
|
|
, (5, 0.25)
|
|
, (5, 0.25)
|
|
, (5, 0.5)
|
|
, (3, 0.25)
|
|
, (3, 0.25)
|
|
, (3, 0.25)
|
|
, (3, 0.25)
|
|
, (3, 0.25)
|
|
, (3, 0.25)
|
|
, (3, 0.5)
|
|
, (-2, 0.5)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.25)
|
|
, (0, 0.5)]
|
|
|
|
o2 = concat [note n bts | (n, bts) <- stBeats2]
|
|
o2' = concat [note n bts | (n, bts) <- stB']
|
|
where
|
|
stB' = map (\(n,bts) -> (n,bts*2)) stBeats2
|
|
|
|
|
|
stBeats3 :: [(Semitone, Beat)]
|
|
stBeats3 =
|
|
[ (0, 1)
|
|
, (1, 1)
|
|
, (2, 1)
|
|
, (3, 0.25)
|
|
, (4, 0.25)
|
|
, (5, 0.25)]
|
|
o3 = concat [note n bts | (n, bts) <- stBeats3]
|
|
|
|
|
|
stBeats4 :: [(Semitone, Beat)]
|
|
stBeats4 =
|
|
[ (240, 1.0)
|
|
, (270, 1.0)
|
|
, (300, 1.0)
|
|
, (320, 1.0)
|
|
, (360, 1.0)
|
|
, (400, 1.0)
|
|
, (450, 1.0)
|
|
, (480, 1.0)]
|
|
o4 = concat [note n bts | (n, bts) <- stBeats4]
|
|
|
|
|
|
-- sa re ga ma
|
|
freqDur5 :: [(Hz, Sec)]
|
|
freqDur5 =
|
|
[ (240, 2.0)
|
|
, (270, 2.0)
|
|
, (300, 2.0)
|
|
, (320, 2.0)
|
|
, (360, 2.0)
|
|
, (400, 2.0)
|
|
, (450, 2.0)
|
|
, (480, 2.0)]
|
|
o5 = concat [genWave f d | (f, d) <- freqDur5]
|
|
|
|
|
|
|
|
-- w = wave
|
|
-- main :: IO ()
|
|
-- main = do
|
|
-- play a
|