diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Anton Kholomiov 2011 +Copyright Anton Kholomiov 2011-2012 All rights reserved. diff --git a/src/Temporal/Music.hs b/src/Temporal/Music.hs new file mode 100644 --- /dev/null +++ b/src/Temporal/Music.hs @@ -0,0 +1,19 @@ +module Temporal.Music( + -- * Introduction + -- | This library provides two kinds of musical structures. + -- First is general 'Score' representation. It tells how to + -- combine musical things together and how they can be transformed. + -- Second is just the oposite of the first one, it stands for + -- very basic musical structures like 'Pitch', 'Scale', 'Volume'. + + module Temporal.Music.Pitch, + module Temporal.Music.Volume, + module Temporal.Music.Note, + module Temporal.Music.Score) + +where + +import Temporal.Music.Pitch +import Temporal.Music.Volume +import Temporal.Music.Note +import Temporal.Music.Score diff --git a/src/Temporal/Music/Notation.hs b/src/Temporal/Music/Notation.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation.hs +++ /dev/null @@ -1,53 +0,0 @@ -module Temporal.Music.Notation ( - -- * Introduction - -- | This library provides two kinds of musical structures. First is - -- general 'Score' representation. It tells how to combine musical - -- things together and how they can be transformed. Second is just - -- the oposite side of first one, it stands for - -- very basic musical structures like 'Pitch', 'Scale', 'Tone', 'Volume'. - -- - -- So you can see huge gap inbetween the two. For example this - -- module doesn't exports any - -- specific datatype for notes. Though there are data types 'Note' - -- and 'Drum' defined in "Temporal.Music.Notation.Note" module - -- that can be seen as example of usage of basic data types. - -- It's up to you to fill in between. - -- But this gap is not just gap it's gap with bridges. - -- Pch\/Tone\/Vol Functors are those ropes that tie together those two - -- levels. To use all basic structures transformation in your specific - -- note-representation you only need to tell how they are wrapped, i.e. - -- provide instances of your note-representation for basic functors. - -- And then you can use the bridges. - -- - -- For every XxxFunctor there is general instance for 'Score'. - -- - -- For example - -- - -- >instance PchFunctor a => PchFunctor (Score c a) where (...) - -- - -- It implies that transformations like - -- 'quiet', 'step' or 'lower' can act on bunch of notes packed in - -- 'Score' if notes are inside 'PchFunctor'. - -- - -- There are two preliminary steps for using this library - -- - -- * find note representation that suits you - -- - -- * if it contains basic musical structures, define corresponding - -- XxxFunctor instances - -- - -- And then let it sound in 'Score'. - -- - -- Examples can be found in package source folder. - - module Temporal.Music.Notation.Volume, - module Temporal.Music.Notation.Pitch, - module Temporal.Music.Notation.Score, - module Temporal.Music.Notation.Seg -) -where - -import Temporal.Music.Notation.Volume -import Temporal.Music.Notation.Pitch -import Temporal.Music.Notation.Score -import Temporal.Music.Notation.Seg diff --git a/src/Temporal/Music/Notation/Note.hs b/src/Temporal/Music/Notation/Note.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation/Note.hs +++ /dev/null @@ -1,211 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} --- | Module defines two musical structures 'Note' and 'Drum' and provides --- constructor-shortcuts for them. Value of type 'Note' contains --- pitch and volume. Value of type 'Drum' is just 'Volume' - -module Temporal.Music.Notation.Note( - -- * Types - Note(..), absNote, Drum(..), absDrum, - - -- * Shortcuts - -- | Shortcuts for rests, notes and drums construction. - -- Naming conventions : name has two parts, first describes duration of - -- resulting score and second describes that result is rest, note or - -- drum note. - -- - -- For name @xy@ - -- - -- First part @x@ can be [b | w | h | q | e | s | t | d[x] ] - -- - -- @b@ means brewis (duration is 2) - -- - -- @w@ means whole (duration is 1) - -- - -- @h@ means half (duration is 1/2) - -- - -- @q@ means quater (duration is 1/4) - -- - -- @e@ means eighth (duration is 1/8) - -- - -- @s@ means sixteenth (duration is 1/16) - -- - -- @t@ means thirty second (duration is 1/32) - -- - -- @d[x]@ means dotted [x] (stretch 1.5 $ x) - -- - -- Second part @y@ can be [nr | n | d] - -- - -- @nr@ means rest - -- - -- @n@ means result contains 'Note' - -- - -- @d@ means result contains 'Drum' - - -- ** Rests - bnr, wnr, hnr, qnr, enr, snr, tnr, - dbnr, dwnr, dhnr, dqnr, denr, dsnr, dtnr, - - -- ** Notes - -- - -- | It is assumed here that for 'Note' most important information is - -- tone and shortcuts construct 'Note' values from 'Tone' 's, - -- other values are set to default values. It means that scale is - -- equaly tempered, bend is set to zero, volume level is set to - -- mediumLevel, - -- accent is set to zero and volume diapason is set to interval (1e-5, 1). - -- - bn, wn, hn, qn, en, sn, tn, - dbn, dwn, dhn, dqn, den, dsn, dtn, - - -- ** Drums - -- - -- | It is assumed here that for 'Drum' most important information is - -- accent and shortcuts construct 'Drum' from 'Accent' 's, other - -- parameters are set to default values. It means that volume level - -- is mediumLevel and volume diapason is (1e-5, 1) - bd, wd, hd, qd, ed, sd, td, - dbd, dwd, dhd, dqd, ded, dsd, dtd -) -where - - -import Temporal.Music.Notation.Seg -import Temporal.Music.Notation.Pitch -import Temporal.Music.Notation.Volume -import Temporal.Music.Notation.Score (Dur, Score, note, rest, dot) - -import Temporal.Music.Notation.Scales(eqts) - --- Note - --- | Value of type 'Note' contains pitch, volume and some specific --- timbre information. -data Note nVol nPch a = Note - { noteVolume :: Volume nVol - , notePitch :: Pitch nPch - , noteParam :: Maybe a - } deriving (Show, Eq) - --- volume instances - -instance (Seg nVol, Seg nPch) - => VolumeFunctor (Note nVol nPch a) where - mapVolume f n = n{ noteVolume = f $ noteVolume n } - -instance (Seg nVol, Seg nPch) - => LevelFunctor (Note nVol nPch a) where - mapLevel f n = n{ noteVolume = mapLevel f $ noteVolume n } - --- pitch instances - -instance (Seg nVol, Seg nPch) - => PitchFunctor (Note nVol nPch a) where - mapPitch f n = n{ notePitch = f $ notePitch n } - -instance (Seg nVol, Seg nPch) - => ToneFunctor (Note nVol nPch a) where - mapTone f n = n{ notePitch = mapTone f $ notePitch n } - --- | calculates 'absVolume' and 'absPitch' on notes -absNote :: (Seg nVol, Seg nPch) - => Note nVol nPch a -> (Amplitude, Frequency) -absNote (Note v p _) = (absVolume v, absPitch p) - --- Drum - --- | Value of type 'Drum' is just 'Volume'. -data Drum n a = Drum - { drumVolume :: Volume n - , drumParam :: Maybe a - } deriving (Show, Eq) - - --- volume instances - -instance Seg nVol => VolumeFunctor (Drum nVol a) where - mapVolume f n = n{ drumVolume = f $ drumVolume n } - -instance Seg nVol=> LevelFunctor (Drum nVol a) where - mapLevel f n = n{ drumVolume = mapLevel f $ drumVolume n } - - --- | synonym for 'absVolume' -absDrum :: (Seg nVol) - => Drum nVol a -> Amplitude -absDrum = absVolume . drumVolume - --- shortcuts - - --- notes - -n :: (Vol nVol, Pch nPch) - => Dur -> Tone nPch -> Score (Note nVol nPch a) -n dt t = note dt $ Note (volume mediumLevel) (pitch t) Nothing - -bn, wn, hn, en, sn, tn, dbn, dwn, dhn, den, dsn, dtn :: - (Vol nVol, Pch nPch) - => Tone nPch -> Score (Note nVol nPch a) - -bn = n 2 -wn = n 1 -hn = n 0.5 -qn = n 0.25 -en = n 0.125 -sn = n 0.0625 -tn = n 0.03125 -dbn = dot . bn -dwn = dot . wn -dhn = dot . hn -dqn = dot . qn -den = dot . en -dsn = dot . sn -dtn = dot . tn - - --- drums - -d :: (Vol nVol) - => Dur -> Accent -> Score (Drum nVol a) -d dt a = note dt $ Drum (setAccent a $ volume mediumLevel) Nothing - -bd, wd, hd, ed, sd, td, dbd, dwd, dhd, ded, dsd, dtd :: - (Vol nVol) - => Accent -> Score (Drum nVol a) - -bd = d 2 -wd = d 1 -hd = d 0.5 -qd = d 0.25 -ed = d 0.125 -sd = d 0.0625 -td = d 0.03125 -dbd = dot . bd -dwd = dot . wd -dhd = dot . hd -dqd = dot . qd -ded = dot . ed -dsd = dot . sd -dtd = dot . td - --- rests --- - -bnr, wnr, hnr, qnr, enr, snr, tnr, - dbnr, dwnr, dhnr, dqnr, denr, dsnr, dtnr :: Score a - -bnr = rest 2 -wnr = rest 1 -hnr = rest 0.5 -qnr = rest 0.25 -enr = rest 0.125 -snr = rest 0.0625 -tnr = rest 0.03125 -dbnr = dot $ bnr -dwnr = dot $ wnr -dhnr = dot $ hnr -dqnr = dot $ qnr -denr = dot $ enr -dsnr = dot $ snr -dtnr = dot $ tnr - diff --git a/src/Temporal/Music/Notation/Pitch.hs b/src/Temporal/Music/Notation/Pitch.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation/Pitch.hs +++ /dev/null @@ -1,399 +0,0 @@ -{-# LANGUAGE - FlexibleInstances, - TypeSynonymInstances, - Rank2Types #-} - --- | Representing pitch -module Temporal.Music.Notation.Pitch ( - -- * Types - -- - -- | There are four main datatypes 'Frequency', 'Pitch', 'Scale' and 'Tone'. - -- 'Pitch' consists of 'Scale' and 'Tone'. - -- Every 'Pitch' can be converted to 'Frequency' (see a 'absPitch'). - -- 'Scale' defines logarithmic mapping from 2d integer coordinates of - -- 'Tone' to 1d double values. 'Scale' is 2d logarithmic grid in - -- frequency domain and 'Tone' is point on that grid. - Frequency, c1, a1, - Pch(pitch), - Pitch(..), - Interval, Scale(..), scaleSize, fromIntervals, - Bend, Octave, Step, - Tone(..), tone, toneNum, - -- * Transformers - -- ** Pitch - PitchFunctor(..), - -- ** Scale - setScale, mapBase, setBase, transposeScale, - -- ** Tone - ToneFunctor(..), - setBend, bend, step, transp, - low, l', ll', high, h', hh', lower, higher, invert, - -- * Rendering - frequency, absPitch, - toneAsDouble, scaleAt, scaleAtInt, scaleStep - ) -where - -import Data.Function(on) -import qualified Data.Vector as V - -import Temporal.Music.Notation.Score(Score) -import Control.Arrow(first, second) -import Temporal.Music.Notation.Seg - -type Frequency = Double - --- | middle C (261.626 Hz) -c1 :: Frequency -c1 = 261.626 - --- | middle A (440 Hz) -a1 :: Frequency -a1 = 440 - - -class Seg a => Pch a where - pitch :: Tone a -> Pitch a -{- -instance Nat n => Pch (IntSeg n) where - pitch x = Pitch (defaultScale x) x - where defaultScale x = Scale (0, c1) 2 $ V.fromList $ - let n = toneNum x - n' = fromIntegral n - eqt = (2 ** ) . (/n') . fromIntegral - in map eqt [0 .. n-1] --} - --- | 'Pitch' consists of 'Scale' and 'Tone' -data Seg n => Pitch n = Pitch - { pitchScale :: Scale - , pitchTone :: Tone n - } deriving (Show, Eq) - - --------------------------------------------------------------- --- Scale - --- | Musical interval. Ratio between two frequency values. -type Interval = Frequency - --- | 'Scale' defines 2d grid in frequency domain. First value of 2d vector --- is octave and second is step. 'Scale' consists of base tone, --- octave interval and individual tone intervals inside octave. --- Base tone links scale coordinates to frequency coordinates. --- Base tone is pair (n, f) of integer value and frequency value, --- Base tone defines that @'tone' n@ corresponds to frequency @f@. --- --- For example scales @s1@ and @s2@ are equal --- --- >import Temporal.Music.Notation.Local.Scales(eqt) --- > --- >s1 = eqt 0 c1 --- >s2 = eqt 9 a1 --- --- This doesn't make much sense for equal temperament. But can be useful --- for just scales. For example this gives just pythagorean scale in G major --- --- >import Temporal.Music.Notation.Local.Scales(pyth) --- > --- >pythG = pyth 7 (3/2 * c1) --- --- if you write just @pyth 0 (3/2 * c1)@ note (0 :: Tone N12) corresponds --- to G. - -data Scale = Scale - { scaleBase :: (Int, Frequency) - -- ^ start point of the grid, - -- @(n, cps)@ corresponds to @(0, n)@ - -- where n is step id of 'scaleBase' and - -- @cps@ is 'scaleBase' in frequency units. - - , scaleOctave :: Interval - -- ^ octave interval - - , scaleSteps :: V.Vector Interval - -- ^ multipliers for each step in octave - } deriving (Show, Eq) - --- | gives number of steps in one octave. -scaleSize :: Scale -> Int -scaleSize = V.length . scaleSteps - --- | 'fromIntervals' makes scale constructor from 'octave' interval and --- scale step intervals. -fromIntervals :: - Interval -> [Interval] - -> (Int -> Frequency -> Scale) -fromIntervals octave steps = \c0 f0 -> Scale (c0, f0) octave $ V.fromList steps - - -------------------------------------------------------------- --- Tone - --- | represents tone's diversion from scale grid. -type Bend = Double -type Octave = Int -type Step = Int - --- | 'Tone' is 2d integer value (octave, step) that can be converted to --- frequency --- with some scale. 'Bend' is a level of diversion from scale-tones --- 1-level bend is equal to 1 step. For tones with fractional bends frequency --- is calculated with linear interpolation by nearest values in scale. -data Seg n => Tone n = Tone - { toneBend :: Bend - , toneOctave :: Octave - , toneStep :: n - } deriving (Eq, Show) - --- | 'tone' constructs Tone from step value. Bend is set to zero. -tone :: Seg n => n -> Tone n -tone = Tone 0 0 - --- | 'toneNum' queries number of steps in scale for given tone. --- It decodes type value to 'Int'. -toneNum :: Seg n => Tone n -> Int -toneNum x = segSize $ num x - where num :: Seg n => Tone n -> n - num = const undefined - --- instances - -instance (Eq n, Seg n) => Ord (Tone n) where - compare = compare `on` (\(Tone b o s) -> (o, fromEnum s, b)) - -instance Seg n => Enum (Tone n) where - toEnum x = res - where res = Tone 0 o $ toEnum s - (o, s) = divMod x (toneNum res) - fromEnum x = toneOctave x * toneNum x + (fromEnum $ toneStep x) - -instance (Eq n, Show n, Seg n) => Num (Tone n) where - (+) = liftBi (+) (+) (+) - (-) = liftBi (-) (-) (+) - (*) = liftBi (*) (*) (*) - - abs = liftUn abs abs abs - signum t@(Tone b o s) - | abs b < 1e-6 && o == 0 && s == minBound = 0 - | t > 0 = fromInteger 1 - | otherwise = fromInteger $ -1 - - fromInteger x = step (fromInteger x) $ tone minBound - -------------------------------------------------------------------- -------------------------------------------------------------------- --- Transformers - --- Pitch - -class PitchFunctor a where - mapPitch :: (forall n . Seg n => Pitch n -> Pitch n) -> (a -> a) - -instance Seg n => PitchFunctor (Pitch n) where - mapPitch f = f - -instance (PitchFunctor a) => PitchFunctor (Score a) where - mapPitch f = fmap (mapPitch f) - - --- Scale - -mapScale :: PitchFunctor a => (Scale -> Scale) -> a -> a -mapScale f = mapPitch $ \p -> p{ pitchScale = f $ pitchScale p } - --- | setting specific scale -setScale :: PitchFunctor a => Scale -> a -> a -setScale x = mapScale $ const x - --- | mapping of scale base tone -mapBase :: PitchFunctor a => (Frequency -> Frequency) -> a -> a -mapBase f = mapScale $ \s -> s{ scaleBase = second f $ scaleBase s } - --- | setting scale base tone -setBase :: PitchFunctor a => Frequency -> a -> a -setBase b = mapBase $ const b - --- | 'transposeScale' shifts scaleSteps by given number. --- For example if your just scale is defined with middle C as base --- and you want to transpose it to middle D you can write --- --- >res = someScale 2 (wholeTone * c1) --- > where wholeTone = 9/8 --- --- or --- --- >transposeScale 2 $ someScale 0 c1 --- --- And now 0 corresponds to middle C and step multipliers are rearranged --- so that someScale starts from middle D. -transposeScale :: PitchFunctor a => Step -> a -> a -transposeScale n = mapScale $ \(Scale b o s) -> Scale b o $ rotateSteps n s - where rotateSteps x s = V.map ( (/d) . (s V.! ) . flip mod n) ids - where n = V.length s - d = s V.! (mod x n) - ids = V.fromList [x .. x + n] - --- Tone --- | transformer for types that contain tone -class ToneFunctor a where - mapTone :: (forall n . Seg n => Tone n -> Tone n) -> (a -> a) - -instance Seg n => ToneFunctor (Tone n) where - mapTone f = f - -instance ToneFunctor a => ToneFunctor (Score a) where - mapTone f = fmap (mapTone f) - -instance Seg n => ToneFunctor (Pitch n) where - mapTone f (Pitch s t) = Pitch s $ f t - --- | set bend value -setBend :: ToneFunctor a => Bend -> a -> a -setBend d = mapTone $ \x -> x{ toneBend = d } - --- | shift in bends -bend :: ToneFunctor a => Bend -> a -> a -bend d = mapTone $ \x -> x{ toneBend = toneBend x + d } - --- | transposition, shift in steps -step :: ToneFunctor a => Step -> a -> a -step n = mapTone $ liftUn id id ( + n) - - --- | transposition, shift in steps -transp :: ToneFunctor a => Step -> a -> a -transp = step - --- | one octave lower -low :: ToneFunctor a => a -> a -low = lower 1 - --- | shorcut for 'low' -l' :: ToneFunctor a => a -> a -l' = low - --- | shorcut for @'lower' 2@ -ll' :: ToneFunctor a => a -> a -ll' = lower 2 - --- | one octave higher -high :: ToneFunctor a => a -> a -high = higher 1 - --- | shorcut for 'high' -h' :: ToneFunctor a => a -> a -h' = high - --- | shorcut for @'higher' 2@ -hh' :: ToneFunctor a => a -> a -hh' = higher 2 - - --- | shifts downwards in octaves -lower :: ToneFunctor a => Int -> a -> a -lower n = higher (-n) - --- | shifts upwards in octaves -higher :: ToneFunctor a => Int -> a -> a -higher n = mapTone $ \(Tone b o s) -> Tone b (o + n) s - --- | inverts note around some tone center. Tone center defines --- two tones octave apart around current note in wich inversion takes place. --- --- For example with center at 5 note @c@ in twelve tone scale --- @[5, 6, 7, 8, 9, bb, 11, c, 1, 2, 3, 4, 5]@ goes into note bb. --- Inversion counts number of steps from lower center tone to given tone --- and then result is higher center tone shifted lower by this number. -invert :: ToneFunctor a => Step -> a -> a -invert center = mapTone $ - \t@(Tone b o s) -> - let n = toneNum t - c = mod center n - w = fromEnum s - q = if c <= w - then (2 * c + n - w) - else (2 * c - n - w) - (o', s') = divMod q n - in Tone b (o + o') $ toEnum s' - - ------------------------------------------------------------ --- rendering - --- | pitch to frequency conversion -absPitch :: Seg n => Pitch n -> Frequency -absPitch (Pitch s t) = frequency s t - --- | calculates frequency value for given tone on scale grid -frequency :: Seg n => Scale -> Tone n -> Frequency -frequency s t = scaleAt s $ toneAsDouble t - --- | flattens tone to double. -toneAsDouble :: Seg s => Tone s -> Double -toneAsDouble t@(Tone b o s) = (fromIntegral $ fromEnum t) + b - - --- | scale value on doubles -scaleAt :: Scale -> Double -> Double -scaleAt s x = scaleAtInt s d * bendCoeff s n r - where (d, r) = properFraction x - n = mod (d - c0) $ scaleSize s - c0 = fst $ scaleBase s - --- | scale value on integers -scaleAtInt :: Scale -> Int -> Frequency -scaleAtInt s x = f0 * scaleStep s x - where f0 = snd $ scaleBase s - --- | gives scale multiplier -scaleStep :: Scale -> Int -> Interval -scaleStep s x = (scaleOctave s ^^ o) * scaleSteps s V.! n - where (o, n) = divMod (x - c0) $ scaleSize s - c0 = fst $ scaleBase s - - -bendCoeff :: Scale -> Int -> Double -> Frequency -bendCoeff s n x - | abs x < 1e-6 = 1 - | x > 0 = flip loginterpCoeff x $ getTones s n $ n + 1 - | otherwise = flip loginterpCoeff (abs x) $ getTones s n $ n - 1 - where getTones s n1 n2 = (getTone s n1, getTone s n2) - getTone s x - | x >= 0 && x < n = scaleSteps s V.! x - | x == n = o - | x == -1 = scaleSteps s V.! (n-1) / o - | otherwise = error $ "scaleStep: out of bounds" - where n = scaleSize s - o = scaleOctave s - - -loginterpCoeff :: (Double, Double) -> Double -> Double -loginterpCoeff (l, r) x = (r / l) ** x - - --- tone manipulation - -liftUn :: Seg n - => (Double -> Double) - -> (Int -> Int) - -> (Int -> Int) - -> Tone n -> Tone n -liftUn f g h t@(Tone b o s) = - (uncurry $ Tone (f b)) $ - fit (toneNum t) (g o, h $ fromEnum s) - - - -liftBi :: Seg n - => (Double -> Double -> Double) - -> (Int -> Int -> Int) - -> (Int -> Int -> Int) - -> Tone n -> Tone n -> Tone n -liftBi f g h t@(Tone b o s) (Tone b' o' s') = - (uncurry $ Tone (b `f` b')) $ - fit (toneNum t) (o `g` o', fromEnum s `h` fromEnum s') - -fit :: Seg s => Int -> (Int, Int) -> (Int, s) -fit n (o, s) = (o + o', toEnum s') - where (o', s') = divMod s n diff --git a/src/Temporal/Music/Notation/Scales.hs b/src/Temporal/Music/Notation/Scales.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation/Scales.hs +++ /dev/null @@ -1,256 +0,0 @@ --- | specific scales -module Temporal.Music.Notation.Scales -( - -- * just scales - ji3, ji5, ji7, - pyth, - hindGb, - hindFs, - justBP, - partchean, - luScale, - superJust, harmonicJust, - sruti, - -- * Irregular scales - eqt, eqts, eqBP, hind, - -- * Subscales - -- | extracting 5-tone scales out of 12-tone scales - minor5, major5, - bluesMinor5, bluesMajor5, egyptian5, - -- | extracting 7-tone scales out of 12-tone scales - major, minor, - ionian, dorian, phrygian, lydian, - mixolydian, aeolian, locrian) -where - -import Temporal.Music.Notation.Pitch(Frequency, - Scale(..), scaleSize, fromIntervals) -import qualified Data.Vector as V - -sliceScale :: Int -> [Int] -> Scale -> Scale -sliceScale octaveLength ids x - | octaveLength == (V.length $ scaleSteps x) = - Scale (scaleBase x) (scaleOctave x) $ - V.fromList $ map (scaleSteps x V.! ) ids - | otherwise = error - ("scale must have " ++ show octaveLength ++ - " tones in octave") - - ---------------------------------------------------- --- 12-tone modes - - --- 5 tone - -minor5 = slice12 minor5Is -major5 = slice12 major5Is -egyptian5 = slice12 egyptian5Is -bluesMinor5 = slice12 bluesMinor5Is -bluesMajor5 = slice12 bluesMajor5Is - -major5Is = pentaIs -egyptian5Is = rot 1 $ pentaIs -bluesMinor5Is = rot 2 $ pentaIs -bluesMajor5Is = rot 3 $ pentaIs -minor5Is = rot 4 $ pentaIs - -pentaIs = [2, 2, 3, 2, 2] - --- 7 tone - -major, minor, - ionian, dorian, phrygian, lydian, - mixolydian, aeolian, locrian :: Scale -> Scale - -major = slice12 majorIs -minor = slice12 minorIs - -ionian = slice12 ionianIs -dorian = slice12 dorianIs -phrygian = slice12 phrygianIs -lydian = slice12 lydianIs -mixolydian = slice12 mixolydianIs -aeolian = slice12 aeolianIs -locrian = slice12 locrianIs - - -majorIs = [2, 2, 1, 2, 2, 2, 1] -minorIs = aeolianIs - -ionianIs = rot 0 majorIs -dorianIs = rot 1 majorIs -phrygianIs = rot 2 majorIs -lydianIs = rot 3 majorIs -mixolydianIs = rot 4 majorIs -aeolianIs = rot 5 majorIs -locrianIs = rot 7 majorIs - -slice12 :: [Int] -> (Scale -> Scale) -slice12 ids = sliceScale 12 (fromIs ids) - -fromIs = (0:) . fst . foldl f ([], 0) . init - where f (res, i) x = (res ++ [i + x], i + x) - -rot :: Int -> [a] -> [a] -rot n xs = drop n xs ++ take n xs - - ---------------------------------------------------- --- equal temperament - --- | 12 tone equal temperament scale -eqt :: Int -> Frequency -> Scale -eqt = fromIntervals 2 (map ((2 **) . (/12)) [0 .. 11]) - --- | general equal temperament scale -eqts :: Int -> Frequency -> Scale -eqts = res - where n = scaleSize $ res 0 0 - res = fromIntervals 2 $ - (map ((2 **) . (/fromIntegral n) . fromIntegral) [0 .. n-1]) - --- | hindemithean scale with mean of fs and gb for tritone -hind ::Int -> Frequency -> Scale -hind = hindemitheanGen $ 0.5 * (ji5 (-1, 2, 1) + ji5 (2, -2, -1)) - --- | equal Bohlen-Pierce scale -eqBP :: Int -> Frequency -> Scale -eqBP = fromIntervals 3 (map ((3 **) . (/13) . fromIntegral) [0 .. 12]) - - ---------------------------------------------------- - --- | pythagorean scale -pyth :: Int -> Frequency -> Scale -pyth = fromIntervals 2 $ map toPyth --- 0 1 2 3 4 5 - [(0, 0), (-5, 3), (2, -1), (-3, 2), (4, -2), (-1, 1), --- 6 7 8 9 10 11 - (-6, 4), (1, 0), (-4, 3), (3, -1), (-2, 2), (5, -2)] - -toPyth :: (Int, Int) -> Frequency -toPyth (a, b) = ji3 (b, a) - --- | 3-limit basis @(2, 3\/2)@ -ji3 :: (Int, Int) -> Frequency -ji3 (a, b) = (2 ^^ a) * (1.5 ^^ b) - --------------------------------------------------------- --- Just intonation - --- 5-limit --- - --- | 5-limit basis @(2, 3\/2, 5\/4)@ -ji5 :: (Int, Int, Int) -> Frequency -ji5 (a, b, c) = (2 ^^ a) * (1.5 ^^ b) * (1.25 ^^ c) - --- | hindemithean scale with fs for tritone -hindFs :: Int -> Frequency -> Scale -hindFs = hindemitheanGen $ ji5 (-1, 2, 1) - --- | hindemithean scale with gb for tritone -hindGb :: Int -> Frequency -> Scale -hindGb = hindemitheanGen $ ji5 (2, -2, -1) - -hindemitheanGen :: Frequency -> Int -> Frequency -> Scale -hindemitheanGen tritone = fromIntervals 2 $ map ji5 --- 0 1, 2, 3, 4, 5 - [(0, 0, 0), (1, -1, -1), (-1, 2, 0), (0, 1, -1), (0, 0, 1), (1, -1, 0)] --- 6 - ++ [tritone] ++ map ji5 --- 7 8, 9, 10, - [(0, 1, 0), (1, 0, -1), (1, -1, 1), (2, -2, 0), (0, 1, 1)] - --- 7-limit - --- | 7-limit basis @(2, 3\/2, 5\/4, 7\/6)@ -ji7 :: (Int, Int, Int, Int) -> Double -ji7 (a, b, c, d) = (2 ^^ a) * (1.5 ^^ b) * (1.25 ^^ c) * ((7/6) ^^ d) - --- | just Bohlen-Pierce scale -justBP :: Int -> Frequency -> Scale -justBP = fromIntervals 3 --- 0 1, 2, 3, - [1, 27/25, 25/21, 9/7, --- 4, 5, 6, 7 - 7/5, 75/49, 5/3, 9/5, --- 8, 9, 10, 11 - 49/25, 15/7, 7/3, 63/25, --- 12 - 25/9] - - --- | Harry Partch's 43-tone scale -partchean :: Int -> Frequency -> Scale -partchean c0 f0 = Scale (c0, f0) 2 $ V.fromList --- 0, 1, 2, 3, 4, - [1, 81/80, 33/32, 21/20, 16/15, --- 5, 6, 7, 8, 9, - 12/11, 11/10, 10/9, 9/8, 8/7, - --- 10, 11, 12, 13, 14 - 7/6, 32/27, 6/5, 11/9, 5/4, --- 15, 16, 17, 18, 19, - 14/11, 9/7, 21/16, 4/3, 27/20, - --- 20, 21, 22, 23, 24, - 11/8, 7/5, 10/7, 16/11, 40/27, --- 25, 26, 27, 28, 29, - 3/2, 32/21, 14/9, 11/7, 8/5, - --- 30, 31, 32, 33, 34, - 18/11, 5/3, 27/16, 12/7, 7/4, --- 35, 36, 37, 38, 39, - 16/9, 9/5, 20/11, 11/6, 15/8, - --- 40, 41, 42, - 40/21, 64/33, 160/81] - --- | Chinese Lu 12-tone scale -luScale :: Int -> Frequency -> Scale -luScale = fromIntervals 2 --- 0, 1, 2, 3, 4, - [1, 18/17, 9/8, 6/5, 54/43, --- 5, 6, 7, 8, 9, - 4/3, 27/19, 3/2, 27/17, 27/16, --- 10, 11, 12, 13, 14 - 9/5, 36/19] - --- | Wendy Carlos super just 12-tone scale -superJust :: Int -> Frequency -> Scale -superJust = fromIntervals 2 --- 0, 1, 2, 3, 4, - [1, 17/16, 9/8, 6/5, 5/4, --- 5, 6, 7, 8, 9, - 4/3, 11/8, 3/2, 13/8, 5/3, --- 10, 11, 12, 13, 14 - 7/4, 15/8] - --- | Wendy Carlos harmonic 12-tone scale -harmonicJust :: Int -> Frequency -> Scale -harmonicJust = fromIntervals 2 --- 0, 1, 2, 3, 4, - [1, 17/16, 9/8, 19/16, 5/4, --- 5, 6, 7, 8, 9, - 21/16, 11/8, 3/2, 13/8, 27/16, --- 10, 11, 12, 13, 14 - 7/4, 15/8] - - --- | Indian Sruti 22-tone scale - -sruti :: Int -> Frequency -> Scale -sruti = fromIntervals 2 --- 0, 1, 2, 3, 4, - [1, 256/243, 16/15, 10/9, 9/8, --- 5, 6, 7, 8, 9, - 32/27, 6/5, 5/4, 81/64, 4/3, --- 10, 11, 12, 13, 14, - 27/20, 45/32, 729/512, 3/2, 128/81, --- 15, 16, 17, 18, 19, - 8/5, 5/3, 27/16, 16/9, 9/5, --- 20, 21, - 15/8, 243/128] - diff --git a/src/Temporal/Music/Notation/Score.hs b/src/Temporal/Music/Notation/Score.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation/Score.hs +++ /dev/null @@ -1,241 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - --- | Functions for score composition. --- --- -module Temporal.Music.Notation.Score ( - -- * Types - Time, Dur, Score, - -- * Constructors - rest, note, - -- * Duration querry - dur, - -- * Composition - (+:+), (=:=), (=:/), - line, chord, chordT, - loop, trill, - -- * Transformers - -- ** In time domain - delay, - stretch, - bpm, dot, ddot, tri, - slice, takeS, dropS, reverseS, - pedal, pedalBy, - sustain, sustainBy, - -- ** Mappings - tmap, dmap, tdmap, eventMap, - -- * Rendering - Event(..), - EventList(..), - renderScore, - -- * Miscellaneous - tmapRel, dmapRel, tdmapRel, - linseg -) -where - -import qualified Temporal.Media as M -import Temporal.Media(Event(..), EventList(..), linseg) - -import Control.Arrow(first, second) - --- | time -type Time = Double - --- | duration -type Dur = Double - --- | In 'Score' @a@ values of type @a@ --- can be wrapped in time events as if they present or abscent for some --- time 'Dur' and combined together in parrallel or sequent ways. --- --- Score is instance of --- --- * 'Functor' 'Score' --- --- 'Functor' instance means that you can map over score values --- with some function @(a -> b)@, rests are mapped to rests and values --- transformed with given function. - -type Score a = M.Media Dur a - - --- | querry score's duration -dur :: Score a -> Dur -dur = M.dur - --- | pause for some "Dur" time -rest :: Dur -> Score a -rest = M.none - --- | stretch in time domain. Duration of every note segemnt is multiplied by --- given factor. -stretch :: Dur -> Score a -> Score a -stretch = M.stretch - --- | stretch with 1.5 -dot :: Score a -> Score a -dot = stretch 1.5 - --- | double 'dot', stretch with 1.75 -ddot :: Score a -> Score a -ddot = stretch 1.75 - --- | stretch with 2/3 -tri :: Score a -> Score a -tri = stretch (2/3) - --- | adds given amount of duration to all notes -sustain :: Dur -> Score a -> Score a -sustain k = sustainBy $ \t d a -> (d + k, a) - --- | set tempo in beats per minute, --- if 1 "Dur" is equal to 1 second before transformation. -bpm :: Double -> (Score a -> Score a) -bpm beat = stretch (x1/x0) - where x0 = 0.25 - x1 = 60/beat - --- | general sustain -sustainBy :: (Time -> Dur -> a -> (Dur, b)) -> Score a -> Score b -sustainBy f = M.eventMap $ - \(M.Event t d a) -> let (d', a') = f t d a - in M.Event t d' a' - --- | adds sustain, but total duration of score elements remains unchaged --- --- notes are sustained within total duration interval. --- adds given amount of time to all notes. -pedal :: Dur -> Score a -> Score a -pedal dt' = pedalBy (\t dt a -> (dt + dt', a)) - --- | general \"pedal\" --- --- Total duration of score element remains unchanged. notes are sustained within total duration interval -pedalBy :: (Time -> Dur -> a -> (Dur, b)) -> Score a -> Score b -pedalBy f x = sustainBy f' x - where d = dur x - f' t dt a = first (min (d - t)) $ f t dt a - --- | Constructor of score. Constructs note out of given value that lasts --- for some time. -note :: Dur -> a -> Score a -note = M.temp - --- | Delay scores by given duration. -delay :: Dur -> Score a -> Score a -delay = M.delay - --- | binary sequential composition, @a +:+ b@ means play a and then play b. -(+:+) :: Score a -> Score a -> Score a -(+:+) = (M.+:+) - --- | binary parallel composition, @a =:= b@ means play a and b simultoneously. -(=:=) :: Score a -> Score a -> Score a -(=:=) = (M.=:=) - --- | turncating parallel composition --- --- for a =:/ b composes two scores together and turncates biggest one by --- duration of smallest one. -(=:/) :: Score a -> Score a -> Score a -a =:/ b - | dur a < dur b = a =:= takeS (dur a) b - | otherwise = b =:= takeS (dur b) a - --- | sequential composition for list of scores -line :: [Score a] -> Score a -line = M.sequent - --- | parallel composition for list of scores -chord :: [Score a] -> Score a -chord = M.parallel - --- | turncating parallel composition for lists of scores -chordT :: [Score a] -> Score a -chordT xs = chord $ map (takeS d) xs - where d = minimum $ map dur xs - --- | Arranges n copies of score in line. -loop :: Int -> Score a -> Score a -loop = M.loop - --- | loop for two groups of notes. Repeats n times line of two scores. -trill :: Int -> Score a -> Score a -> Score a -trill n a b = loop n $ line [a, b] - --- | extracting score parts in some time interval. --- it reverses output if @t1 < t0@. -slice :: Dur -> Dur -> Score a -> Score a -slice = M.slice - --- | take sub-score from begining -takeS :: Dur -> Score a -> Score a -takeS = M.takeM - --- | drop sub-score -dropS :: Dur -> Score a -> Score a -dropS = M.dropM - --- | reverse score -reverseS :: Score a -> Score a -reverseS = M.reverseM - --- | temporal functor 'tmap' method for scores --- --- map with time -tmap :: (Time -> a -> b) -> Score a -> Score b -tmap = M.tmap - --- | temporal functor 'dmap' method for scores --- --- map with duration -dmap :: (Dur -> a -> b) -> Score a -> Score b -dmap = M.dmap - --- | temporal functor 'tdmap' method for scores --- --- map with time and duration -tdmap :: (Time -> Dur -> a -> b) -> Score a -> Score b -tdmap = M.tdmap - - --- | General mapping. In the end all values of type 'Score' --- are to be converted to 'EventList' wich is list of 'Event' s --- and function 'eventMap' allows mapping on 'Score' subvalues as if --- they are events already. --- --- Warning : It is possible to change start time position with --- 'eventMap' but it can lead to unexpected outcome when used --- with 'slice' function. 'slice' operates on structure of --- type 'Score' (how value was built with 'sequent', 'parallel' --- or 'stretch' and other functions), but 'eventMap' operates --- on 'Score' subvalues as if they are converted to 'Event' s --- and some shifted events can slip through 'slice' 's fingers. -eventMap :: (Event Dur a -> Event Dur b) -> Score a -> Score b -eventMap = M.eventMap - --- | relative 'tmap' --- --- map with time normalized by total duration value -tmapRel :: (Time -> a -> b) -> Score a -> Score b -tmapRel = M.tmapRel - --- | relative 'dmap' --- --- map with duration normalized by total duration value -dmapRel :: (Dur -> a -> b) -> Score a -> Score b -dmapRel = M.dmapRel - --- | relative 'tdmap' --- --- map with time and duration normalized by total duration value -tdmapRel :: (Time -> Dur -> a -> b) -> Score a -> Score b -tdmapRel = M.tdmapRel - -------------------------------------------------------- --- Rendering - --- | Transform 'Score' to 'EventList' -renderScore :: Score a -> EventList Dur a -renderScore = M.renderMedia diff --git a/src/Temporal/Music/Notation/Seg.hs b/src/Temporal/Music/Notation/Seg.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation/Seg.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Temporal.Music.Notation.Seg( - Seg(..), segSize - -- IntSeg(..), - -- module TypeLevel.Nat.Decimal - ) -where - ---import TypeLevel.Nat.Decimal - --- | 'Seg' means segment, values that 'Enum' and 'Bounded'. -class (Enum a, Bounded a) => Seg a where - -segSize :: Seg a => a -> Int -segSize x = 1 + phi maxBound x - phi minBound x - where phi a b = fromEnum $ a `asTypeOf` b - -{- --- | Bounded 'Int'. Type parameter encodes 'maxBound', --- 'minBound' equals to zero. -newtype Nat n => IntSeg n = IntSeg { runIntSeg :: Int } - deriving (Show, Eq) - - -instance Nat n => Bounded (IntSeg n) where - minBound = IntSeg 0 - maxBound = res - where res = IntSeg $ toInt $ phi res - phi :: IntSeg n -> n - phi = const undefined - - -instance Nat n => Enum (IntSeg n) where - fromEnum = runIntSeg - toEnum x = res - where res = phi res x - phi t x - | x < a || x > b = error "IntSeg :: out of bounds" - | otherwise = IntSeg x - where a = fromEnum $ minBound `asTypeOf` t - b = fromEnum $ maxBound `asTypeOf` t - -instance Nat n => Seg (IntSeg n) --} - - diff --git a/src/Temporal/Music/Notation/Volume.hs b/src/Temporal/Music/Notation/Volume.hs deleted file mode 100644 --- a/src/Temporal/Music/Notation/Volume.hs +++ /dev/null @@ -1,291 +0,0 @@ -{-# LANGUAGE - FlexibleInstances, - TypeSynonymInstances, - Rank2Types #-} - --- | representing volume -module Temporal.Music.Notation.Volume( - -- * Types - -- | Main datatypes are 'Amplitude', 'Diapason' and 'Level'. - -- 'Volume' consists of 'Diapason' and 'Level'. Every - -- 'Volume' can be converted to 'Amplitude' (see 'absVolume'). - -- 'Amplitude' is linear units and 'Level' is logarithmic units, - -- or decibels. 'Diapason' defines lower and upper bound for volume level - -- in amplitude linear units. - Amplitude, - Diapason, Accent, - Vol(volume), - Volume(..), Level(..), - volumeNum, levelNum, - level, mediumLevel, - -- * Transformers - VolumeFunctor(..), LevelFunctor(..), - setDiapason, setDiapasonRel, setLevel, setAccent, - accent, al', aq', - loud, quiet, louder, quieter, - dynamics, dynamicsRel, dynamicsSeg, - -- * Rendering - amplitude, unsafeAmplitude, - absVolume, unsafeAbsVolume, - diapasonAt, - levelAsDouble, unsafeLevelAsDouble, - levelAsDoubleRel, unsafeLevelAsDoubleRel -) -where - -import Data.Function(on) - -import Temporal.Music.Notation.Seg(Seg, segSize) -import Temporal.Music.Notation.Score(Score, Time, tmapRel, linseg) - --- | Linear volume units -type Amplitude = Double - --- | Volume lower and upper bounds. Lower bound must be positive --- and upper bound must exceed lower bound. -type Diapason = (Amplitude, Amplitude) - --- | 'Accent' defines values between 'Level' values on logarithmic --- scale. 1 'Accent' == 1 'Level' 's step. -type Accent = Double - - -class Seg a => Vol a where - volume :: Level a -> Volume a - --- | 'Volume' consists of 'Diapason' and 'Level'. -data Seg n => Volume n = Volume - { volumeDiapason :: Diapason - , volumeLevel :: Level n - } deriving (Show, Eq) - -class VolumeFunctor a where - mapVolume :: (forall n . Seg n => Volume n -> Volume n) -> (a -> a) - -instance Seg n => VolumeFunctor (Volume n) where - mapVolume f = f - -instance VolumeFunctor a => VolumeFunctor (Score a) where - mapVolume f = fmap (mapVolume f) - -instance Seg n => LevelFunctor (Volume n) where - mapLevel f = \(Volume d l) -> Volume d $ f l - --- | sets diapason to specified value -setDiapason :: VolumeFunctor a => (Amplitude, Amplitude) -> a -> a -setDiapason x = mapVolume $ \(Volume _ l) -> Volume x l - --- | relative update of diapason value in decibels, --- (0, 1) turns diapason interval into itself. -setDiapasonRel :: VolumeFunctor a => (Double, Double) -> a -> a -setDiapasonRel (a, b) = mapVolume $ - \(Volume x l) -> Volume (diapasonAt x a, diapasonAt x b) l - --------------------------------------------------- --------------------------------------------------- --- Level - --- | 'Level' defines number of equally spaced stamps on --- logarithmic scale (steps), and degree of diversion --- from the stamps (accents). -data Seg n => Level n = Level - { levelAccent :: Accent - , levelStep :: n - } deriving (Show, Eq) - --- | number of levels in 'Volume' scale -volumeNum :: Seg n => Volume n -> Int -volumeNum = phantomNum - --- | number of levels in 'Level' scale -levelNum :: Seg n => Level n -> Int -levelNum = phantomNum - -phantomNum :: Seg n => f n -> Int -phantomNum = segSize . num - where num :: f n -> n - num = const undefined - -------------------------------------------- --- constructors - --- | 'level' constructs 'Level' from type of class 'Seg'. 'Accent' is set to zero. -level :: Seg n => n -> Level n -level = Level 0 - -------------------------------------------- --- instances - -instance Seg n => Enum (Level n) where - toEnum = level . toEnum - fromEnum = fromEnum . levelStep - -instance Seg n => Bounded (Level n) where - maxBound = level maxBound - minBound = level minBound - -instance Seg n => Seg (Level n) - -instance (Eq n, Seg n) => Ord (Level n) where - compare = compare `on` (\(Level a s) -> (fromIntegral $ fromEnum s) + a) - -instance (Show n, Eq n, Seg n) => Num (Level n) where - (+) = liftBi (+) (+) - (-) = liftBi (-) (-) - (*) = liftBi (*) (*) - abs = id - signum x - | x == minBound = 0 - | otherwise = 1 - fromInteger x = res - where n = levelNum res - res = level $ toEnum $ sat 0 n $ fromInteger x - --------------------------------------- --- transformers - -class LevelFunctor a where - mapLevel :: (forall n . Seg n => Level n -> Level n) -> (a -> a) - -instance Seg n => LevelFunctor (Level n) where - mapLevel f = f - -instance LevelFunctor a => LevelFunctor (Score a) where - mapLevel f = fmap (mapLevel f) - --- | 'accent' increases 'Accent' value by some degree -accent :: LevelFunctor a => Accent -> a -> a -accent d = mapLevel $ \(Level a s) -> Level (a+d) s - --- | shorcut for 'accent louder' -al' :: LevelFunctor a => Accent -> a -> a -al' = accent - --- | shorcut for 'accent quieter' -aq' :: LevelFunctor a => Accent -> a -> a -aq' = accent . negate - --- | 'setAccent' sets 'Accent' value to given input -setAccent :: LevelFunctor a => Accent -> a -> a -setAccent d = mapLevel $ \(Level _ s) -> Level d s - --- | 'setLevel' sets 'levelStep' to given input -setLevel :: (Seg n, LevelFunctor a) => n -> a -> a -setLevel n = mapLevel - (\l@(Level a _) -> Level a $ toEnum $ sat 0 (levelNum l) $ fromEnum n) - --- | Input becomes one step louder -loud :: LevelFunctor a => a -> a -loud = louder 1 - --- | Input becomes one step quieter -quiet :: LevelFunctor a => a -> a -quiet = quieter 1 - --- | Input becomes given number of steps quieter -quieter :: LevelFunctor a => Int -> a -> a -quieter n = louder (-n) - --- | Input becomes given number of steps louder -louder :: LevelFunctor a => Int -> a -> a -louder n - | n > 0 = mapLevel $ liftUn id (+n) - | n < 0 = mapLevel $ liftUn id (\x -> x - n) - --- | Medium level -mediumLevel :: Seg n => Level n -mediumLevel = res - where res = level $ toEnum $ round $ fromIntegral n / 2 - n = levelNum res - --- | Accent that depends on time of note -dynamics :: LevelFunctor a => (Time -> Accent) -> Score a -> Score a -dynamics f = tmapRel $ \t -> accent (f t) - --- | Linear relative 'dyn' function. Function is defined by list of --- its values equaly spaced along time axis. For example --- list [0, 1, 0] defines rise then decay lineary along full 'Score' 's --- input duration. Time intervals of --- rise and decay segments are equal to 'dur' /2. And list [0, 1, 0.5, 0] --- defines --- rise and decay again but here decay segment is twice longer then --- rise segment. -dynamicsRel :: LevelFunctor a => [Accent] -> Score a -> Score a -dynamicsRel xs = dynamics $ linseg $ init $ f =<< xs - where dt = recip $ fromIntegral $ length xs - f x = [x, dt] - --- | 'dynSeg' lifts 'linseg' function to dynamics level -dynamicsSeg :: LevelFunctor a => [Double] -> Score a -> Score a -dynamicsSeg xs = dynamics $ linseg xs - --------------------------------------------------- --- rendering - --- | converts volume to amplitude with 'amplitude' function -absVolume :: Seg n => Volume n -> Amplitude -absVolume (Volume d l) = amplitude d l - --- | converts volume to amplitude with 'unsafeAmplitude' function -unsafeAbsVolume :: Seg n => Volume n -> Amplitude -unsafeAbsVolume (Volume d l) = unsafeAmplitude d l - --- | converts equally spaced between lower and upper diapason bounds --- 'Level' values to amplitudes. --- Here resulting amplitude value lies within 'Diapason' interval. --- All outsiders are placed inside interval with saturation. -amplitude :: Seg n => Diapason -> Level n -> Amplitude -amplitude d l = diapasonAt d $ levelAsDoubleRel l - --- | unsafe analog of 'amplitude' function. Here result can go --- beyond limits of 'Diapason' interval. -unsafeAmplitude :: Seg n => Diapason -> Level n -> Amplitude -unsafeAmplitude d l = diapasonAt d $ unsafeLevelAsDouble l - --- | mapps decibels to amplitudes within specified amplitude diapason, --- 0 turns to lower diapason value and 1 turns to higher diapason value -diapasonAt :: Diapason -> Double -> Double -diapasonAt (low, high) d = (low * ) $ (high / low) ** d - --- | converts level value to double -levelAsDouble :: Seg s => Level s -> Double -levelAsDouble x = sat 0 n $ unsafeLevelAsDouble x - where n = fromIntegral $ levelNum x - 1 - --- | converts level value to double, value can exceed level limits -unsafeLevelAsDouble :: Seg s => Level s -> Double -unsafeLevelAsDouble l@(Level a x) = (fromIntegral $ fromEnum l) + a - --- | converts level value to double, and normalizes output by level limits -levelAsDoubleRel :: Seg s => Level s -> Double -levelAsDoubleRel l = (/n) $ levelAsDouble l - where n = fromIntegral $ levelNum l - 1 - --- | converts level value to double and normalizes output by level limits, --- value can exceed (0, 1) interval -unsafeLevelAsDoubleRel :: Seg s => Level s -> Double -unsafeLevelAsDoubleRel l = (/n) $ unsafeLevelAsDoubleRel l - where n = fromIntegral $ levelNum l - 1 - --------------------------------------- --- level manipulation - -liftUn :: Seg n - => (Accent -> Accent) - -> (Int -> Int) - -> (Level n -> Level n) -liftUn f g l@(Level a s) = Level (f a) - (toEnum $ sat 0 (levelNum l) $ g $ fromEnum s) - -liftBi :: Seg n - => (Accent -> Accent -> Accent) - -> (Int -> Int -> Int ) - -> (Level n -> Level n -> Level n) -liftBi f g l@(Level a s) (Level a' s') = - Level (a `f` a') (toEnum $ sat 0 (levelNum l) $ fromEnum s `g` fromEnum s') - -sat :: Ord a => a -> a -> a -> a -sat low high x - | x < low = low - | x > high = high - | otherwise = x diff --git a/src/Temporal/Music/Note.hs b/src/Temporal/Music/Note.hs new file mode 100644 --- /dev/null +++ b/src/Temporal/Music/Note.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-} + +-- | This module gives an example of complete musical structure. +-- It defines the notion of note. +module Temporal.Music.Note( + -- * Types + Note(..), note, mapNoteParam, + Drum(..), bam, mapDrumParam, + -- * Shortcuts + -- ** Note shortcuts + -- | Function n[i] is equivalent to call @note i@. + n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, + n12, n13, n14, n15, n16, n17, n18, n19, n20, n21, n22, n23, + -- ** Drum shortcuts + -- | See "Temporal.Music.Score" shortcuts for naming conventions. + bd, wd, hd, qd, ed, sd, td, + dbd, dwd, dhd, dqd, ded, dsd, dtd +) where + +import Data.Default + +import Temporal.Music.Score(Score, temp, accent, + dot, bn, hn, qn, en, sn, tn) +import Temporal.Music.Volume +import Temporal.Music.Pitch + +-- note + +-- | 'Note' has volume, pitch and some timbral paramters. +data Note a = Note { + noteVolume :: Volume, + notePitch :: Pitch, + noteParam :: Maybe a + } deriving (Show, Eq) + + +instance Functor Note where + fmap f n = Note + { notePitch = notePitch n + , noteVolume = noteVolume n + , noteParam = fmap f $ noteParam n + } + +instance PitchLike (Note a) where + setPitch p a = a{ notePitch = p } + getPitch = notePitch + +instance VolumeLike (Note a) where + setVolume v a = a{ noteVolume = v } + getVolume = noteVolume + +instance Default (Note a) where + def = Note def def def + +-- | Constructs default 'Note' with given step value. +note :: Step -> Score (Note a) +note a = temp $ Note def def{ pitchStep = a } def + +-- | Updates note's timbral paramters. +mapNoteParam :: (Maybe a -> Maybe b) -> Note a -> Note b +mapNoteParam f n = Note + { notePitch = notePitch n + , noteVolume = noteVolume n + , noteParam = f $ noteParam n + } + +-- drum + +-- | 'Drum' has only pitch and some timbral paramters. +data Drum a = Drum { + drumVolume :: Volume, + drumParam :: Maybe a + } deriving (Show, Eq) + +instance Functor Drum where + fmap f n = Drum + { drumVolume = drumVolume n + , drumParam = fmap f $ drumParam n + } + +instance VolumeLike (Drum a) where + setVolume v a = a{ drumVolume = v } + getVolume = drumVolume + +instance Default (Drum a) where + def = Drum def def + +-- | Constructs drum note with given accent. Level is set to the default +-- value. +bam :: Accent -> Score (Drum a) +bam a = accent a $ temp def + +-- | Updates drum-note's timbral paramters. +mapDrumParam :: (Maybe a -> Maybe b) -> Drum a -> Drum b +mapDrumParam f n = Drum + { drumVolume = drumVolume n + , drumParam = f $ drumParam n + } + + +-------------------------------------------------------------- +-- notes +-- + +n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, + n12, n13, n14, n15, n16, n17, n18, n19, n20, n21, n22, n23 + :: Score (Note a) + +n0 = note 0; n1 = note 1; n2 = note 2; n3 = note 3; +n4 = note 4; n5 = note 5; n6 = note 6; n7 = note 7; +n8 = note 8; n9 = note 9; n10 = note 10; n11 = note 11; + +n12 = note 12; n13 = note 13; n14 = note 14; n15 = note 15; +n16 = note 16; n17 = note 17; n18 = note 18; n19 = note 19; +n20 = note 20; n21 = note 21; n22 = note 22; n23 = note 23; + +-------------------------------------------------------------- +-- drums +-- + +bd, wd, hd, qd, ed, sd, td :: Accent -> Score (Drum a) + +bd = bn . bam +wd = bam +hd = hn . bam +qd = qn . bam +ed = en . bam +sd = sn . bam +td = tn . bam + +dbd, dwd, dhd, dqd, ded, dsd, dtd :: Accent -> Score (Drum a) + +dbd = dot . bd +dwd = dot . wd +dhd = dot . hd +dqd = dot . qd +ded = dot . ed +dsd = dot . sd +dtd = dot . td + diff --git a/src/Temporal/Music/Pitch.hs b/src/Temporal/Music/Pitch.hs new file mode 100644 --- /dev/null +++ b/src/Temporal/Music/Pitch.hs @@ -0,0 +1,181 @@ +-- | This module defines notion of pitch. +module Temporal.Music.Pitch ( + Hz, Interval, c1, a1, transpose, + -- * Pitch + Pitch(..), fromStep, Bend, Octave, Step, + -- * Scale + Scale(..), fromIntervals, + scaleStep, scaleLength, + -- * PitchLike + PitchLike(..), mapPitch, + -- * Render + hz, pitchAsDouble, scaleAt +) +where + +import Data.Default +import qualified Data.Vector as V + +-- | Cycles per second +type Hz = Double + +-- | Multiplier of Hz +type Interval = Double + +-- | Middle C (261.626 Hz) +c1 :: Hz +c1 = 261.626 + +-- | Middle A (440 Hz) +a1 :: Hz +a1 = 440 + + +-- Pitch + +-- | 'Pitch' denotes 'Hz' value. But it's not a double for ease of +-- performing some musical transformations, transposition, bend, +-- inversion, changing scales. 'Pitch' can be converted to 'Hz' with +-- function 'hz'. Pitch contains 'Scale', and point on the tone plane. +-- The point is a triple @(bend, octave, step)@. 'Bend' +-- denotes divergens from vertices of scale grid. 'Octave' and 'Step' +-- are integers. +data Pitch = Pitch { + pitchScale :: Scale, + pitchBend :: Bend, + pitchOctave :: Octave, + pitchStep :: Step + } deriving (Show, Eq) + +-- | 'Bend' represents tone's diversion from scale grid. +type Bend = Double +type Octave = Int +type Step = Int + +-- | Calculates position on tone plane for value of type 'Pitch'. +pitchAsDouble :: Pitch -> Double +pitchAsDouble p = pitchBend p + fromIntegral (pitchAsInt p) + +-- | Calculates integer position on tone plane for value of type 'Pitch' +-- without bend bias. +pitchAsInt :: Pitch -> Int +pitchAsInt p = pitchOctave p * (scaleLength $ pitchScale p) + pitchStep p + +instance Default Pitch where + def = Pitch def def def def + +-- Scale + +-- | 'Scale' defines 2D grid (octave, step) in space of 'Hz' units. +-- 'Bend' is a level of diversion from grid vertices. +-- 1-level bend is equal to 1 step. For tones with fractional bends frequency +-- is calculated with linear interpolation by nearest values in scale. +-- Example: +-- +-- > s = Scale f0 d intervals +-- +-- Here scale @s@ defines 2D grid that mapps center point @(0, 0)@ to +-- frequency @f0@ 'Hz'. Value 'd' is octave interval. Octave interval +-- is divided on steps. Steps are 'Interval' s from base frequency @f0@ +-- to desired frequency. Let's define equal temperament scale: +-- +-- > eqt = Scale c1 2 $ Vector.fromList $ (map ((2 **) . (/12)) [0..11]) +data Scale = Scale { + scaleBase :: Hz, + scaleOctave :: Interval, + scaleSteps :: V.Vector Interval + } deriving (Show, Eq) + + +instance Default Scale where + def = eqt c1 + where eqt = fromIntervals 2 (map ((2 **) . (/12)) [0 .. 11]) + +-- | 'Scale' constructor. +fromIntervals :: Interval -> [Interval] -> (Hz -> Scale) +fromIntervals octave steps = \f0 -> Scale f0 octave $ V.fromList steps + +-- | Scale value on doubles +scaleAt :: Scale -> Double -> Hz +scaleAt s x = scaleAtInt s d * bendCoeff s n r + where (d, r) = properFraction x + n = mod d $ scaleLength s + + +-- | 'Pitch' can be used alongside with many +-- other parameters (they can define timbre or loudness). +-- Class 'PitchLike' provides getters and setters for +-- data types that contain value of type 'Pitch'. +-- In "Temporal.Music.Score" module you can find many +-- functions that are defined in terms of this class. Once you +-- have chosen some note representation you can make an instance +-- for it and use all pitch-modifiers. +class PitchLike a where + setPitch :: Pitch -> a -> a + getPitch :: a -> Pitch + +-- | Pitch modifier. +mapPitch :: PitchLike a => (Pitch -> Pitch) -> a -> a +mapPitch f x = setPitch (f $ getPitch x) x + +instance PitchLike Pitch where + setPitch = const id + getPitch = id + + +-- | Constructs 'Pitch' from some step value. 'Bend' and +-- 'Octave' are set to zeroes. 'Scale' is set to default scale +-- which is defined in 'HasScale' class. +fromStep :: Int -> Pitch +fromStep a = def{ pitchStep = a } + + +-- | Gives scale multiplier +scaleStep :: Scale -> Int -> Interval +scaleStep s x = (scaleOctave s ^^ o) * scaleSteps s V.! n + where (o, n) = divMod x $ scaleLength s + + +-- | Gives number of steps in one octave. +scaleLength :: Scale -> Int +scaleLength = V.length . scaleSteps + + +-- | Transpose cycles per second by some interval. +transpose :: Interval -> Hz -> Hz +transpose k a = k * a + +--------------------------------------------------------- +-- rendering + +absPitch :: Pitch -> Hz +absPitch p = pitchScale p `scaleAt` pitchAsDouble p + +-- | Calculates cycles per second for a pitch. +hz :: PitchLike a => a -> Hz +hz = absPitch . getPitch + + +-- | scale value on integers +scaleAtInt :: Scale -> Int -> Hz +scaleAtInt s x = scaleBase s * scaleStep s x + +bendCoeff :: Scale -> Int -> Double -> Hz +bendCoeff s n x + | abs x < 1e-6 = 1 + | x > 0 = flip loginterpCoeff x $ getTones s n $ n + 1 + | otherwise = flip loginterpCoeff (abs x) $ getTones s n $ n - 1 + where getTones s n1 n2 = (getTone s n1, getTone s n2) + getTone s x + | x >= 0 && x < n = scaleSteps s V.! x + | x == n = o + | x == -1 = scaleSteps s V.! (n-1) / o + | otherwise = error $ "scaleStep: out of bounds" + where n = scaleLength s + o = scaleOctave s + + +loginterpCoeff :: (Double, Double) -> Double -> Double +loginterpCoeff (l, r) x = (r / l) ** x + + diff --git a/src/Temporal/Music/Scales.hs b/src/Temporal/Music/Scales.hs new file mode 100644 --- /dev/null +++ b/src/Temporal/Music/Scales.hs @@ -0,0 +1,258 @@ +-- | Specific scales. Scale constructor makes scale that starts +-- at the given frequency. + +module Temporal.Music.Scales +( + -- * just scales + ji3, ji5, ji7, + pyth, + hindGb, + hindFs, + justBP, + partchean, + luScale, + superJust, harmonicJust, + sruti, + -- * Irregular scales + eqt, eqts, eqBP, hind, + -- * Subscales + -- | extracting 5-tone scales out of 12-tone scales + minor5, major5, + bluesMinor5, bluesMajor5, egyptian5, + -- | extracting 7-tone scales out of 12-tone scales + major, minor, + ionian, dorian, phrygian, lydian, + mixolydian, aeolian, locrian) +where + +import Temporal.Music.Pitch(Hz, Interval, + Scale(..), scaleLength, fromIntervals) +import qualified Data.Vector as V + +sliceScale :: Int -> [Int] -> Scale -> Scale +sliceScale octaveLength ids x + | octaveLength == (V.length $ scaleSteps x) = + Scale (scaleBase x) (scaleOctave x) $ + V.fromList $ map (scaleSteps x V.! ) ids + | otherwise = error + ("scale must have " ++ show octaveLength ++ + " tones in octave") + + +--------------------------------------------------- +-- 12-tone modes + + +-- 5 tone + +minor5 = slice12 minor5Is +major5 = slice12 major5Is +egyptian5 = slice12 egyptian5Is +bluesMinor5 = slice12 bluesMinor5Is +bluesMajor5 = slice12 bluesMajor5Is + +major5Is = pentaIs +egyptian5Is = rot 1 $ pentaIs +bluesMinor5Is = rot 2 $ pentaIs +bluesMajor5Is = rot 3 $ pentaIs +minor5Is = rot 4 $ pentaIs + +pentaIs = [2, 2, 3, 2, 2] + +-- 7 tone + +major, minor, + ionian, dorian, phrygian, lydian, + mixolydian, aeolian, locrian :: Scale -> Scale + +major = slice12 majorIs +minor = slice12 minorIs + +ionian = slice12 ionianIs +dorian = slice12 dorianIs +phrygian = slice12 phrygianIs +lydian = slice12 lydianIs +mixolydian = slice12 mixolydianIs +aeolian = slice12 aeolianIs +locrian = slice12 locrianIs + + +majorIs = [2, 2, 1, 2, 2, 2, 1] +minorIs = aeolianIs + +ionianIs = rot 0 majorIs +dorianIs = rot 1 majorIs +phrygianIs = rot 2 majorIs +lydianIs = rot 3 majorIs +mixolydianIs = rot 4 majorIs +aeolianIs = rot 5 majorIs +locrianIs = rot 7 majorIs + +slice12 :: [Int] -> (Scale -> Scale) +slice12 ids = sliceScale 12 (fromIs ids) + +fromIs = (0:) . fst . foldl f ([], 0) . init + where f (res, i) x = (res ++ [i + x], i + x) + +rot :: Int -> [a] -> [a] +rot n xs = drop n xs ++ take n xs + + +--------------------------------------------------- +-- equal temperament + +-- | 12 tone equal temperament scale +eqt :: Hz -> Scale +eqt = fromIntervals 2 (map ((2 **) . (/12)) [0 .. 11]) + +-- | general equal temperament scale +eqts :: Hz -> Scale +eqts = res + where n = scaleLength $ res 0 + res = fromIntervals 2 $ + (map ((2 **) . (/fromIntegral n) . fromIntegral) [0 .. n-1]) + +-- | hindemithean scale with mean of fs and gb for tritone +hind :: Hz -> Scale +hind = hindemitheanGen $ 0.5 * (ji5 (-1, 2, 1) + ji5 (2, -2, -1)) + +-- | equal Bohlen-Pierce scale +eqBP :: Hz -> Scale +eqBP = fromIntervals 3 (map ((3 **) . (/13) . fromIntegral) [0 .. 12]) + + +--------------------------------------------------- + +-- | pythagorean scale +pyth :: Hz -> Scale +pyth = fromIntervals 2 $ map toPyth +-- 0 1 2 3 4 5 + [(0, 0), (-5, 3), (2, -1), (-3, 2), (4, -2), (-1, 1), +-- 6 7 8 9 10 11 + (-6, 4), (1, 0), (-4, 3), (3, -1), (-2, 2), (5, -2)] + +toPyth :: (Int, Int) -> Interval +toPyth (a, b) = ji3 (b, a) + +-- | 3-limit basis @(2, 3\/2)@ +ji3 :: (Int, Int) -> Interval +ji3 (a, b) = (2 ^^ a) * (1.5 ^^ b) + +-------------------------------------------------------- +-- Just intonation + +-- 5-limit +-- + +-- | 5-limit basis @(2, 3\/2, 5\/4)@ +ji5 :: (Int, Int, Int) -> Interval +ji5 (a, b, c) = (2 ^^ a) * (1.5 ^^ b) * (1.25 ^^ c) + +-- | hindemithean scale with fs for tritone +hindFs :: Hz -> Scale +hindFs = hindemitheanGen $ ji5 (-1, 2, 1) + +-- | hindemithean scale with gb for tritone +hindGb :: Hz -> Scale +hindGb = hindemitheanGen $ ji5 (2, -2, -1) + +hindemitheanGen :: Interval -> Hz -> Scale +hindemitheanGen tritone = fromIntervals 2 $ map ji5 +-- 0 1, 2, 3, 4, 5 + [(0, 0, 0), (1, -1, -1), (-1, 2, 0), (0, 1, -1), (0, 0, 1), (1, -1, 0)] +-- 6 + ++ [tritone] ++ map ji5 +-- 7 8, 9, 10, + [(0, 1, 0), (1, 0, -1), (1, -1, 1), (2, -2, 0), (0, 1, 1)] + +-- 7-limit + +-- | 7-limit basis @(2, 3\/2, 5\/4, 7\/6)@ +ji7 :: (Int, Int, Int, Int) -> Interval +ji7 (a, b, c, d) = (2 ^^ a) * (1.5 ^^ b) * (1.25 ^^ c) * ((7/6) ^^ d) + +-- | just Bohlen-Pierce scale +justBP :: Hz -> Scale +justBP = fromIntervals 3 +-- 0 1, 2, 3, + [1, 27/25, 25/21, 9/7, +-- 4, 5, 6, 7 + 7/5, 75/49, 5/3, 9/5, +-- 8, 9, 10, 11 + 49/25, 15/7, 7/3, 63/25, +-- 12 + 25/9] + + +-- | Harry Partch's 43-tone scale +partchean :: Hz -> Scale +partchean = fromIntervals 2 +-- 0, 1, 2, 3, 4, + [1, 81/80, 33/32, 21/20, 16/15, +-- 5, 6, 7, 8, 9, + 12/11, 11/10, 10/9, 9/8, 8/7, + +-- 10, 11, 12, 13, 14 + 7/6, 32/27, 6/5, 11/9, 5/4, +-- 15, 16, 17, 18, 19, + 14/11, 9/7, 21/16, 4/3, 27/20, + +-- 20, 21, 22, 23, 24, + 11/8, 7/5, 10/7, 16/11, 40/27, +-- 25, 26, 27, 28, 29, + 3/2, 32/21, 14/9, 11/7, 8/5, + +-- 30, 31, 32, 33, 34, + 18/11, 5/3, 27/16, 12/7, 7/4, +-- 35, 36, 37, 38, 39, + 16/9, 9/5, 20/11, 11/6, 15/8, + +-- 40, 41, 42, + 40/21, 64/33, 160/81] + +-- | Chinese Lu 12-tone scale +luScale :: Hz -> Scale +luScale = fromIntervals 2 +-- 0, 1, 2, 3, 4, + [1, 18/17, 9/8, 6/5, 54/43, +-- 5, 6, 7, 8, 9, + 4/3, 27/19, 3/2, 27/17, 27/16, +-- 10, 11, 12, 13, 14 + 9/5, 36/19] + +-- | Wendy Carlos super just 12-tone scale +superJust :: Hz -> Scale +superJust = fromIntervals 2 +-- 0, 1, 2, 3, 4, + [1, 17/16, 9/8, 6/5, 5/4, +-- 5, 6, 7, 8, 9, + 4/3, 11/8, 3/2, 13/8, 5/3, +-- 10, 11, 12, 13, 14 + 7/4, 15/8] + +-- | Wendy Carlos harmonic 12-tone scale +harmonicJust :: Hz -> Scale +harmonicJust = fromIntervals 2 +-- 0, 1, 2, 3, 4, + [1, 17/16, 9/8, 19/16, 5/4, +-- 5, 6, 7, 8, 9, + 21/16, 11/8, 3/2, 13/8, 27/16, +-- 10, 11, 12, 13, 14 + 7/4, 15/8] + + +-- | Indian Sruti 22-tone scale + +sruti :: Hz -> Scale +sruti = fromIntervals 2 +-- 0, 1, 2, 3, 4, + [1, 256/243, 16/15, 10/9, 9/8, +-- 5, 6, 7, 8, 9, + 32/27, 6/5, 5/4, 81/64, 4/3, +-- 10, 11, 12, 13, 14, + 27/20, 45/32, 729/512, 3/2, 128/81, +-- 15, 16, 17, 18, 19, + 8/5, 5/3, 27/16, 16/9, 9/5, +-- 20, 21, + 15/8, 243/128] + diff --git a/src/Temporal/Music/Score.hs b/src/Temporal/Music/Score.hs new file mode 100644 --- /dev/null +++ b/src/Temporal/Music/Score.hs @@ -0,0 +1,428 @@ +-- | Composition and control. +module Temporal.Music.Score( + -- * Types + Dur, Score, Event(..), eventEnd, within, + -- * Composition + temp, rest, stretch, delay, reflect, (+|), (*|), (=:=), (+:+), (=:/), + line, chord, chordT, loop, sustain, sustainT, + -- * Filtering + clip, takeS, dropS, filterEvents, + -- * Mappings + mapEvents, tmap, tmapRel, + -- * Rendering + render, alignByZero, sortEvents, + -- * Miscellaneous + linseg, linsegRel, + -- ** Monoid synonyms + -- + -- | This package heavily relies on 'Monoid's, so there are shorcuts + -- for 'Monoid' methods. + nil, + module Data.Monoid, + -- * Volume control + setDiap, setDiapRel, setLevel, setAccent, accent, (!), + louder, quieter, loud, quiet, envelope, envelopeSeg, envelopeRel, + -- * Pitch control + setScale, setBend, setStep, step, bend, + lower, higher, low, high, + -- ** Shortcuts + -- | Denotes @lower 1-2@ and @higher 1-2@. + l', ll', hh', h', + -- * Time stretching + r, dot, ddot, tri, bpm, + + -- ** Shortcuts + -- | Naming conventions : + -- + -- First part @x@ can be [b | w | h | q | e | s | t | d[x] ] + -- + -- @b@ means brewis @(stretch 2)@ + -- + -- @w@ means whole @(stretch 1)@ + -- + -- @h@ means half @(stretch $ 1/2)@ + -- + -- @q@ means quater @(stretch $ 1/4)@ + -- + -- @e@ means eighth @(stretch $ 1/8)@ + -- + -- @s@ means sixteenth @(stretch $ 1/16)@ + -- + -- @t@ means thirty second @(stretch $ 1/32)@ + -- + -- @d[x]@ means dotted [x] @(stretch 1.5 $ x)@ + bn, wn, hn, qn, en, sn, tn, + dbn, dwn, dhn, dqn, den, dsn, dtn, + + -- ** Pauses + -- | Naming conventions are the same as for 'time stretching'. + bnr, wnr, hnr, qnr, enr, snr, tnr, + dbnr, dwnr, dhnr, dqnr, denr, dsnr, dtnr + ) + +where + +import Temporal.Media(Event(..), within, eventEnd, nil, + linseg, linsegRel, alignByZero, sortEvents) +import qualified Temporal.Media as M +import Temporal.Music.Pitch +import Temporal.Music.Volume +import Data.Monoid +import Data.Foldable + +-- | Duration. +type Dur = Double + +-- | Instances +-- +-- * 'Functor' 'Score' +-- +-- * 'Foldable' 'Score' +-- +-- * 'Monoid' @(@'Score' @a)@ +type Score a = M.Track Double a + +------------------------------------------------------- +-- Composition +-- + +-- | 'temp' constructs just an event. +-- Value of type @a@ lasts for one time unit and starts at zero. +temp :: a -> Score a +temp = M.temp + +-- | Empty 'Score' that lasts for some time. +rest :: Dur -> Score a +rest = M.rest + +-- | Delays all events by given duration. +delay :: Dur -> Score a -> Score a +delay = M.delay + +-- | Stretches 'Score' in time domain. +stretch :: Dur -> Score a -> Score a +stretch = M.stretch + +-- | Infix 'delay' function. +(+|) :: Dur -> Score a -> Score a +(+|) = delay + +-- | Infix 'stretch' function. +(*|) :: Dur -> Score a -> Score a +(*|) = stretch + +-- | Reversing the scores +reflect :: Score a -> Score a +reflect = M.reflect + +-- | Parallel composition. Play two scores simultaneously. +(=:=) :: Score a -> Score a -> Score a +(=:=) = (M.=:=) + +-- | Sequent composition. Play first score then second. +(+:+) :: Score a -> Score a -> Score a +(+:+) = (M.+:+) + +-- | Turncating parallel composition. Total duration +-- equals to minimum of the two scores. All events +-- that goes beyond the lmimt are dropped. +(=:/) :: Score a -> Score a -> Score a +(=:/) = (M.=:/) + +-- | Sequent composition on list of scores. +line :: [Score a] -> Score a +line = M.line + +-- | Parallel composition on list of scores. +chord :: [Score a] -> Score a +chord = M.chord + +-- | Turncating parallel composition on list of scores. +chordT :: [Score a] -> Score a +chordT = M.chordT + +-- | Analog of 'replicate' function for scores. Replicated +-- scores are played sequentially. +loop :: Int -> Score a -> Score a +loop = M.loop + + +-- | After this transformation events last longer +-- by some constant amount of time. +sustain :: Dur -> Score a -> Score a +sustain = M.sustain + +-- | Prolongated events can not exceed total score duration. +-- All event are sustained but those that are close to +-- end of the score are clipped. It resembles sustain on piano, +-- when score ends you release the pedal. +sustainT :: Dur -> Score a -> Score a +sustainT = M.sustainT + +-------------------------------------------------- +-- filtering + +-- | 'clip' cuts piece of value within given time interval. +-- for @('clip' t0 t1 m)@, if @t1 < t0@ result is reversed. +-- If @t0@ is negative or @t1@ goes beyond @'dur' m@ blocks of +-- nothing inserted so that duration of result equals to +-- @'abs' (t0 - t1)@. +clip :: Dur -> Dur -> Score a -> Score a +clip = M.clip + +-- | @('takeS' t)@ is equivalent to @('clip' 0 t)@. +takeS :: Dur -> Score a -> Score a +takeS = M.takeT + +-- | @('dropS' t m)@ is equivalent to @('clip' t (dur a) a)@. +dropS :: Dur -> Score a -> Score a +dropS = M.dropT + +-- | Filter score. +filterEvents :: (Event Dur a -> Bool) -> Score a -> Score a +filterEvents = M.filterEvents + +------------------------------------------------------ +-- mapping + +-- | General mapping. Mapps not only values but events. +mapEvents :: (Event Dur a -> Event Dur b) -> Score a -> Score b +mapEvents = M.mapEvents + +-- | Mapps values and time stamps. +tmap :: (Event Dur a -> b) -> Score a -> Score b +tmap = M.tmap + +-- | Relative tmap. Time values are normalized by argument's duration. +tmapRel :: (Event Dur a -> b) -> Score a -> Score b +tmapRel = M.tmapRel + +------------------------------------------------------ +-- rendering + +-- | Calculates duration. +dur :: Score a -> Dur +dur = M.dur + +-- | Gets all recordered events. +render :: Score a -> [Event Dur a] +render = M.render + +------------------------------------------------------- +-- Volume control +-- + +-- | Sets diapason to specified value. +setDiap :: VolumeLike a => (Amp, Amp) -> Score a -> Score a +setDiap a = fmap $ mapVolume $ + \v -> let d = volumeDiap v + in v{ volumeDiap = d{ diapRange = a } } + +-- | Relative update of diapason value in decibels, +-- (0, 1) turns diapason interval into itself. +setDiapRel :: VolumeLike a => (Double, Double) -> Score a -> Score a +setDiapRel (a, b) = fmap $ mapVolume $ + \v -> let d = volumeDiap v + in v{ volumeDiap = d{ diapRange = (diapAt d a, diapAt d b) } } + + +-- | Sets level to the given value. +setLevel :: VolumeLike a => Level -> Score a -> Score a +setLevel a = fmap $ mapVolume $ + \v -> v{ volumeLevel = a } + +-- | Sets accent to the given value +setAccent :: VolumeLike a => Accent -> Score a -> Score a +setAccent a = fmap $ mapVolume $ + \v -> v{ volumeAccent = a } + +-- | Increases 'Accent' by the given value. +accent :: VolumeLike a => Accent -> Score a -> Score a +accent a = fmap $ mapVolume $ + \v -> v{ volumeAccent = a + volumeAccent v } + +-- | Synonym for @flip setAcent@ +(!) :: VolumeLike a => Score a -> Accent -> Score a +(!) = flip setAccent + +-- | Input becomes louder by given number of levels. +louder :: (VolumeLike a) => Int -> Score a -> Score a +louder n = fmap $ mapVolume $ + \v -> v{ volumeLevel = volumeLevel v + n } + +-- | Input becomes quieter by given number of levels. +quieter :: (VolumeLike a) => Int -> Score a -> Score a +quieter = louder . negate + +-- | Input becomes one level louder. +loud :: (VolumeLike a) => Score a -> Score a +loud = louder 1 + +-- | Input becomes one level quieter. +quiet :: (VolumeLike a) => Score a -> Score a +quiet = quieter 1 + + +-- | Accent that depends on time of note, time is relative, +-- so 'Score' starts at 't = 0' and ends at 't = 1'. +envelope :: (VolumeLike a) => (Dur -> Accent) -> Score a -> Score a +envelope f = tmapRel $ \(Event s d c) -> accent' c (f s) + where accent' v a = mapVolume (\v -> v{ volumeAccent = a }) v + +-- | 'envelopeSeg' lifts function 'linseg' to dynamics level +envelopeSeg :: (VolumeLike a) => [Double] -> Score a -> Score a +envelopeSeg xs = envelope $ (linseg xs) + +-- | 'envelopeRel' lifts function 'linsegRel' to dynamics level +envelopeRel :: (VolumeLike a) => [Accent] -> Score a -> Score a +envelopeRel xs a = envelope (linsegRel 1 xs) a + + +--------------------------------------------------------- +-- Pitch control + +-- | Sets new scale +setScale :: PitchLike a => Scale -> Score a -> Score a +setScale s = fmap $ mapPitch $ + \p -> p{ pitchScale = s } + +-- | Sets bend value +setBend :: PitchLike a => Bend -> Score a -> Score a +setBend b = fmap $ mapPitch $ + \p -> p{ pitchBend = b } + +-- | Increases 'Bend' by given value. +bend :: PitchLike a => Bend -> Score a -> Score a +bend b = fmap $ mapPitch $ + \p -> p{ pitchBend = b + pitchBend p } + +-- | Sets step value +setStep :: PitchLike a => Step -> Score a -> Score a +setStep s = fmap $ mapPitch $ + \p -> p{ pitchStep = s } + +-- | Transposition. Increases (octave, step) coordinate by +-- given number of steps. +step :: (PitchLike a) => Int -> Score a -> Score a +step n = fmap $ mapPitch $ + \p -> p{ pitchStep = pitchStep p + n } + +-- | Transposition by given number of octaves. +higher :: PitchLike a => Int -> Score a -> Score a +higher n = fmap $ mapPitch $ + \p -> p{ pitchOctave = pitchOctave p + n } + + +-- | Transposition by given number of octaves. +lower :: PitchLike a => Int -> Score a -> Score a +lower = higher . negate + + +-- | One octave higher. +high :: PitchLike a => Score a -> Score a +high = higher 1 + + +-- | One octave lower. +low :: PitchLike a => Score a -> Score a +low = lower 1 + + +l', ll', hh', h' :: PitchLike a => Score a -> Score a + +l' = low +ll' = lower 2 +h' = high +hh' = higher 2 + +{- +-- | inverts note around some tone center. Tone center defines +-- two tones octave apart around current note in wich inversion takes place. +-- +-- For example with center at 5 note @c@ in twelve tone scale +-- @[5, 6, 7, 8, 9, bb, 11, c, 1, 2, 3, 4, 5]@ goes into note bb. +-- Inversion counts number of steps from lower center tone to given tone +-- and then result is higher center tone shifted lower by this number. +invert :: (Finite (Step a), PitchLike a) => Int -> Score a -> Score a +invert center = fmap $ mapPitch $ + \p -> let n = domLength $ pitchStep p + c = mod center n + w = fromEnum $ pitchStep p + q = if c <= w + then 2 * c + n - w + else 2 * c - n - w + (o, s) = divMod q n + in p{ pitchOctave = o + pitchOctave p, + pitchStep = toEnum s } +-} + +-------------------------------------------------------------- +-- time stretching +-- + +-- | Shortcut for 'rest' +r :: Dur -> Score a +r = rest + +-- | Means 'triolet'. Plays three notes as fast as two. +tri :: Score a -> Score a +tri = stretch (2/3) + + +-- | Sets tempo in beats per minute, +-- if 1 "Dur" is equal to 1 second before transformation. +bpm :: Dur -> (Score a -> Score a) +bpm beat = stretch (x1/x0) + where x0 = 0.25 + x1 = 60/beat + +bn, wn, hn, qn, en, sn, tn :: Score a -> Score a + +bn = stretch 2 +wn = id +hn = stretch $ 1/2 +qn = stretch $ 1/4 +en = stretch $ 1/8 +sn = stretch $ 1/16 +tn = stretch $ 1/32 + +dbn, dwn, dhn, dqn, den, dsn, dtn :: Score a -> Score a + +-- | Synonym to @'stretch' (3/2)@ +dot :: Score a -> Score a +dot = stretch $ 3/2 + +-- | double 'dot', stretch with 1.75 +ddot :: Score a -> Score a +ddot = stretch 1.75 + +dbn = dot . bn +dwn = dot . wn +dhn = dot . hn +dqn = dot . qn +den = dot . en +dsn = dot . sn +dtn = dot . tn + + +bnr, wnr, hnr, qnr, enr, snr, tnr :: Score a + +wnr = rest 1 + +bnr = bn wnr +hnr = hn wnr +qnr = qn wnr +enr = en wnr +snr = sn wnr +tnr = tn wnr + +dbnr, dwnr, dhnr, dqnr, denr, dsnr, dtnr :: Score a + +dbnr = dbn wnr +dwnr = dwn wnr +dhnr = dhn wnr +dqnr = dqn wnr +denr = den wnr +dsnr = dsn wnr +dtnr = dtn wnr + diff --git a/src/Temporal/Music/Volume.hs b/src/Temporal/Music/Volume.hs new file mode 100644 --- /dev/null +++ b/src/Temporal/Music/Volume.hs @@ -0,0 +1,106 @@ +-- | This module defines the notion of volume. +module Temporal.Music.Volume( + -- * Types + Amp, Diap(..), Volume(..), Level, Accent, + -- * VolumeLike + VolumeLike(..), mapVolume, + -- * Rendering + amp, volumeAsDouble, diapAt) +where + +import Data.Default + +-- | Amplitude. +type Amp = Double + +-- | Diapason defines minimum and maximum bound for 'Volume' level. +-- Field 'diapLim' specifies volume limit. Value 'diapLim' is +-- rendered to highest amplitude and @-diapLim@ is rendered to +-- the lowest amplitude. All values that go beyond the limit are clipped. +data Diap = Diap + { diapRange :: (Amp, Amp) + , diapLim :: Int + } deriving (Show, Eq) + + +instance Default Diap where + def = Diap (1e-5, 1) 5 + +-- | 'Accent' defines values between 'volumeLevel' values on logarithmic +-- scale. 1 'Accent' == 1 'volumeLevel' 's step. +type Accent = Double + +-- | Volume levels. +type Level = Int + +-- | 'Volume' denotes 'Amp' value. It's not a 'Double' +-- for ease of performing some musical transformations, such as +-- making notes louder or using accents. 'Volume' can be converted +-- to 'Amp' with function 'amp'. +data Volume = Volume { + volumeDiap :: Diap, + volumeAccent :: Accent, + volumeLevel :: Level + } deriving (Show, Eq) + + +instance Default Volume where + def = Volume def def def + +-- | 'Volume' can be used alongside with many +-- other parameters (they can define timbre or pitch). +-- Class 'VolumeLike' provides getters and setters for +-- data types that contain value of type 'Volume'. +-- In "Temporal.Music.Score" module you can find many +-- functions that are defined in terms of this class. Once you +-- have chosen some note representation you can make an instance +-- for it and use all volume-modifiers. +class VolumeLike a where + setVolume :: Volume -> a -> a + getVolume :: a -> Volume + + +instance VolumeLike Volume where + setVolume = const id + getVolume = id + + +-- | 'Volume' modifier. +mapVolume :: VolumeLike a => (Volume -> Volume) -> (a -> a) +mapVolume f x = setVolume (f (getVolume x)) x + +-------------------------------------------- +-- rendering +-- + +absVolume :: Volume -> Amp +absVolume v = diapAt (volumeDiap v) (volumeAsDouble v) + +-- | Calculates amplitude for a 'Volume' -like value. +amp :: (VolumeLike a) => a -> Amp +amp = absVolume . getVolume + +-- | Calculates value of type 'Volume' as coordinate +-- within specidfied diapason. 1 corresponds to maximum bound +-- and 0 corresponds to minimum bound. +volumeAsDouble :: Volume -> Double +volumeAsDouble v = 0.5 + d / 2 + where l = volumeLevel v + a = volumeAccent v + c = (diapLim $ volumeDiap v) + d = sat (-1) 1 $ (fromIntegral l + a) / fromIntegral c + +sat :: Ord a => a -> a -> a -> a +sat a b x + | x < a = a + | x > b = b + | otherwise = x + + +-- | Mapps decibels to amplitudes within specified amplitude +-- diapason, 0 turns to lower diapason value and 1 turns +-- to higher diapason value. +diapAt :: Diap -> Double -> Double +diapAt = diapAt' . diapRange + where diapAt' (low, high) x = (low * ) $ (high / low) ** x + diff --git a/temporal-music-notation.cabal b/temporal-music-notation.cabal --- a/temporal-music-notation.cabal +++ b/temporal-music-notation.cabal @@ -1,5 +1,5 @@ Name: temporal-music-notation -Version: 0.1.6 +Version: 0.2.0 Cabal-Version: >= 1.2 License-file: LICENSE License: BSD3 @@ -15,14 +15,13 @@ Library Build-Depends: base >= 4, base < 5, - vector >= 0.7, - temporal-media >= 0.2.1 + vector >= 0.7, data-default >= 0.3, + temporal-media >= 0.3.0 Hs-Source-Dirs: src/ Exposed-Modules: - Temporal.Music.Notation - Temporal.Music.Notation.Volume - Temporal.Music.Notation.Pitch - Temporal.Music.Notation.Score - Temporal.Music.Notation.Note - Temporal.Music.Notation.Seg - Temporal.Music.Notation.Scales + Temporal.Music + Temporal.Music.Volume + Temporal.Music.Pitch + Temporal.Music.Score + Temporal.Music.Note + Temporal.Music.Scales