temporal-music-notation 0.1 → 0.1.2
raw patch · 9 files changed
+578/−452 lines, 9 filesdep +type-level-natural-number-decimaldep −type-level-natural-numberdep −type-level-natural-number-operationsdep ~temporal-mediadep ~vector
Dependencies added: type-level-natural-number-decimal
Dependencies removed: type-level-natural-number, type-level-natural-number-operations
Dependency ranges changed: temporal-media, vector
Files
- src/Temporal/Music/Notation.hs +2/−4
- src/Temporal/Music/Notation/Local/Scales.hs +0/−242
- src/Temporal/Music/Notation/Note.hs +46/−40
- src/Temporal/Music/Notation/Pitch.hs +131/−98
- src/Temporal/Music/Notation/Scales.hs +256/−0
- src/Temporal/Music/Notation/Score.hs +4/−2
- src/Temporal/Music/Notation/Seg.hs +45/−0
- src/Temporal/Music/Notation/Volume.hs +87/−59
- temporal-music-notation.cabal +7/−7
src/Temporal/Music/Notation.hs view
@@ -43,13 +43,11 @@ module Temporal.Music.Notation.Volume, module Temporal.Music.Notation.Pitch, module Temporal.Music.Notation.Score,- module TypeLevel.NaturalNumber+ module Temporal.Music.Notation.Seg ) where import Temporal.Music.Notation.Volume import Temporal.Music.Notation.Pitch import Temporal.Music.Notation.Score--import TypeLevel.NaturalNumber-+import Temporal.Music.Notation.Seg
− src/Temporal/Music/Notation/Local/Scales.hs
@@ -1,242 +0,0 @@--- | specific scales-module Temporal.Music.Notation.Local.Scales -(- -- * just scales - ji3, ji5, ji7,- pyth,- hindGb,- hindFs,- justBP,- partchean, N43,- luScale,- superJust, harmonicJust,- sruti, N22,- -- * Irregular scales- eqt, eqts, eqBP, hind, - -- * Subscales - -- | extracting 7-tone scales out of 12-tone scales- major, minor, - ionian, dorian, phrygian, lydian, - mixolydian, aeolian, locrian)-where--import TypeLevel.NaturalNumber-import TypeLevel.NaturalNumber.Operations--import Temporal.Music.Notation.Pitch(Frequency, - Scale(..), scaleSize, fromIntervals)-import qualified Data.Vector as V--sliceScale :: (NaturalNumber n, NaturalNumber n') - => Int -> [Int] -> Scale n -> Scale n'-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--major, minor,- ionian, dorian, phrygian, lydian, - mixolydian, aeolian, locrian :: Scale N12 -> Scale N7--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 N12 -> Scale N7)-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 N12-eqt = fromIntervals 2 (map ((2 **) . (/12)) [0 .. 11])---- | general equal temperament scale-eqts :: NaturalNumber n => Int -> Frequency -> Scale n-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 N12-hind = hindemitheanGen $ 0.5 * (ji5 (-1, 2, 1) + ji5 (2, -2, -1))---- | equal Bohlen-Pierce scale-eqBP :: Int -> Frequency -> Scale N13-eqBP = fromIntervals 3 (map ((3 **) . (/13) . fromIntegral) [0 .. 12]) ---------------------------------------------------------- | pythagorean scale-pyth :: Int -> Frequency -> Scale N12-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 N12-hindFs = hindemitheanGen $ ji5 (-1, 2, 1)---- | hindemithean scale with gb for tritone-hindGb :: Int -> Frequency -> Scale N12-hindGb = hindemitheanGen $ ji5 (2, -2, -1)--hindemitheanGen :: Frequency -> Int -> Frequency -> Scale N12-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 N13-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]---type N43 = Plus N10 (Plus N10 (Plus N10 N13))---- | Harry Partch's 43-tone scale-partchean :: Int -> Frequency -> Scale N43-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 N12-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 N12-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 N12-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 --type N22 = Plus N10 N12--sruti :: Int -> Frequency -> Scale N22-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] -
src/Temporal/Music/Notation/Note.hs view
@@ -68,77 +68,84 @@ ) where -import TypeLevel.NaturalNumber(NaturalNumber) +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.Local.Scales(eqts)+import Temporal.Music.Notation.Scales(eqts) -- Note -- | Value of type 'Note' contains pitch, volume and some specific -- timbre information.-data (NaturalNumber nVol, NaturalNumber nPch) - => Note nVol nPch = Note+data Note nVol nPch a = Note { noteVolume :: Volume nVol , notePitch :: Pitch nPch+ , noteParam :: Maybe a } deriving (Show, Eq) -- volume instances -instance (NaturalNumber nVol, NaturalNumber nPch)- => VolFunctor (Note nVol nPch) where- mapVol f (Note v p) = Note (f v) p+instance (Seg nVol, Seg nPch)+ => VolumeFunctor (Note nVol nPch a) where+ mapVolume f n = n{ noteVolume = f $ noteVolume n } -instance (NaturalNumber nVol, NaturalNumber nPch)- => LevelFunctor (Note nVol nPch) where- mapLevel f (Note v p) = Note (mapLevel f v) p+instance (Seg nVol, Seg nPch)+ => LevelFunctor (Note nVol nPch a) where+ mapLevel f n = n{ noteVolume = mapLevel f $ noteVolume n } -- pitch instances -instance (NaturalNumber nVol, NaturalNumber nPch)- => PchFunctor (Note nVol nPch) where- mapPch f (Note v p) = Note v (f p)--instance (NaturalNumber nVol, NaturalNumber nPch)- => ScaleFunctor (Note nVol nPch) where- mapScale f (Note v p) = Note v (mapScale f p)+instance (Seg nVol, Seg nPch)+ => PitchFunctor (Note nVol nPch a) where+ mapPitch f n = n{ notePitch = f $ notePitch n } -instance (NaturalNumber nVol, NaturalNumber nPch)- => ToneFunctor (Note nVol nPch) where- mapTone f (Note v p) = Note v (mapTone f p)+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 :: (NaturalNumber nVol, NaturalNumber nPch) - => Note nVol nPch -> (Amplitude, Frequency)-absNote (Note v p) = (absVolume v, absPitch p)+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'.-type Drum n = Volume n+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 :: (NaturalNumber nVol) - => Drum nVol -> Amplitude-absDrum = absVolume+absDrum :: (Seg nVol) + => Drum nVol a -> Amplitude+absDrum = absVolume . drumVolume -- shortcuts -defaultVolume :: NaturalNumber n => Volume n-defaultVolume = Volume (1e-5, 1) mediumLevel -- notes -n :: (NaturalNumber nVol, NaturalNumber nPch) - => Dur -> Tone nPch -> Score (Note nVol nPch)-n dt t = note dt $ Note defaultVolume (Pitch (eqts 0 c1) t)+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 :: - (NaturalNumber nVol, NaturalNumber nPch) - => Tone nPch -> Score (Note nVol nPch)+ (Vol nVol, Pch nPch) + => Tone nPch -> Score (Note nVol nPch a) bn = n 2 wn = n 1@@ -158,14 +165,13 @@ -- drums -d :: (NaturalNumber nVol) - => Dur -> Accent -> Score (Drum nVol)-d dt a = note dt $ setAccent a defaultVolume+d :: (Vol nVol) + => Dur -> Accent -> Score (Drum nVol a)+d dt a = note dt $ Drum (setAccent a $ volume mediumLevel) Nothing --- | brevis note rest bd, wd, hd, ed, sd, td, dbd, dwd, dhd, ded, dsd, dtd :: - (NaturalNumber nVol) - => Accent -> Score (Drum nVol)+ (Vol nVol) + => Accent -> Score (Drum nVol a) bd = d 2 wd = d 1
src/Temporal/Music/Notation/Pitch.hs view
@@ -14,29 +14,31 @@ -- 'Tone' to 1d double values. 'Scale' is 2d logarithmic grid in -- frequency domain and 'Tone' is point on that grid. Frequency, c1, a1,- Pitch(..), etPitch,+ Pch(pitch), + Pitch(..), Interval, Scale(..), scaleSize, fromIntervals, Bend, Octave, Step, Tone(..), tone, toneNum, -- * Transformers -- ** Pitch - PchFunctor(..),+ PitchFunctor(..), -- ** Scale - ScaleFunctor(..), setScale, mapBase, setBase, transposeScale,+ setScale, mapBase, setBase, transposeScale, -- ** Tone ToneFunctor(..), - setBend, bend, step, low, high, lower, higher, invert,+ setBend, bend, step, transp,+ low, l', ll', high, h', hh', lower, higher, invert, -- * Rendering frequency, absPitch ) where -import TypeLevel.NaturalNumber 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 @@ -48,18 +50,26 @@ 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 NaturalNumber n => Pitch n = Pitch - { pitchScale :: Scale n+data Seg n => Pitch n = Pitch + { pitchScale :: Scale , pitchTone :: Tone n } deriving (Show, Eq) --- | twelve tone equal temperament scale pitch. Scale base tone is @(0, 'c1')@-etPitch :: Tone N12 -> Pitch N12-etPitch = Pitch etc- where etc = Scale (0, c1) 2 (V.fromList $ map ((2 **) . (/12)) [0 .. 11])- -------------------------------------------------------------- -- Scale @@ -90,7 +100,7 @@ -- if you write just @pyth 0 (3/2 * c1)@ note (0 :: Tone N12) corresponds -- to G. -data NaturalNumber n => Scale n = Scale +data Scale = Scale { scaleBase :: (Int, Frequency) -- ^ start point of the grid, -- @(n, cps)@ corresponds to @(0, n)@@@ -105,19 +115,18 @@ } deriving (Show, Eq) -- | gives number of steps in one octave.-scaleSize :: NaturalNumber n => Scale n -> Int-scaleSize = naturalNumberAsInt . num- where num :: NaturalNumber n => Scale n -> n- num = const undefined+scaleSize :: Scale -> Int+scaleSize = V.length . scaleSteps -- | 'fromIntervals' makes scale constructor from 'octave' interval and -- scale step intervals.-fromIntervals :: NaturalNumber n - => Interval -> [Interval]- -> (Int -> Frequency -> Scale n)+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.@@ -130,46 +139,46 @@ -- 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 NaturalNumber n => Tone n = Tone+data Seg n => Tone n = Tone { toneBend :: Bend , toneOctave :: Octave - , toneStep :: Step+ , toneStep :: n } deriving (Eq, Show) -- | 'tone' constructs Tone from step value. Bend is set to zero.-tone :: NaturalNumber n => Step -> Tone n-tone x = res- where res = (uncurry $ Tone 0) $ divMod x d- d = toneNum res+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 :: NaturalNumber n => Tone n -> Int-toneNum x = naturalNumberAsInt $ num x- where num :: NaturalNumber n => Tone n -> n+toneNum :: Seg n => Tone n -> Int+toneNum x = segSize $ num x+ where num :: Seg n => Tone n -> n num = const undefined -- instances -instance NaturalNumber n => Ord (Tone n) where- compare = compare `on` (\(Tone b o s) -> (o, s, b))+instance (Eq n, Seg n) => Ord (Tone n) where+ compare = compare `on` (\(Tone b o s) -> (o, fromEnum s, b)) -instance NaturalNumber n => Enum (Tone n) where- toEnum = tone- fromEnum x = toneOctave x * toneNum x + toneStep x+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 NaturalNumber n => Num (Tone n) where- (+) = liftBi (+) (+)- (-) = liftBi (-) (-)- (*) = liftBi (*) (*)+instance (Eq n, Show n, Seg n) => Num (Tone n) where+ (+) = liftBi (+) (+) (+)+ (-) = liftBi (-) (-) (+)+ (*) = liftBi (*) (*) (*) - abs = liftOne abs abs+ abs = liftUn abs abs abs signum t@(Tone b o s)- | abs b < 1e-6 && o == 0 && s == 0 = 0- | t > 0 = tone 1- | otherwise = tone $ -1+ | abs b < 1e-6 && o == 0 && s == minBound = 0+ | t > 0 = fromInteger 1+ | otherwise = fromInteger $ -1 - fromInteger = tone . fromInteger+ fromInteger x = step (fromInteger x) $ tone minBound ------------------------------------------------------------------- -------------------------------------------------------------------@@ -177,41 +186,31 @@ -- Pitch -class PchFunctor a where- mapPch :: (forall n . NaturalNumber n => Pitch n -> Pitch n) -> (a -> a)+class PitchFunctor a where+ mapPitch :: (forall n . Seg n => Pitch n -> Pitch n) -> (a -> a) -instance NaturalNumber n => PchFunctor (Pitch n) where- mapPch f = f+instance Seg n => PitchFunctor (Pitch n) where+ mapPitch f = f -instance (PchFunctor a) => PchFunctor (Score a) where- mapPch f = fmap (mapPch f)+instance (PitchFunctor a) => PitchFunctor (Score a) where+ mapPitch f = fmap (mapPitch f) -- Scale -class ScaleFunctor a where- mapScale :: (forall n . NaturalNumber n => Scale n -> Scale n) -> (a -> a)--instance NaturalNumber n => ScaleFunctor (Scale n) where- mapScale f = f--instance (ScaleFunctor a) => ScaleFunctor (Score a) where- mapScale f = fmap (mapScale f)--instance NaturalNumber n => ScaleFunctor (Pitch n) where- mapScale f (Pitch s t) = Pitch (f s) t+mapScale :: PitchFunctor a => (Scale -> Scale) -> a -> a+mapScale f = mapPitch $ \p -> p{ pitchScale = f $ pitchScale p } -- | setting specific scale-setScale :: (NaturalNumber n, ScaleFunctor a) => Scale n -> a -> a-setScale x = mapScale $ - \s -> s{ scaleBase = scaleBase x, scaleSteps = scaleSteps x }+setScale :: PitchFunctor a => Scale -> a -> a+setScale x = mapScale $ const x -- | mapping of scale base tone -mapBase :: ScaleFunctor a => (Frequency -> Frequency) -> a -> a+mapBase :: PitchFunctor a => (Frequency -> Frequency) -> a -> a mapBase f = mapScale $ \s -> s{ scaleBase = second f $ scaleBase s } -- | setting scale base tone-setBase :: ScaleFunctor a => Frequency -> a -> a +setBase :: PitchFunctor a => Frequency -> a -> a setBase b = mapBase $ const b -- | 'transposeScale' shifts scaleSteps by given number.@@ -227,7 +226,7 @@ -- -- And now 0 corresponds to middle C and step multipliers are rearranged -- so that someScale starts from middle D.-transposeScale :: ScaleFunctor a => Step -> a -> a+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 @@ -237,15 +236,15 @@ -- Tone -- | transformer for types that contain tone class ToneFunctor a where- mapTone :: (forall n . NaturalNumber n => Tone n -> Tone n) -> (a -> a)+ mapTone :: (forall n . Seg n => Tone n -> Tone n) -> (a -> a) -instance NaturalNumber n => ToneFunctor (Tone n) where+instance Seg n => ToneFunctor (Tone n) where mapTone f = f instance ToneFunctor a => ToneFunctor (Score a) where mapTone f = fmap (mapTone f) -instance NaturalNumber n => ToneFunctor (Pitch n) where+instance Seg n => ToneFunctor (Pitch n) where mapTone f (Pitch s t) = Pitch s $ f t -- | set bend value @@ -258,16 +257,38 @@ -- | transposition, shift in steps step :: ToneFunctor a => Step -> a -> a-step n = mapTone (tone n + )+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)@@ -288,55 +309,67 @@ \t@(Tone b o s) -> let n = toneNum t c = mod center n- q = if c <= s- then (2 * c + n - s)- else (2 * c - n - s)+ 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') s'+ in Tone b (o + o') $ toEnum s' ----------------------------------------------------------- -- rendering -- | pitch to frequency conversion-absPitch :: NaturalNumber n => Pitch n -> Frequency+absPitch :: Seg n => Pitch n -> Frequency absPitch (Pitch s t) = frequency s t -- | calculates frequency value for given tone on scale grid-frequency :: NaturalNumber n => Scale n -> Tone n -> Frequency-frequency s (Tone b o n) = (bendCoeff r' n' s * ) $- f0 * (scaleOctave s ^^ (o + o')) * (scaleSteps s V.! n')- where (o', n') = divMod (n - c0 + fromIntegral b') $ scaleSize s- b' = floor b- r' = b - fromInteger b'- (c0, f0) = scaleBase s-+frequency :: Seg n => Scale -> Tone n -> Frequency+frequency s t@(Tone b o n) = (bendCoeff r' d s * ) $+ scaleFreq s d+ where (b', r') = properFraction b+ d = fromEnum t + fromIntegral b' -bendCoeff :: NaturalNumber n => Bend -> Step -> Scale n -> Double+bendCoeff :: Bend -> Step -> Scale -> Double bendCoeff r n s | abs r < 1e-6 = 1 | r > 0 = flip loginterpCoeff r $ getTones s n $ n + 1 | otherwise = flip loginterpCoeff (abs r) $ getTones s n $ n - 1- where getTones s n1 n2 = (getTone s n1, getTone s n2) - getTone s = frequency s . tone - + where getTones s n1 n2 = (scaleFreq s n1, scaleFreq s n2) + ++scaleFreq :: Scale -> Int -> Frequency+scaleFreq s x = f0 * (scaleOctave s ^^ o) * (scaleSteps s V.! n)+ where (o, n) = divMod (x - c0) $ scaleSize s+ (c0, f0) = scaleBase s + loginterpCoeff :: (Double, Double) -> Double -> Double loginterpCoeff (l, r) x = (r / l) ** x -- tone manipulation -liftOne :: NaturalNumber n - => (Double -> Double) -> (Int -> Int) +liftUn :: Seg n + => (Double -> Double) + -> (Int -> Int) + -> (Int -> Int) -> Tone n -> Tone n-liftOne f g (Tone b o s) = fit $ Tone (f b) (g o) (g s)+liftUn f g h t@(Tone b o s) = + (uncurry $ Tone (f b)) $ + fit (toneNum t) (g o, h $ fromEnum s)+ -liftBi :: NaturalNumber n - => (Double -> Double -> Double) -> (Int -> Int -> Int) ++liftBi :: Seg n + => (Double -> Double -> Double) + -> (Int -> Int -> Int) + -> (Int -> Int -> Int) -> Tone n -> Tone n -> Tone n-liftBi f g (Tone b o s) (Tone b' o' s') = - fit $ Tone (b `f` b') (o `g` o') (s `g` s')+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 :: NaturalNumber n => Tone n -> Tone n-fit t@(Tone b o s) = Tone b (o + o') s'- where (o', s') = divMod s $ toneNum t+fit :: Seg s => Int -> (Int, Int) -> (Int, s)+fit n (o, s) = (o + o', toEnum s')+ where (o', s') = divMod s n
+ src/Temporal/Music/Notation/Scales.hs view
@@ -0,0 +1,256 @@+-- | 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] +
src/Temporal/Music/Notation/Score.hs view
@@ -25,6 +25,8 @@ -- ** Mappings tmap, dmap, tdmap, -- * Rendering+ Event(..),+ EventList(..), renderScore, -- * Miscellaneous tmapRel, dmapRel, tdmapRel,@@ -33,7 +35,7 @@ where import qualified Temporal.Media as M-import Temporal.Media(linseg)+import Temporal.Media(Event(..), EventList(..), linseg) import Control.Arrow(first, second) @@ -220,5 +222,5 @@ -- Rendering -- | Transform 'Score' to 'EventList'-renderScore :: Score a -> M.EventList Dur a+renderScore :: Score a -> EventList Dur a renderScore = M.renderMedia
+ src/Temporal/Music/Notation/Seg.hs view
@@ -0,0 +1,45 @@+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)+-}++
src/Temporal/Music/Notation/Volume.hs view
@@ -14,15 +14,16 @@ -- in amplitude linear units. Amplitude, Diapason, Accent,+ Vol(volume), Volume(..), Level(..), volumeNum, levelNum, level, mediumLevel, -- * Transformers- VolFunctor(..), LevelFunctor(..),+ VolumeFunctor(..), LevelFunctor(..), setDiapason, setLevel, setAccent,- accent,+ accent, al', aq', loud, quiet, louder, quieter,- dynamic, dynamicRel,+ dynamics, dynamicsRel, dynamicsSeg, -- * Rendering amplitude, unsafeAmplitude, absVolume, unsafeAbsVolume@@ -30,7 +31,8 @@ where import Data.Function(on)-import TypeLevel.NaturalNumber++import Temporal.Music.Notation.Seg(Seg, segSize) import Temporal.Music.Notation.Score(Score, Time, tmapRel, linseg) -- | Linear volume units@@ -44,27 +46,31 @@ -- 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 NaturalNumber n => Volume n = Volume +data Seg n => Volume n = Volume { volumeDiapason :: Diapason , volumeLevel :: Level n } deriving (Show, Eq) -class VolFunctor a where- mapVol :: (forall n . NaturalNumber n => Volume n -> Volume n) -> (a -> a)+class VolumeFunctor a where+ mapVolume :: (forall n . Seg n => Volume n -> Volume n) -> (a -> a) -instance NaturalNumber n => VolFunctor (Volume n) where- mapVol f = f+instance Seg n => VolumeFunctor (Volume n) where+ mapVolume f = f -instance VolFunctor a => VolFunctor (Score a) where- mapVol f = fmap (mapVol f)+instance VolumeFunctor a => VolumeFunctor (Score a) where+ mapVolume f = fmap (mapVolume f) -instance NaturalNumber n => LevelFunctor (Volume n) where+instance Seg n => LevelFunctor (Volume n) where mapLevel f = \(Volume d l) -> Volume d $ f l -- | setDiapason-setDiapason :: VolFunctor a => (Amplitude, Amplitude) -> a -> a-setDiapason x = mapVol $ \(Volume _ l) -> Volume x l+setDiapason :: VolumeFunctor a => (Amplitude, Amplitude) -> a -> a+setDiapason x = mapVolume $ \(Volume _ l) -> Volume x l -------------------------------------------------- -------------------------------------------------- -- Level@@ -72,62 +78,66 @@ -- | 'Level' defines number of equally spaced stamps on -- logarithmic scale (steps), and degree of diversion -- from the stamps (accents).-data NaturalNumber n => Level n = Level+data Seg n => Level n = Level { levelAccent :: Accent- , levelStep :: Int+ , levelStep :: n } deriving (Show, Eq) -- | number of levels in 'Volume' scale-volumeNum :: NaturalNumber n => Volume n -> Int+volumeNum :: Seg n => Volume n -> Int volumeNum = phantomNum -- | number of levels in 'Level' scale-levelNum :: NaturalNumber n => Level n -> Int+levelNum :: Seg n => Level n -> Int levelNum = phantomNum -phantomNum :: NaturalNumber n => f n -> Int-phantomNum = naturalNumberAsInt . num+phantomNum :: Seg n => f n -> Int+phantomNum = segSize . num where num :: f n -> n num = const undefined ------------------------------------------- -- constructors --- | 'level' constructs 'Level' from 'Int'. 'Accent' is set to zero.--- If input exceeds 'levelNum' then result is set to 'levelNum',--- if input is negative then result set is to zero.-level :: NaturalNumber n => Int -> Level n-level x = res- where n = levelNum res- res = Level 0 $ sat 0 n x+-- | 'level' constructs 'Level' from type of class 'Seg'. 'Accent' is set to zero.+level :: Seg n => n -> Level n+level = Level 0 ------------------------------------------- -- instances -instance NaturalNumber n => Enum (Level n) where- toEnum = level- fromEnum = levelStep- -instance NaturalNumber n => Ord (Level n) where- compare = compare `on` (\(Level a s) -> fromIntegral s + a)+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 NaturalNumber n => Num (Level n) where+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 == level 0 = 0- | otherwise = 1- fromInteger = level . fromInteger+ | 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 . NaturalNumber n => Level n -> Level n) -> (a -> a)+ mapLevel :: (forall n . Seg n => Level n -> Level n) -> (a -> a) -instance NaturalNumber n => LevelFunctor (Level n) where+instance Seg n => LevelFunctor (Level n) where mapLevel f = f instance LevelFunctor a => LevelFunctor (Score a) where@@ -137,14 +147,22 @@ 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 :: LevelFunctor a => Int -> a -> a+setLevel :: (Seg n, LevelFunctor a) => n -> a -> a setLevel n = mapLevel - (\l@(Level a _) -> Level a $ sat 0 (levelNum l) n)+ (\l@(Level a _) -> Level a $ toEnum $ sat 0 (levelNum l) $ fromEnum n) -- | Input becomes one step louder loud :: LevelFunctor a => a -> a@@ -161,21 +179,20 @@ -- | Input becomes given number of steps louder louder :: LevelFunctor a => Int -> a -> a louder n - | n > 0 = mapLevel ( + level n)- | n < 0 = mapLevel (\x -> x - level n)-+ | n > 0 = mapLevel $ liftUn id (+n)+ | n < 0 = mapLevel $ liftUn id (\x -> x - n) -- | Medium level-mediumLevel :: NaturalNumber n => Level n+mediumLevel :: Seg n => Level n mediumLevel = res- where res = level $ round $ fromIntegral n / 2+ where res = level $ toEnum $ round $ fromIntegral n / 2 n = levelNum res -- | Accent that depends on time of note-dynamic :: LevelFunctor a => (Time -> Accent) -> Score a -> Score a-dynamic f = tmapRel $ \t -> accent (f t)+dynamics :: LevelFunctor a => (Time -> Accent) -> Score a -> Score a+dynamics f = tmapRel $ \t -> accent (f t) --- | Linear relative 'dynamic' function. Function is defined by list of+-- | 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 @@ -183,51 +200,62 @@ -- defines -- rise and decay again but here decay segment is twice longer then -- rise segment.-dynamicRel :: LevelFunctor a => [Accent] -> Score a -> Score a-dynamicRel xs = dynamic $ linseg $ init $ f =<< xs+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 :: NaturalNumber n => Volume n -> Amplitude+absVolume :: Seg n => Volume n -> Amplitude absVolume (Volume d l) = amplitude d l -- | converts volume to amplitude with 'unsafeAmplitude' function-unsafeAbsVolume :: NaturalNumber n => Volume n -> Amplitude+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 :: NaturalNumber n => Diapason -> Level n -> Amplitude+amplitude :: Seg n => Diapason -> Level n -> Amplitude amplitude d l = amplitudeGen (sat 0 $ fromIntegral $ levelNum l) d l -- | unsafe analog of 'amplitude' function. Here result can go -- beyond limits of 'Diapason' interval.-unsafeAmplitude :: NaturalNumber n => Diapason -> Level n -> Amplitude+unsafeAmplitude :: Seg n => Diapason -> Level n -> Amplitude unsafeAmplitude = amplitudeGen id -amplitudeGen :: NaturalNumber n +amplitudeGen :: Seg n => (Double -> Double) -> Diapason -> Level n -> Amplitude amplitudeGen bound (low, high) l@(Level a s) = (low * ) $ (high / low) ** x where n = fromIntegral $ levelNum l- x = ( / n) $ bound $ fromIntegral s + a+ x = ( / n) $ bound $ (fromIntegral $ fromEnum s) + a -------------------------------------- -- level manipulation -liftBi :: NaturalNumber n+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') (sat 0 (levelNum l) $ s `g` 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
temporal-music-notation.cabal view
@@ -1,5 +1,5 @@ Name: temporal-music-notation-Version: 0.1+Version: 0.1.2 Cabal-Version: >= 1.2 License-file: LICENSE License: BSD3@@ -9,7 +9,7 @@ Description: Library for expressing musical ideas. Includes composable score representation, microsound tunings, flexible pitch and volume control. Category: Music Stability: Experimental-Tested-With: GHC==6.12.1+Tested-With: GHC==6.12.3 Build-Type: Simple Extra-Source-Files:@@ -23,10 +23,9 @@ Library Build-Depends: base >= 4, base < 5,- vector, - temporal-media >= 0.2,- type-level-natural-number, - type-level-natural-number-operations+ vector >= 0.7, + temporal-media >= 0.2.1,+ type-level-natural-number-decimal Hs-Source-Dirs: src/ Exposed-Modules: Temporal.Music.Notation@@ -34,4 +33,5 @@ Temporal.Music.Notation.Pitch Temporal.Music.Notation.Score Temporal.Music.Notation.Note- Temporal.Music.Notation.Local.Scales+ Temporal.Music.Notation.Seg+ Temporal.Music.Notation.Scales