Techno/Techno

module Pattern where
import Data.Int
import Data.WAVE
import System.Process

sampleRate = 44100
bitrate = 32

-- From an answer by David Milani at:
-- https://stackoverflow.com/questions/5658391/generating-wav-sound-data-in-haskell
sound :: Double  -- | Frequency
      -> Int     -- | Samples per second
      -> Double  -- | Length 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))..]

genWaveFormCycle p fs = samples
    where
        doubleList = fs <*> map (* (2 * p * pi / (fromIntegral sampleRate))) [0.0 .. (fromIntegral sampleRate ) / p]
        samples = map doubleToSample doubleList

genWaveForm :: [WAVESample]  -- | One cycle of the wave
            -> Int           -- | duration in seconds
            -> [WAVESample]

genWaveForm wavecycle duration = concat $ replicate n wavecycle
    where
        n = duration * sampleRate `div` (length wavecycle)

genWaveFile xs = WAVE header xs
    where header = WAVEHeader 1 sampleRate bitrate (Just $ length $ concat xs)

a5 = sound 880 sampleRate 1 (doubleToSample 0.0625)
a4 = sound 440 sampleRate 1 (doubleToSample 0.125)
a3 = sound 220 sampleRate 1 (doubleToSample 0.25)
a2 = sound 110 sampleRate 1 (doubleToSample 0.5)
organA2 = zipWith (+) a2 $ zipWith (+) a3 $ zipWith (+) a4 a5
sineWave = genWaveFile $ concat $ replicate 5 [organA2, a2, a3, a4, a5]

wobbleFuncs = map (\x y -> 0.5 * sin (x * y) ) [1.0, 1.1 .. 3]
genWobbleWave p d = genWaveForm (genWaveFormCycle p (wobbleFuncs ++ (reverse wobbleFuncs))) d
wobbleWave = genWaveFile $ concat  $ replicate 4  [ genWobbleWave 55 3 , genWobbleWave 97.99886 1]

main :: IO ()
main =
    do
        putWAVEFile "out.wav" wobbleWave
        pid <- runCommand "aplay -q out.wav"
        -- waitForProcess pid
        return ()