daily pastebin goal
66%
SHARE
TWEET

Techno/Techno

katkitten1 May 17th, 2018 111 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
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top