調 (Key)

2003/3/16 平野拓一（東京工業大学）
Takuichi Hirano (Tokyo Institute of Technology)

Define Rotate Function

長音階 (major scale)

PrintNoteInterval[WHToneNoteList_]:=Module[{},
  
\(gnotelis = 
                Table[{{AbsoluteThickness[2], 
                      Line[{{\((i - 1)\) - 1/2, \(-1\)/2}, {\((i - 1)\) + 
                              1/2, \(-1\)/2}, {\((i - 1)\) + 1/2, 
                            1/2}, {\((i - 1)\) - 1/2, 
                            1/2}, {\((i - 1)\) - 1/2, \(-1\)/
                              2}}]}, 
Text[
                      StyleForm[WHToneNoteList[\([1, i]\)], 
                        FontSize -> 14, 
                        FontWeight -> "Bold"], {i - 1, 0}, {0, 
                        0}, {1, 0}]}, {i, 1, 
                    Length[WHToneNoteList[\([2]\)]]}]; 
gintervallis = 
                Table[Text[
                    StyleForm[WHToneNoteList[\([2, i]\)], 
                      FontSize -> 14, 
                      FontWeight -> "Bold"], {i - 1 + 1/2, 1}, {0, 
                      0}, {1, 0}], {i, 1, 
                    Length[WHToneNoteList[\([1]\)]]}]; 
Show[
                Graphics[{gnotelis, 
                    gintervallis}], 
PlotRange -> 
                  All, 
AspectRatio -> Automatic]\)
];

ApplySharp[Note_]:=Module[{},
  
\(If[
              StringTake[
                  Note, \(-1\)] == "♭", 
StringTake[
                Note, {1, 
                  StringLength[Note] - 
                    1}], 
Note\  <> \ "♯"
]\)
];
ApplyFlat[Note_]:=Module[{},
  
\(If[
                StringTake[
                    Note, \(-1\)] == "♯", 
StringTake[
                  Note, {1, 
                    StringLength[Note] - 
                      1}], 
Note\  <> \ "♭"
]\)
];

ApplySharpInScale[NoteWHToneList_, n_]:=Module[{lis = NoteWHToneList},
  
lis = 
              ReplacePart[lis, 
                ApplySharp[lis[[1, n]] ], {1, 
                  n}]; 
lis = 
              ReplacePart[lis, 
                lis[[2, n - 1]] + 1, {2, 
                  n - 1}]; 
lis = 
              ReplacePart[lis, 
                lis[[2, n]] - 1, {2, n}]; 
lis
];
ApplyFlatInScale[NoteWHToneList_, n_]:=Module[{lis = NoteWHToneList},
  
lis = 
                ReplacePart[lis, 
                  ApplyFlat[lis[[1, n]] ], {1, 
                    n}]; 
lis = 
                ReplacePart[lis, 
                  lis[[2, n - 1]] - 1, {2, 
                    n - 1}]; 
lis = 
                ReplacePart[lis, 
                  lis[[2, n]] + 1, {2, n}]; 
lis
];

\(NextSharpMajorScale[
          NoteWHToneList_] := 
        Module[{}, 
LisInitial = {RotateLeft[
                NoteWHToneList[\([1]\)], 4], 
              RotateLeft[NoteWHToneList[\([2]\)], 
                4]}; 
Print["**** Initial After RotateLeft[*,4] ****"]; 
PrintNoteInterval[
            LisInitial]; 

Print["**** Modified Major Scale ****"]; 
LisModified = 
            LisInitial; 
Print["Key: ", 
            LisModified[\([1, 
                1]\)], " Major"]; 

LisModified = 
            ApplySharpInScale[LisModified, 
              7]; 

PrintNoteInterval[
            LisModified]; 

LisModified];\)
\(NextFlatMajorScale[NoteWHToneList_] := 
        Module[{}, 
LisInitial = {RotateRight[
                NoteWHToneList[\([1]\)], 4], 
              RotateRight[NoteWHToneList[\([2]\)], 
                4]}; 
Print["**** Initial After RotateRight[*,4] ****"]; 
PrintNoteInterval[
            LisInitial]; 

Print["**** Modified Major Scale ****"]; 
LisModified = 
            LisInitial; 
Print["Key: ", 
            LisModified[\([1, 
                1]\)], " Major"]; 

LisModified = 
            ApplyFlatInScale[LisModified, 
              4]; 

PrintNoteInterval[
            LisModified]; 

LisModified];\)

Sharp Major

Initial

\(\(WHToneNoteList = {{"C", "D", "E", "F", "G", "A", "B"}, {2, 2, 1, 2, 2, 2, 1}};\)\)
PrintNoteInterval[WHToneNoteList];

1 times

lis1 = NextSharpMajorScale[WHToneNoteList]

2 times

lis2 = NextSharpMajorScale[lis1]

3 times

lis3 = NextSharpMajorScale[lis2]

4 times

lis4 = NextSharpMajorScale[lis3]

5 times

lis5 = NextSharpMajorScale[lis4]

6 times

lis6 = NextSharpMajorScale[lis5]

7 times

lis7 = NextSharpMajorScale[lis6]

Flat Major

Initial

\(\(WHToneNoteList = {{"C", "D", "E", "F", "G", "A", "B"}, {2, 2, 1, 2, 2, 2, 1}};\)\)
PrintNoteInterval[WHToneNoteList];

1 times

lis1 = NextFlatMajorScale[WHToneNoteList]

2 times

lis2 = NextFlatMajorScale[lis1]

3 times

lis3 = NextFlatMajorScale[lis2]

4 times

lis4 = NextFlatMajorScale[lis3]

5 times

lis5 = NextFlatMajorScale[lis4]

6 times

lis6 = NextFlatMajorScale[lis5]

7 times

lis7 = NextFlatMajorScale[lis6]