soundgen-0.1.1.0: src/Main.hs

module Main where

import Data.WAVE
import Data.Int (Int32)
import Data.List.Split (splitOn)
import System.Environment (getArgs)

samplesPS = 16000
bitrate = 32

header = WAVEHeader 1 samplesPS bitrate Nothing

sound :: Double  -- | Frequency
      -> Int     -- | Samples per second
      -> Double  -- | Lenght of sound in seconds
      -> Int32   -- | Volume, (maxBound :: Int32) for highest, 0 for lowest
      -> [Int32]
sound freq samples len volume = take (round $ len * (fromIntegral samples)) $  map (round . (* fromIntegral volume)) $ map sin [0.0, (freq * 2 * pi / (fromIntegral samples))..]

samples :: Double -> Double ->[[Int32]]
samples f d = map (:[]) $ sound f samplesPS d (maxBound `div` 2)

samples' :: Double -> Double -> Double -> Double -> [[Int32]] -- play two tones at once
samples' f1 d1 f2 d2 = map (:[]) $ zipWith (+) (sound f1 samplesPS d1 (maxBound `div` 2)) (sound f2 samplesPS d2 (maxBound `div` 2))

waveData :: Double -> Double -> WAVE
waveData f d = WAVE header (samples f d) 

waveData' :: Double -> Double -> Double -> Double ->WAVE
waveData' f1 d1 f2 d2 = WAVE header (samples' f1 d1 f2 d2)

makeWavFile :: WAVE -> IO ()
makeWavFile wav = putWAVEFile "sound.wav" wav

main = do args <- getArgs  
          case args of 
               [f1,d1,f2,d2] -> (makeWavFile (waveData' (read f1) (read d1) (read f2) (read d2))) >> putStrLn "Done"
               [f,d] -> (makeWavFile (waveData (read f) (read d))) >> putStrLn "Done"
               _     -> putStrLn "USAGE: sound <frequency  (Hz)> <duration  (s)>" >> 
                        putStrLn "       sound <frequency1 (Hz)> <duration1 (s)> <frequency2 (Hz)> <duration2 (s)>"