-- | (Undocumented class) module Sound.SC3.UGen.Record.PV_SoftWipe where import qualified Sound.SC3.UGen as S import Sound.SC3.UGen.Record data PV_SoftWipe = PV_SoftWipe { bufferA :: S.UGen, bufferB :: S.UGen, wipe :: S.UGen } deriving (Show) pv_SoftWipe :: PV_SoftWipe pv_SoftWipe = PV_SoftWipe { bufferA = 0.0, bufferB = 0.0, wipe = 0.0 } mkPV_SoftWipe :: PV_SoftWipe -> S.UGen mkPV_SoftWipe (PV_SoftWipe a' b' c') = S.mkOsc S.KR "PV_SoftWipe" [a',b',c'] 1 instance Make PV_SoftWipe where ugen = mkPV_SoftWipe