Fusic/Program.fs at master · TheoTr/Fusic · GitHub

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
type note =
    | C
    | Db // C#
    | D
    | Eb // D#
    | E
    | F
    | Gb // F#
    | G
    | Ab // G#
    | A
    | Bb // A#
    | B

type Interval = note -> note

let semitone : Interval =
    function
    | C -> Db
    | Db -> D
    | D -> Eb
    | Eb -> E
    | E -> F
    | F -> Gb
    | Gb -> G
    | G -> Ab
    | Ab -> A
    | A -> Bb
    | Bb -> B
    | B -> C

let tone : Interval =
    function
    | C -> D
    | Db -> Eb
    | D -> E
    | Eb -> F
    | E -> Gb
    | F -> G
    | Gb -> Ab
    | G -> A
    | Ab -> Bb
    | A -> B
    | Bb -> C
    | B -> Db

type triad =
    | I of note
    | II of note
    | III of note
    | IV of note
    | V of note
    | VI of note
    | VII of note

let major = [ tone; tone; semitone; tone; tone; tone; semitone ]

let chord (scale : triad list) =
    match scale with
    | [ I tonic; II _; III mediant; IV _; V dominant; VI _; VII _; I _ ] ->
        [ tonic; mediant; dominant ]
    | _ -> []

let scale (intervals : Interval list) (tonic : note) =
    intervals
    |> List.fold (fun notes interval ->
           notes @ [ (match (List.last notes) with
                      | I tonic -> II(interval tonic)
                      | II supertonic -> III(interval supertonic)
                      | III mediant -> IV(interval mediant)
                      | IV subdominant -> V(interval subdominant)
                      | V dominant -> VI(interval dominant)
                      | VI submediant -> VII(interval submediant)
                      | VII leadingTone -> I(interval leadingTone)) ])
           [ I tonic ]

let noteFromString =
    function
    | "C" -> Some C
    | "C#" | "Db" -> Some Db
    | "D" -> Some D
    | "D#" | "Eb" -> Some Eb
    | "E" -> Some E
    | "F" -> Some F
    | "F#" | "Gb" -> Some Gb
    | "G" -> Some G
    | "G#" | "Ab" -> Some Ab
    | "A" -> Some A
    | "A#" | "Bb" -> Some Bb
    | "B" -> Some B
    | _ -> None

[<EntryPoint>]
let main args =
    let input = args.[0]
    let note = input |> noteFromString
    match note with
    | Some note ->
        let scale = scale major note
        let chord = chord scale
        printfn "Scale: %A\nChord: %A" scale chord
    | None -> printf "Note %s not recognized" input
    0