{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} module Synthesizer.LLVM.LAC2011 where import qualified Synthesizer.LLVM.Filter.ComplexFirstOrderPacked as BandPass import qualified Synthesizer.LLVM.Filter.Allpass as Allpass import qualified Synthesizer.LLVM.Filter.Butterworth as Butterworth import qualified Synthesizer.LLVM.Filter.Chebyshev as Chebyshev import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1 import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2 import qualified Synthesizer.LLVM.Filter.SecondOrderPacked as Filt2P import qualified Synthesizer.LLVM.Filter.Moog as Moog import qualified Synthesizer.LLVM.Filter.Universal as UniFilter import qualified Synthesizer.LLVM.CausalParameterized.Controlled as CtrlP import qualified Synthesizer.LLVM.CausalParameterized.ControlledPacked as CtrlPS import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS import qualified Synthesizer.LLVM.CausalParameterized.ProcessValue as CausalPV import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV import qualified Synthesizer.LLVM.Causal.Process as Causal import qualified Synthesizer.LLVM.Simple.Signal as Gen import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Frame as Frame import qualified Synthesizer.LLVM.Wave as Wave import qualified Synthesizer.LLVM.Parameter as Param import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Class as C import LLVM.Core (Value, value, valueOf, Vector, constVector, constOf, ) import LLVM.Util.Arithmetic () -- Floating instance for TValue import qualified LLVM.Core as LLVM import Type.Data.Num.Decimal (D4, D8, D16, d0, d1, d2, d3, d4, d5, d6, d7, d8, ) import qualified Type.Data.Num.Decimal as TypeNum import qualified Synthesizer.LLVM.Parameterized.SignalPacked as GenPS import qualified Synthesizer.LLVM.Parameterized.Signal as GenP import Synthesizer.LLVM.Causal.Process (($<), ($*), ($*#), ) import Synthesizer.LLVM.Parameter (($#), ) import qualified Synthesizer.Plain.Filter.Recursive as FiltR import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1Core import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core import Control.Arrow (Arrow, arr, (&&&), (^<<), ) import Control.Category ((<<<), (.), id, ) import Control.Monad ((<=<), ) import Control.Applicative (liftA2, pure, ) import Control.Functor.HT (void, ) import Data.Traversable (traverse, ) import Foreign.Storable (Storable, ) import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV import qualified Data.EventList.Relative.TimeBody as EventList import qualified Data.EventList.Relative.BodyTime as EventListBT import qualified Data.EventList.Relative.MixedTime as EventListMT import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Numeric.NonNegative.Wrapper as NonNeg import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Sound.Sox.Option.Format as SoxOption import qualified Sound.Sox.Frame as SoxFrame import qualified Sound.Sox.Play as SoxPlay -- import qualified Sound.ALSA.PCM as ALSA -- import qualified Synthesizer.ALSA.Storable.Play as Play import Data.Word (Word32, ) -- import qualified Data.Function.HT as F import Data.List (genericLength, ) import System.Random (randomRs, mkStdGen, ) import qualified System.IO as IO -- import System.Exit (ExitCode, ) import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive import NumericPrelude.Numeric import NumericPrelude.Base hiding (fst, snd, id, (.), ) import qualified NumericPrelude.Base as P asMono :: vector Float -> vector Float asMono = id asStereo :: vector (Stereo.T Float) -> vector (Stereo.T Float) asStereo = id asMonoPacked :: vector (LLVM.Vector D4 Float) -> vector (LLVM.Vector D4 Float) asMonoPacked = id asMonoPacked16 :: vector (LLVM.Vector D16 Float) -> vector (LLVM.Vector D16 Float) asMonoPacked16 = id asWord32 :: vector Word32 -> vector Word32 asWord32 = id asWord32Packed :: vector (LLVM.Vector D4 Word32) -> vector (LLVM.Vector D4 Word32) asWord32Packed = id playStereo :: Gen.T (Stereo.T (Value Float)) -> IO () playStereo = playStereoStream . Gen.renderChunky (SVL.chunkSize 100000) playStereoStream :: SVL.Vector (Stereo.T Float) -> IO () playStereoStream = playStreamSox playMono :: Gen.T (Value Float) -> IO () playMono = playMonoStream . Gen.renderChunky (SVL.chunkSize 100000) playMonoParam :: GenP.T () (Value Float) -> IO () playMonoParam = playMonoStream . ($ ()) . ($ SVL.chunkSize 100000) <=< GenP.runChunky playMonoPacked :: GenP.T () (Serial.Value D4 Float) -> IO () playMonoPacked = playMonoStream . SigStL.unpack . ($ ()) . ($ SVL.chunkSize 100000) <=< GenP.runChunky playMonoStream :: SVL.Vector Float -> IO () playMonoStream = playStreamSox {- play :: (C.MakeValueTuple y, ValueTuple y ~ a, Memory.C a struct) => Gen.T a -> IO () play = playStreamSox . Gen.renderChunky (SVL.chunkSize 100000) -} {- playStreamALSA :: (Additive.C y, ALSA.SampleFmt y) => SVL.Vector y -> IO () playStreamALSA = Play.auto (Play.makeSink Play.defaultDevice (0.05::Double) sampleRate) -} -- reacts faster to CTRL-C playStreamSox :: (Storable y, SoxFrame.C y) => SVL.Vector y -> IO () playStreamSox = void . SoxPlay.simple SVL.hPut SoxOption.none sampleRate sampleRate :: Ring.C a => a sampleRate = 44100 intSecond :: Ring.C a => Float -> a intSecond t = fromInteger $ round $ t * sampleRate secondP :: Param.T p Float -> Param.T p Float secondP t = t * sampleRate hertzP :: Param.T p Float -> Param.T p Float hertzP f = f / sampleRate second :: Field.C a => a -> a second t = t * sampleRate hertz :: Field.C a => a -> a hertz f = f / sampleRate {- second :: Float -> Param.T p Float second t = return (t * sampleRate) hertz :: Float -> Param.T p Float hertz f = return (f / sampleRate) -} sine :: IO () sine = playMono (0.99 * Gen.osci Wave.sine 0 (hertz 440)) ping :: IO () ping = playMono (Gen.exponential2 (second 1) 1 * Gen.osci Wave.triangle 0 (hertz 440)) tremolo :: IO () tremolo = playMono (Gen.osci Wave.sine 0 (hertz 0.3) * Gen.osci Wave.triangle 0 (hertz 440)) stereo :: IO () stereo = playStereo (liftA2 Stereo.cons (Gen.osci Wave.triangle 0 (hertz 439)) (Gen.osci Wave.triangle 0 (hertz 441))) stereoFancy :: IO () stereoFancy = playStereo (traverse (Gen.osci Wave.triangle 0 . hertz) (Stereo.cons 439 441)) fst :: Arrow arrow => arrow (a,b) a fst = arr P.fst snd :: Arrow arrow => arrow (a,b) b snd = arr P.snd pingParam :: IO (Float -> SVL.Vector Float) pingParam = fmap ($ SVL.chunkSize 1024) $ GenP.runChunky $ GenP.exponential2 (second 0.3) 1 * GenP.osciSimple Wave.triangle 0 id playPingParam :: IO () playPingParam = do png <- pingParam playMonoStream (SVL.take (intSecond 1) $ png (hertz 880)) melody :: IO (SVL.Vector Float) melody = do png <- pingParam return $ SVL.concat $ map (SVL.take (intSecond 0.2) . png . hertz) $ cycle [440, 550, 660, 880] playMelody :: IO () playMelody = do mel <- melody playMonoStream mel pingParam2 :: IO ((Float, Float) -> SVL.Vector Float) pingParam2 = fmap ($ SVL.chunkSize 1024) $ GenP.runChunky $ GenP.exponential2 (second 0.3) fst * GenP.osciSimple Wave.triangle 0 snd playMelody2 :: IO () playMelody2 = do png <- pingParam2 playMonoStream $ SVL.concat $ map (SVL.take (intSecond 0.2) . png) $ zip (map sin $ [0,0.1..]) (cycle $ map hertz [440, 550, 660, 880]) retard :: GenP.T p (Value Float) -> GenP.T p (Value Float) retard xs = CausalP.frequencyModulationLinear xs . CausalV.map Field.recip $* GenP.rampCore (1 / secondP 10) 1 playRetarded :: IO () playRetarded = do mel <- melody playMonoParam $ retard $ GenP.fromStorableVectorLazy $ pure $ mel pingGen :: GenP.T p (Value Float) pingGen = GenP.exponential2 (second 0.5) 0.7 * GenP.osciSimple Wave.triangle 0 (hertzP 440) delayp :: Param.T p Int -> CausalP.T p (Value Float) (Value Float) delayp = CausalP.delayZero delay :: IO () delay = playMonoParam $ pingGen + 0.7 * (delayp (intSecond 0.5) $* pingGen) delayArrow :: IO () delayArrow = playMonoParam ((id + 0.7 * delayp (intSecond 0.5)) $* pingGen) comb :: IO () comb = playMonoParam $ (CausalP.loopZero (id &&& 0.7 * delayp (intSecond 0.5) <<< CausalP.mix) $* pingGen) lfoSine :: Param.T p Float -> GenP.T p (Moog.Parameter D8 (Value Float)) lfoSine reduct = Causal.map (Moog.parameter d8 (valueOf (30::Float))) . CausalP.mapExponential 2 (hertz 700) $* GenP.osciSimple Wave.sine 0 (reduct * hertz 0.1) filterSweep :: IO () filterSweep = playMonoParam $ (0.2 * CtrlP.processCtrlRate 128 lfoSine $* GenP.noise 0 0.3) pingPacked :: IO () pingPacked = playMonoPacked (GenPS.exponential2 (second 1) 1 * GenPS.osciSimple Wave.triangle 0 (hertz 440)) {- Module can be loaded into GHCi only when synthesizer-llvm was installed with $ cabal install --enable-shared In contrast to that, you have to install with $ cabal install -fbuildTests -fbuildExamples --enable-shared --disable-library-profiling --ghc-option=-dynamic for build the executables. But then GHCi complains: $ ghci GHCi, version 6.12.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Loading package ffi-1.0 ... linking ... done. [1 of 1] Compiling Main ( src/Synthesizer/LLVM/Test.hs, interpreted ) src/Synthesizer/LLVM/Test.hs:4:0: Bad interface file: /home/thielema/.cabal/lib/synthesizer-llvm-0.3/ghc-6.12.3/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hi mismatched interface file ways (wanted "", got "dyn") Failed, modules loaded: none. -}