Safe Haskell | None |
---|---|
Language | Haskell2010 |
A music theory library for just intonation and other mathematically pure ideas.
Synopsis
- data CompactWavetable = CompactWavetable {}
- type Wavetable = Waveform Tick Discrete
- type DWave = Waveform Double Double
- newtype Waveform t a = Waveform {
- sample :: t -> a
- quotRoundUp :: Int -> Int -> Int
- sampleFrom :: (t -> a) -> Waveform t a
- sampleAt :: t -> Waveform t a -> a
- sinWave :: Floating a => a -> Waveform a a
- fastSin :: Double -> Double -> Wavetable
- compactWave :: (Ord t, Num t) => (t, t) -> Waveform t Bool
- muting :: Num a => Bool -> a -> a
- modulate :: (a -> b -> c) -> Waveform t a -> Waveform t b -> Waveform t c
- amplitudeModulate :: Num a => Waveform t a -> Waveform t a -> Waveform t a
- phaseModulate :: Num t => t -> Waveform t t -> Waveform t a -> Waveform t a
- changeSpeed :: (Ord a, Fractional a) => a -> a -> a -> Waveform a a -> Waveform a a
- balanceChord :: Fractional a => [Waveform t a] -> Waveform t a
- mergeWaves :: Num a => [Waveform t a] -> Waveform t a
- waveformToWAVE :: Tick -> Int -> Wavetable -> WAVE
- triWave :: (Ord a, RealFrac a) => a -> Waveform a a
- stdtr :: Num a => a
- testWave :: String -> Wavetable -> IO ()
- testDiagram :: PitchFactorDiagram -> IO ()
- sequenceToBeat :: Double -> Double -> Beat DWave -> DWave
- sequenceNotes :: (Ord t, Fractional t, Fractional a) => [((t, t), Waveform t a)] -> Waveform t a
- buildChord :: (Num a, RealFrac a) => [a] -> a -> Waveform a a
- buildChordNoBalance :: [Double] -> Double -> DWave
- majorChordOver :: Double -> DWave
- minorChordOver :: Double -> DWave
- concertA :: Num a => a
- envelope :: Double -> Double -> Double -> Double -> Double -> Double -> DWave
- timeShift :: Num t => t -> Waveform t a -> Waveform t a
- seekTo :: Num t => t -> Waveform t a -> Waveform t a
- equalTime :: Double -> [DWave] -> DWave
- setVolume :: Num a => a -> Waveform t a -> Waveform t a
- emptyWave :: Num a => Waveform t a
- discreteConvolve :: (Num a, Num t) => Waveform t [(t, a)] -> Waveform t a -> Waveform t a
- wackyNotConvolution :: (a -> b -> c) -> Waveform t (Waveform t a) -> Waveform t b -> Waveform t c
- tickConvolution :: Fractional a => Tick -> Tick -> Waveform Tick (Waveform Tick a) -> Waveform Tick a -> Waveform Tick a
- sampledConvolution :: (RealFrac t, Fractional a) => t -> t -> Waveform t (Waveform t a) -> Waveform t a -> Waveform t a
- bandpassFilter :: Fractional a => Double -> Double -> Waveform Double a
- discretize :: Waveform t Double -> Waveform t Discrete
- tickTable :: Double -> Waveform Double a -> Waveform Tick a
- tickTableMemo :: Double -> Waveform Double a -> Waveform Tick a
- solidSlice :: Tick -> Tick -> Wavetable -> Wavetable
- optimizeFilter :: Tick -> Wavetable -> Wavetable
- fourierTransform :: Tick -> Double -> Waveform Tick (Complex Double) -> Waveform Double (Complex Double)
- realDFT :: Tick -> Double -> Wavetable -> Wavetable
- skipTicks :: Tick -> Waveform Tick a -> Waveform Tick a
- exploitPeriodicity :: Tick -> Wavetable -> Wavetable
- usingFFT :: Tick -> Wavetable -> Wavetable
- fft :: [Complex Double] -> [Complex Double]
- semi :: Floating a => a
- allSemis :: Floating a => [a]
- takeFinAlignments :: Floating a => Int -> [[a]]
- newtype PitchFactorDiagram = Factors {
- getFactors :: [Integer]
- diagramToRatio :: Fractional a => PitchFactorDiagram -> a
- diagramToFloatyRatio :: PitchFactorDiagram -> Rational
- diagramToSemi :: Floating a => PitchFactorDiagram -> a
- normalizePFD :: PitchFactorDiagram -> PitchFactorDiagram
- countPFDFuzzy :: Double -> PitchFactorDiagram
- countPFD :: Rational -> PitchFactorDiagram
- intervalOf :: PitchFactorDiagram -> Double -> Double
- scalePFD :: Integer -> PitchFactorDiagram -> PitchFactorDiagram
- invertPFD :: PitchFactorDiagram -> PitchFactorDiagram
- addPFD :: PitchFactorDiagram -> PitchFactorDiagram -> PitchFactorDiagram
- printTheSequence :: Int -> IO ()
- data Beat a
- class SummaryChar a where
- data DrumRack
- rockBeat :: Beat DrumRack
- primeBeat :: Beat a -> Beat a
- octave :: PitchFactorDiagram
- perfectFifth :: PitchFactorDiagram
- majorThird :: PitchFactorDiagram
- mysterySeven :: PitchFactorDiagram
- majorSecond :: PitchFactorDiagram
- mystery25 :: PitchFactorDiagram
- counterExample :: PitchFactorDiagram
- newtype Discrete = Discrete {
- unDiscrete :: Int32
- doubleToDiscrete :: Double -> Discrete
- discreteToDouble :: Discrete -> Double
- discFactor :: Num a => a
- properFloor :: RealFrac a => a -> Int32
- multiplyDiscrete :: Discrete -> Discrete -> Discrete
- disguise :: (Double -> Double) -> Discrete -> Discrete
- newtype Tick = Tick {}
Documentation
data CompactWavetable Source #
A data structure for storing the results of a
on some subset of its domain.
Used internally.Wavetable
type Wavetable = Waveform Tick Discrete Source #
A domain- and codomain-discretized
suitable for writing to a WAVE file.
See Waveform
.waveformToWAVE
type DWave = Waveform Double Double Source #
A Double
valued wave with time also in terms of Double
.
This models a real-valued waveform which typically has values in [-1,1]
and
is typically supported on either the entire real line (sinWave
) or on a compact subset (compactWave
)
A Waveform
is a function (of time) that we can later sample.
quotRoundUp :: Int -> Int -> Int Source #
A version of
that rounds away from zero instead of towards it.quot
sampleFrom :: (t -> a) -> Waveform t a Source #
Build a Waveform
by sampling the given function.
fastSin :: Double -> Double -> Wavetable Source #
Sine wave that is optimized to store only a small
. Frequency given in CompactWavetable
compactWave :: (Ord t, Num t) => (t, t) -> Waveform t Bool Source #
is a wave which is compactWave
(l,h)
on True
[l,h)
and
elsewhereFalse
modulate :: (a -> b -> c) -> Waveform t a -> Waveform t b -> Waveform t c Source #
Modulate one wave with another according to the given function pointwise.
This means you can't implement phaseModulate
using only this combinator because phase modulation
requires information about the target wave at times other than the current time.
amplitudeModulate :: Num a => Waveform t a -> Waveform t a -> Waveform t a Source #
Modulate the amplitude of one wave with another. This is simply pointwise multiplication:
amplitudeModulate
= modulate
(*
)
changeSpeed :: (Ord a, Fractional a) => a -> a -> a -> Waveform a a -> Waveform a a Source #
Smoothly transition to playing a wave back at a different speed after some time
balanceChord :: Fractional a => [Waveform t a] -> Waveform t a Source #
Play several waves on top of each other, normalizing so that e.g. playing three notes together doesn't triple the volume.
mergeWaves :: Num a => [Waveform t a] -> Waveform t a Source #
Play several waves on top of each other, without worrying about the volume. See balanceChord
for
a normalized version.
waveformToWAVE :: Tick -> Int -> Wavetable -> WAVE Source #
gives a waveformToWAVE
outputLength
file object by sampling the given WAVE
at DWave
44100Hz
.
May disbehave or clip based on behavior of
if the DWave takes values outside of doubleToSample
[-1,1]
.
testWave :: String -> Wavetable -> IO () Source #
Output the first ten seconds of the given
to the file DWave
test.wav
for testing.
The volume is also attenuated by 50% to not blow out your eardrums.
Also pretty prints the wave.
testDiagram :: PitchFactorDiagram -> IO () Source #
Outputs a sound test of the given
as an interval above PitchFactorDiagram
as a concertA
to the file sinWave
diag.wav
for testing.
sequenceNotes :: (Ord t, Fractional t, Fractional a) => [((t, t), Waveform t a)] -> Waveform t a Source #
Sequences some waves to play on the given time intervals.
buildChord :: (Num a, RealFrac a) => [a] -> a -> Waveform a a Source #
Builds a chord out of the given ratios relative to the root pitch
buildChord ratios root
buildChordNoBalance :: [Double] -> Double -> DWave Source #
Builds a chord out of the given ratios relative to the root pitch, without normalizing the volume. (Warning: may be loud)
majorChordOver :: Double -> DWave Source #
Builds a just-intonated major chord over the given root pitch
minorChordOver :: Double -> DWave Source #
Builds an equal temperament minor chord over the given root pitch
envelope :: Double -> Double -> Double -> Double -> Double -> Double -> DWave Source #
Build an envelope waveform with the given parameters: Predelay Time, Attack Time, Hold Time, Decay Time, Sustain Level, Release Time
timeShift :: Num t => t -> Waveform t a -> Waveform t a Source #
Shift a wave in time to start at the specified time after its old start time
seekTo :: Num t => t -> Waveform t a -> Waveform t a Source #
Shift a wave in time such that the new zero is at the specified position
equalTime :: Double -> [DWave] -> DWave Source #
Play several waves in a row with eqqual time each, using
.sequenceNotes
setVolume :: Num a => a -> Waveform t a -> Waveform t a Source #
Modify the amplitude of a wave by a constant multiple
discreteConvolve :: (Num a, Num t) => Waveform t [(t, a)] -> Waveform t a -> Waveform t a Source #
Convolve with explicit discrete filter kernel weights.
wackyNotConvolution :: (a -> b -> c) -> Waveform t (Waveform t a) -> Waveform t b -> Waveform t c Source #
This operation is not convolution, but something kind of like it. Use for creative purposes? Should be fast!
wackyNotConvolution modf profile w = sampleFrom $ t -> sample (modulate modf (sample profile t) w) t
:: Fractional a | |
=> Tick | tickRadius |
-> Tick | skipRate |
-> Waveform Tick (Waveform Tick a) | The kernel of the convolution at each |
-> Waveform Tick a | w(t) |
-> Waveform Tick a |
Perform a discrete convolution. The output waveform is f(t) = int_{t-tickRadius}^{t+tickRadius} (kernel(t))(x) * w(t+x) dx
but is discretized such that x
is always a multiple of skipRate
.
:: (RealFrac t, Fractional a) | |
=> t |
|
-> t |
|
-> Waveform t (Waveform t a) | Kernel of convolution for each time |
-> Waveform t a | |
-> Waveform t a |
Same as
but for arbitarily valued waveforms. Works on tickConvolution
for example.DWave
:: Fractional a | |
=> Double | bandCenter |
-> Double | bandSize |
-> Waveform Double a |
Makes a filter which selects frequencies near bandCenter
with tuning parameter bandSize
.
Try: optimizeFilter
200 . tickTable
stdtr
$ bandpassFilter
concertA
100
discretize :: Waveform t Double -> Waveform t Discrete Source #
Discretize the output of a
producing waveformDouble
Discretize the input to a
consuming waveformDouble
tickTableMemo :: Double -> Waveform Double a -> Waveform Tick a Source #
Tries and fails to optimize a
through memoization but actually hangs and eats all your memory.Waveform
optimizeFilter :: Tick -> Wavetable -> Wavetable Source #
Optimize a filter by doing
around solidSlice
t=0
since those values are sampled repeatedly in a filter
fourierTransform :: Tick -> Double -> Waveform Tick (Complex Double) -> Waveform Double (Complex Double) Source #
Take the Fourier Transform of a complex valued
sampled waveformTick
:: Tick | Radius of Fourier Transform window in |
-> Double | Sampling rate to use for the Fourier transform. Try the sample sample rate as the |
-> Wavetable | |
-> Wavetable |
Take the Fourier Transform of a Wavetable
usingFFT :: Tick -> Wavetable -> Wavetable Source #
Attempts to do a fast fourier transform, but the units of the domain of the output are highly suspect. May be unreliable, use with caution.
allSemis :: Floating a => [a] Source #
12 tone equal temperament ratios for all semitones in an octave.
takeFinAlignments :: Floating a => Int -> [[a]] Source #
List multiples of the single octave semitone ratios upto a certain amount.
newtype PitchFactorDiagram Source #
A pitch factor diagram is a list of prime exponents that represents a rational number
via diagramToRatio
. These are useful because pitches with few prime factors, that is,
small PitchFactorDiagram
s with small factors in them, are generally consonant, and
many interesting just intonation intervals can be written this way (see perfectFifth
and majorThird
).
Factors | |
|
Instances
Show PitchFactorDiagram Source # | |
Defined in Boopadoop.Diagram showsPrec :: Int -> PitchFactorDiagram -> ShowS # show :: PitchFactorDiagram -> String # showList :: [PitchFactorDiagram] -> ShowS # | |
Semigroup PitchFactorDiagram Source # |
|
Defined in Boopadoop.Diagram (<>) :: PitchFactorDiagram -> PitchFactorDiagram -> PitchFactorDiagram # sconcat :: NonEmpty PitchFactorDiagram -> PitchFactorDiagram # stimes :: Integral b => b -> PitchFactorDiagram -> PitchFactorDiagram # | |
Monoid PitchFactorDiagram Source # |
|
Defined in Boopadoop.Diagram |
diagramToRatio :: Fractional a => PitchFactorDiagram -> a Source #
Convert a factor diagram to the underlying ratio by raising each prime (starting from two) to the power in the factor list. For instance, going up two perfect fifths and down three major thirds yields:
diagramToRatio (Factors [4,2,-3]) = (2 ^^ 4) * (3 ^^ 2) * (5 ^^ (-3)) = 144/125
diagramToFloatyRatio :: PitchFactorDiagram -> Rational Source #
Similar to diagramToRatio
, but simplifies the resulting ratio to the simplest ratio within 0.05
.
diagramToSemi :: Floating a => PitchFactorDiagram -> a Source #
Convert a PFD to its decimal number of semitones. Useful for approximating weird ratios in a twelvetone scale:
diagramToSemi (normalizePFD $ Factors [0,0,0,1]) = diagramToSemi (countPFD (7/4)) = 9.688259064691248
normalizePFD :: PitchFactorDiagram -> PitchFactorDiagram Source #
Normalize a PFD by raising or lowering it by octaves until its ratio lies between 1
(unison) and 2
(one octave up).
This operation is idempotent.
countPFD :: Rational -> PitchFactorDiagram Source #
Calculates the PitchFactorDiagram
corresponding to a given frequency ratio by finding prime factors of the numerator and denominator.
intervalOf :: PitchFactorDiagram -> Double -> Double Source #
Converts a PFD into an operation on frequencies.
is the just intonation E5.intervalOf
perfectFifth
concertA
scalePFD :: Integer -> PitchFactorDiagram -> PitchFactorDiagram Source #
Scale a PFD by raising the underlying ratio to the given power. scalePFD
2 perfectFifth
= addPFD
octave
majorSecond
addPFD :: PitchFactorDiagram -> PitchFactorDiagram -> PitchFactorDiagram Source #
Adds two PFDs together by multiplying their ratios. addPFD
minorThird majorThird
= perfectFifth
printTheSequence :: Int -> IO () Source #
Prints the natural numbers from the given value up to 128
, highlighting primes and powers of two.
Interesting musical intervals are build out of the relative distance of a prime between the two
nearest powers of two.
A rhythm is represented as a rose tree where each subtree is given equal amounts of time.
Leaves are either a Beat of type a
or empty (a rest).
class SummaryChar a where Source #
Class for things that can be summarized in a single character, for use in printing out rhythms.
Instances
SummaryChar DrumRack Source # | |
A rack of drums. Simple enumeration of the different possible drum types.
Instances
SummaryChar DrumRack Source # | |
primeBeat :: Beat a -> Beat a Source #
Force there to be only prime divisions of time in the rhythm. This is done without affecting the actual rhythm. This operation is not uniquely valued in any way, and this algorithm prefers small primes first.
octave :: PitchFactorDiagram Source #
Interval of one octave, ratio is 2.
perfectFifth :: PitchFactorDiagram Source #
Interval of a perfect fifth 3:2
majorThird :: PitchFactorDiagram Source #
Interval of a major third 5:4
mysterySeven :: PitchFactorDiagram Source #
Interval 7:4
majorSecond :: PitchFactorDiagram Source #
Interval of a major second 9:8
mystery25 :: PitchFactorDiagram Source #
Interval 25:16
counterExample :: PitchFactorDiagram Source #
Interval 199:200. Should be mostly consonant to your ear but has non-small PFD:
[-3,0,-2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1]
represents Discrete
xx/
as a floating point number in [-1,1].discFactor
doubleToDiscrete :: Double -> Discrete Source #
Breaks when the double is not in [-1,1]
discFactor :: Num a => a Source #
This is the conversion factor between the internal value of a
and the value it represents.Discrete
properFloor :: RealFrac a => a -> Int32 Source #
Round toward zero
disguise :: (Double -> Double) -> Discrete -> Discrete Source #
Make a function of doubles a function of discretes
A discrete representation of time. See
for the sampling rate.tickTable