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 " >> putStrLn " sound "