daily pastebin goal
12%
SHARE
TWEET

Techno/Techno

katkitten1 May 17th, 2018 102 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Pattern where
  2. import Data.Int
  3. import Data.WAVE
  4. import System.Process
  5.  
  6. sampleRate = 44100
  7. bitrate = 32
  8.  
  9. -- From an answer by David Milani at:
  10. -- https://stackoverflow.com/questions/5658391/generating-wav-sound-data-in-haskell
  11. sound :: Double  -- | Frequency
  12.       -> Int     -- | Samples per second
  13.       -> Double  -- | Length of sound in seconds
  14.       -> Int32   -- | Volume, (maxBound :: Int32) for highest, 0 for lowest
  15.       -> [Int32]
  16.  
  17. sound freq samples len volume =
  18.    take (round $ len * (fromIntegral samples)) $
  19.          map (round . (* fromIntegral volume)) $
  20.          map sin [0.0, (freq * 2 * pi / (fromIntegral samples))..]
  21.  
  22. genWaveFormCycle p fs = samples
  23.     where
  24.         doubleList = fs <*> map (* (2 * p * pi / (fromIntegral sampleRate))) [0.0 .. (fromIntegral sampleRate ) / p]
  25.         samples = map doubleToSample doubleList
  26.  
  27. genWaveForm :: [WAVESample]  -- | One cycle of the wave
  28.             -> Int           -- | duration in seconds
  29.             -> [WAVESample]
  30.  
  31. genWaveForm wavecycle duration = concat $ replicate n wavecycle
  32.     where
  33.         n = duration * sampleRate `div` (length wavecycle)
  34.  
  35. genWaveFile xs = WAVE header xs
  36.     where header = WAVEHeader 1 sampleRate bitrate (Just $ length $ concat xs)
  37.  
  38. a5 = sound 880 sampleRate 1 (doubleToSample 0.0625)
  39. a4 = sound 440 sampleRate 1 (doubleToSample 0.125)
  40. a3 = sound 220 sampleRate 1 (doubleToSample 0.25)
  41. a2 = sound 110 sampleRate 1 (doubleToSample 0.5)
  42. organA2 = zipWith (+) a2 $ zipWith (+) a3 $ zipWith (+) a4 a5
  43. sineWave = genWaveFile $ concat $ replicate 5 [organA2, a2, a3, a4, a5]
  44.  
  45. wobbleFuncs = map (\x y -> 0.5 * sin (x * y) ) [1.0, 1.1 .. 3]
  46. genWobbleWave p d = genWaveForm (genWaveFormCycle p (wobbleFuncs ++ (reverse wobbleFuncs))) d
  47. wobbleWave = genWaveFile $ concat  $ replicate 4  [ genWobbleWave 55 3 , genWobbleWave 97.99886 1]
  48.  
  49. main :: IO ()
  50. main =
  51.     do
  52.         putWAVEFile "out.wav" wobbleWave
  53.         pid <- runCommand "aplay -q out.wav"
  54.         -- waitForProcess pid
  55.         return ()
RAW Paste Data
Top