forked from donya/Kulitta
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathPostProc.lhs
133 lines (87 loc) · 3.85 KB
/
PostProc.lhs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Post Processing Module to Link Grammar with OPTIC Functions
Donya Quick and Paul Hudak
Last modified: 19-Dec-2014
For paper: Grammar-Based Automated Music Composition in Haskell
Post processing module to turn Terms into music using Euterpea.
> module PostProc where
> import EuterpeaSpecial
> import PTGG
> import MusicGrammars
> import ChordSpaces
> import Data.List
> import System.Random
Intermediate types:
(NOTE: AbsPitch = PitchNum)
> type Key = (AbsPitch, Mode)
> type RChord = (Key, Dur, CType)
> type TChord = (Key, Dur, AbsChord)
> type TNote = (Key, Dur, AbsPitch)
> type Voice = [TNote]
Accessing the members of a TNote:
> tnK (k,d,p) = k
> tnD (k,d,p) = d
> tnP (k,d,p) = p
> newP (k,d,p) p' = (k,d,p')
The goal using these intermediate types is the following:
INPUT STEP OUTPUT FUNCTION
Seeds -----(grammar)-------> Sentence gen
Sentence --(mode info)-----> [TChord] toAbsChords
[TChord] ------------------> [Voice] toVoices
[Voice] -------------------> Music Pitch vsToMusic or vsToMusicI
> unTerm :: [Term a MP] -> [(Key, Dur, a)]
> unTerm = map (\(a,mp) -> ((key mp, mode mp), dur mp, a)) . toPairs . expand []
> toChords :: [Term CType MP] -> [RChord]
> toChords = unTerm
> toAbsChords :: [Term CType MP] -> [TChord]
> toAbsChords ts = map toAbsChord $ toChords ts
> toAbsChord :: RChord -> TChord
> toAbsChord ((k,m),d,c) = ((k,m), d, t k $ toAs c m)
We also provide an alternate version that doesn't use diminished chords.
> toAbsChordNoDim :: RChord -> TChord
> toAbsChordNoDim ((k,m),d,c) = ((k,m), d, t k $ toAsNoDim c m)
> toAbsChordsNoDim :: [Term CType MP] -> [TChord]
> toAbsChordsNoDim ts = map toAbsChordNoDim $ toChords ts
Conversion of a single chord to a mode rooted at zero:
> toAs :: CType -> Mode -> [AbsPitch]
> toAs ct m =
> let s = getScale m ++ map (+12) s -- fininite scale
> i = head $ findIndices (==ct) [I, II, III, IV, V, VI, VII] -- can be updated w/enum
> in map (s !!) $ map (+i) [0,2,4]
> toAsNoDim :: CType -> Mode -> [AbsPitch]
> toAsNoDim ct m =
> let s = getScale m ++ map (+12) s -- fininite scale
> i = head $ findIndices (==ct) [I, II, III, IV, V, VI, VII] -- can be updated w/enum
> in map (s !!) $ fixDim $ map (+i) [0,2,4] where
> fixDim x = if optEq x [0,3,6] then t (head x) [0,3,7] else x
Transposition using a key (to avoid C-major assignment only):
> atTrans :: AbsPitch -> [(Key, Dur, AbsChord)] -> [(Key, Dur, AbsChord)]
> atTrans a = map (\((k,m),d,c) -> (((k+a) `mod` 12,m), d, t a c))
map (\((k,m),d,c) -> ((fixK k a m,m),d, t (a `mod` 12) c))
The toCords functon does a similar thing, but returns a CType and
its key/mode context without performing the conversion to AbsChord.
> ctTrans :: AbsPitch -> [(Key, Dur, CType)] -> [(Key, Dur, CType)]
> ctTrans a = map (\((k,m),d,c) -> (((k+a) `mod` 12,m),d,c))
map (\((k,m),d,c) -> ((fixK k a m,m),d,c))
> fixK k a Major = (k + a) `mod` 12
> fixK k a Minor = ((k + a) `mod` 12) + 12
Conversion of intermediate type to Music Pitch:
> tChordsToMusic :: [TChord] -> Music Pitch
> tChordsToMusic = line . map f where
> f ((k,m),d, as) = chord $ map (\a -> note d (pitch a)) as
============ SPLITTING VOICES APART ===========
The code here places TChords into a form more suitable
for additional musical processing. A Voice is a list of
pitches with duration and key/mode context.
> toVoices :: [TChord] -> [Voice]
> toVoices ts =
> let (ks,ds,ps) = unzip3 ts
> in map (\v -> zip3 ks ds v) $ Data.List.transpose ps
> toNotes :: Voice -> Music Pitch
> toNotes = line . map (\(k,d,p) -> note' d p) where
> note' d p = if p<0 then rest d else note d (pitch p)
> vsToMusic :: [Voice] -> Music Pitch
> vsToMusic =
> chord . map toNotes
> vsToMusicI :: [InstrumentName] -> [Voice] -> Music Pitch
> vsToMusicI is =
> chord . zipWith (\i m -> instrument i m) is . map toNotes