temporal-music-notation (empty) → 0.1
raw patch · 15 files changed
+1890/−0 lines, 15 filesdep +basedep +temporal-mediadep +type-level-natural-numbersetup-changed
Dependencies added: base, temporal-media, type-level-natural-number, type-level-natural-number-operations, vector
Files
- LICENSE +30/−0
- Setup.hs +3/−0
- examples/Orchestra.hs +89/−0
- examples/Readme.hs +31/−0
- examples/arpeggi.hs +78/−0
- examples/choral.hs +248/−0
- examples/dm.hs +29/−0
- examples/teardrop.hs +41/−0
- src/Temporal/Music/Notation.hs +55/−0
- src/Temporal/Music/Notation/Local/Scales.hs +242/−0
- src/Temporal/Music/Notation/Note.hs +205/−0
- src/Temporal/Music/Notation/Pitch.hs +342/−0
- src/Temporal/Music/Notation/Score.hs +224/−0
- src/Temporal/Music/Notation/Volume.hs +236/−0
- temporal-music-notation.cabal +37/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Anton Kholomiov 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Anton Kholomiov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ examples/Orchestra.hs view
@@ -0,0 +1,89 @@+-- | csound instruments+module Orchestra+where++import CsoundExpr.Base+import qualified CsoundExpr.Opcodes as C++import Temporal.Music.Notation+import Temporal.Music.Notation.Local.Western +++type Score' = Score NoteW++type CsdNote = (Amp, Cps)++type Amp = Irate+type Cps = Irate++-- | converts note representation to csound values+absCsdNote :: NoteW -> CsdNote+absCsdNote x = (double amp, double cps)+ where (amp, cps) = absNote x++-- | converts note representation to csound values+absCsdDrum :: DrumW-> Amp+absCsdDrum = double . absDrum++ftsin = gen10 8192 [1]++-- csound instruments++bassDrum :: (Irate, Irate) -> SignalOut+bassDrum (amp, pch) = C.out $ C.oscilA [] env cps ftsin+ where env = amp ^* C.exponA 1 0.2 0.001+ cps = C.exponK pch 0.2 20++openHiHat :: Irate -> SignalOut+openHiHat amp = C.out $ C.buthp [] sig (num 7000)+ where sig = fst $ se1 $ C.noise env (num 0)+ env = amp ^* C.exponA 1 1.5 0.001 ++pluckInstr :: (Irate, Irate) -> SignalOut +pluckInstr (amp, pch) = outList [+ C.out $ env <*> C.wgpluck2 0.75 amp pch (num 0.75) (num 0.5), + C.xtratim 1]+ where env = C.linsegrK [0, idur * 0.05, 1, idur * 0.9, 1] 1 0 +++pipeOrgan :: CsdNote -> SignalOut+pipeOrgan (amp, cps) = C.out sig+ where ft = ftsin+ outch1 = num 1+ outch2 = num 2+ atk = num 10+ op1f = cps+ op2f = 2.01 * cps+ op3f = 3.99 * cps+ op4f = 8 * cps+ op5f = 0.5 * cps+ op7f = 16 * cps+ dclick = C.linsegK [0, 0.001, amp, idur-0.002, amp, 0.001, 0]+ amp1 = C.linsegK [0, 0.01, 1, idur-0.02, 1, 0.01, 0]+ amp2 = C.linsegK [0, 0.05, 1, 0.1, 0.7, idur-0.16, 0.7, 0.01, 0]+ amp3 = C.linsegK [0, 0.03, 0.8, 0.05, 0, 0.01, 0]+ amp4 = C.linsegK [0, 0.1, 0.3, 0.1, 0.05, idur-0.3, 0.1, 0.1, 0]+ op8 = C.oscilA [] amp4 op5f ft+ p1 = op8 + 1+ op1 = C.oscilA [] amp1 (op1f ^* p1) ft+ op2 = C.oscilA [] amp2 (op2f ^* p1) ft+ op3 = C.oscilA [] amp2 (op3f) ft+ op4 = C.oscilA [] amp2 (op4f) ft+ op5 = C.oscilA [] amp3 (op5f * 5) ft+ op7 = C.oscilA [] amp2 (op7f) ft+ sig = (dclick <*>) $ op1 + op2 + op3 + op3 + op4 + op5 + op7++-- instruments on notes+--++bassDrum', pipeOrgan', guitar :: Score NoteW -> Score SignalOut +openHiHat' :: Score DrumW -> Score SignalOut++bassDrum' = fmap (bassDrum . absCsdNote) . setDiapason (1e3, 1.5 * 1e4)+openHiHat' = fmap (openHiHat . absCsdDrum) . setDiapason (1e3, 1.0 * 1e4)++pipeOrgan' = fmap (pipeOrgan . absCsdNote) . setDiapason (1e2, 5*1e3)+guitar = fmap (pluckInstr . absCsdNote). setDiapason (1000, 1.5*1e4) + . lower 1++
+ examples/Readme.hs view
@@ -0,0 +1,31 @@+-- Examples+--+-- In this folder you can find some examples for 'temporal-music-notation'+-- package. It can produce no sound but can combine events in+-- functional way. Package 'csound-expression' is responsible for +-- sound output. 'csound-expression' allows to construct csounds '.csd' +-- files from haskell. See Orchestra.hs to see how it can be done.+--+-- warning : external libraries are used+-- 'temporal-music-notation', 'temporal-music-notation-western',+-- and 'csound-expression'+--+-- If you have installed only 'temporal-music-notation', +-- to run examples make first: +--+-- cabal update+-- cabal install temporal-music-notation-western+-- cabal install csound-expression+--+-- Sound is produced with csound language. +-- 'temporal-music-notation' combines +-- notes tigether. Output of the example is out.csd+-- file, which is for csound. +--+-- If you are not familliar with csound. Csound is+-- language for musical composition and sound synthesis.+-- It can be downloaded here <http://csounds.com>.+-- Run csound on out.csd to hear result finally.+--+-- >csound out.csd+
+ examples/arpeggi.hs view
@@ -0,0 +1,78 @@+-- radiohead - weird fishes (intro)++import CsoundExpr.Base(csd, play, headerMono)++import Temporal.Music.Notation+import Temporal.Music.Notation.Local.Western ++import Orchestra(guitar)++-- accent every fourth beat+beat = cycle [accent 0.5, id, id, id]++-- chords++guitarChord1, guitarChord2, guitarChord3 :: [Tone N12] -> Score NoteW++-- guitar 1++guitarChord1 = line . zipWith ($) beat . map en . concat . replicate 10++ch11 = [high d, g, e]+ch12 = map (step wholeTone) ch11+ch13 = [high a, a, high cs]+ch14 = [high fs, b, g]++chSeq1 = [ch11, ch12, ch13, ch14]++-- guitar 2++guitarChord2 = + line . zipWith ($) beat . map en . + concat . replicate 6 . arpeggi . map high+ where arpeggi x = x ++ take 2 x+++ch21 = [low g, d, e]+ch22 = map (step wholeTone) ch21+ch23 = [cs, e, a]+ch24 = [d, g, e]++chSeq2 = [ch21, ch22, ch23, ch24]++-- guitar 3++guitarChord3 = + line . zipWith ($) beat . map en . + concat . replicate 6 . arpeggi . map high+ where arpeggi x = take 2 x ++ x++ch31 = [e, g, b]+ch32 = map (step wholeTone) ch31+ch33 = [fs, a, high cs]+ch34 = [high d, g, b]++chSeq3 = [ch31, ch32, ch33, ch34]++-- score++scoG1 = mfl $ line $ map guitarChord1 chSeq1+scoG2 = pl $ line $ map guitarChord2 chSeq2+scoG3 = pppl $ line $ map guitarChord3 chSeq3+++scoG2intro = slice (3*30/8) (4*30/8) scoG2++intro = chord [scoG1, scoG3, delay (3*30/8) scoG2intro]+chords = loop 3 $ chord [scoG1, scoG2, scoG3] ++sco = bpm (presto 0.4) $ guitar $ intro +:+ chords++file = "out.csd"+flags = "-d"++out = csd flags headerMono $ renderScore sco++main = writeFile file $ show out+--main = play "totem" "tmp" "new" out+
+ examples/choral.hs view
@@ -0,0 +1,248 @@+-- J.S. Bach - Choral prelude F-moll 'Ich ruf zu dir Herr Jesu Christ'++import Temporal.Music.Notation+import Temporal.Music.Notation.Local.Western++import CsoundExpr(headerMono, csd, play) ++import Orchestra(pipeOrgan')++-- alto dynamics++up :: Double -> [Tone N12] -> Score NoteW+up x = dynamicRel [x, x + accDiap] . line . map sn ++down :: Double -> [Tone N12] -> Score NoteW+down x = dynamicRel [x + accDiap, x] . line . map sn ++upDown :: Double -> [Tone N12] -> Score NoteW+upDown x = dynamicRel [x, x + accDiap, x] . line . map sn ++downUp :: Double -> [Tone N12] -> Score NoteW+downUp x = dynamicRel [x, x-accDiap, x] . line . map sn ++flat :: Double -> [Tone N12] -> Score NoteW+flat x = accent x . line . map sn++accDiap = 0.5++--------------------------------------------------+-- solo++-- Part I++solo0 = qn $ high c++solo1 = line [+-- 1 bar+ qn ab, qn bb, den ab, sn g, den f, sn g,+-- 2 bar+ dynamicRel [0, 0.2, 0] $ line [line $ map sn [ab, bb, ab, bb],+ trill 3 (accent 0.2 $ tn $ high c) (tn bb), tn ab, tn bb], + high $ line [accent 0.2 $ qn $ c, den c, sn db, +-- 3 bar+ qn eb, tn db, stretch (1/4 - 3/32) $ wn c, + sn $ low bb, qn $ low ab, en $ low bb, en c] + ]++solo11 = high $ line [+ stretch (1/4 + 1/16) $ wn db, + line $ map tn [eb, f, eb, db], sn c, qn c, qn c]+++solo12 = high $ line [+ qn db, sn db,+ line $ map tn [eb, f, eb, db],sn c, qn c, qn eb]++ +soloI = line [solo0, reprise solo1 solo11 solo12]+++-- Part II++solo21 = high $ line [+-- 1 bar+ qn f, en eb, tn db, tn c, sn db,+ low $ line $ map en [high c, bb, ab, bb],+-- 2 bar+ qn c, qn c, qn $ low bb, qn $ low ab,+-- 3 bar+ low $ line [hn g, hn f, +-- 4 bar + qn ab, qn g, hn f]+ ]++solo22 = line [+-- 5 bar+ dhn eb, qn eb,+-- 6 bar+ qn ab, qn ab, qn bb, qn bb,+-- 7 bar + high $ line [dhn c, qn db],+-- 8 bar+ high $ qn c, qn bb, qn ab, den f, sn g,+-- 9 bar+ qn ab, qn g, qn f+ ]++soloII = solo21 +:+ solo22++solo = pedal (1/128) $ ppl $ soloI +:+ soloII++---------------------------------------------------+-- alto++-- Part I++alto0 = high $ up 0 [low ab, c, f, e] ++alto1 = line [+-- 1 bar+ high $ down 0.5 [f, c, low ab, low f], + upDown 0 [g, bb, high db, high c],+ upDown 0 [f, ab, high c, bb],+ downUp 0 [ab, f, ab, high c],++-- 2 bar+ high $ downUp 0.2 [f, e, f, ab],+ high $ down 0 [g, f, e, f],+ high $ downUp 0 [e, c, low g, low bb, low ab, c, f, ab],++-- 3 bar+ high $ flat 0 [g, eb, ab, g],+ high $ up 0 [ab, eb, f, gb, f, db, f, ab, g, db, c, gb]+ ] ++alto11 = high $ line [+ upDown 0 [f, low bb, db, f, bb, ab, g, ab, g, c, e, low bb],+ upDown 0 [low f, c, f, e]+ ]++alto12 = high $ line [+ upDown 0 [f, low bb, db, f, bb, ab, g, ab],+ down 0 [g, low bb, low ab, f, low g, db, low ab, c]+ ]++ +altoI = line [alto0, reprise alto1 alto11 alto12]++-- Part II++alto21 = high $ line [+-- 1 bar+ upDown 0 [+ low ab, c, low bb, db, low bb, db, ab, g, + ab, eb, db, g, c, f, ab, g],+-- 2 bar+ down (-accDiap) [+ ab, eb, low ab, gb, f, low ab, low g, db, + c, low ab, c, eb, g, c, low bb, g,+-- 3 bar + db, f, g, f],+ up (-accDiap) [+ e, low bb, db, c,+ low ab, c, f, e, f, c, low ab, low f],+-- 4 bar+ flat 0 [+ low bb, f, g, f, low bb, eb, f, eb,+ c, eb, f, eb, d, low g, low b, d+ ]+ ]++alto22 = high $ line [+-- 5 bar+ down (-accDiap) $ [+ low g, c, eb, db, low g, low bb, db, c] +++ map low [eb, ab, high c, bb, high db, bb, c, high db,+-- 6 bar+ f, ab, high db, high c, f, ab, high c, bb, + f, ab, bb, ab, g, bb, high db, high c],++-- 7 bar+ up (-accDiap) [+ low ab, c, eb, ab, eb, bb, high c, bb,+ a, eb, gb, low a, low bb, g, low ab, f+ ],++-- 8 bar+ down (-accDiap) [+ low ab, eb, d, eb, low f, db, eb, db, + low eb, c, db, c, low bb, f, g, f,+-- 9 bar+ d, f, g, f, e, db, low bb, low g, + low a, c]++ ]++alto23 = en $ high f++altoII = line [alto21, alto22, alto23]++alto = pedal (1/132) $ lower 3 $ pl $ line [altoI, altoII]+++----------------------------------------------------------+-- bass ++-- Part I++bass0 = lower 1 $ line [en f, en f]++bass1 = (line $ map en [+-- 1 bar+ f, f, f, e, f, f, f, eb,+-- 2 bar+ db, db, db, db, c, c, f, f]) +:++-- 3 bar+ (high $ line $ map en [c, c, c, c, c, c, low bb, low a])++bass11 = line $ map en [bb, ab, g, f, e, c, low f, low f]++bass12 = line $ map en [bb, ab, g, f, e, f, c, c]++bassI = line [bass0, reprise bass1 bass11 bass12]+++-- Part II++bass21 = line $ map en [+-- 1 bar+ db, db, eb, eb, ab, eb, f, db,+-- 2 bar+ low f, low f, f, f, d, e, f, db,+-- 3 bar+ low bb, low g, c, c, db, db, db , db,+-- 4 bar+ d, d, d, d, low a, low a, low b, low b+ ] + +bass22 = low $ line $ map en [+-- 5 bar+ high c, high c, bb, bb, ab, ab, g, g,+-- 6 bar+ f, f, eb, eb, d, d, eb, eb, +-- 7 bar+ ab, ab, gb, gb, f, f, bb, bb,+-- 8 bar+ bb, ab, ab, g, g, f, high db, high db,+-- 9 bar+ b, b, high c, high c+ ]++bass23 = qn $ low f++ +bassII = line [bass21, bass22, bass23]++bass = lower 3 $ line [bassI, bassII]++sco = delay (-4) $ bpm (lento $ -0.5) $ pipeOrgan' $ chord [solo, alto, bass]++file = "out.csd"+flags = "-d"++out = csd flags headerMono $ renderScore sco++main = writeFile file $ show out+--main = play "totem" "tmp" "new" out+
+ examples/dm.hs view
@@ -0,0 +1,29 @@+-- D minor chord++import CsoundExpr.Base+import qualified CsoundExpr.Opcodes as C++import Temporal.Music.Notation+import Temporal.Music.Notation.Local.Western ++-- | sinusoidal oscilator+instr :: Irate -> SignalOut+instr cps = C.out $ C.oscilA [] (num 3000) cps (gen10 4096 [1])++-- | pythagorean scale from middle C+scale = pyth 0 c1++-- | d minor chord+sco = fmap (instr . double . frequency scale) $+ line notes +:+ (stretch 2 $ chord notes)+ where notes = map (note 1) [d, f, a, high d]++file = "out.csd"+flags = "-d"++out = csd flags headerMono $ renderScore sco++main = writeFile file $ show out+--main = play "totem" "tmp" "new" out++
+ examples/teardrop.hs view
@@ -0,0 +1,41 @@+-- massive attack - teardrop (intro)++import CsoundExpr.Base+import qualified CsoundExpr.Opcodes as C++import Temporal.Music.Notation+import Temporal.Music.Notation.Local.Western ++import Orchestra(pipeOrgan', openHiHat', bassDrum', guitar)++scoBassDrum = low $ line [en c, qn c, en c, accent 0.5 $ hn f]+scoHiHat = line [hnr, dim 3 $ loop 4 $ ed 0]++scoDrums = loop 20 $ chord [+ bassDrum' $ fl scoBassDrum,+ openHiHat' $ pl scoHiHat ]+++scoGuitar = sustain (1/16) $ guitar $ + dynamicRel [0, 2, 4, 4, 2] $+ loop 4 $ + ppl $ high $ line [qnr, line $ map qn + [low a, e, low a, d, low a, d, e]] ++scoOrgan = pipeOrgan' $ chord [q, low q]+ where q = loop 2 $ lower 3 $ line $ map bn [a, g, d, low a]++sco = bpm (moderato 0.7) $ chord [+ delay 10 $ scoGuitar,+ scoDrums,+ delay 2 $ scoOrgan,+ rest 0]++file = "out.csd"+flags = "-d"++out = csd flags headerMono $ renderScore sco++main = writeFile file $ show out+--main = play "totem" "tmp" "new" out+
+ src/Temporal/Music/Notation.hs view
@@ -0,0 +1,55 @@+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 TypeLevel.NaturalNumber+)+where++import Temporal.Music.Notation.Volume+import Temporal.Music.Notation.Pitch+import Temporal.Music.Notation.Score++import TypeLevel.NaturalNumber+
+ src/Temporal/Music/Notation/Local/Scales.hs view
@@ -0,0 +1,242 @@+-- | 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
@@ -0,0 +1,205 @@+{-# 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 TypeLevel.NaturalNumber(NaturalNumber)++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)++-- Note++-- | Value of type 'Note' contains pitch, volume and some specific +-- timbre information.+data (NaturalNumber nVol, NaturalNumber nPch) + => Note nVol nPch = Note+ { noteVolume :: Volume nVol+ , notePitch :: Pitch nPch+ } 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 (NaturalNumber nVol, NaturalNumber nPch)+ => LevelFunctor (Note nVol nPch) where+ mapLevel f (Note v p) = Note (mapLevel f v) p++-- 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 (NaturalNumber nVol, NaturalNumber nPch)+ => ToneFunctor (Note nVol nPch) where+ mapTone f (Note v p) = Note v (mapTone f p)++-- | calculates 'absVolume' and 'absPitch' on notes+absNote :: (NaturalNumber nVol, NaturalNumber nPch) + => Note nVol nPch -> (Amplitude, Frequency)+absNote (Note v p) = (absVolume v, absPitch p)++-- Drum++-- | Value of type 'Drum' is just 'Volume'.+type Drum n = Volume n++-- | synonym for 'absVolume'+absDrum :: (NaturalNumber nVol) + => Drum nVol -> Amplitude+absDrum = absVolume++-- 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)++bn, wn, hn, en, sn, tn, dbn, dwn, dhn, den, dsn, dtn :: + (NaturalNumber nVol, NaturalNumber nPch) + => Tone nPch -> Score (Note nVol nPch)++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 :: (NaturalNumber nVol) + => Dur -> Accent -> Score (Drum nVol)+d dt a = note dt $ setAccent a defaultVolume++-- | brevis note rest+bd, wd, hd, ed, sd, td, dbd, dwd, dhd, ded, dsd, dtd :: + (NaturalNumber nVol) + => Accent -> Score (Drum nVol)++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+
+ src/Temporal/Music/Notation/Pitch.hs view
@@ -0,0 +1,342 @@+{-# 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,+ Pitch(..), etPitch,+ Interval, Scale(..), scaleSize, fromIntervals,+ Bend, Octave, Step, + Tone(..), tone, toneNum,+ -- * Transformers+ -- ** Pitch + PchFunctor(..),+ -- ** Scale + ScaleFunctor(..), setScale, mapBase, setBase, transposeScale,+ -- ** Tone+ ToneFunctor(..), + setBend, bend, step, low, high, 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)++type Frequency = Double++-- | middle C (261.626 Hz)+c1 :: Frequency+c1 = 261.626 ++-- | middle A (440 Hz)+a1 :: Frequency+a1 = 440++-- | 'Pitch' consists of 'Scale' and 'Tone'+data NaturalNumber n => Pitch n = Pitch + { pitchScale :: Scale n+ , 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++-- | 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 NaturalNumber n => Scale n = 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 :: NaturalNumber n => Scale n -> Int+scaleSize = naturalNumberAsInt . num+ where num :: NaturalNumber n => Scale n -> n+ num = const undefined++-- | 'fromIntervals' makes scale constructor from 'octave' interval and+-- scale step intervals.+fromIntervals :: NaturalNumber n + => Interval -> [Interval]+ -> (Int -> Frequency -> Scale n)+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 NaturalNumber n => Tone n = Tone+ { toneBend :: Bend + , toneOctave :: Octave + , toneStep :: Step+ } 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++-- | '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+ num = const undefined++-- instances++instance NaturalNumber n => Ord (Tone n) where+ compare = compare `on` (\(Tone b o s) -> (o, s, b))++instance NaturalNumber n => Enum (Tone n) where+ toEnum = tone+ fromEnum x = toneOctave x * toneNum x + toneStep x+ +instance NaturalNumber n => Num (Tone n) where+ (+) = liftBi (+) (+)+ (-) = liftBi (-) (-)+ (*) = liftBi (*) (*)++ abs = liftOne abs abs+ signum t@(Tone b o s)+ | abs b < 1e-6 && o == 0 && s == 0 = 0+ | t > 0 = tone 1+ | otherwise = tone $ -1++ fromInteger = tone . fromInteger++-------------------------------------------------------------------+-------------------------------------------------------------------+-- Transformers++-- Pitch++class PchFunctor a where+ mapPch :: (forall n . NaturalNumber n => Pitch n -> Pitch n) -> (a -> a)+ +instance NaturalNumber n => PchFunctor (Pitch n) where+ mapPch f = f++instance (PchFunctor a) => PchFunctor (Score a) where+ mapPch f = fmap (mapPch 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++-- | setting specific scale+setScale :: (NaturalNumber n, ScaleFunctor a) => Scale n -> a -> a+setScale x = mapScale $ + \s -> s{ scaleBase = scaleBase x, scaleSteps = scaleSteps x }++-- | mapping of scale base tone +mapBase :: ScaleFunctor 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 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 :: ScaleFunctor 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 . NaturalNumber n => Tone n -> Tone n) -> (a -> a)++instance NaturalNumber 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+ 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 (tone n + )++-- | one octave lower+low :: ToneFunctor a => a -> a+low = lower 1++-- | one octave higher+high :: ToneFunctor a => a -> a+high = higher 1++-- | 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+ q = if c <= s+ then (2 * c + n - s)+ else (2 * c - n - s)+ (o', s') = divMod q n+ in Tone b (o + o') s'+++-----------------------------------------------------------+-- rendering++-- | pitch to frequency conversion+absPitch :: NaturalNumber 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+++bendCoeff :: NaturalNumber n => Bend -> Step -> Scale n -> 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 + +loginterpCoeff :: (Double, Double) -> Double -> Double+loginterpCoeff (l, r) x = (r / l) ** x+++-- tone manipulation++liftOne :: NaturalNumber n + => (Double -> Double) -> (Int -> Int) + -> Tone n -> Tone n+liftOne f g (Tone b o s) = fit $ Tone (f b) (g o) (g s)++liftBi :: NaturalNumber n + => (Double -> Double -> Double) -> (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')++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
+ src/Temporal/Music/Notation/Score.hs view
@@ -0,0 +1,224 @@+{-# 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, + -- * Rendering+ renderScore, + -- * Miscellaneous+ tmapRel, dmapRel, tdmapRel,+ linseg+)+where++import qualified Temporal.Media as M+import Temporal.Media(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+++-- | 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 -> M.EventList Dur a+renderScore = M.renderMedia
+ src/Temporal/Music/Notation/Volume.hs view
@@ -0,0 +1,236 @@+{-# 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,+ Volume(..), Level(..),+ volumeNum, levelNum,+ level, mediumLevel,+ -- * Transformers+ VolFunctor(..), LevelFunctor(..),+ setDiapason, setLevel, setAccent,+ accent,+ loud, quiet, louder, quieter,+ dynamic, dynamicRel,+ -- * Rendering+ amplitude, unsafeAmplitude, + absVolume, unsafeAbsVolume+)+where++import Data.Function(on)+import TypeLevel.NaturalNumber+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++-- | 'Volume' consists of 'Diapason' and 'Level'.+data NaturalNumber 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)++instance NaturalNumber n => VolFunctor (Volume n) where+ mapVol f = f++instance VolFunctor a => VolFunctor (Score a) where+ mapVol f = fmap (mapVol f)++instance NaturalNumber 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+--------------------------------------------------+--------------------------------------------------+-- Level++-- | '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+ { levelAccent :: Accent+ , levelStep :: Int+ } deriving (Show, Eq)++-- | number of levels in 'Volume' scale+volumeNum :: NaturalNumber n => Volume n -> Int+volumeNum = phantomNum++-- | number of levels in 'Level' scale+levelNum :: NaturalNumber n => Level n -> Int+levelNum = phantomNum++phantomNum :: NaturalNumber n => f n -> Int+phantomNum = naturalNumberAsInt . 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++-------------------------------------------+-- 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 NaturalNumber n => Num (Level n) where+ (+) = liftBi (+) (+)+ (-) = liftBi (-) (-)+ (*) = liftBi (*) (*)+ abs = id+ signum x+ | x == level 0 = 0+ | otherwise = 1+ fromInteger = level . fromInteger++--------------------------------------+-- transformers++class LevelFunctor a where+ mapLevel :: (forall n . NaturalNumber n => Level n -> Level n) -> (a -> a)++instance NaturalNumber 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++-- | '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 n = mapLevel + (\l@(Level a _) -> Level a $ sat 0 (levelNum l) 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 ( + level n)+ | n < 0 = mapLevel (\x -> x - level n)+++-- | Medium level+mediumLevel :: NaturalNumber n => Level n+mediumLevel = res+ where res = level $ 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)++-- | Linear relative 'dynamic' 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.+dynamicRel :: LevelFunctor a => [Accent] -> Score a -> Score a+dynamicRel xs = dynamic $ linseg $ init $ f =<< xs+ where dt = recip $ fromIntegral $ length xs+ f x = [x, dt]++--------------------------------------------------+-- rendering++-- | converts volume to amplitude with 'amplitude' function+absVolume :: NaturalNumber 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 (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 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 = amplitudeGen id++amplitudeGen :: NaturalNumber 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+++--------------------------------------+-- level manipulation++liftBi :: NaturalNumber 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')++sat :: Ord a => a -> a -> a -> a+sat low high x+ | x < low = low+ | x > high = high+ | otherwise = x
+ temporal-music-notation.cabal view
@@ -0,0 +1,37 @@+Name: temporal-music-notation+Version: 0.1+Cabal-Version: >= 1.2+License-file: LICENSE+License: BSD3+Author: Anton Kholomiov+Maintainer: Anton Kholomiov+Synopsis: music notation+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+Build-Type: Simple++Extra-Source-Files:+ examples/Readme.hs + examples/dm.hs + examples/arpeggi.hs + examples/choral.hs + examples/teardrop.hs + examples/Orchestra.hs ++Library+ Build-Depends:+ base >= 4, base < 5,+ vector, + temporal-media >= 0.2,+ type-level-natural-number, + type-level-natural-number-operations+ 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.Local.Scales