temporal-music-notation 0.1.6 → 0.2.0

raw patch · 15 files changed

+1142/−1507 lines, 15 filesdep +data-defaultdep ~temporal-mediaPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default

Dependency ranges changed: temporal-media

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• src/Temporal/Music.hs +19/−0
• src/Temporal/Music/Notation.hs +0/−53
• src/Temporal/Music/Notation/Note.hs +0/−211
• src/Temporal/Music/Notation/Pitch.hs +0/−399
• src/Temporal/Music/Notation/Scales.hs +0/−256
• src/Temporal/Music/Notation/Score.hs +0/−241
• src/Temporal/Music/Notation/Seg.hs +0/−45
• src/Temporal/Music/Notation/Volume.hs +0/−291
• src/Temporal/Music/Note.hs +140/−0
• src/Temporal/Music/Pitch.hs +181/−0
• src/Temporal/Music/Scales.hs +258/−0
• src/Temporal/Music/Score.hs +428/−0
• src/Temporal/Music/Volume.hs +106/−0
• temporal-music-notation.cabal +9/−10

@@ -1,4 +1,4 @@-Copyright Anton Kholomiov 2011+Copyright Anton Kholomiov 2011-2012  All rights reserved. 

@@ -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

@@ -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

@@ -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-

@@ -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

@@ -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] -

@@ -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

@@ -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)--}--

@@ -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

@@ -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+

@@ -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++

@@ -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] +

@@ -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+

@@ -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+

@@ -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